jsonlite::fromJSON -> Rarr::read_zarr_attributes

.github/workflows/check-bioc.yml

@@ -22,7 +22,6 @@
 
 on:
   push:
-  pull_request:
 
 name: R-CMD-check-bioc
 
@@ -52,7 +51,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - { os: ubuntu-latest, r: '4.5', bioc: '3.22', cont: "bioconductor/bioconductor_docker:RELEASE_3_22", rspm: "https://p3m.dev/cran/__linux__/noble/latest" }
+          #- { os: ubuntu-latest, r: '4.5', bioc: '3.22', cont: "bioconductor/bioconductor_docker:RELEASE_3_22", rspm: "https://p3m.dev/cran/__linux__/noble/latest" }
           - { os: ubuntu-latest, r: 'devel', bioc: 'devel', cont: "bioconductor/bioconductor_docker:devel", rspm: "https://p3m.dev/cran/__linux__/noble/latest" }
           - { os: macOS-latest, r: 'devel', bioc: 'devel'}
           - { os: windows-latest, r: 'devel', bioc: 'devel'}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SpatialData
 Title: Representation of Python's SpatialData in R
 Depends: R (>= 4.5)
-Version: 0.99.24
+Version: 0.99.25
 Description: Interface to Python's 'SpatialData', currently including:
     reticulate-based use of 'spatialdata-io' for reading of manufracturer
     data and writing to .zarr, on-disk representation of images/labels as
@@ -40,10 +40,10 @@ Imports:
     dplyr,
     geoarrow,
     graph,
-    jsonlite,
     Matrix,
     methods,
     ZarrArray,
+    Rarr,
     RBGL,
     reticulate,
     anndataR,

NAMESPACE

@@ -39,6 +39,7 @@ exportMethods("table<-")
 exportMethods("tables<-")
 exportMethods(CTdata)
 exportMethods(CTgraph)
+exportMethods(CTlist)
 exportMethods(CTname)
 exportMethods(CTpath)
 exportMethods(CTtype)
@@ -48,6 +49,7 @@ exportMethods(axes)
 exportMethods(channels)
 exportMethods(colnames)
 exportMethods(data)
+exportMethods(data_type)
 exportMethods(dim)
 exportMethods(element)
 exportMethods(getTable)
@@ -87,11 +89,14 @@ importClassesFrom(S4Vectors,DFrame)
 importFrom(BiocGenerics,as.data.frame)
 importFrom(BiocGenerics,colnames)
 importFrom(BiocGenerics,rownames)
+importFrom(DelayedArray,DelayedArray)
 importFrom(DelayedArray,realize)
 importFrom(Matrix,rowSums)
 importFrom(Matrix,sparseVector)
 importFrom(Matrix,t)
 importFrom(RBGL,sp.between)
+importFrom(Rarr,read_zarr_attributes)
+importFrom(Rarr,zarr_overview)
 importFrom(S4Arrays,as.array.Array)
 importFrom(S4Vectors,"metadata<-")
 importFrom(S4Vectors,coolcat)
@@ -108,6 +113,7 @@ importFrom(SummarizedExperiment,"colData<-")
 importFrom(SummarizedExperiment,assay)
 importFrom(SummarizedExperiment,colData)
 importFrom(ZarrArray,ZarrArray)
+importFrom(ZarrArray,path)
 importFrom(arrow,open_dataset)
 importFrom(basilisk,BasiliskEnvironment)
 importFrom(basilisk,basiliskRun)
@@ -131,7 +137,6 @@ importFrom(graph,graph.par)
 importFrom(graph,graphAM)
 importFrom(graph,nodeData)
 importFrom(graph,nodes)
-importFrom(jsonlite,fromJSON)
 importFrom(methods,as)
 importFrom(methods,callNextMethod)
 importFrom(methods,is)

R/AllGenerics.R

@@ -53,6 +53,7 @@ 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"))
 setGeneric("CTtype", \(x, ...) standardGeneric("CTtype"))
@@ -80,6 +81,7 @@ setGeneric("query", \(x, ...) standardGeneric("query"))
 setGeneric("mask", \(x, i, j, ...) standardGeneric("mask"))
 
 setGeneric("channels", \(x, ...) standardGeneric("channels"))
+setGeneric("data_type", \(x, ...) standardGeneric("data_type"))
 
 # tbl ----
 

R/ImageArray.R

@@ -32,60 +32,53 @@ ImageArray <- function(data=list(), meta=Zattrs(), metadata=list(), ...) {
 #' @rdname ImageArray
 #' @aliases channels
 #' @export
-setMethod("channels", "ImageArray", \(x, ...) meta(x)$omero$channels$label)
+setMethod("channels", "Zattrs", \(x, ...) unlist(x$omero$channels))
+
+#' @rdname ImageArray
+#' @aliases channels
+#' @export
+setMethod("channels", "ImageArray", \(x, ...) channels(meta(x)))
 
 #' @rdname ImageArray
 #' @export
 setMethod("channels", "ANY", \(x, ...) stop("only 'images' have channels"))
 
 #' @importFrom S4Vectors isSequence
 .get_multiscales_dataset_paths <- function(md) {
-
-    # validate multiscales attributes
+    # validate 'multiscales'
     .validate_multiscales_dataset_path(md)
-
-    # get paths
-    paths <- md$multiscales$datasets[[1]]$path
-    paths <- suppressWarnings({as.numeric(sort(paths, decreasing=FALSE))})
-
-    # TODO: how to check if a vector of values here are integers
-    # check paths and return
-    # if(all(paths %% 0 == 0)){
-    #   if(S4Vectors::isSequence(paths))
-    #     return(paths) 
-    # }
-    return(paths)
-
-    # stop if not a sequence of integers
-    stop("ImageArray paths are ill-defined, should be e.g. 0,1,2, ..., n")
+    # get & validate 'path's
+    ds <- md$multiscales[[1]]$datasets
+    ps <- vapply(ds, \(.) .$path, character(1))
+    ps <- suppressWarnings(as.numeric(sort(ps, decreasing=FALSE)))
+    if (length(ps)) {
+        qs <- seq(min(ps), max(ps))
+        if (!isTRUE(all.equal(ps, qs)))
+            stop("ImageArray paths are ill-defined, should",
+                " be an integer sequence, e.g., 0,1,...,n")
+    }
+    return(ps)
 }
 
 #' @noRd
 .validate_multiscales_dataset_path <- function(md) {
     # validate 'multiscales' 
-    if ("multiscales" %in% names(md)) {
-        ms <- md[["multiscales"]]
-
+    ms <- md$multiscales
+    if (!is.null(ms)) {
         # validate 'datasets' 
-        if("datasets" %in% names(ms)) {
-          ds <- ms[["datasets"]]
-
-          # validate 'paths'
-          valid <- vapply(ds, \(ds) "path" %in% colnames(ds), logical(1))
-
-          if (!all(valid)) {
-            stop("'ImageArray' paths are ill-defined,",
-                " no 'path' attribute under 'multiscale-datasets'")
-          } 
-
-        } else {
-            stop("'ImageArray' paths are ill-defined,",
-                " no 'datasets' attribute under 'multiscale'")
-        }
-    } else {
-        stop("'ImageArray' paths are ill-defined,",
-            " no 'multiscales' attribute under '.zattrs'")
-    }
+        ds <- ms[[1]]$datasets
+        if (!is.null(ds)) {
+            # validate 'paths'
+            ok <- vapply(ds, \(.) !is.null(.$path), logical(1))
+            if (!all(ok))
+                stop("'ImageArray' paths are ill-defined,",
+                    " no 'path' attribute under 'multiscale-datasets'")
+        } else stop(
+            "'ImageArray' paths are ill-defined,",
+            " no 'datasets' attribute under 'multiscale'")
+    } else stop( 
+        "'ImageArray' paths are ill-defined,",
+        " no 'multiscales' attribute under '.zattrs'")
 }
 
 .check_jk <- \(x, .) {

R/SpatialData.R

@@ -30,7 +30,7 @@
 #' @examples
 #' x <- file.path("extdata", "blobs.zarr")
 #' x <- system.file(x, package="SpatialData")
-#' (x <- readSpatialData(x, anndataR=FALSE))
+#' (x <- readSpatialData(x, anndataR=TRUE))
 #' 
 #' # subsetting
 #' # layers are taken in order of appearance

R/Zattrs.R

@@ -11,11 +11,11 @@
 #' x <- system.file(x, package="SpatialData")
 #' x <- readSpatialData(x, tables=FALSE)
 #' 
-#' z <- meta(label(x))
-#' axes(z) 
-#' CTdata(z)
+#' (z <- meta(label(x)))
+#' 
 #' CTname(z)
 #' CTtype(z)
+#' CTdata(z, "scale")
 #'
 #' @export
 Zattrs <- \(x=list()) {
@@ -33,3 +33,44 @@ Zattrs <- \(x=list()) {
 #' @rdname Zattrs
 #' @exportMethod $
 setMethod("$", "Zattrs", \(x, name) x[[name]])
+
+.showZattrs <- function(object) {
+    cat("class: Zattrs\n")
+    ax <- axes(object)
+    cat(sprintf("axes(%d):\n", length(ax)))
+    if (is.character(ax[[1]])) {
+        cat("- name:", unlist(ax), "\n")
+    } else {
+        cat("- name:", vapply(ax, \(.) .$name, character(1)), "\n")
+        cat("- type:", vapply(ax, \(.) .$type, character(1)), "\n")
+    }
+    cat(sprintf("coordTrans(%d):\n", n <- length(CTname(object))))
+    g <- \(.) {
+        . <- paste(unlist(.), collapse=",")
+        if (!grepl(",", .)) return(.)
+        sprintf("[%s]", .)
+    }
+    f <- \(.) {
+        if (is.null(.)) return("")
+        paste0(":", g(lapply(., g)))
+    }
+    for (i in seq_len(n))
+        cat(sprintf("- %s: (%s%s)\n",
+            CTname(object)[i],
+            CTtype(object)[i],
+            f(CTdata(object)[[i]][[CTtype(object)[i]]])))
+    ms <- object$multiscales[[1]]
+    if (!is.null(ms)) {
+        ds <- ms$datasets
+        ps <- vapply(ds, \(.) .$path, character(1))
+        coolcat("datasets(%d): %s\n", ps)
+        for (i in seq_along(ds)) {
+            ct <- ds[[i]]$coordinateTransformations[[1]]
+            cat(sprintf("- %s: (%s:%s)\n", 
+                ps[i], ct$type, g(ct[[ct$type]]))) 
+        }
+    }
+    cs <- unlist(channels(object))
+    if (!is.null(cs)) coolcat("channels(%d): %s\n", cs)
+}
+setMethod("show", "Zattrs", .showZattrs)