diff --git a/R/SpatialExperiment.R b/R/SpatialExperiment.R index 6133742..e8c8460 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. @@ -220,19 +222,41 @@ 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) names(formals(x))[names(formals(x)) != "..."], + 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 <- args[p_arg_nms][!sapply(args[p_arg_nms], is.null)] + + # 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) + 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) } @@ -249,7 +273,8 @@ SpatialExperiment <- function(..., loadImage=TRUE, imgData=NULL, spatialDataNames=NULL, - spatialData=NULL) { + spatialData=NULL, + ...) { old <- S4Vectors:::disableValidity() if (!isTRUE(old)) { @@ -339,17 +364,31 @@ 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)) } 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) + 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/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 = ", "))) diff --git a/R/imgData-methods.R b/R/imgData-methods.R index 3a75045..f2d1ae7 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). @@ -142,7 +143,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 +183,22 @@ 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, ...) + + # 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)))) + } + + # 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 79e9e05..703a576 100644 --- a/R/imgData-utils.R +++ b/R/imgData-utils.R @@ -53,7 +53,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)) @@ -76,5 +76,7 @@ sample_id, image_id, data=I(list(spi)), - scaleFactor=scaleFactor) + scaleFactor=scaleFactor, + ... + ) } diff --git a/inst/NEWS b/inst/NEWS index a6b39de..7bcdca4 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -7,6 +7,9 @@ changes in version 1.15.1 (2024-06-20) changes in version 1.15.0 (2024-05-01) + Bioconductor 3.19 release +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 diff --git a/man/SpatialExperiment.Rd b/man/SpatialExperiment.Rd index b18e963..8f29eb9 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 81cb360..7211362 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) @@ -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, diff --git a/tests/testthat/test_SpatialExperiment-validity.R b/tests/testthat/test_SpatialExperiment-validity.R index 846990a..88e4f3c 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 additional columns", { + # 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)) + expect_equal(dim(imgData(spe)), c(2, 6)) + + # 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 + expect_error(addImg(spe, + 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 + spe3 <- spe + img_data <- imgData(spe3) + img_data$image_id <- NULL + expect_error(imgData(spe3) <- img_data) +}) diff --git a/tests/testthat/test_SpatialExperiment.R b/tests/testthat/test_SpatialExperiment.R index 8a34624..9a7f024 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))) +}) +