diff --git a/NAMESPACE b/NAMESPACE index b9c913a9..07522e54 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/crop.R b/R/crop.R index b187fe83..e777e239 100644 --- a/R/crop.R +++ b/R/crop.R @@ -232,6 +232,7 @@ 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' @@ -239,12 +240,31 @@ setMethod("crop", "SpatialData", \(x, y, j=1, ...) { 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) diff --git a/R/SDattrs.R b/R/sdAttrs.R similarity index 98% rename from R/SDattrs.R rename to R/sdAttrs.R index 52c07d30..8944f798 100644 --- a/R/SDattrs.R +++ b/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 diff --git a/R/tables.R b/R/tables.R index d765f2a2..ae593733 100644 --- a/R/tables.R +++ b/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"), diff --git a/tests/testthat/test-tables.R b/tests/testthat/test-tables.R index c631983e..ee7a8fc3 100644 --- a/tests/testthat/test-tables.R +++ b/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))