drop table instances on crop()

NAMESPACE

@@ -147,6 +147,7 @@ importFrom(ZarrArray,path)
 importFrom(ZarrArray,type)
 importFrom(anndataR,read_zarr)
 importFrom(dplyr,all_of)
+importFrom(dplyr,anti_join)
 importFrom(dplyr,coalesce)
 importFrom(dplyr,collect)
 importFrom(dplyr,count)

R/crop.R

@@ -232,19 +232,39 @@ setMethod("crop", "SpatialDataFrame", \(x, y, j=1, ...) {
 
 #' @export
 #' @rdname crop
+#' @importFrom dplyr anti_join
 setMethod("crop", "SpatialData", \(x, y, j=1, ...) {
     if (is.numeric(j)) j <- CTname(x)[j]
     # crop elements that share coordinate space 'j'
     z <- .lapplyElement(x, \(z) {
         if (j %in% CTname(z))
             crop(z, y, j=j)
     })
-    # filter tables by remaining element(s)
-    ok <- unlist(colnames(z))
+    rs <- unlist(colnames(z))
     ts <- lapply(tables(z), \(t) {
-        t <- t[, regions(t) %in% ok]
-        region(t) <- intersect(region(t), ok)
-        return(t)
+        # filter for remaining element(s)
+        t <- t[, regions(t) %in% rs]
+        region(t) <- intersect(region(t), rs)
+        # table's regions-instances
+        df <- data.frame(
+            r=regions(t), 
+            i=instances(t),
+            keep=seq_len(ncol(t)))
+        # for each annotated element
+        is <- lapply(region(t), \(r) {
+            # subset look-up
+            df <- df[df$r == r, ]
+            e <- element(z, r)
+            if (is(e, "SpatialDataShape")) {
+                # element's regions-instances
+                i <- e[[instance_key(t)]]
+                fd <- data.frame(r, i)
+                # return table indices in element
+                right_join(df, fd, names(fd))$keep
+            } else df$keep
+        })
+        # subset table instances
+        t <- t[, unlist(is)]
     })
     tables(z) <- ts
     return(z)

R/SDattrs.R → R/sdAttrs.R

@@ -180,11 +180,7 @@ setReplaceMethod("region_key", c("SingleCellExperiment", "NULL"), \(x, value) {
 
 #' @export
 #' @rdname SpatialDataAttrs
-setMethod("region", "SingleCellExperiment", \(x) {
-    rk <- region_key(x)
-    if (is.null(rk)) return(NULL)
-    meta(x)[[rk]]
-})
+setMethod("region", "SingleCellExperiment", \(x) meta(x)[["region"]])
 
 #' @export
 #' @rdname SpatialDataAttrs

R/tables.R

@@ -159,7 +159,7 @@ setMethod("setTable", c("SpatialData", "ANY"), \(x, i, ..., name=NULL, rk="rk",
 #' @export
 setMethod("setTable", c("SpatialData", "character"), \(x, i, y,
     name=NULL, rk="region", ik="instance_id") {
-    
+
     # validity
     stopifnot(
         is(y, "SingleCellExperiment"),

tests/testthat/test-tables.R

@@ -85,11 +85,9 @@ test_that("setTable(),labels", {
     expect_error(setTable(x, character(2), SingleCellExperiment()))
     # 'name' that already exists fails
     expect_error(setTable(x, i, SingleCellExperiment(), name=tableNames(x)))
-    # valid w/o name
+    # valid w/o specifications
     e <- element(x, i)
     sce <- SingleCellExperiment(matrix(0, 0, length(instances(e))))
-    # set instances manually
-    int_colData(sce)$instance_id <- instances(e)
     y <- setTable(x, i, sce)
     expect_length(tables(y), 2)
     expect_true(hasTable(y, i))