feat: check existence instead of equality for colnames of imgData

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

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 = ", ")))

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)
     })
 

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,
+        ...
+    )
 }

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
 

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)
+})

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)))
+})
+