Zarr v3

.gitignore

@@ -10,3 +10,4 @@ inst/extdata/xenium1.zarr
 inst/extdata/visiumhd.zarr
 *.Rproj
 *.html
+R/_*

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SpatialData
 Title: Representation of Python's SpatialData in R
 Depends: R (>= 4.6)
-Version: 0.99.28
+Version: 0.99.29
 Description: Interface to Python's 'SpatialData', currently including:
     reticulate-based use of 'spatialdata-io' for reading of manufacturer
     data and writing to .zarr, on-disk representation of images/labels as
@@ -51,7 +51,6 @@ Imports:
     sf,
     S4Arrays,
     S4Vectors,
-    SparseArray,
     SingleCellExperiment,
     SummarizedExperiment
 Suggests:
@@ -63,8 +62,7 @@ Suggests:
     Rgraphviz,
     SpatialData.data,
     SpatialData.plot,
-    testthat,
-    DT
+    testthat
 Remotes:
     keller-mark/anndataR@spatialdata,
     HelenaLC/SpatialData.data,

R/AllGenerics.R

@@ -40,7 +40,6 @@ setGeneric("tables<-", \(x, value) standardGeneric("tables<-"))
 
 # trs ----
 
-setGeneric("axes", \(x, ...) standardGeneric("axes"))
 setGeneric("CTlist", \(x, ...) standardGeneric("CTlist"))
 setGeneric("CTdata", \(x, ...) standardGeneric("CTdata"))
 setGeneric("CTname", \(x, ...) standardGeneric("CTname"))
@@ -79,11 +78,13 @@ setGeneric("meta", \(x, ...) standardGeneric("meta"))
 setGeneric("query", \(x, ...) standardGeneric("query"))
 setGeneric("mask", \(x, i, j, ...) standardGeneric("mask"))
 
+setGeneric("axes", \(x, ...) standardGeneric("axes"))
+setGeneric("extent", \(x, ...) standardGeneric("extent"))
 setGeneric("channels", \(x, ...) standardGeneric("channels"))
+setGeneric("centroids", \(x, ...) standardGeneric("centroids"))
 setGeneric("data_type", \(x, ...) standardGeneric("data_type"))
 setGeneric("geom_type", \(x, ...) standardGeneric("geom_type"))
-setGeneric("centroids", \(x, ...) standardGeneric("centroids"))
-setGeneric("extent", \(x, ...) standardGeneric("extent"))
+setGeneric("multiscales", \(x, ...) standardGeneric("multiscales"))
 
 # tbl ----
 

R/CTgraph.R

@@ -10,6 +10,19 @@
 #' @param fac,max scalar numeric; node labels with \code{nchar>max}
 #'   are split and hyphenated at position \code{floor(nchar/fac)}
 #' 
+#' @returns
+#' \itemize{
+#' \item \code{CTgraph}: 
+#'   \code{graph::graphAM} object with nodes for each element and
+#'   coordinate space, and edges for each transformation (if specified)
+#' \item \code{CTpath}: 
+#'   list of transformations from \code{i} to \code{j};
+#'   length > 1 if \code{type} is \code{"sequential"}, length-1 otherwise;
+#'   each element specifies \code{type} and \code{data} of the transformation
+#' \item \code{CTplot}: 
+#'   visualizes the element-coordinate space graph with \code{Rgraphviz}
+#' }
+#' 
 #' @examples
 #' x <- file.path("extdata", "blobs.zarr")
 #' x <- system.file(x, package="SpatialData")

R/coord_utils.R → R/CTutils.R

@@ -1,17 +1,34 @@
-#' @name coord-utils
-#' @title Coordinate transformations
+#' @name CTutils
+#' @title Coord. trans. utilities
 #' @aliases axes CTlist CTname CTtype CTdata addCT rmvCT
 #' 
 #' @param x \code{SpatialData}, an element, or \code{Zattrs}.
 #' @param i for \code{CTpath}, source node label; else, string or 
 #'   scalar integer giving the name or index of a coordinate space.
-#' @param j character string; name of target coordinate space.
 #' @param name character(1); name of coordinate space
 #' @param type character(1); type of transformation
 #' @param data transformation data; size and shape depend on transformation and
 #'   element type (e.g., numeric(1) for rotation, numeric(2) for scaling in 2D)
 #' @param ... option arguments passed to and from other methods.
 #' 
+#' @returns
+#' \itemize{
+#' \item \code{CTname}: character string; 
+#'   transformation name (e.g., "global")
+#' \item \code{CTtype}: character string; 
+#'   transformation type (e.g., "affine")
+#' \item \code{CTdata}: list;
+#'   transformation data (e.g., scalar numeric for rotation)
+#' \item \code{CTlist}: list;
+#'   list of transformation specifications per OME-NGFF spec
+#' \item \code{add/rmvCT}: 
+#'   \code{SpatialDataElement} or \code{Zattrs} 
+#'   with transformation(s) added/removed
+#' \item \code{axes}: list; 
+#'   each element is a character string (name), or list 
+#'   with axis name and type (e.g., "space" or "channel")
+#' }
+#' 
 #' @examples
 #' x <- file.path("extdata", "blobs.zarr")
 #' x <- system.file(x, package="SpatialData")
@@ -38,30 +55,31 @@ NULL
 
 # axes() ----
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("axes", "Zattrs", \(x, ...) {
-    if (!is.null(ms <- x$multiscales)) x <- ms[[1]]
+    ms <- multiscales(x)
+    if (!is.null(ms)) x <- ms[[1]]
     if (is.null(x <- x$axes)) stop("couldn't find 'axes'") 
     return(x)
 })
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("axes", "SpatialDataElement", \(x, ...) axes(meta(x)))
 
 # CTlist/data/type/name() ----
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTlist", "Zattrs", \(x, ...) {
-    ms <- "multiscales"
+    ms <- multiscales(x)
     ct <- "coordinateTransformations"
-    if (is.null(x[[ms]])) return(x[[ct]])
-    x[[ms]][[1]][[ct]]
+    if (is.null(ms)) return(x[[ct]])
+    ms[[1]][[ct]]
 })
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTdata", "Zattrs", \(x, i=1, ...) {
     stopifnot(length(i) == 1)
@@ -81,31 +99,35 @@ setMethod("CTdata", "Zattrs", \(x, i=1, ...) {
     mapply(x=ts, i=names(ts), \(x, i) x[[i]], SIMPLIFY=FALSE)
 })
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
-setMethod("CTtype", "Zattrs", \(x, ...) vapply(CTlist(x), \(.) .$type, character(1)))
+setMethod("CTtype", "Zattrs", \(x, ...) {
+    vapply(CTlist(x), \(.) .$type, character(1))
+})
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
-setMethod("CTname", "Zattrs", \(x, ...) vapply(CTlist(x), \(.) .$output$name, character(1)))
+setMethod("CTname", "Zattrs", \(x, ...) {
+    vapply(CTlist(x), \(.) .$output$name, character(1))
+})
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTlist", "SpatialDataElement", \(x, ...) CTlist(meta(x)))
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTdata", "SpatialDataElement", \(x, i=1, ...) CTdata(meta(x), i))
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTtype", "SpatialDataElement", \(x, ...) CTtype(meta(x)))
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTname", "SpatialDataElement", \(x, ...) CTname(meta(x)))
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("CTname", "SpatialData", \(x, ...) {
     g <- CTgraph(x)
@@ -115,12 +137,12 @@ setMethod("CTname", "SpatialData", \(x, ...) {
 
 # rmv ----
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("rmvCT", "SpatialDataElement", 
     \(x, i) { x@meta <- rmvCT(meta(x), i); x })
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("rmvCT", "Zattrs", \(x, i) {
     nms <- CTname(x)
@@ -155,7 +177,7 @@ setMethod("rmvCT", "Zattrs", \(x, i) {
 
 # add ----
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("addCT", "SpatialDataElement", \(x, name, type, data) {
     x@meta <- addCT(meta(x), name, type, data); x })
@@ -173,7 +195,7 @@ setMethod("addCT", "SpatialDataElement", \(x, name, type, data) {
     if (!.) f(t)
 }
 
-#' @rdname coord-utils
+#' @rdname CTutils
 #' @export
 setMethod("addCT", "Zattrs", \(x, name, type="identity", data=NULL) {
     stopifnot(

R/ImageArray.R

@@ -31,7 +31,12 @@ ImageArray <- function(data=list(), meta=Zattrs(), metadata=list(), ...) {
 #' @rdname ImageArray
 #' @aliases channels
 #' @export
-setMethod("channels", "Zattrs", \(x, ...) unlist(x$omero$channels))
+setMethod("channels", "Zattrs", \(x, ...) {
+    v <- x$spatialdata_attrs$version
+    if (!length(v)) stop("couldn't find 'version' in 'spatialdata_attrs'")
+    if (v == "0.3") x <- x$ome
+    unlist(x$omero$channels)
+})
 
 #' @rdname ImageArray
 #' @aliases channels
@@ -43,11 +48,11 @@ setMethod("channels", "ImageArray", \(x, ...) channels(meta(x)))
 setMethod("channels", "ANY", \(x, ...) stop("only 'images' have channels"))
 
 #' @importFrom S4Vectors isSequence
-.get_multiscales_dataset_paths <- function(md) {
+.get_multiscales_dataset_paths <- function(za) {
     # validate 'multiscales'
-    .validate_multiscales_dataset_path(md)
+    ms <- .check_ms(za)
     # get & validate 'path's
-    ds <- md$multiscales[[1]]$datasets
+    ds <- ms[[1]]$datasets
     ps <- vapply(ds, \(.) .$path, character(1))
     ps <- suppressWarnings(as.numeric(sort(ps, decreasing=FALSE)))
     if (length(ps)) {
@@ -59,10 +64,9 @@ setMethod("channels", "ANY", \(x, ...) stop("only 'images' have channels"))
     return(ps)
 }
 
-#' @noRd
-.validate_multiscales_dataset_path <- function(md) {
-    # validate 'multiscales' 
-    ms <- md$multiscales
+.check_ms <- \(za) {
+    # validate 'multiscales'
+    ms <- multiscales(za)
     if (!is.null(ms)) {
         # validate 'datasets' 
         ds <- ms[[1]]$datasets
@@ -78,6 +82,7 @@ setMethod("channels", "ANY", \(x, ...) stop("only 'images' have channels"))
     } else stop( 
         "'ImageArray' paths are ill-defined,",
         " no 'multiscales' attribute under '.zattrs'")
+    return(ms)
 }
 
 .check_jk <- \(x, .) {

R/LabelArray.R

@@ -25,7 +25,13 @@
 #' @return \code{LabelArray}
 #'
 #' @examples
-#' # TODO
+#' x <- file.path("extdata", "blobs.zarr")
+#' x <- system.file(x, package="SpatialData")
+#' x <- file.path(x, "labels", "blobs_labels")
+#' 
+#' (y <- readLabel(x))
+#' y[1:10, 1:10]
+#' meta(y)
 #'
 #' @importFrom S4Vectors metadata<-
 #' @importFrom methods new

R/ShapeFrame.R

@@ -10,7 +10,7 @@
 #'   content describing the overall object.
 #' @param name character string for extraction (see \code{?base::`$`}).
 #' @param i,j indices specifying elements to extract.
-#' @param drop ignored.
+#' @param drop,pattern ignored.
 #' @param ... optional arguments passed to and from other methods.
 #'
 #' @return \code{ShapeFrame}
@@ -55,15 +55,15 @@ setMethod("names", "ShapeFrame", \(x) names(data(x)))
 #' @export
 #' @rdname ShapeFrame
 #' @importFrom utils .DollarNames
-.DollarNames.ShapeFrame <- \(x, pattern="") {
+.DollarNames.ShapeFrame <- \(x, pattern="") 
     grep(pattern, names(x), value=TRUE)
-}
 
 #' @rdname ShapeFrame
 #' @exportMethod $
 setMethod("$", "ShapeFrame", \(x, name) data(x)[[name]])
 
 #' @export
+#' @rdname ShapeFrame
 #' @importFrom sf st_as_sf st_geometry_type
 setMethod("geom_type", "ShapeFrame", \(x) {
     y <- st_as_sf(data(x[1, ]))

R/SpatialData.R

@@ -8,6 +8,8 @@
 #' image images image<- images<- imageNames 
 #' shape shapes shape<- shapes<- shapeNames 
 #' table tables table<- tables<- tableNames 
+#' [[<-,SpatialData,character,ANY-method
+#' [[<-,SpatialData,numeric,ANY-method
 #' 
 #' @description ...
 #'