getters for SpatialData format (version)

NAMESPACE

@@ -113,6 +113,7 @@ exportMethods(tableNames)
 exportMethods(tables)
 exportMethods(transform)
 exportMethods(translation)
+exportMethods(version)
 importFrom(BiocGenerics,
   as.data.frame,
   colnames,

R/AllGenerics.R

@@ -78,6 +78,7 @@ setGeneric("feature_key", \(x, ...) standardGeneric("feature_key"))
 setGeneric("feature_key<-", \(x, value) standardGeneric("feature_key<-"))
 setGeneric("instance_key", \(x, ...) standardGeneric("instance_key"))
 setGeneric("instance_key<-", \(x, value) standardGeneric("instance_key<-"))
+setGeneric("version", \(x, ...) standardGeneric("version"))
 
 # uts ----
 

R/path.R

@@ -54,19 +54,5 @@ setMethod("path", "SingleCellExperiment", \(object, ...) {
 
 #' @export
 #' @rdname path
-#' @importFrom dplyr tibble
-setMethod("path", "SpatialData", \(object, simplify=TRUE, ...) {
-    names(ls) <- ls <- rownames(object)
-    ps <- lapply(ls, \(l) {
-        names(es) <- es <- names(object[[l]])
-        lapply(es, \(e) path(object[[l]][[e]]))
-    })
-
-    if (!simplify) return(ps)
-
-    do.call(rbind, lapply(names(ps), \(l) 
-        do.call(rbind, lapply(names(ps[[l]]), \(e)
-            tibble(layer = l, element = e, path = ps[[l]][[e]])
-        ))
-    ))
-})
+setMethod("path", "SpatialData", \(object, simplify=TRUE, ...)
+          .element_apply(object, path, "path", simplify))

R/sdAttrs.R

@@ -94,7 +94,7 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "point", "shape"),
                                                    \(.) list(label = .)))))
         res <- c(res,
                  list(
-                   version=.get_ome_version(ver),
+                   version=.ome_ver_from_sd(ver),
                    multiscales=
                      list(
                        list(
@@ -199,7 +199,7 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]])
         x$multiscales[[1]]$version %||%
         x$omero$version %||% 
         x$ome$version
-    if (!length(v)) stop("couldn't find 'version' in 'spatialdata_attrs'")
+    if (!length(v)) stop("couldn't find OME-NGFF (OME-Zarr) version")
     .val_ome_ver(v)
 }
 
@@ -215,13 +215,13 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]])
     x
 }
 
-.get_ome_version <- \(x) {
+.ome_ver_from_sd <- \(x) {
   switch(as.character(x), 
          "0.1" = "0.4",
          "0.2" = "0.4-dev-spatialdata",
          "0.3" = "0.5-dev-spatialdata",
-         stop("Invalid SpatialDataImage/Label format! ", 
-              "Must be 0.1, 0.2, or 0.3"))
+         stop("Invalid SpatialData Image/Label element version; ", 
+              "expected '0.x' where x is 1-3"))
 }
 
 # internal use only!
@@ -396,3 +396,49 @@ setReplaceMethod("instances", c("SingleCellExperiment", "ANY"), \(x, value) {
     int_colData(x)[[ik]] <- value
     return(x)
 })
+
+# version ----
+
+#' @name version
+#' @title Retrieve versions of \code{SpatialData} elements
+#' 
+#' @param x \code{\link{SpatialData}} object or one of its elements.
+#' @param simplify logical scalar; whether to flatten paths into a tibble.
+#' @param ... ignored.
+#' 
+#' @returns
+#' for single elements, a character string; 
+#' for \link{SpatialData} objects, if \code{simplify=TRUE} (default), 
+#' a \code{tibble} where rows=elements and columns=layers/elements/versions. 
+#' if \code{simplify=FALSE}, a depth-3 list where levels=layers/elements/versions.
+#' 
+#' @examples
+#' zs <- file.path("extdata", "blobs.zarr")
+#' zs <- system.file(zs, package="spatialdataR")
+#' sd <- readSpatialData(zs)
+#' 
+#' # element-wise
+#' version(shape(sd))
+#' 
+#' # object-wide
+#' version(sd)
+#' version(sd, FALSE)$labels
+#' 
+NULL
+
+#' @export
+#' @rdname version
+setMethod("version", "SpatialDataElement", \(x) version(meta(x)))
+
+#' @export
+#' @rdname version
+setMethod("version", "SpatialDataAttrs", \(x) x$spatialdata_attrs$version)
+
+#' @export
+#' @rdname version
+setMethod("version", "SingleCellExperiment", \(x) meta(x)$version)
+
+#' @export
+#' @rdname version
+setMethod("version", "SpatialData", \(x, simplify=TRUE, ...)
+          .element_apply(x, version, "version", simplify))

R/utils.R

@@ -167,18 +167,18 @@
 # validate OME version
 .val_ome_ver <- \(v) {
     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-6")
+    if (!ok) stop("invalid OME-NGFF (OME-Zarr) 'version'; expected '0.x' where x is 1-6")
     return(v)
 }
 
 # validate SpatialData version
 .val_sd_ver <- \(v, type) {
-  type <- match.arg(type, c("image", "label", "point", "shape"))
+  type <- match.arg(type, c("table", "image", "label", "point", "shape"))
   ok <- length(v) == 1 && 
     is.character(v) && 
-    v %in% sprintf("0.%d", seq_len(if(type == "point") 2 else 3))
-  if (!ok) stop("invalid SpatialData 'version'; expected '0.x' where x is 1-3 ", 
-                "for image/label/shape and 1-2 for point")
+    v %in% sprintf("0.%d", seq_len(if(type %in% c("point", "table")) 2 else 3))
+  if (!ok) stop("invalid SpatialData element version; expected '0.x' where ", 
+                "x is 1-3 for image/label/shape and 1-2 for point and table")
   return(v)
 }
 
@@ -220,3 +220,26 @@
             " least one data() pair with identical dimensions")
     return(ks)
 }
+
+# path/version ----
+
+#' @importFrom dplyr tibble
+#' @noRd
+.element_apply <- function(x, FUN, col, simplify=TRUE) {
+    names(ls) <- ls <- rownames(x)
+    ps <- lapply(ls, \(l) {
+        names(es) <- es <- names(x[[l]])
+        lapply(es, \(e) FUN(x[[l]][[e]]))
+    })
+
+    if (!simplify) return(ps)
+
+    df <- do.call(rbind, lapply(names(ps), \(l) 
+        do.call(rbind, lapply(names(ps[[l]]), \(e)
+            tibble(layer=l, element=e, value=ps[[l]][[e]])
+        ))
+    ))
+
+    if (!is.null(df)) names(df)[3] <- col
+    df
+}

inst/NEWS

@@ -1,7 +1,8 @@
 changes in version 0.99.47
 
 - support 'affine' coordinate transformations for
-  point/shape elements via 'duckspatial::ST_affine'
+  point/shape elements via 'duckspatial::ST_affine' (#276)
+- added 'version()' to retrieve format versions of SpatialData elements (#288)
 
 changes in version 0.99.46
 
@@ -14,7 +15,6 @@ changes in version 0.99.45
 - setup auto-benchmarks
 - add contribution guidelines
 - code style and efficiency improvements
-<<<<<<< HEAD
 - added read support from S3 object storage for
   "images", "labels", "points", "shapes" elements
 - added new 'CTunit()' helper function
@@ -54,7 +54,7 @@ changes in version 0.99.39
 
 - class revision: SpatialData slots were base::list, now prototyped 
   S4Vectors::SimpleList with layer-specific properties & validation
-- added 'path()' to retrieve on-disk paths of spatial data elements
+- added 'path()' to retrieve on-disk paths of SpatialData elements
 
 changes in version 0.99.38
 

tests/testthat/test-sdattrs.R

@@ -1,4 +1,13 @@
-z <- list(v1="blobs.zarr", v3="blobs_v3.zarr")
+# testing for both SpatialData container versions 0.1 and 0.2
+z <- list(v01="blobs.zarr", v02="blobs_v3.zarr")
+zv <- list(
+    v01 = list(
+        image="0.1", label="0.1", point="0.1", shape="0.2", table="0.1"
+    ),
+    v02 = list(
+        image="0.3", label="0.3", point="0.2", shape="0.3", table="0.2"
+    )
+)
 
 for (v in names(z)) {
 
@@ -35,7 +44,7 @@ for (v in names(z)) {
         # missing
         y <- image(x)
         switch(v,
-            "v3"=y@meta$ome$multiscales[[1]]$axes <- NULL,
+            "v02"=y@meta$ome$multiscales[[1]]$axes <- NULL,
             y@meta$multiscales[[1]]$axes <- NULL)
         expect_error(axes(y))
     })
@@ -45,6 +54,20 @@ for (v in names(z)) {
         expect_silent(z <- channels(y <- image(x)))
         expect_length(z, dim(y)[1])
     })
+
+    test_that("version()", {
+        vx <- version(x)
+        expect_s3_class(vx, c("tbl_df", "tbl", "data.frame"))
+        expect_equal(colnames(vx), 
+                     c("layer", "element", "version"))
+        expect_all_true(vx$layer %in% paste0(names(zv[[v]]), "s"))
+        for (el in names(zv[[v]])[1:4]) {
+            f <- match.fun(el)
+            expect_equal(version(f(x)), zv[[v]][[el]])
+        }
+        # match.fun matches with base::table
+        expect_equal(version(table(x)), zv[[v]][["table"]])
+    })
 }
 
 test_that(".val_ome_ver()", {
@@ -70,15 +93,18 @@ test_that(".val_sd_ver()", {
     expect_error(.val_sd_ver("0.30", "image"))
     expect_error(.val_sd_ver(c("0.3", "0.4"), "image"))
     expect_error(.val_sd_ver("0.3", "point"))
+    expect_error(.val_sd_ver("0.3", "table"))
     # valid
     expect_silent(x <- .val_sd_ver(v <- "0.3", "image"))
     expect_silent(x <- .val_sd_ver(v <- "0.3", "label"))
     expect_silent(x <- .val_sd_ver(v <- "0.3", "shape"))
     expect_silent(x <- .val_sd_ver(v <- "0.2", "point"))
+    expect_silent(x <- .val_sd_ver(v <- "0.2", "table"))
     expect_type(x, "character")
     expect_length(x, 1)
     expect_identical(x, v)
 })
+
 test_that("SpatialDataAttrs()", {
     # invalid
     expect_error(SpatialDataAttrs(nch=0))