From caa77f3b41a8efa27df1df4254cc4931c3b12289 Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Mon, 2 Oct 2023 13:08:05 +0200 Subject: [PATCH 01/12] feat: check exiatence instead of equality for colnames of imgData --- R/Validity.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/Validity.R b/R/Validity.R index 39dff8b..b0f135c 100644 --- a/R/Validity.R +++ b/R/Validity.R @@ -61,7 +61,7 @@ return(msg) nms <- c("sample_id", "image_id", "data", "scaleFactor") - if (!identical(nms, names(df))) + if (!all(nms %in% names(df))) msg <- c(msg, paste( "'imgData' field in 'int_metadata' should have columns:", paste(sQuote(nms), collapse = ", "))) From 3494ab6e5018fb300b653bff56575958dc41848c Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Fri, 6 Oct 2023 15:38:28 +0200 Subject: [PATCH 02/12] fix: bugs --- R/SpatialExperiment.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/SpatialExperiment.R b/R/SpatialExperiment.R index 9039d02..63cbaab 100644 --- a/R/SpatialExperiment.R +++ b/R/SpatialExperiment.R @@ -337,13 +337,14 @@ SpatialExperiment <- function(..., image_id <- sub("(.*)\\..*$", "\\1", basename(imageSources)) image_id <- paste0(sample_id, "_", image_id, seq_along(imageSources)) } else { - stopifnot(length(image_id) != length(imageSources)) + stopifnot(length(image_id) == length(imageSources)) } for (i in seq_along(imageSources)) { scaleFactor <- .get_scaleFactor(scaleFactors, imageSources[i]) spe <- addImg(spe, imageSource=imageSources[i], scaleFactor=scaleFactor, - sample_id=sample_id[i], image_id=image_id[i], load=loadImage) + sample_id=ifelse(length(sample_id) > 1, sample_id[i], sample_id), + image_id=image_id[i], load=loadImage) } } else { imgData(spe) <- NULL From fb65f569e110a4deaebadde46f75c8bd6a0e4a94 Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Fri, 6 Oct 2023 16:00:48 +0200 Subject: [PATCH 03/12] feat: user-defined columns for `imgData` --- DESCRIPTION | 1 + NAMESPACE | 2 + R/SpatialExperiment.R | 92 +++++++++++++++---- R/imgData-methods.R | 22 ++++- R/imgData-utils.R | 6 +- man/SpatialExperiment.Rd | 6 +- man/imgData-methods.Rd | 2 +- .../test_SpatialExperiment-validity.R | 46 ++++++++++ 8 files changed, 148 insertions(+), 29 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9c13ddb..06220de 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,6 +36,7 @@ Depends: SingleCellExperiment Imports: rjson, + purrr, grDevices, magick, utils, diff --git a/NAMESPACE b/NAMESPACE index cc67cab..9aefe8c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -97,6 +97,8 @@ importFrom(methods,as) importFrom(methods,callNextMethod) importFrom(methods,is) importFrom(methods,new) +importFrom(purrr,compact) +importFrom(purrr,discard) importFrom(rjson,fromJSON) importFrom(utils,.DollarNames) importFrom(utils,head) diff --git a/R/SpatialExperiment.R b/R/SpatialExperiment.R index 63cbaab..d3e1cee 100644 --- a/R/SpatialExperiment.R +++ b/R/SpatialExperiment.R @@ -13,8 +13,10 @@ #' addition, the class supports storage of spatial information via #' \code{\link{spatialCoords}} and storage of images via \code{\link{imgData}}. #' -#' @param ... Arguments passed to the \code{\link{SingleCellExperiment}} -#' constructor to fill the slots of the base class. +#' @param ... Arguments passed either to the \code{\link{SingleCellExperiment}} +#' constructor to fill the slots of the base class, or to +#' \code{\link{addImg}} for user-defined columns in \code{\link{imgData}} +#' (same length as \code{imageSources}). #' @param sample_id A \code{character} sample identifier, which matches the #' \code{sample_id} in \code{\link{imgData}}. The \code{sample_id} will also #' be stored in a new column in \code{\link{colData}}, if not already present. @@ -202,6 +204,7 @@ NULL #' @importFrom S4Vectors DataFrame #' @importFrom SingleCellExperiment SingleCellExperiment +#' @importFrom purrr discard compact #' @export SpatialExperiment <- function(..., sample_id="sample01", @@ -214,26 +217,56 @@ SpatialExperiment <- function(..., imgData=NULL, spatialDataNames=NULL, spatialData=NULL) { + + args <- list(...) + + # Get names of arguments for parent constructors. + p_arg_nms <- unlist(sapply( + c("SingleCellExperiment", "SummarizedExperiment"), + function(x) discard(names(formals(x)), function(y) y == "..."), + simplify = FALSE, + USE.NAMES = FALSE + )) - sce <- SingleCellExperiment(...) - spe <- .sce_to_spe(sce=sce, - sample_id=sample_id, - spatialCoordsNames=spatialCoordsNames, - spatialCoords=spatialCoords, - scaleFactors=scaleFactors, - imageSources=imageSources, - image_id=image_id, - loadImage=loadImage, - imgData=imgData, - spatialDataNames=spatialDataNames, - spatialData=spatialData) + # A list of arguments for parent constructors. + p_args <- compact(args[p_arg_nms]) + + # A list of user-defined arguments for `addImg`. + other_arg_nms <- discard(names(args), function(x) x %in% p_arg_nms) + other_args <- compact(args[other_arg_nms]) + + sce <- do.call( + SingleCellExperiment, + p_args + ) + spe <- do.call( + .sce_to_spe, + c( + list( + sce=sce, + sample_id=sample_id, + spatialCoordsNames=spatialCoordsNames, + spatialCoords=spatialCoords, + scaleFactors=scaleFactors, + imageSources=imageSources, + image_id=image_id, + loadImage=loadImage, + imgData=imgData, + spatialDataNames=spatialDataNames, + spatialData=spatialData + ), + other_args + ) + ) return(spe) } #' @importFrom methods new #' @importFrom S4Vectors DataFrame #' @importFrom SingleCellExperiment int_metadata<- -.sce_to_spe <- function(sce, +#' @importFrom purrr discard +.sce_to_spe <- function(..., + sce, sample_id="sample01", spatialCoordsNames=NULL, spatialCoords=NULL, @@ -333,6 +366,11 @@ SpatialExperiment <- function(..., stopifnot(imgData$sample_id %in% spe$sample_id) imgData(spe) <- imgData } else if (!is.null(imageSources) ){ + # Handle extra arguments. + args <- list(...) + arg_lens <- vapply(args, length, FUN.VALUE = integer(1), USE.NAMES = TRUE) + stopifnot(all(arg_lens == length(imageSources))) + if (is.null(image_id)) { image_id <- sub("(.*)\\..*$", "\\1", basename(imageSources)) image_id <- paste0(sample_id, "_", image_id, seq_along(imageSources)) @@ -340,11 +378,25 @@ SpatialExperiment <- function(..., stopifnot(length(image_id) == length(imageSources)) } for (i in seq_along(imageSources)) { - scaleFactor <- .get_scaleFactor(scaleFactors, imageSources[i]) - spe <- addImg(spe, - imageSource=imageSources[i], scaleFactor=scaleFactor, - sample_id=ifelse(length(sample_id) > 1, sample_id[i], sample_id), - image_id=image_id[i], load=loadImage) + scaleFactor <- ifelse( + length(scaleFactors) > 1 && is.numeric(scaleFactors), + scaleFactors[i], + .get_scaleFactor(scaleFactors, imageSources[i]) + ) + spe <- do.call( + addImg, + c( + list( + spe, + imageSource=imageSources[i], + scaleFactor=scaleFactor, + sample_id=ifelse(length(sample_id) > 1,sample_id[i], sample_id), + image_id=image_id[i], + load=loadImage + ), + lapply(args, `[`, i) + ) + ) } } else { imgData(spe) <- NULL diff --git a/R/imgData-methods.R b/R/imgData-methods.R index d3d4603..56c4935 100644 --- a/R/imgData-methods.R +++ b/R/imgData-methods.R @@ -142,7 +142,7 @@ setMethod("getImg", "SpatialExperiment", #' @rdname imgData-methods #' @export setMethod("addImg", "SpatialExperiment", - function(x, imageSource, scaleFactor, sample_id, image_id, load=TRUE) { + function(x, imageSource, scaleFactor, sample_id, image_id, load=TRUE, ...) { # check validity of input arguments stopifnot( is.numeric(scaleFactor), @@ -182,9 +182,23 @@ setMethod("addImg", "SpatialExperiment", " 'image_id = %s' and 'sample_id = %s'", dQuote(image_id), dQuote(sample_id))) - # get & add valid 'imgData' entry - df <- .get_imgData(imageSource, scaleFactor, sample_id, image_id, load) - imgData(x) <- rbind(imgData(x), df) + # current 'imgData' entry + img_data <- imgData(x) + + # get an 'imgData' entry + df <- .get_imgData(imageSource, scaleFactor, sample_id, image_id, load, ...) + + # sanity check: same columns for both 'imgData' + if (!is.null(img_data) && prod(dim(img_data)) > 0) { + stopifnot( + ncol(img_data) == ncol(df), + identical(sort(colnames(img_data)), sort(colnames(df))) + ) + } + + # add to 'imgData' entry + imgData(x) <- rbind(img_data, df) + return(x) }) diff --git a/R/imgData-utils.R b/R/imgData-utils.R index bb120bc..8da5da6 100644 --- a/R/imgData-utils.R +++ b/R/imgData-utils.R @@ -44,7 +44,7 @@ #' @importFrom grDevices as.raster #' @importFrom magick image_read #' @importFrom S4Vectors DataFrame -.get_imgData <- function(img, scaleFactor, sample_id, image_id, load=TRUE) { +.get_imgData <- function(img, scaleFactor, sample_id, image_id, load=TRUE, ...) { is_path <- tryCatch( error=function(e) e, .path_validity(img)) @@ -67,5 +67,7 @@ sample_id, image_id, data=I(list(spi)), - scaleFactor=scaleFactor) + scaleFactor=scaleFactor, + ... + ) } diff --git a/man/SpatialExperiment.Rd b/man/SpatialExperiment.Rd index 5348448..9f38010 100644 --- a/man/SpatialExperiment.Rd +++ b/man/SpatialExperiment.Rd @@ -6,8 +6,10 @@ \alias{SpatialExperiment} \title{The SpatialExperiment class} \arguments{ -\item{...}{Arguments passed to the \code{\link{SingleCellExperiment}} -constructor to fill the slots of the base class.} +\item{...}{Arguments passed either to the \code{\link{SingleCellExperiment}} +constructor to fill the slots of the base class, or to +\code{\link{addImg}} for user-defined columns in \code{\link{imgData}} +(same length as \code{imageSources}).} \item{sample_id}{A \code{character} sample identifier, which matches the \code{sample_id} in \code{\link{imgData}}. The \code{sample_id} will also diff --git a/man/imgData-methods.Rd b/man/imgData-methods.Rd index 46cd8d4..b376f9b 100644 --- a/man/imgData-methods.Rd +++ b/man/imgData-methods.Rd @@ -16,7 +16,7 @@ \usage{ \S4method{getImg}{SpatialExperiment}(x, sample_id = NULL, image_id = NULL) -\S4method{addImg}{SpatialExperiment}(x, imageSource, scaleFactor, sample_id, image_id, load = TRUE) +\S4method{addImg}{SpatialExperiment}(x, imageSource, scaleFactor, sample_id, image_id, load = TRUE, ...) \S4method{rmvImg}{SpatialExperiment}(x, sample_id = NULL, image_id = NULL) diff --git a/tests/testthat/test_SpatialExperiment-validity.R b/tests/testthat/test_SpatialExperiment-validity.R index 846990a..4d5d494 100644 --- a/tests/testthat/test_SpatialExperiment-validity.R +++ b/tests/testthat/test_SpatialExperiment-validity.R @@ -84,3 +84,49 @@ test_that("imgData", { int_metadata(spe)$imgData <- NULL expect_error(validObject(spe)) }) + +test_that("imgData_1", { + # initialize mock SPE + img <- system.file( + "extdata", "10xVisium", "section1", "outs", "spatial", + "tissue_lowres_image.png", package="SpatialExperiment") + spe <- SpatialExperiment( + assays=diag(n <- 10), + colData=DataFrame(a=seq(n)), + sample_id="foo", + imageSources=c(img, img), + image_id=c("bar_1", "bar_2"), + my_col_1=c("foo_bar_1", "foo_bar_2"), + my_col_2=c("bar_foo_1", "bar_foo_2") + ) + expect_true(validObject(spe)) + + # add another image with the same columns in `imgData` + tmp <- addImg(spe, + imageSource=img, + scaleFactor=1, + sample_id="foo", + image_id="bar_3", + load=FALSE, + my_col_2="bar_foo_3", + my_col_1="foo_bar_3" + ) + expect_true(validObject(tmp)) + + # add another image with different columns in `imgData` + expect_error(addImg(spe, + imageSource=img, + scaleFactor=1, + sample_id="foo", + image_id="bar_3", + load=FALSE, + my_col="bar_foo_3", # a new column that does not match the existing one + my_col_1="foo_bar_3" + )) + + # remove a required column (image_id) in `imgData` + tmp <- spe + img_data <- imgData(tmp) + img_data$image_id <- NULL + expect_error(imgData(tmp) <- img_data) +}) From 9f1978707f7fcafce3830f8ef1e4603d229b33f7 Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Fri, 6 Oct 2023 16:32:03 +0200 Subject: [PATCH 04/12] fix: bugs --- R/SpatialExperiment.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/SpatialExperiment.R b/R/SpatialExperiment.R index d3e1cee..fd2b216 100644 --- a/R/SpatialExperiment.R +++ b/R/SpatialExperiment.R @@ -265,8 +265,7 @@ SpatialExperiment <- function(..., #' @importFrom S4Vectors DataFrame #' @importFrom SingleCellExperiment int_metadata<- #' @importFrom purrr discard -.sce_to_spe <- function(..., - sce, +.sce_to_spe <- function(sce, sample_id="sample01", spatialCoordsNames=NULL, spatialCoords=NULL, @@ -276,7 +275,8 @@ SpatialExperiment <- function(..., loadImage=TRUE, imgData=NULL, spatialDataNames=NULL, - spatialData=NULL) { + spatialData=NULL, + ...) { old <- S4Vectors:::disableValidity() if (!isTRUE(old)) { From 4c54e1b59a5be3b39d5ed9bd073b0df508e11b96 Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Sun, 8 Oct 2023 11:38:31 +0200 Subject: [PATCH 05/12] doc: add doc for new arguments --- R/imgData-methods.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/imgData-methods.R b/R/imgData-methods.R index 56c4935..17dc256 100644 --- a/R/imgData-methods.R +++ b/R/imgData-methods.R @@ -48,6 +48,7 @@ #' returns the path to the image's cached file, and FALSE its URL. #' For \code{Stored/LoadedSpatialImage}s, a path/NA is returned, #' irrespective of \code{path}. +#' @param ... Arguments for user-defined columns in \code{\link{imgData}}. #' #' @return #' \code{getImg()} returns a single or list of \code{SpatialImage}(s). From 424d0c461f2643c264fb60a5832e95465767fc4b Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Sun, 8 Oct 2023 11:48:50 +0200 Subject: [PATCH 06/12] doc: add doc for new arguments --- man/imgData-methods.Rd | 2 ++ 1 file changed, 2 insertions(+) diff --git a/man/imgData-methods.Rd b/man/imgData-methods.Rd index b376f9b..11ca8b9 100644 --- a/man/imgData-methods.Rd +++ b/man/imgData-methods.Rd @@ -47,6 +47,8 @@ coordinates according to the image's resolution} loaded into memory as a \code{raster} object? if \code{FALSE}, will store the path/URL instead} +\item{...}{Arguments for user-defined columns in \code{\link{imgData}}.} + \item{path}{logical; for \code{RemoteSpatialImage}s, TRUE returns the path to the image's cached file, and FALSE its URL. For \code{Stored/LoadedSpatialImage}s, a path/NA is returned, From 15785b11bd2d596835cc3ec4bb9986fe43ca73b2 Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Thu, 14 Mar 2024 22:01:03 +0100 Subject: [PATCH 07/12] feat: remove additional dependencies --- DESCRIPTION | 2 +- NAMESPACE | 2 -- R/SpatialExperiment.R | 10 ++++------ man/SpatialExperiment-colData.Rd | 2 +- man/SpatialExperiment-methods.Rd | 10 +++++----- 5 files changed, 11 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 06220de..8dd8541 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,4 +52,4 @@ Suggests: BumpyMatrix, DropletUtils VignetteBuilder: knitr -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/NAMESPACE b/NAMESPACE index 9aefe8c..cc67cab 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -97,8 +97,6 @@ importFrom(methods,as) importFrom(methods,callNextMethod) importFrom(methods,is) importFrom(methods,new) -importFrom(purrr,compact) -importFrom(purrr,discard) importFrom(rjson,fromJSON) importFrom(utils,.DollarNames) importFrom(utils,head) diff --git a/R/SpatialExperiment.R b/R/SpatialExperiment.R index fd2b216..618eb93 100644 --- a/R/SpatialExperiment.R +++ b/R/SpatialExperiment.R @@ -204,7 +204,6 @@ NULL #' @importFrom S4Vectors DataFrame #' @importFrom SingleCellExperiment SingleCellExperiment -#' @importFrom purrr discard compact #' @export SpatialExperiment <- function(..., sample_id="sample01", @@ -223,17 +222,17 @@ SpatialExperiment <- function(..., # Get names of arguments for parent constructors. p_arg_nms <- unlist(sapply( c("SingleCellExperiment", "SummarizedExperiment"), - function(x) discard(names(formals(x)), function(y) y == "..."), + function(x) names(formals(x))[names(formals(x)) != "..."], simplify = FALSE, USE.NAMES = FALSE )) # A list of arguments for parent constructors. - p_args <- compact(args[p_arg_nms]) + p_args <- args[p_arg_nms][!sapply(args[p_arg_nms], is.null)] # A list of user-defined arguments for `addImg`. - other_arg_nms <- discard(names(args), function(x) x %in% p_arg_nms) - other_args <- compact(args[other_arg_nms]) + other_arg_nms <- names(args)[!(names(args) %in% p_arg_nms)] + other_args <- args[other_arg_nms][!sapply(args[other_arg_nms], is.null)] sce <- do.call( SingleCellExperiment, @@ -264,7 +263,6 @@ SpatialExperiment <- function(..., #' @importFrom methods new #' @importFrom S4Vectors DataFrame #' @importFrom SingleCellExperiment int_metadata<- -#' @importFrom purrr discard .sce_to_spe <- function(sce, sample_id="sample01", spatialCoordsNames=NULL, diff --git a/man/SpatialExperiment-colData.Rd b/man/SpatialExperiment-colData.Rd index b35c486..b406aec 100644 --- a/man/SpatialExperiment-colData.Rd +++ b/man/SpatialExperiment-colData.Rd @@ -10,7 +10,7 @@ \usage{ \S4method{colData}{SpatialExperiment,DataFrame}(x) <- value -\S4method{colData}{SpatialExperiment,`NULL`}(x) <- value +\S4method{colData}{SpatialExperiment,NULL}(x) <- value } \arguments{ \item{x}{a \code{\link{SpatialExperiment}}} diff --git a/man/SpatialExperiment-methods.Rd b/man/SpatialExperiment-methods.Rd index 965e3f9..129f0f3 100644 --- a/man/SpatialExperiment-methods.Rd +++ b/man/SpatialExperiment-methods.Rd @@ -36,25 +36,25 @@ \S4method{spatialData}{SpatialExperiment,DFrame}(x) <- value -\S4method{spatialData}{SpatialExperiment,`NULL`}(x) <- value +\S4method{spatialData}{SpatialExperiment,NULL}(x) <- value \S4method{spatialDataNames}{SpatialExperiment}(x) \S4method{spatialDataNames}{SpatialExperiment,character}(x) <- value -\S4method{spatialDataNames}{SpatialExperiment,`NULL`}(x) <- value +\S4method{spatialDataNames}{SpatialExperiment,NULL}(x) <- value \S4method{spatialCoords}{SpatialExperiment}(x) \S4method{spatialCoords}{SpatialExperiment,matrix}(x) <- value -\S4method{spatialCoords}{SpatialExperiment,`NULL`}(x) <- value +\S4method{spatialCoords}{SpatialExperiment,NULL}(x) <- value \S4method{spatialCoordsNames}{SpatialExperiment}(x) \S4method{spatialCoordsNames}{SpatialExperiment,character}(x) <- value -\S4method{spatialCoordsNames}{SpatialExperiment,`NULL`}(x) <- value +\S4method{spatialCoordsNames}{SpatialExperiment,NULL}(x) <- value \S4method{scaleFactors}{SpatialExperiment}(x, sample_id = TRUE, image_id = TRUE) @@ -64,7 +64,7 @@ \S4method{imgData}{SpatialExperiment,DataFrame}(x) <- value -\S4method{imgData}{SpatialExperiment,`NULL`}(x) <- value +\S4method{imgData}{SpatialExperiment,NULL}(x) <- value } \arguments{ \item{x}{A \code{\link{SpatialExperiment}} object.} From 9c030ef68102ee49e74ed833ffaa064d4a7401e9 Mon Sep 17 00:00:00 2001 From: Lukas Weber Date: Fri, 15 Mar 2024 14:03:42 -0400 Subject: [PATCH 08/12] remove purrr from Imports in DESCRIPTION --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8dd8541..fd13193 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,6 @@ Depends: SingleCellExperiment Imports: rjson, - purrr, grDevices, magick, utils, From db33b7b226a7ef70c8f7b0988cafd8ca7b655fc3 Mon Sep 17 00:00:00 2001 From: Lukas Weber Date: Fri, 15 Mar 2024 14:11:03 -0400 Subject: [PATCH 09/12] more consistent code formatting and style --- R/SpatialExperiment.R | 76 ++++++++++++++++++------------------------- R/imgData-methods.R | 9 +++-- 2 files changed, 36 insertions(+), 49 deletions(-) diff --git a/R/SpatialExperiment.R b/R/SpatialExperiment.R index 618eb93..7c4e974 100644 --- a/R/SpatialExperiment.R +++ b/R/SpatialExperiment.R @@ -221,42 +221,36 @@ SpatialExperiment <- function(..., # Get names of arguments for parent constructors. p_arg_nms <- unlist(sapply( - c("SingleCellExperiment", "SummarizedExperiment"), - function(x) names(formals(x))[names(formals(x)) != "..."], - simplify = FALSE, - USE.NAMES = FALSE + c("SingleCellExperiment", "SummarizedExperiment"), + function(x) names(formals(x))[names(formals(x)) != "..."], + simplify = FALSE, + USE.NAMES = FALSE )) # A list of arguments for parent constructors. p_args <- args[p_arg_nms][!sapply(args[p_arg_nms], is.null)] - # A list of user-defined arguments for `addImg`. + # A list of user-defined arguments for addImg(). other_arg_nms <- names(args)[!(names(args) %in% p_arg_nms)] other_args <- args[other_arg_nms][!sapply(args[other_arg_nms], is.null)] sce <- do.call( - SingleCellExperiment, - p_args - ) + SingleCellExperiment, + p_args) spe <- do.call( - .sce_to_spe, - c( - list( - sce=sce, - sample_id=sample_id, - spatialCoordsNames=spatialCoordsNames, - spatialCoords=spatialCoords, - scaleFactors=scaleFactors, - imageSources=imageSources, - image_id=image_id, - loadImage=loadImage, - imgData=imgData, - spatialDataNames=spatialDataNames, - spatialData=spatialData - ), - other_args - ) - ) + .sce_to_spe, + c(list(sce=sce, + sample_id=sample_id, + spatialCoordsNames=spatialCoordsNames, + spatialCoords=spatialCoords, + scaleFactors=scaleFactors, + imageSources=imageSources, + image_id=image_id, + loadImage=loadImage, + imgData=imgData, + spatialDataNames=spatialDataNames, + spatialData=spatialData), + other_args)) return(spe) } @@ -368,7 +362,7 @@ SpatialExperiment <- function(..., args <- list(...) arg_lens <- vapply(args, length, FUN.VALUE = integer(1), USE.NAMES = TRUE) stopifnot(all(arg_lens == length(imageSources))) - + if (is.null(image_id)) { image_id <- sub("(.*)\\..*$", "\\1", basename(imageSources)) image_id <- paste0(sample_id, "_", image_id, seq_along(imageSources)) @@ -377,24 +371,18 @@ SpatialExperiment <- function(..., } for (i in seq_along(imageSources)) { scaleFactor <- ifelse( - length(scaleFactors) > 1 && is.numeric(scaleFactors), - scaleFactors[i], - .get_scaleFactor(scaleFactors, imageSources[i]) - ) + length(scaleFactors) > 1 && is.numeric(scaleFactors), + scaleFactors[i], + .get_scaleFactor(scaleFactors, imageSources[i])) spe <- do.call( - addImg, - c( - list( - spe, - imageSource=imageSources[i], - scaleFactor=scaleFactor, - sample_id=ifelse(length(sample_id) > 1,sample_id[i], sample_id), - image_id=image_id[i], - load=loadImage - ), - lapply(args, `[`, i) - ) - ) + addImg, + c(list(spe, + imageSource=imageSources[i], + scaleFactor=scaleFactor, + sample_id=ifelse(length(sample_id) > 1,sample_id[i], sample_id), + image_id=image_id[i], + load=loadImage), + lapply(args, `[`, i))) } } else { imgData(spe) <- NULL diff --git a/R/imgData-methods.R b/R/imgData-methods.R index 17dc256..4502527 100644 --- a/R/imgData-methods.R +++ b/R/imgData-methods.R @@ -189,12 +189,11 @@ setMethod("addImg", "SpatialExperiment", # get an 'imgData' entry df <- .get_imgData(imageSource, scaleFactor, sample_id, image_id, load, ...) - # sanity check: same columns for both 'imgData' + # check: same columns for both 'imgData' entries if (!is.null(img_data) && prod(dim(img_data)) > 0) { - stopifnot( - ncol(img_data) == ncol(df), - identical(sort(colnames(img_data)), sort(colnames(df))) - ) + stopifnot( + ncol(img_data) == ncol(df), + identical(sort(colnames(img_data)), sort(colnames(df)))) } # add to 'imgData' entry From 13a3e96ec1dbfd58933aa3a93bfdd202112f6bf9 Mon Sep 17 00:00:00 2001 From: Lukas Weber Date: Fri, 15 Mar 2024 14:12:04 -0400 Subject: [PATCH 10/12] additional tests and tests formatting / naming for additional columns in imgData --- .../test_SpatialExperiment-validity.R | 68 +++++++++---------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/tests/testthat/test_SpatialExperiment-validity.R b/tests/testthat/test_SpatialExperiment-validity.R index 4d5d494..88e4f3c 100644 --- a/tests/testthat/test_SpatialExperiment-validity.R +++ b/tests/testthat/test_SpatialExperiment-validity.R @@ -85,48 +85,48 @@ test_that("imgData", { expect_error(validObject(spe)) }) -test_that("imgData_1", { +test_that("imgData additional columns", { # initialize mock SPE img <- system.file( - "extdata", "10xVisium", "section1", "outs", "spatial", - "tissue_lowres_image.png", package="SpatialExperiment") + "extdata", "10xVisium", "section1", "outs", "spatial", + "tissue_lowres_image.png", package="SpatialExperiment") spe <- SpatialExperiment( - assays=diag(n <- 10), - colData=DataFrame(a=seq(n)), - sample_id="foo", - imageSources=c(img, img), - image_id=c("bar_1", "bar_2"), - my_col_1=c("foo_bar_1", "foo_bar_2"), - my_col_2=c("bar_foo_1", "bar_foo_2") - ) + assays=diag(n <- 10), + colData=DataFrame(a=seq(n)), + sample_id="foo", + imageSources=c(img, img), + image_id=c("bar_1", "bar_2"), + my_col_1=c("foo_bar_1", "foo_bar_2"), + my_col_2=c("bar_foo_1", "bar_foo_2")) expect_true(validObject(spe)) + expect_equal(dim(imgData(spe)), c(2, 6)) - # add another image with the same columns in `imgData` - tmp <- addImg(spe, - imageSource=img, - scaleFactor=1, - sample_id="foo", - image_id="bar_3", - load=FALSE, - my_col_2="bar_foo_3", - my_col_1="foo_bar_3" - ) - expect_true(validObject(tmp)) + # add another image with the same columns in imgData + spe1 <- addImg(spe, + imageSource=img, + scaleFactor=1, + sample_id="foo", + image_id="bar_3", + load=FALSE, + my_col_1="foo_bar_3", + my_col_2="bar_foo_3") + expect_true(validObject(spe1)) + expect_equal(dim(imgData(spe1)), c(3, 6)) - # add another image with different columns in `imgData` + # add another image with different columns in imgData expect_error(addImg(spe, - imageSource=img, - scaleFactor=1, - sample_id="foo", - image_id="bar_3", - load=FALSE, - my_col="bar_foo_3", # a new column that does not match the existing one - my_col_1="foo_bar_3" + imageSource=img, + scaleFactor=1, + sample_id="foo", + image_id="bar_3", + load=FALSE, + my_col_1="foo_bar_3", + my_col="bar_foo_3" # new column that does not match existing ones )) - # remove a required column (image_id) in `imgData` - tmp <- spe - img_data <- imgData(tmp) + # remove a required column (image_id) in imgData + spe3 <- spe + img_data <- imgData(spe3) img_data$image_id <- NULL - expect_error(imgData(tmp) <- img_data) + expect_error(imgData(spe3) <- img_data) }) From 21deab15cdda84a47b960ff0474fde1da9f67a6f Mon Sep 17 00:00:00 2001 From: Lukas Weber Date: Fri, 15 Mar 2024 14:27:05 -0400 Subject: [PATCH 11/12] add NEWS --- inst/NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/inst/NEWS b/inst/NEWS index 977438f..e8da3a2 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,3 +1,6 @@ +changes in version 1.13.2 (2024-03-15) ++ enable adding additional columns in imgData + changes in version 1.11.2 (2023-09-01) + move DropletUtils package to Suggests From 067ec8a0e86f797f783c8a6c64703233b995e5c3 Mon Sep 17 00:00:00 2001 From: Senbai Kang Date: Wed, 20 Mar 2024 22:54:18 +0100 Subject: [PATCH 12/12] fix: added unit tests for additional arguments of the ctor --- tests/testthat/test_SpatialExperiment.R | 36 +++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/tests/testthat/test_SpatialExperiment.R b/tests/testthat/test_SpatialExperiment.R index b1554fc..bb85e20 100644 --- a/tests/testthat/test_SpatialExperiment.R +++ b/tests/testthat/test_SpatialExperiment.R @@ -163,3 +163,39 @@ test_that("deprecated spatialData/Names returns message", { expect_message(SpatialExperiment(colData = cd, spatialDataNames = names(cd))) }) +test_that("Additional arguments for the constructor of SpatialExperiment", { + img <- system.file( + "extdata", "10xVisium", "section1", "outs", "spatial", + "tissue_lowres_image.png", package="SpatialExperiment") + + # New columns named by any of "assays, rowData, rowRanges, colData, + # metadata, checkDimnames" do not go to imgData. + spe_1 <- SpatialExperiment( + assays=diag(n <- 10), + rowRanges=GRanges(rep("chr1", 10), IRanges(1, 100)), + colData=DataFrame(a=seq(n)), + metadata=list(), + checkDimnames=FALSE, + sample_id="foo", + imageSources=c(img, img), + image_id=c("bar_1", "bar_2")) + expect_false(any( + c("assays", "rowRanges", "colData", "metadata", "checkDimnames") %in% colnames(imgData(spe_1)) + )) + + spe_2 <- SpatialExperiment( + assays=diag(n <- 10), + rowData=DataFrame(a=seq(n)), + colData=DataFrame(b=seq(n)), + metadata=list(), + checkDimnames=FALSE, + sample_id="foo", + imageSources=c(img, img), + image_id=c("bar_1", "bar_2"), + my_col = c("foo_1", "foo_2")) + expect_false(any( + c("assays", "rowData", "colData", "metadata", "checkDimnames") %in% colnames(imgData(spe_2)) + )) + expect_true("my_col" %in% colnames(imgData(spe_2))) +}) +