combine() on (named) list

R/combine.R

@@ -17,43 +17,63 @@
 #' imageNames(y)
 #' region(table(y, 1))
 #' region(table(y, 2))
+#' 
+#' y <- combine(list(Alpha=x, x, Omega=x))
+#' shapeNames(y)
+#' 
+#' @importFrom BiocGenerics combine
 NULL
 
-#' @export
-#' @rdname combine
-#' @importFrom BiocGenerics combine
-setMethod("combine", c("SpatialData", "SpatialData"), \(x, y, ...) {
-    # ensure element names are unique across objects
-    old <- list(unlist(colnames(x)), unlist(colnames(y)))
-    idx <- rep.int(c(1, 2), lengths(old))
-    new <- split(make.unique(unlist(old)), idx)
-    for (i in c(1, 2)) {
-        # get input element names
-        z <- get(c("x", "y")[i])
-        old_nms <- unlist(colnames(z)[.ls])
-
-        # find new names for these elements
+.combine <- \(xs, old, new) {
+    for (i in seq_along(xs)) {
+        x <- xs[[i]]
+        # elements that might be referred to by tables (labels, shapes)
+        old_nms <- unlist(colnames(x)[.ls])
         j <- match(old_nms, old[[i]])
         new_nms <- new[[i]][j]
-
         # rename elements
         for (l in .ls) {
-            j <- match(names(z[[l]]), old[[i]])
-            names(z[[l]]) <- new[[i]][j]
+            j <- match(names(x[[l]]), old[[i]])
+            names(x[[l]]) <- new[[i]][j]
         }
         # sync tables
-        z <- .sync_tables_sdattrs(z, old_nms, new_nms)
-
+        x <- .sync_tables_sdattrs(x, old_nms, new_nms)
         # rename tables themselves
-        j <- match(tableNames(z), old[[i]])
-        tableNames(z) <- new[[i]][j]
-
-        assign(c("x", "y")[i], z)
+        j <- match(tableNames(x), old[[i]])
+        tableNames(x) <- new[[i]][j]
+        xs[[i]] <- x
     }
-    SpatialData(
-        images=c(x$images, y$images),
-        labels=c(x$labels, y$labels),
-        points=c(x$points, y$points),
-        shapes=c(x$shapes, y$shapes),
-        tables=c(x$tables, y$tables))
+    names(ls) <- ls <- .LAYERS
+    args <- lapply(ls, \(l) do.call(c, lapply(unname(xs), \(x) x[[l]])))
+    do.call(SpatialData, args)
+}
+
+#' @export
+#' @rdname combine
+setMethod("combine", c("list", "missing"), \(x, y, ...) {
+    # validate input
+    ok <- all(vapply(x, \(.) is(., "SpatialData"), logical(1)))
+    if (!ok) stop("'x' should be a list of 'SpatialData' objects")
+    # get current element names
+    old <- lapply(x, \(z) unlist(colnames(z)))
+    # get list names; if missing, use empty strings
+    if (is.null(nms <- names(x))) 
+        nms <- character(length(x))
+    # prepend list names to element names where available
+    new <- lapply(seq_along(x), \(i) {
+        if (nms[i] == "") return(old[[i]])
+        paste(nms[i], old[[i]], sep=".")
+    })
+    # ensure global uniqueness
+    new <- split(
+        make.unique(unlist(new)), 
+        rep(seq_along(new), lengths(new)))
+    .combine(x, old, new)
 })
+
+#' @export
+#' @rdname combine
+setMethod("combine", 
+    c("SpatialData", "SpatialData"), 
+    \(x, y, ...) combine(list(x, y)))
+

tests/testthat/test-combine.R

@@ -2,7 +2,7 @@ x <- file.path("extdata", "blobs.zarr")
 x <- system.file(x, package="spatialdataR")
 x <- readSpatialData(x)
 
-test_that("combine", {
+test_that("combine two SpatialData objects", {
     # auto-fixed names
     expect_no_message(y <- combine(x, x))
     f <- \(.) unlist(colnames(.))
@@ -38,3 +38,22 @@ test_that("combine", {
         expect_identical(c[[.]][[2]], b[[.]][[1]])
     }
 })
+
+test_that("combine length-2+ list of objects", {
+    # partially named
+    y <- combine(list(a=x, b=x, x))
+    old <- unlist(colnames(x))
+    new <- unlist(colnames(y))
+    expect_true(all(old %in% new))
+    expect_true(!any(duplicated(new)))
+    expect_true(all(paste0("a.", old) %in% new))
+    expect_true(all(paste0("b.", old) %in% new))
+    expect_length(new, 3*length(unlist(colnames(x))))
+    # unnamed
+    y <- combine(list(x, x))
+    new <- unlist(colnames(y))
+    expect_true(all(old %in% new))
+    expect_length(new, 2*length(old))
+    expect_true(!any(duplicated(new)))
+    expect_true(all(paste0(old, ".1") %in% new))
+})