More validation for images and labels

R/AllGenerics.R

@@ -107,6 +107,7 @@ setGeneric("centroids", \(x, ...) standardGeneric("centroids"))
 setGeneric("data_type", \(x, ...) standardGeneric("data_type"))
 setGeneric("geom_type", \(x, ...) standardGeneric("geom_type"))
 setGeneric("multiscales", \(x, ...) standardGeneric("multiscales"))
+setGeneric("datasets", \(x, ...) standardGeneric("datasets"))
 
 # tbl ----
 

R/read.R

@@ -46,24 +46,29 @@ NULL
 #' @importFrom ZarrArray ZarrArray
 .readArray <- function(x, ...) {
     md <- read_zarr_attributes(x)
-    ps <- .get_multiscales_paths(x)
-    ps <- file.path(x, as.character(ps))
-    as <- lapply(ps, ZarrArray)
-    list(array=as, md=md)
+    mdattr <- SpatialDataAttrs(md)
+    # TODO: paths to datasets have to be validated properly in the future
+    # https://ngff.openmicroscopy.org/specifications/0.5/index.html#images
+    # The name of the array is arbitrary with the ordering defined by
+    # by the "multiscales" metadata, but is often a sequence starting at 0.
+    ds <- .validate_multiscales_paths(x, datasets(mdattr))
+    ds <- file.path(x, as.character(ds))
+    as <- lapply(ds, ZarrArray)
+    list(array=as, mdattr=mdattr)
 }
 
 #' @rdname readSpatialData
 #' @export
 readImage <- function(x, ...) {
     l <- .readArray(x, ...)
-    SpatialDataImage(data=l$array, meta=SpatialDataAttrs(l$md), ...)
+    SpatialDataImage(data=l$array, meta=l$mdattr, ...)
 }
 
 #' @rdname readSpatialData
 #' @export
 readLabel <- function(x, ...) {
     l <- .readArray(x, ...)
-    SpatialDataLabel(data=l$array, meta=SpatialDataAttrs(l$md), ...)
+    SpatialDataLabel(data=l$array, meta=l$mdattr, ...)
 }
 
 #' @rdname readSpatialData

R/sdArray.R

@@ -146,20 +146,14 @@ setMethod("channels", "SpatialDataImage", \(x, ...) channels(meta(x)))
 #' @rdname SpatialDataArray
 setMethod("channels", "SpatialDataElement", \(x, ...) stop("only 'images' have channels"))
 
+# compares metadata dataset paths to arrays on disk
 #' @importFrom S4Vectors isSequence
-.get_multiscales_paths <- function(x) {
+.validate_multiscales_paths <- function(x, ds) {
     ps <- list.files(x)
-    ps <- suppressWarnings(as.numeric(sort(ps, decreasing=FALSE)))
-    ps <- ps[!is.na(ps)]
-    if (length(ps)) {
-        qs <- seq(min(ps), max(ps))
-        if (!isTRUE(all.equal(ps, qs)))
-            stop("SpatialDataImage paths are ill-defined, should",
-                " be an integer sequence, e.g., 0,1,...,n")
-    } else {
-      stop("SpatialDataImage path is empty")
-    }
-    return(ps)
+    ds <- ds[ds %in% ps]
+    if (!length(ds))
+      stop("Invalid SpatialData image or label: metadata does not match the names of Zarr arrays")
+    return(ds)
 }
 
 # sub ----

R/sdAttrs.R

@@ -142,6 +142,14 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]])
 #' @noRd 
 setMethod("multiscales", "list", .ms)
 
+# internal use only!
+#' @noRd 
+setMethod("datasets", "list", \(x, ...) {
+  vapply(multiscales(x)[[1]]$datasets, \(.){
+    .$path
+  }, character(1))
+})
+
 # features ----
 
 #' @export