fix data/table

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SpatialData
 Title: Representation of Python's SpatialData in R
 Depends: R (>= 4.6)
-Version: 0.99.35
+Version: 0.99.36
 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 
@@ -67,7 +67,6 @@ Imports:
     RBGL,
     rlang,
     sf,
-    S4Arrays,
     S4Vectors,
     SingleCellExperiment,
     SummarizedExperiment,

NAMESPACE

@@ -118,6 +118,7 @@ importFrom(BiocGenerics,as.data.frame)
 importFrom(BiocGenerics,colnames)
 importFrom(BiocGenerics,combine)
 importFrom(BiocGenerics,rownames)
+importFrom(BiocGenerics,table)
 importFrom(DBI,dbIsValid)
 importFrom(DelayedArray,DelayedArray)
 importFrom(EBImage,rotate)
@@ -187,6 +188,7 @@ importFrom(methods,callNextMethod)
 importFrom(methods,is)
 importFrom(methods,new)
 importFrom(methods,setClassUnion)
+importFrom(methods,setMethod)
 importFrom(methods,setReplaceMethod)
 importFrom(rlang,"!!")
 importFrom(rlang,.data)

R/AllGenerics.R

@@ -4,7 +4,8 @@ setGeneric("image", \(x, ...) standardGeneric("image"))
 setGeneric("label", \(x, ...) standardGeneric("label"))
 setGeneric("shape", \(x, ...) standardGeneric("shape"))
 setGeneric("point", \(x, ...) standardGeneric("point"))
-setGeneric("table", \(x, ...) standardGeneric("table"))
+#setGeneric("table", \(x, ...) standardGeneric("table"))
+#' @importFrom BiocGenerics table
 
 # get all ----
 
@@ -86,7 +87,7 @@ setGeneric("instance_key<-", \(x, value) standardGeneric("instance_key<-"))
 
 # uts ----
 
-setGeneric("data", \(x, ...) standardGeneric("data"))
+setGeneric("data", \(...) standardGeneric("data"))
 setGeneric("meta", \(x, ...) standardGeneric("meta"))
 
 setGeneric("data<-", \(x, ..., value) standardGeneric("data<-"))

R/SpatialData.R

@@ -1,8 +1,9 @@
 #' @name SpatialData
 #' @title The `SpatialData` class
 #' 
-#' @aliases data meta layer element
-#' @aliases image label point shape table
+#' @aliases data meta 
+#' @aliases layer element element<-
+#' @aliases image label point shape table,ANY-method
 #' @aliases images labels points shapes tables
 #' @aliases image<- label<- point<- shape<- table<-
 #' @aliases images<- labels<- points<- shapes<- tables<-
@@ -31,7 +32,9 @@
 #' @param drop ignored.
 #' @param name character string for extraction (see \code{?base::`$`}).
 #' @param value (list of) element(s) with layer-compliant object(s), 
-#'   or NULL/\code{list()} to remove an element/layer completely.
+#'   or NULL/\code{list()} to remove an element/layer completely; 
+#'   for \code{element<-}, a single \code{SpatialDataElement}
+#'   of the same class as \code{element(x, i)}.
 #' @param ... optional arguments passed to and from other methods.
 #'
 #' @return \code{SpatialData}

R/methods.R

@@ -1,3 +1,5 @@
+#' @importFrom methods is setMethod callNextMethod setReplaceMethod
+
 #' @export
 #' @importFrom utils .DollarNames
 .DollarNames.SpatialData <- \(x, pattern="") grep(pattern, .LAYERS, value=TRUE)
@@ -12,7 +14,6 @@ setReplaceMethod("$", "SpatialData", \(x, name, value) `[[<-`(x, i=name, value=v
 
 #' @export
 #' @rdname SpatialData
-#' @importFrom methods callNextMethod
 setMethod("[[", c("SpatialData", "numeric"), \(x, i, ...) {
     i <- .LAYERS[i]
     callNextMethod(x, i)
@@ -26,7 +27,28 @@ setMethod("[[", c("SpatialData", "character"), \(x, i, ...) attr(x, i))
 
 #' @export
 #' @rdname SpatialData
-setMethod("data", "SpatialDataElement", \(x) x@data)
+setMethod("data", "ANY", \(...) {
+    l <- list(...)
+    x <- l[[1]]
+    if (!is(x, "SpatialDataElement")) 
+        return(utils::data(...))
+    if (!is(x, "SpatialDataArray")) 
+        return(x@data)
+    # return list of available scales
+    k <- if (length(l) == 1) 1 else l[[2]]
+    if (is.null(k)) return(x@data)
+    # should be a scalar positive integer
+    ok <- length(k) == 1 && is.numeric(k) && k > 0 && k == round(k)
+    if (!ok) stop("invalid 'k'; should be ",
+        "NULL or a scalar positive integer")
+    # get number of available scales
+    n <- length(x <- x@data)   
+    # input of Inf uses lowest
+    if (is.infinite(k)) k <- n 
+    # return specified scale
+    if (k <= n) return(x[[k]]) 
+    stop("'k=", k, "' but only ", n, " resolution(s) available")
+})
 
 #' @export
 #' @rdname SpatialData
@@ -207,11 +229,10 @@ for (. in one) eval(f(.), parent.env(environment()))
 # get one ----
 
 #' @name SpatialData
-#' @exportMethod image label point shape table
+#' @exportMethod image label point shape
 NULL
 
-f <- \(.) setMethod(., "SpatialData", \(x, i=1) {
-    y <- x[[paste0(., "s")]]
+.get <- \(y, i) {
     if (is.numeric(i)) {
         if (i < 1 || !is.finite(i)) stop(
             "invalid 'i'; should be a ",
@@ -225,15 +246,31 @@ f <- \(.) setMethod(., "SpatialData", \(x, i=1) {
         "invalid 'i'; should be one of: ",
         paste(names(y), collapse=", "))
     y[[i]]
+}
+
+#' @name SpatialData
+#' @export
+setMethod("table", "ANY", \(...) {
+    l <- list(...)
+    if (!is(l[[1]], "SpatialData")) 
+        return(base::table(...))
+    n <- length(l)
+    i <- if (n == 1) 1 else l[[2]]
+    m <- length(i)
+    if (any(c(n, m) > 2)) 
+        stop("too many arguments")
+    y <- l[[1]]$tables
+    .get(y, i)
 })
-for (. in one) eval(f(.), parent.env(environment()))
+
+.set <- \(.) setMethod(., "SpatialData", \(x, i=1) .get(x[[paste0(., "s")]], i))
+for (. in setdiff(one, "table")) eval(.set(.), parent.env(environment()))
 
 # set all ----
 
 # |_[[<- ----
 
 #' @rdname SpatialData
-#' @importFrom methods setReplaceMethod
 #' @export
 setReplaceMethod("[[", c("SpatialData", "numeric"), 
     \(x, i, value) { x[[.LAYERS[i]]] <- value; x })

R/misc.R

@@ -64,7 +64,7 @@ NULL
     d <- lapply(d, paste, collapse=",")
     cat(sprintf("- tables(%s):\n", length(t)))
     for (. in seq_along(t)) {
-        r <- paste(region(SpatialData::table(object, t[.])), collapse=",")
+        r <- paste(region(table(object, t[.])), collapse=",")
         cat(sprintf("  - %s (%s) [%s]\n", t[.], d[.], r))
     }
     # spaces

R/query.R

@@ -33,7 +33,7 @@ NULL
 setMethod("query", "SpatialData", \(x, ..., i=1) {
     if (!length(tables(x)))
         stop("There aren't any tables")
-    t <- SpatialData::table(x, i)
+    t <- table(x, i)
     df <- data.frame(.i=seq_len(ncol(t)), colData(t), int_colData(t))
     df <- filter(df, ...)
     if (!nrow(df)) stop("Nothing left after query")

R/sdArray.R

@@ -23,9 +23,9 @@
 #' @param data list of \code{ZarrArray}s
 #' @param meta \code{\link{SpatialDataAttrs}}
 #' @param metadata optional list of arbitrary additional content.
-#' @param k scalar index specifying which image scale to extract.
+
 #' @param ... option arguments passed to and from other methods.
-#' @param i,j indices specifying elements to extract.
+#' @param i,j,k indices specifying elements/slices to extract.
 #' @param drop ignored.
 #'
 #' @return \code{SpatialDataArray}
@@ -85,20 +85,6 @@ SpatialDataLabel <- function(data=list(), meta=SpatialDataAttrs(), metadata=list
 
 # utils ----
 
-#' @rdname SpatialDataArray
-#' @export
-setMethod("data", "SpatialDataArray", \(x, k=1) {
-    # direct accession needed here
-    # to get at available scales
-    x <- x@data 
-    if (is.null(k)) return(x)
-    stopifnot(length(k) == 1, is.numeric(k), k > 0)
-    n <- length(x) # get number of available scales
-    if (is.infinite(k)) k <- n # input of Inf uses lowest
-    if (k <= n) return(x[[k]]) # return specified scale
-    stop("'k=", k, "' but only ", n, " resolution(s) available")
-})
-
 #' @rdname SpatialDataArray
 #' @export
 setMethod("dim", "SpatialDataArray", \(x) dim(data(x)))

R/tables.R

@@ -118,7 +118,7 @@ setMethod("getTable", c("SpatialData", "character"), \(x, i, j, assay=1, drop=TR
     stopifnot(isTRUE(drop) || isFALSE(drop))
     # get 'table' annotating 'i', if any
     nm <- hasTable(x, i, name=TRUE) 
-    t <- SpatialData::table(x, nm)
+    t <- table(x, nm)
     # only keep observations belonging to 'i' (optional)
     if (drop) {
         rk <- region_key(t)

R/utils.R

@@ -47,7 +47,7 @@
 .sync_shapes_on_drop <- \(x, i) {
     # skip when there aren't any shapes
     if (!length(shapes(x))) return(x)
-    t <- SpatialData::table(x, i)
+    t <- table(x, i)
     for (j in region(t)) {
         # skip non-shape elements
         if (layer(x, j) != "shapes") next

R/validity.R

@@ -4,7 +4,7 @@
     msg <- c()
     sce <- \(.) is(., "SingleCellExperiment")
     for (i in seq_along(tables(object))) {
-        ok <- sce(se <- SpatialData::table(object, i))
+        ok <- sce(se <- table(object, i))
         if (!ok) msg <- c(msg, paste0(
             i, "-th table is not a 'SingleCellExperiment'"))
         if (!ok) next

inst/NEWS

@@ -1,3 +1,7 @@
+changes in version 0.99.36
+
+- fix conflicts with 'base::table' and 'utils::data'
+
 changes in version 0.99.35
 
 - class renaming

tests/testthat/test-combine.R

@@ -13,7 +13,7 @@ test_that("combine", {
     expect_all_true(r %in% f(y))
     expect_true(!all(r %in% f(x)))
     expect_all_true(!duplicated(r))
-    expect_true(r[1] == region(SpatialData::table(x)))
+    expect_true(r[1] == region(table(x)))
 
     f <- \(x, y) `names<-`(x, paste(names(x), y, sep="."))
     a <- b <- x

tests/testthat/test-ctgraph.R

@@ -5,7 +5,7 @@ x <- readSpatialData(x)
 test_that("CTgraph", {
     # invalid
     expect_error(CTgraph(list()))
-    expect_error(CTgraph(SpatialData::table(x)))
+    expect_error(CTgraph(table(x)))
     # object-wide
     g <- CTgraph(x)
     expect_is(g, "graph")

tests/testthat/test-methods.R

@@ -144,9 +144,9 @@ test_that("set nms", {
     y <- x; val <- letters[seq_along(images(x))]
     expect_silent(imageNames(y) <- val)
     expect_identical(imageNames(y), val)
-    r <- region(SpatialData::table(x))
+    r <- region(table(x))
     y <- x; labelNames(y) <- "x"
-    r <- region(SpatialData::table(y))
+    r <- region(table(y))
     expect_identical(r, "x")
 })