From c0bda979a664efbb5548f44658ffc85a484f5757 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Tue, 12 May 2026 11:10:47 +0200 Subject: [PATCH 1/4] assures shapes live in same duckdb conn --- R/crop.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/crop.R b/R/crop.R index fee6c94..cb6585d 100644 --- a/R/crop.R +++ b/R/crop.R @@ -223,6 +223,7 @@ setMethod("crop", "SpatialDataFrame", \(x, y, j=1, ...) { fd <- st_sf(geometry=st_as_sfc(st_bbox(unlist(y)))) } 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), ] From fa68381797ef508d9fce0a70f4b57b1f535c4131 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Tue, 12 May 2026 15:04:17 +0200 Subject: [PATCH 2/4] table replacement --- NAMESPACE | 8 ++++---- R/combine.R | 9 +++++---- R/methods.R | 34 ++++++++++++++++++++-------------- R/utils.R | 19 ++++++++++++++++++- man/SpatialDataFrame.Rd | 8 ++++---- tests/testthat/test-tables.R | 33 +++++++++++++++++++++++++++++++-- 6 files changed, 82 insertions(+), 29 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 3ea9571..186a31c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,10 +4,6 @@ S3method(.DollarNames,SpatialData) S3method(.DollarNames,SpatialDataAttrs) S3method(.DollarNames,SpatialDataPoint) S3method(.DollarNames,SpatialDataShape) -S3method(filter,SpatialDataFrame) -S3method(mutate,SpatialDataFrame) -S3method(pull,SpatialDataFrame) -S3method(select,SpatialDataFrame) export(.SpatialData) export(CTplot) export(SpatialData) @@ -17,8 +13,11 @@ export(SpatialDataLabel) export(SpatialDataPoint) export(SpatialDataShape) export(filter) +export(filter.SpatialDataFrame) export(mutate) +export(mutate.SpatialDataFrame) export(pull) +export(pull.SpatialDataFrame) export(readImage) export(readLabel) export(readPoint) @@ -26,6 +25,7 @@ export(readShape) export(readSpatialData) export(readTable) export(select) +export(select.SpatialDataFrame) exportClasses(SpatialData) exportMethods("$") exportMethods("[") diff --git a/R/combine.R b/R/combine.R index 2cd66dd..04a7b90 100644 --- a/R/combine.R +++ b/R/combine.R @@ -28,20 +28,21 @@ setMethod("combine", c("SpatialData", "SpatialData"), \(x, y, ...) { idx <- rep.int(c(1, 2), vapply(old, length, integer(1))) new <- split(make.unique(unlist(old)), idx) for (i in c(1, 2)) { + # get input element names z <- get(c("x", "y")[i]) - layer_nms <- setdiff(rownames(z), "tables") - old_nms <- unlist(colnames(z)[layer_nms]) + old_nms <- unlist(colnames(z)[.ls]) + # find new names for these elements j <- match(old_nms, old[[i]]) new_nms <- new[[i]][j] # rename elements - for (l in layer_nms) { + for (l in .ls) { j <- match(names(z[[l]]), old[[i]]) names(z[[l]]) <- new[[i]][j] } # sync tables - z <- .sync_tables(z, old_nms, new_nms) + z <- .sync_tables_sdattrs(z, old_nms, new_nms) # rename tables themselves j <- match(tableNames(z), old[[i]]) diff --git a/R/methods.R b/R/methods.R index bab1cdd..9e837dd 100644 --- a/R/methods.R +++ b/R/methods.R @@ -6,6 +6,10 @@ #' @rdname SpatialData setMethod("$", "SpatialData", \(x, name) attr(x, name)) +#' @exportMethod $<- +#' @rdname SpatialData +setReplaceMethod("$", "SpatialData", \(x, name, value) `[[<-`(x, i=name, value=value)) + #' @export #' @rdname SpatialData #' @importFrom methods callNextMethod @@ -16,9 +20,7 @@ setMethod("[[", c("SpatialData", "numeric"), \(x, i, ...) { #' @rdname SpatialData #' @export -setMethod("[[", c("SpatialData", "character"), \(x, i, ...) { - attr(x, grep(i, names(attributes(x)), value=TRUE)) -}) +setMethod("[[", c("SpatialData", "character"), \(x, i, ...) attr(x, i)) # data/meta ---- @@ -173,7 +175,9 @@ all <- paste0(one, "s") #' @exportMethod imageNames labelNames pointNames shapeNames tableNames NULL -f <- \(.) setMethod(paste0(., "Names"), "SpatialData", \(x) names(x[[.]])) +f <- \(.) setMethod( + paste0(., "Names"), "SpatialData", + \(x) names(x[[paste0(., "s")]])) for (. in one) eval(f(.), parent.env(environment())) # set nms ---- @@ -190,7 +194,7 @@ f <- \(.) setReplaceMethod( old <- names(x[[paste0(., "s")]]) new <- names(x[[paste0(., "s")]]) <- value if (. == "table") return(x) - .sync_tables(x, old, new) + .sync_tables_sdattrs(x, old, new) }) for (. in one) eval(f(.), parent.env(environment())) @@ -226,7 +230,7 @@ for (. in one) eval(f(.), parent.env(environment())) #' @importFrom methods setReplaceMethod #' @export setReplaceMethod("[[", c("SpatialData", "numeric"), - \(x, i, value) { attr(x, .LAYERS[i]) <- value; return(x) }) + \(x, i, value) { x[[.LAYERS[i]]] <- value; x }) #' @rdname SpatialData #' @export @@ -237,12 +241,17 @@ setReplaceMethod("[[", c("SpatialData", "character"), old <- names(attr(x, l)) new <- names(value) if (length(old) == length(new) && any(old != new)) - x <- .sync_tables(x, old, new) + x <- .sync_tables_sdattrs(x, old, new) } attr(x, l) <- value - if (l != "tables") + if (l != "tables") { x <- .sync_tables_on_drop(x) - return(x) + } else { + for (t in tableNames(x)) { + x <- .sync_shapes_on_drop(x, t) + } + } + x }) # |_value=list ---- @@ -258,7 +267,7 @@ f <- \(.) setReplaceMethod(., old <- names(attr(x, .)) new <- names(value) if (length(old) == length(new) && any(old != new)) - x <- .sync_tables(x, old, new) + x <- .sync_tables_sdattrs(x, old, new) } attr(x, .) <- value if (. != "tables") @@ -286,14 +295,11 @@ f <- \(.) setReplaceMethod(., y <- attr(x, paste0(., "s")) y[[i]] <- value attr(x, paste0(., "s")) <- y + if (. == "table") x <- .sync_shapes_on_drop(x, i) return(x) }) for (. in one) eval(f(.), parent.env(environment())) -# TODO: something like table(x)$cluster_id <- doesn't work atm... -# not sure how to get around without defining all the possible -# SCE replacement methods :/ - # _i=numeric ---- #' @name SpatialData diff --git a/R/utils.R b/R/utils.R index b3de2fb..63d4334 100644 --- a/R/utils.R +++ b/R/utils.R @@ -19,7 +19,7 @@ return(x) } -.sync_tables <- \(x, old, new) { +.sync_tables_sdattrs <- \(x, old, new) { if (!length(ts <- tables(x))) return(x) for (i in seq_along(ts)) { t <- ts[[i]] @@ -44,6 +44,23 @@ return(x) } +.sync_shapes_on_drop <- \(x, i) { + # skip when there aren't any shapes + if (!length(shapes(x))) return(x) + t <- SpatialData::table(x, i) + for (j in region(t)) { + # skip non-shape elements + if (layer(x, j) != "shapes") next + # get element 'y' annotated by table 't' + y <- element(x, j) + # match instances between them + y <- y[match(instances(t), instances(y), nomatch=0)] + # return matching shape instances + shape(x, j) <- y + } + return(x) +} + .sync_tables_on_drop <- \(x) { if (!length(ts <- tables(x))) return(x) all_nms <- unlist(colnames(x)[.ls]) diff --git a/man/SpatialDataFrame.Rd b/man/SpatialDataFrame.Rd index c175fb8..f235168 100644 --- a/man/SpatialDataFrame.Rd +++ b/man/SpatialDataFrame.Rd @@ -47,13 +47,13 @@ SpatialDataShape( \S4method{geom_type}{SpatialDataShape}(x) -\method{pull}{SpatialDataFrame}(.data, ...) +pull.SpatialDataFrame(.data, ...) -\method{select}{SpatialDataFrame}(.data, ...) +select.SpatialDataFrame(.data, ...) -\method{mutate}{SpatialDataFrame}(.data, ...) +mutate.SpatialDataFrame(.data, ...) -\method{filter}{SpatialDataFrame}(.data, ...) +filter.SpatialDataFrame(.data, ...) \S4method{[[}{SpatialDataFrame,ANY,ANY}(x, i, j, ...) diff --git a/tests/testthat/test-tables.R b/tests/testthat/test-tables.R index ee7a8fc..64037aa 100644 --- a/tests/testthat/test-tables.R +++ b/tests/testthat/test-tables.R @@ -4,11 +4,40 @@ x <- file.path("extdata", "blobs.zarr") x <- system.file(x, package="SpatialData") x <- readSpatialData(x) -se <- SpatialData::table(x) -md <- int_metadata(se) +t <- SpatialData::table(x) +md <- int_metadata(t) md <- md$spatialdata_attrs i <- md[[rk <- md$region_key]] +test_that("table<-", { + # labels aren't affected + y <- x + i <- region(t) + table(y) <- t[, -1] + expect_identical(element(x, i), element(y, i)) + # shapes are synchronized + i <- shapeNames(x)[1] + y <- shape(x, i) + m <- 77; n <- length(y) + u <- matrix(m*n, m, n) + u <- SingleCellExperiment(u) + a <- setTable(x, i, u, name="x") + v <- element(a, "x")[-33, -3] + f <- \(a, b) { + a <- element(a, "x") + b <- element(b, "x") + expect_equal(dim(a), c(m,n)) + expect_equal(dim(b), c(m-1,n-1)) + expect_identical(instances(a), instances(y)) + expect_identical(instances(b), instances(y)[-3]) + } + b <- a; b$tables$x <- v; f(a, b) + b <- a; table(b, "x") <- v; f(a, b) + b <- a; b$tables <- list(x=v); f(a, b) + b <- a; tables(b) <- list(x=v); f(a, b) + b <- a; table(b, grep("x", tableNames(b))) <- v; f(a, b) +}) + test_that("hasTable()", { # TRUE i <- region(SpatialData::table(x)) From 61814305f7631ae407f96ebf6312a7cb6efd4936 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Tue, 12 May 2026 15:20:10 +0200 Subject: [PATCH 3/4] fix dplyr exports --- NAMESPACE | 10 +++++----- R/AllClasses.R | 6 ------ man/SpatialData.Rd | 9 ++++++--- man/SpatialDataFrame.Rd | 8 ++++---- 4 files changed, 15 insertions(+), 18 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 186a31c..fb003ef 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,10 @@ S3method(.DollarNames,SpatialData) S3method(.DollarNames,SpatialDataAttrs) S3method(.DollarNames,SpatialDataPoint) S3method(.DollarNames,SpatialDataShape) +S3method(filter,SpatialDataFrame) +S3method(mutate,SpatialDataFrame) +S3method(pull,SpatialDataFrame) +S3method(select,SpatialDataFrame) export(.SpatialData) export(CTplot) export(SpatialData) @@ -13,11 +17,8 @@ export(SpatialDataLabel) export(SpatialDataPoint) export(SpatialDataShape) export(filter) -export(filter.SpatialDataFrame) export(mutate) -export(mutate.SpatialDataFrame) export(pull) -export(pull.SpatialDataFrame) export(readImage) export(readLabel) export(readPoint) @@ -25,9 +26,9 @@ export(readShape) export(readSpatialData) export(readTable) export(select) -export(select.SpatialDataFrame) exportClasses(SpatialData) exportMethods("$") +exportMethods("$<-") exportMethods("[") exportMethods("[[") exportMethods("[[<-") @@ -111,7 +112,6 @@ exportMethods(tables) exportMethods(transform) exportMethods(translation) import(geoarrow) -importClassesFrom(S4Arrays,Array) importClassesFrom(S4Vectors,DFrame) importFrom(BiocGenerics,as.data.frame) importFrom(BiocGenerics,colnames) diff --git a/R/AllClasses.R b/R/AllClasses.R index bbaafdb..3d7f94b 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -2,12 +2,6 @@ Class="SpatialDataAttrs", contains="list") -#' @importFrom methods setClassUnion -#' @importClassesFrom S4Arrays Array -setClassUnion( - "array_OR_df", - c("Array", "array", "data.frame")) - .SpatialDataImage <- setClass( Class="SpatialDataImage", contains=c("Annotated"), diff --git a/man/SpatialData.Rd b/man/SpatialData.Rd index 9b7c6ed..3d29631 100644 --- a/man/SpatialData.Rd +++ b/man/SpatialData.Rd @@ -42,6 +42,7 @@ \alias{[[<-,SpatialData,character,ANY-method} \alias{[[<-,SpatialData,numeric,ANY-method} \alias{$,SpatialData-method} +\alias{$<-,SpatialData-method} \alias{[[,SpatialData,numeric,ANY-method} \alias{[[,SpatialData,character,ANY-method} \alias{data,SpatialDataElement-method} @@ -66,6 +67,8 @@ SpatialData(images, labels, points, shapes, tables) \S4method{$}{SpatialData}(x, name) +\S4method{$}{SpatialData}(x, name) <- value + \S4method{[[}{SpatialData,numeric,ANY}(x, i, j, ...) \S4method{[[}{SpatialData,character,ANY}(x, i, j, ...) @@ -121,15 +124,15 @@ SpatialData(images, labels, points, shapes, tables) \item{name}{character string for extraction (see \code{?base::`$`}).} +\item{value}{(list of) element(s) with layer-compliant object(s), +or NULL/\code{list()} to remove an element/layer completely.} + \item{i, j}{character string, scalar or vector of indices specifying the element to extract from a given layer.} \item{...}{optional arguments passed to and from other methods.} \item{drop}{ignored.} - -\item{value}{(list of) element(s) with layer-compliant object(s), -or NULL/\code{list()} to remove an element/layer completely.} } \value{ \code{SpatialData} diff --git a/man/SpatialDataFrame.Rd b/man/SpatialDataFrame.Rd index f235168..c175fb8 100644 --- a/man/SpatialDataFrame.Rd +++ b/man/SpatialDataFrame.Rd @@ -47,13 +47,13 @@ SpatialDataShape( \S4method{geom_type}{SpatialDataShape}(x) -pull.SpatialDataFrame(.data, ...) +\method{pull}{SpatialDataFrame}(.data, ...) -select.SpatialDataFrame(.data, ...) +\method{select}{SpatialDataFrame}(.data, ...) -mutate.SpatialDataFrame(.data, ...) +\method{mutate}{SpatialDataFrame}(.data, ...) -filter.SpatialDataFrame(.data, ...) +\method{filter}{SpatialDataFrame}(.data, ...) \S4method{[[}{SpatialDataFrame,ANY,ANY}(x, i, j, ...) From e5671e6040a38d468aa5758fb255cbba27ad1944 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Tue, 12 May 2026 15:28:55 +0200 Subject: [PATCH 4/4] add element<- --- NAMESPACE | 1 + R/AllGenerics.R | 1 + R/methods.R | 6 ++++++ man/SpatialData.Rd | 3 +++ tests/testthat/test-methods.R | 10 ++++++++++ 5 files changed, 21 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index fb003ef..0011b09 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,6 +32,7 @@ exportMethods("$<-") exportMethods("[") exportMethods("[[") exportMethods("[[<-") +exportMethods("element<-") exportMethods("feature_key<-") exportMethods("image<-") exportMethods("imageNames<-") diff --git a/R/AllGenerics.R b/R/AllGenerics.R index d987509..23ff5d1 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -94,6 +94,7 @@ setGeneric("meta<-", \(x, ..., value) standardGeneric("meta<-")) setGeneric("layer", \(x, i, ...) standardGeneric("layer")) setGeneric("element", \(x, i, ...) standardGeneric("element")) +setGeneric("element<-", \(x, i, value) standardGeneric("element<-")) setGeneric("elements", \(x, i, ...) standardGeneric("elements")) setGeneric("query", \(x, ...) standardGeneric("query")) diff --git a/R/methods.R b/R/methods.R index 9e837dd..a97693f 100644 --- a/R/methods.R +++ b/R/methods.R @@ -144,6 +144,12 @@ setMethod("element", c("SpatialData", "missing"), \(x, i) element(x, 1)) setMethod("element", c("SpatialData", "ANY"), \(x, i) stop("invalid 'i'; should be a string specifying an element in 'x'")) +#' @rdname SpatialData +#' @export +setReplaceMethod("element", + c("SpatialData", "character"), + \(x, i, value) { x[[layer(x, i)]][[i]] <- value; x }) + # get all ---- #' @export diff --git a/man/SpatialData.Rd b/man/SpatialData.Rd index 3d29631..17c3f80 100644 --- a/man/SpatialData.Rd +++ b/man/SpatialData.Rd @@ -56,6 +56,7 @@ \alias{element,SpatialData,numeric-method} \alias{element,SpatialData,missing-method} \alias{element,SpatialData,ANY-method} +\alias{element<-,SpatialData,character-method} \alias{images,SpatialData-method} \alias{labels,SpatialData-method} \alias{points,SpatialData-method} @@ -95,6 +96,8 @@ SpatialData(images, labels, points, shapes, tables) \S4method{element}{SpatialData,ANY}(x, i) +\S4method{element}{SpatialData,character}(x, i) <- value + \S4method{images}{SpatialData}(x) \S4method{labels}{SpatialData}(x) diff --git a/tests/testthat/test-methods.R b/tests/testthat/test-methods.R index 5e8c67d..df88598 100644 --- a/tests/testthat/test-methods.R +++ b/tests/testthat/test-methods.R @@ -41,6 +41,16 @@ 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, .)) + y <- x; element(y, .) <- NULL + expect_error(element(y, .)) + } +}) + test_that("get all", { for (f in paste0(fun, "s")) expect_is(get(f)(x), "list")