From 69c96122c1ffc9d4d1a26039990a3e1b58e499bd Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 30 May 2026 17:08:29 +0200 Subject: [PATCH 01/15] Remove extra do.call --- R/extent.R | 2 +- R/read.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/extent.R b/R/extent.R index 382fc9ec..2b5f3357 100644 --- a/R/extent.R +++ b/R/extent.R @@ -29,7 +29,7 @@ NULL setMethod("extent", "SpatialData", \(x, i=1) { ex <- .lapplyLayer(x, extent, i=i) ex <- unlist(ex, recursive=FALSE) - xy <- do.call(rbind, lapply(ex, do.call, what=cbind)) + xy <- do.call(rbind, lapply(ex, list2DF)) list(x=range(xy[, 1]), y=range(xy[, 2])) }) diff --git a/R/read.R b/R/read.R index 101e5bb2..7044fe91 100644 --- a/R/read.R +++ b/R/read.R @@ -143,8 +143,8 @@ readSpatialData <- function(x, stop("couldn't find ", l, " of name", .) j <- j[opt] } - f <- get(paste0("read", toupper(substr(l, 1, 1)), substr(l, 2, nchar(l)-1))) - lapply(j, \(.) do.call(f, list(.))) + f <- paste0("read", toupper(substr(l, 1, 1)), substr(l, 2, nchar(l)-1)) + lapply(j, f) } names(ls) <- ls <- .LAYERS[!skip] From 2bd73f86c54e20f23de23a470f1aafa977043fdc Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 30 May 2026 17:10:12 +0200 Subject: [PATCH 02/15] Remove unnecessary seq_len() and c() --- R/validity.R | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/R/validity.R b/R/validity.R index d609fc92..bad6a6ea 100644 --- a/R/validity.R +++ b/R/validity.R @@ -48,11 +48,10 @@ .validateImage <- \(object) { msg <- c() - res <- length(object) axs <- axes(object) typ <- vapply(axs, \(.) .$type, character(1)) d <- sum(typ != "time") - for (k in seq_len(res)) { + for (k in seq_along(object)) { x <- data(object, k) if (length(dim(x)) != d) msg <- c(msg, paste( "'SpatialDataImage' resolution", k, "is not ", d, "D")) @@ -67,11 +66,10 @@ setValidity2("SpatialDataImage", .validateImage) #' @importFrom ZarrArray type .validateLabel <- \(object) { msg <- c() - res <- length(object) axs <- axes(object) typ <- vapply(axs, \(.) .$type, character(1)) d <- sum(typ == "space") - for (k in seq_len(res)) { + for (k in seq_along(object)) { x <- data(object, k) if (length(dim(x)) != d) msg <- c(msg, paste( "'SpatialDataLabel' resolution", k, "is not ", d, "D")) @@ -85,22 +83,20 @@ setValidity2("SpatialDataLabel", .validateLabel) #' @importFrom dplyr count pull .validatePoint <- \(object) { - msg <- c() cnt <- tryCatch(error=\(.) 0, as.integer( pull(count(spatialdataR::data(object)), "n"))) - if (!cnt) return(msg) + if (!cnt) return(NULL) if (!"geometry" %in% names(object)) - msg <- c(msg, "'SpatialDataPoint' missing 'geometry'.") - return(msg) + return("'SpatialDataPoint' missing 'geometry'.") + return(NULL) } #' @importFrom S4Vectors setValidity2 setValidity2("SpatialDataPoint", .validatePoint) .validateShape <- \(object) { - msg <- c() if (!"geometry" %in% names(object)) - msg <- c(msg, "'SpatialDataShape' missing 'geometry'.") - return(msg) + return("'SpatialDataShape' missing 'geometry'.") + return(NULL) } #' @importFrom S4Vectors setValidity2 setValidity2("SpatialDataShape", .validateShape) From 305f3267bd0d0dabd5f10fc18ce5e9f00b71e4a4 Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 30 May 2026 17:16:08 +0200 Subject: [PATCH 03/15] Use lengths() where appropriate --- R/combine.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/combine.R b/R/combine.R index 49eadcc4..ec7c9af1 100644 --- a/R/combine.R +++ b/R/combine.R @@ -25,7 +25,7 @@ NULL 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), vapply(old, length, integer(1))) + 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 From 49787fa88121c56c881f75cb0dda13abf352c7f4 Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 30 May 2026 17:21:54 +0200 Subject: [PATCH 04/15] Use .data pronoun instead of NULL assign --- R/crop.R | 5 ++--- R/mask.R | 5 ++--- R/sdFrame.R | 3 +-- 3 files changed, 5 insertions(+), 8 deletions(-) diff --git a/R/crop.R b/R/crop.R index 8df0909f..79e7d58c 100644 --- a/R/crop.R +++ b/R/crop.R @@ -201,7 +201,7 @@ setMethod("crop", "SpatialDataArray", \(x, y, j=1, ...) { #' @export #' @rdname crop -#' @importFrom dplyr pull +#' @importFrom dplyr pull .data #' @importFrom duckspatial ddbs_intersects #' @importFrom sf st_sf st_sfc st_as_sfc st_bbox st_polygon st_geometry<- setMethod("crop", "SpatialDataFrame", \(x, y, j=1, ...) { @@ -225,8 +225,7 @@ setMethod("crop", "SpatialDataFrame", \(x, y, j=1, ...) { df <- data(transform(x, j)) fd <- data(SpatialDataShape(fd)) ok <- ddbs_intersects(df, fd, sparse=TRUE) - id_x <- NULL # R CMD check - x[pull(ok, id_x), ] + x[pull(ok, .data$id_x), ] }) #' @export diff --git a/R/mask.R b/R/mask.R index b94545ea..e62d04bf 100644 --- a/R/mask.R +++ b/R/mask.R @@ -180,9 +180,8 @@ setMethod("mask_i_by_j", if (nrow(collect(head(ij, 1))) == 0) stop("found no intersections", " between shapes 'i' and 'j'") - id_x <- id_y <- NULL # R CMD check - is <- pull(ij, id_y) # elements in i - js <- pull(ij, id_x) # masks in j + is <- pull(ij, .data$id_y) # elements in i + js <- pull(ij, .data$id_x) # masks in j na <- setdiff(seq_along(i), is) # aggregation mx <- assay(table, assay) diff --git a/R/sdFrame.R b/R/sdFrame.R index 6f2a177e..c194d6af 100644 --- a/R/sdFrame.R +++ b/R/sdFrame.R @@ -168,8 +168,7 @@ SpatialDataShape <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=l #' @rdname SpatialDataFrame #' @importFrom dplyr tally pull setMethod("length", "SpatialDataFrame", \(x) { - n <- NULL # R CMD check - suppressWarnings(dplyr::pull(dplyr::tally(data(x)), n)) + suppressWarnings(dplyr::pull(dplyr::tally(data(x)), .data$n)) }) #' @export From 55d71e4ccbc5be5b8b549d062b3ec1e7dd0f09d0 Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 30 May 2026 17:56:29 +0200 Subject: [PATCH 05/15] Use dplyr::bind_rows() where possible --- R/extent.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/extent.R b/R/extent.R index 2b5f3357..a9115405 100644 --- a/R/extent.R +++ b/R/extent.R @@ -29,8 +29,8 @@ NULL setMethod("extent", "SpatialData", \(x, i=1) { ex <- .lapplyLayer(x, extent, i=i) ex <- unlist(ex, recursive=FALSE) - xy <- do.call(rbind, lapply(ex, list2DF)) - list(x=range(xy[, 1]), y=range(xy[, 2])) + xy <- dplyr::bind_rows(ex) + list(x=range(xy$x), y=range(xy$y)) }) #' @export From dd17b34b5b4f3ad10dacbe24fa68ddeb5ef4938b Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 30 May 2026 18:04:06 +0200 Subject: [PATCH 06/15] Make error msg match code --- R/sdAttrs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/sdAttrs.R b/R/sdAttrs.R index 7f6ae526..4df79b28 100644 --- a/R/sdAttrs.R +++ b/R/sdAttrs.R @@ -133,7 +133,7 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]]) x$ome$version if (!length(v)) stop("couldn't find 'version' in 'spatialdata_attrs'") ok <- length(v) == 1 && is.character(v) && (v <- gsub("-.*", "", v)) %in% sprintf("0.%d", seq_len(6)) - if (!ok) stop("invalid OME 'version'; expected '0.x' where x is 1-5") + if (!ok) stop("invalid OME 'version'; expected '0.x' where x is 1-6") return(v) } From 9d01cb6144aba545efa3c891ecc928432131283c Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 10:09:07 +0200 Subject: [PATCH 07/15] auto-name elements --- R/methods.R | 15 ++++++++++++ tests/testthat/test-methods.R | 43 ++++++++++++++++++++++++++++------- 2 files changed, 50 insertions(+), 8 deletions(-) diff --git a/R/methods.R b/R/methods.R index 5269587c..7d4ab5e6 100644 --- a/R/methods.R +++ b/R/methods.R @@ -43,6 +43,7 @@ setMethod("data", "SpatialDataElement", \(x, k=1, ...) { "NULL or a scalar positive integer") # get number of available scales n <- length(x <- x@data) + if (!length(x)) return(NULL) # input of Inf uses lowest if (is.infinite(k)) k <- n # return specified scale @@ -262,6 +263,20 @@ NULL f <- \(l) setReplaceMethod(l, c("SpatialData", getSlots("SpatialData")[[l]]), \(x, value) { + if (length(value)) { + nms <- names(value) + e <- gsub("s$", "", l) + if (is.null(nms)) { + nms <- paste0(e, seq_along(value)) + names(value) <- nms + } else { + na <- nchar(nms) == 0 + if (any(na)) { + nms[na] <- paste0(e, which(na)) + names(value) <- nms + } + } + } if (l != "tables") { old <- names(slot(x, l)) new <- names(value) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 9c656d7c..4c05bb18 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -77,10 +77,18 @@ test_that("element()", { test_that("element<-()", { i <- vapply(colnames(x), \(.) .[1], character(1)) for (. in i) { - y <- x; element(y, .) <- element(x, .) - expect_identical(element(y, .), element(x, .)) + # clear y <- x; element(y, .) <- NULL expect_error(element(y, .)) + # valid + y <- x; element(y, .) <- element(x, .) + expect_identical(element(y, .), element(x, .)) + # invalid + es <- colnames(x) + ex <- unlist(es[layer(x, .)]) + es <- setdiff(unlist(es), ex) + el <- element(x, sample(es, 1)) + expect_error(element(x, .) <- el) } }) @@ -117,6 +125,17 @@ test_that("set all", { y[[.]][[2]] <- obj[[.]] expect_length(y[[.]], 2) expect_identical(y[[.]][[2]], obj[[.]]) + # auto-naming to layer+index + y <- x; y[[.]] <- list(obj[[.]]) # all unnamed + expect_named(y[[.]]) + expect_length(y[[.]], 1) + expect_is(y[[.]], "SimpleList") + expect_identical(names(y[[.]]), gsub("s$", "1", .)) + y <- x; y[[.]] <- list(a=obj[[.]], obj[[.]], b=obj[[.]]) # one unnamed + expect_named(y[[.]]) + expect_length(y[[.]], 3) + expect_is(y[[.]], "SimpleList") + expect_identical(names(y[[.]]), c("a", gsub("s$", "2", .), "b")) } }) @@ -131,17 +150,25 @@ test_that("set one", { } # value=in/valid mapply(f=fun, o=obj, t=typ, \(f, o, t) { + all <- get(paste0(f, "s")) set <- get(paste0(f, "<-")) nms <- get(paste0(f, "Names")) + n <- \(.) length(all(.)) # character - x <- set(x, i=".", value=o) - expect_true("." %in% nms(x)) - expect_is(get(f, envir=asNamespace("spatialdataR"))(x, "."), t) + y <- set(x, i=".", value=o) + expect_true("." %in% nms(y)) + expect_is(get(f)(y, "."), t) # numeric - x <- set(x, i=1, value=o) - expect_is(get(f, envir=asNamespace("spatialdataR"))(x, 1), t) + y <- set(x, i=1, value=o) + expect_is(get(f)(y, 1), t) + # when index > number of elements, + # element name becomes layer+index + y <- set(x, i=n(x)+1, value=o) + i <- paste0(f, n(x)+1) + expect_true(i %in% nms(y)) + expect_length(all(y), n(x)+1) + expect_identical(element(y, i), o) # missing - n <- \(.) length(get(paste0(f, "s"))(.)) expect_silent(set(x, value=o)) y <- set(x, value=NULL) expect_equal(n(y), n(x)-1) From 8d5c18c6398b4ead465197daf5191da2c99be479 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 10:28:51 +0200 Subject: [PATCH 08/15] more tests --- tests/testthat/test-methods.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 4c05bb18..5ee7d739 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -168,6 +168,8 @@ test_that("set one", { expect_true(i %in% nms(y)) expect_length(all(y), n(x)+1) expect_identical(element(y, i), o) + z <- set(x, i=n(x)+2, value=o) + expect_identical(nms(y), nms(z)) # missing expect_silent(set(x, value=o)) y <- set(x, value=NULL) From b28d7041c2ba71aca83e5166b50abf7922492705 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 10:59:19 +0200 Subject: [PATCH 09/15] validate layer lists are named; fix SD constructor --- R/SpatialData.R | 10 ++++------ R/validity.R | 17 +++++++++++++++++ 2 files changed, 21 insertions(+), 6 deletions(-) diff --git a/R/SpatialData.R b/R/SpatialData.R index a5a5925e..c490a6b6 100644 --- a/R/SpatialData.R +++ b/R/SpatialData.R @@ -60,10 +60,8 @@ SpatialData <- \( shapes=list(), tables=list()) { - .SpatialData( - images=sdImageList(images), - labels=sdLabelList(labels), - points=sdPointList(points), - shapes=sdShapeList(shapes), - tables=sdTableList(tables)) + sd <- .SpatialData() + for (l in .LAYERS) + sd[[l]] <- get(l) + return(sd) } diff --git a/R/validity.R b/R/validity.R index 7589668c..7791c38e 100644 --- a/R/validity.R +++ b/R/validity.R @@ -101,9 +101,26 @@ setValidity2("SpatialDataPoint", .validatePoint) #' @importFrom S4Vectors setValidity2 setValidity2("SpatialDataShape", .validateShape) +.nm <- \(x, l) { + msg <- c() + lys <- get(l)(x) + nms <- names(lys) + typ <- class(lys)[[1]] + if (is.null(nms)) { + msg <- c(msg, sprintf("'%s' missing names", typ)) + } else { + na <- nchar(nms) == 0 + if (any(na)) { + msg <- c(msg, sprintf("'%s' elements %s missing names", typ, which(na))) + } + } + return(msg) +} + #' @importFrom methods is .validateSpatialData <- \(x) { msg <- c() + for (l in .LAYERS) msg <- c(msg, .nm(x, l)) # TODO: validate .zattrs across all layers for (y in as.list(labels(x))) msg <- c(msg, .validateLabel(y)) for (y in as.list(images(x))) msg <- c(msg, .validateImage(y)) From 783cf86aeb6a36f5a53c4c5229be2774db1d30e4 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 11:19:33 +0200 Subject: [PATCH 10/15] test SpatialData() --- tests/testthat/test-validity.R | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/tests/testthat/test-validity.R b/tests/testthat/test-validity.R index 5203861b..0c2e4147 100644 --- a/tests/testthat/test-validity.R +++ b/tests/testthat/test-validity.R @@ -5,6 +5,28 @@ zs <- file.path("extdata", "blobs.zarr") zs <- system.file(zs, package="spatialdataR") sd <- readSpatialData(zs) +test_that("SpatialData()", { + # empty + expect_silent(x <- SpatialData()) + expect_all_true(lengths(colnames(x)) == 0) + for (l in .LAYERS) expect_is(get(l)(x), "SimpleList") + # single layer + e <- list( + images=SpatialDataImage(), + labels=SpatialDataLabel(), + points=SpatialDataPoint(), + shapes=SpatialDataShape(), + tables=SingleCellExperiment()) + for (l in .LAYERS) { + arg <- list(list(e[[l]])); names(arg) <- l + expect_silent(x <- do.call("SpatialData", arg)) + expect_named(x[[l]]) + expect_length(x[[l]], 1) + expect_is(x[[l]], "SimpleList") + expect_identical(names(x[[l]]), gsub("s$", 1, l)) + } +}) + test_that("validity,SpatialDataImage", { expect_error(SpatialDataImage(list(v <- character(1)))) x <- image(sd,1); x@data[[1]][1,1,1] <- v; expect_error(validObject(x)) From a26f61415acdb0494b3997a422e4c4c6f87436ef Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 11:20:00 +0200 Subject: [PATCH 11/15] accept single-arary (#216) --- R/sdArray.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/sdArray.R b/R/sdArray.R index 12aaf696..a916c87b 100644 --- a/R/sdArray.R +++ b/R/sdArray.R @@ -67,7 +67,8 @@ NULL #' @rdname SpatialDataArray #' @importFrom methods new #' @importFrom S4Vectors metadata<- -SpatialDataImage <- function(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) { +SpatialDataImage <- \(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) { + if (is.array(data)) data <- list(data) x <- .SpatialDataImage(data=data, meta=meta, ...) metadata(x) <- metadata return(x) @@ -77,7 +78,8 @@ SpatialDataImage <- function(data=list(), meta=SpatialDataAttrs(), metadata=list #' @rdname SpatialDataArray #' @importFrom methods new #' @importFrom S4Vectors metadata<- -SpatialDataLabel <- function(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) { +SpatialDataLabel <- \(data=list(), meta=SpatialDataAttrs(), metadata=list(), ...) { + if (is.array(data)) data <- list(data) x <- .SpatialDataLabel(data=data, meta=meta, ...) metadata(x) <- metadata return(x) From 167da067bbd90c0ca2f8753c43243e97c2a8bfe1 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 11:20:40 +0200 Subject: [PATCH 12/15] accept single-arary (#216) --- tests/testthat/test-sdarray.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-sdarray.R b/tests/testthat/test-sdarray.R index c47bb19e..7bbc3458 100644 --- a/tests/testthat/test-sdarray.R +++ b/tests/testthat/test-sdarray.R @@ -25,11 +25,11 @@ test_that("SpatialDataImage()", { rgb <- \(n) sample(seq_len(255), n, replace=TRUE) mat <- array(rgb(3*20*20), dim=c(3,20,20)) # invalid - expect_error(SpatialDataImage(mat)) expect_error(SpatialDataImage(mat, 1)) expect_error(SpatialDataImage(mat, list())) # single scale expect_silent(SpatialDataImage(list())) + expect_silent(SpatialDataImage(mat)) expect_silent(SpatialDataImage(list(mat))) expect_silent(SpatialDataImage(list(mat), SpatialDataAttrs())) # multiscale @@ -56,11 +56,11 @@ test_that("SpatialDataLabel()", { val <- sample(seq_len(12), 20*20, replace=TRUE) mat <- array(val, dim=c(20, 20)) # invalid - expect_error(SpatialDataLabel(mat)) expect_error(SpatialDataLabel(mat, 1)) expect_error(SpatialDataLabel(mat, list())) # single scale expect_silent(SpatialDataLabel(list())) + expect_silent(SpatialDataLabel(mat)) expect_silent(SpatialDataLabel(list(mat))) expect_silent(SpatialDataLabel(list(mat), SpatialDataAttrs())) # multiscale From 7ce347500432d6fc0ebf96de3f9f520ad31bccb2 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 11:42:52 +0200 Subject: [PATCH 13/15] simplify validity --- R/validity.R | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/R/validity.R b/R/validity.R index 13d32821..14606266 100644 --- a/R/validity.R +++ b/R/validity.R @@ -102,15 +102,13 @@ setValidity2("SpatialDataShape", .validateShape) lys <- get(l)(x) nms <- names(lys) typ <- class(lys)[[1]] - if (is.null(nms)) { - msg <- c(msg, sprintf("'%s' missing names", typ)) - } else { - na <- nchar(nms) == 0 - if (any(na)) { - msg <- c(msg, sprintf("'%s' elements %s missing names", typ, which(na))) - } + if (is.null(nms)) return(paste(typ, "missing names")) + na <- nchar(nms) == 0 + if (any(na)) { + na <- paste(which(na), collapse=",") + return(paste(typ, "elements", na, "missing names")) } - return(msg) + return(NULL) } #' @importFrom methods is From fdd748f058faa578c34b606fe41533df917622e5 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 11:43:03 +0200 Subject: [PATCH 14/15] v0.99.40 --- DESCRIPTION | 2 +- inst/NEWS | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5f29f5fd..e15ffa55 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: spatialdataR Title: Representation of Python's spatialdata in R Depends: R (>= 4.6) -Version: 0.99.39 +Version: 0.99.40 Description: R interface to Python/scverse's 'spatialdata' framework for unified spatial omics data handling. Adheres to OME-NGFF standards, providing lazy, on-disk representations for multiscale images and diff --git a/inst/NEWS b/inst/NEWS index c516b5fa..0a6a01e9 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,3 +1,9 @@ +changes in version 0.99.40 + +- validty & setters now assure that each layer is a completely named list +- 'SpatialDataImage/Label()' now accept single array (previously required list) +- simplified various code bits (e.g., using 'lengths()', 'seq_along()', etc.) + changes in version 0.99.39 - class revision: SpatialData slots were base::list, now prototyped From 0696c6257fad84b5425742d0ec61328f14448f49 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 1 Jun 2026 13:07:25 +0200 Subject: [PATCH 15/15] revise combine() to accept (named) list --- R/combine.R | 78 ++++++++++++++++++++++------------- man/combine.Rd | 7 ++++ tests/testthat/test-combine.R | 21 +++++++++- 3 files changed, 76 insertions(+), 30 deletions(-) diff --git a/R/combine.R b/R/combine.R index ec7c9af1..962bccdc 100644 --- a/R/combine.R +++ b/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))) + \ No newline at end of file diff --git a/man/combine.Rd b/man/combine.Rd index 5d9ec1ea..eaad91e5 100644 --- a/man/combine.Rd +++ b/man/combine.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/combine.R \name{combine} \alias{combine} +\alias{combine,list,missing-method} \alias{combine,SpatialData,SpatialData-method} \title{Combine two \code{SpatialData} objects} \usage{ +\S4method{combine}{list,missing}(x, y, ...) + \S4method{combine}{SpatialData,SpatialData}(x, y, ...) } \arguments{ @@ -28,4 +31,8 @@ y <- combine(x, x) imageNames(y) region(table(y, 1)) region(table(y, 2)) + +y <- combine(list(Alpha=x, x, Omega=x)) +shapeNames(y) + } diff --git a/tests/testthat/test-combine.R b/tests/testthat/test-combine.R index b52fe302..4caf01f5 100644 --- a/tests/testthat/test-combine.R +++ b/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)) +})