fix axes metadata for points/shapes

R/CTutils.R

@@ -59,7 +59,12 @@ setMethod("axes", "SpatialDataAttrs", \(x, y=NULL, ...) {
     if (is.null(x)) stop("couldn't find 'axes'") 
     if (is.null(y)) return(x)
     y <- match.arg(y, c("name", "type", "unit"))
-    vapply(x, `[[`, character(1), y)
+    # shape/point axes have no type and unit, return axes names as given
+    if(y == "name" && is.null(names(x[[1]]))){
+      unlist(x)
+    } else {
+      vapply(x, `[[`, character(1), y)
+    }
 })
 
 # CTlist/data/type/name() ----

R/crop.R

@@ -141,9 +141,9 @@ NULL
         ct[[type]] <- .adapt(data, type)
     }
     # update input axes from 'cyx' to 'xy'
-    ct$input$axes <- .default_ax(type="frame")
+    ct$input$axes <- .default_ax(type="shape")
     # create temporary shape & transform back
-    md <- SpatialDataAttrs(type="frame", trans=list(ct))
+    md <- SpatialDataAttrs(type="shape", trans=list(ct))
     z <- SpatialDataShape(df, meta=md)
     z <- transform(z, 1, rev=TRUE)
     # extract coordinates & return range

R/sdAttrs.R

@@ -10,17 +10,18 @@
 #' 
 #' @param x element or list extracted from a OME-NGFF compliant .zattrs file.
 #' @param name character string for extraction (see ?base::`$`).
-#' @param type character string; either "array" (image/label) or "frame" (point/shape).
-#' @param label flag; when \code{type="frame"}, should attributes be for a label?
+#' @param type character string; either "image", "label", "point" or "shape"
 #' @param trans list of coordinate transformations; defaults to identity only.
 #' @param value character string (for one \code{region} and \code{_key}s), 
 #'   or vector (for many \code{region}s, \code{instances} and \code{regions}).
-#' @param ver character string; specifies the OME version to comply with.
+#' @param ver character string; specifies the SpatialData version to comply with.
 #' @param dim scalar integer in 2-4;
-#'   number of dimensions: 2 = XY, 3 adds Z, 4 adds T (time); 
-#'   when \code{type="image"}, C (channel) will be added (for any \code{dim}).
+#'   number of dimensions: 2 = XY, 3 adds Z, 4 adds T (time) for image and 
+#'   label; when \code{type="image"}, C (channel) will be added (for any 
+#'   \code{dim}).
 #' @param nch scalar integer; how many channels should there be?
-#'   (ignored unless \code{type="frame"} and \code{label=FALSE}). 
+#'   (ignored unless \code{type="shape"} or \code{type="point"}, and 
+#'   \code{label=FALSE}). 
 #' @param ... additional attributes (e.g., version, feature_key).
 #' 
 #' @details 
@@ -29,8 +30,8 @@
 #' \code{SingleCellExperiment}: \code{region}, \code{region/instance_key}.
 #' 
 #' When missing \code{x}, \code{SpatialDataAttrs} will generate a valid object 
-#' with default axes (array: cyx, frame: xy) and transformations (identify) 
-#' according to the specified type.
+#' with default axes (image: cyx, label:yx, point/shape: xy) and transformations 
+#' (identify) according to the specified type.
 #' 
 #' @return character string
 #' 
@@ -55,27 +56,30 @@
 #' CTdata(z, "scale")
 #' 
 #' # constructor
-#' SpatialDataAttrs(type="frame")
+#' SpatialDataAttrs(type="point")
+#' SpatialDataAttrs(type="shape")
 #' SpatialDataAttrs(type="image", nch=7)
 #' SpatialDataAttrs(type="label", dim=3)
 #' 
 #' @export
-SpatialDataAttrs <- \(x, type=c("image", "label", "frame"), 
-    trans=NULL, ver="0.3", dim=2, nch=3, ...) 
+SpatialDataAttrs <- \(x, type=c("image", "label", "point", "shape"), 
+    trans=NULL, ver=NULL, dim=2, nch=3, ...) 
 {
-    stopifnot(
-        length(dim) == 1, is.numeric(dim), dim %in% seq(2, 4),
-        length(nch) == 1, is.numeric(nch), round(nch) == nch, nch > 0)
     if (!missing(x)) return(.SpatialDataAttrs(x))
     type <- match.arg(type)
-    ver <- .val_ome_ver(ver)
+    stopifnot(
+        length(dim) == 1, is.numeric(dim), 
+        dim %in% seq(2, if(type %in% c("point", "shape")) 3 else 4),
+        length(nch) == 1, is.numeric(nch), round(nch) == nch, nch > 0)
+    if(is.null(ver)) ver <- if(type == "point") "0.2" else "0.3"
+    ver <- .val_sd_ver(ver, type)
     ax <- .default_ax(type, dim)
     # transformations:
     ct <- trans %||% .default_ct(ax)
     # datasets:
     ds <- .default_ds(.ax_names(ax)) 
     # .zattrs list:
-    if (type != "frame") {
+    if (!type %in% c("point", "shape")) {
         # default structure
         res <- list()
         if(type != "label")
@@ -98,26 +102,30 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "frame"),
         if (ver == "0.3") res <- list(ome=res)
     } else {
         # points/shapes
-        res <- list(axes=ax, coordinateTransformations=ct)
+        res <- list(
+          axes=.ax_names(ax), # point and shape take only names
+          coordinateTransformations=ct
+        )
     }
     res$spatialdata_attrs <- list(version=ver)
     SpatialDataAttrs(res)
 }
 
 # Internal helper to generate OME-NGFF axes
-.default_ax <- \(type=c("image", "label", "frame"), dim=2) {
+.default_ax <- \(type=c("image", "label", "point", "shape"), dim=2) {
     c <- list(name="c", type="channel")
     t <- list(name="t", type="time")
     z <- list(name="z", type="space")
     y <- list(name="y", type="space")
     x <- list(name="x", type="space")
-    switch(match.arg(type), 
+    type <- match.arg(type)
+    switch(type, 
         # xyzt for points/shapes
-        frame={
+        point=,
+        shape={
             ax <- list(x, y)
             if (dim > 2) {
                 ax <- c(ax, list(z))
-                if (dim > 3) ax <- c(ax, list(t))
             }
         },
         # tczyx for images/labels
@@ -138,13 +146,17 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "frame"),
   if (is.character(ax[[1]])) {
     unlist(ax)
   } else {
-    vapply(ax, \(.) .$name, character(1))
+    lapply(ax, \(.) .$name)
   }
 }
 
 # Internal helper to generate coordinate transformations
 .default_ct <- \(axes, name="global", type="identity", data=NULL) {
-    ct <- list(input=axes, output=list(name=name), type=type)
+    ct <- list(input=list(axes=axes, 
+                          name=paste(.ax_names(axes), collapse = "")), 
+               output=list(axes=axes, 
+                           name=name), 
+               type=type)
     if (!is.null(data)) ct[[type]] <- data
     list(ct)
 }
@@ -158,7 +170,7 @@ SpatialDataAttrs <- \(x, type=c("image", "label", "frame"),
       coordinateTransformations = list(
         list(
           scale = lapply(
-            axes,
+            unlist(axes),
             \(.) if(. == "c") 1 else s),
           type = "scale"
         )

R/sdFrame.R

@@ -123,7 +123,7 @@ NULL
 #' @importFrom methods is
 #' @importFrom sf st_geometry_type
 #' @importFrom S4Vectors metadata<-
-SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=list(), ik=NULL, fk=NULL, ...) {
+SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="point"), metadata=list(), ik=NULL, fk=NULL, ...) {
     data <- .df_to_sf(data, "POINT")
     if (isTRUE(nrow(data) > 0L)) {
         gt <- tryCatch(unique(st_geometry_type(data)), error=\(.) "n/a")
@@ -153,7 +153,7 @@ SpatialDataPoint <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=l
 #' @rdname SpatialDataFrame
 #' @importFrom methods is
 #' @importFrom S4Vectors metadata<-
-SpatialDataShape <- \(data=NULL, meta=SpatialDataAttrs(type="frame"), metadata=list(), ...) {
+SpatialDataShape <- \(data=NULL, meta=SpatialDataAttrs(type="shape"), metadata=list(), ...) {
     data <- .df_to_sf(data, "POLYGON")
     if (!is(data, "duckspatial_df")) 
         data <- .duck(data, "sdShape")

R/utils.R

@@ -174,6 +174,17 @@
     return(v)
 }
 
+# validate SpatialData version
+.val_sd_ver <- \(v, type) {
+  type <- match.arg(type, c("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")
+  return(v)
+}
+
 # multiscales ----
 
 # internal helper to get the 'active' metadata level

tests/testthat/test-ctutils.R

@@ -21,6 +21,18 @@ test_that("axes", {
         expect_length(z, d)
         expect_in(z, c("time","channel","space"))
     }
+    es <- list(shape(x), point(x))
+    for (e in es) {
+        z <- axes(e)
+        d <- length(dim(e))
+        expect_type(z, "list")
+        expect_length(z, d)
+        expect_error(axes(e, "bad"))
+        # name
+        # TODO: should "name" only return itself for frames, or return error
+        expect_silent(z <- axes(e, "name"))
+        expect_type(z, "character")
+    }
 })
 
 .CTtype <- c(

tests/testthat/test-sdattrs.R

@@ -61,12 +61,32 @@ test_that(".val_ome_ver()", {
     expect_length(x, 1)
     expect_identical(x, v)
 })
+test_that(".val_sd_ver()", {
+    # invalid
+    expect_error(.val_sd_ver(0.3), 'argument "type" is missing')
+    expect_error(.val_sd_ver(1, "image"))
+    expect_error(.val_sd_ver(TRUE, "image"))
+    expect_error(.val_sd_ver("0.0", "image"))
+    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"))
+    # 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_type(x, "character")
+    expect_length(x, 1)
+    expect_identical(x, v)
+})
 test_that("SpatialDataAttrs()", {
     # invalid
     expect_error(SpatialDataAttrs(nch=0))
     expect_error(SpatialDataAttrs(dim=7))
     expect_error(SpatialDataAttrs(ver="0.0"))
     expect_error(SpatialDataAttrs(type="bad"))
+    expect_error(SpatialDataAttrs(type = "point", dim=4))
+    expect_error(SpatialDataAttrs(type = "shape", dim=4))
     # 2-4D image
     nms <- c("c", "t", "z", "y", "x")
     for (d in seq(2, 4)) {
@@ -87,6 +107,8 @@ test_that("SpatialDataAttrs()", {
         expect_length(y, 7)
         expect_type(y, "character")
         expect_all_true(!duplicated(y))
+        # version
+        expect_equal(x$spatialdata_attrs$version, "0.3")
     }
     # 2-4D label
     for (d in seq(2, 4)) {
@@ -95,14 +117,28 @@ test_that("SpatialDataAttrs()", {
         expect_length(y, d)
         expect_equal(sum(y == "time"), ifelse(d == 4, 1, 0))
         expect_equal(sum(y == "space"), ifelse(d == 2, 2, 3))
+        # version
+        expect_equal(x$spatialdata_attrs$version, "0.3")
     }
     # 3-4D shape/point
-    for (d in seq(2, 4)) {
-        x <- SpatialDataAttrs(type="frame", dim=d)
-        y <- axes(x, "type")
+    nms <- c("x", "y", "z")
+    for (d in seq(2, 3)) {
+      for(typ in c("shape", "point")){
+        x <- SpatialDataAttrs(type=typ, dim=d)
+        ok <- if (d == 2) nms[-3] else nms
+        y <- axes(x)
         expect_length(y, d)
+        expect_equal(unlist(y), ok)
         expect_null(channels(x))
-        expect_equal(sum(y == "time"), ifelse(d == 4, 1, 0))
-        expect_equal(sum(y == "space"), ifelse(d == 2, 2, 3))
+        # axes name
+        y <- axes(x, "name")
+        expect_length(y, d)
+        expect_type(y, "character")
+        expect_identical(y, ok)
+        expect_error(axes(x, "type")) 
+        # version
+        expect_equal(x$spatialdata_attrs$version, 
+                     if(typ == "point") "0.2" else "0.3")
+      }
     }
 })