factor out max-projection

Author: HelenaLC

R/plotImage.R

@@ -161,9 +161,8 @@ NULL
 #' @importFrom spatialdataR data_type
 .df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) {
     a <- .get_ms_data(x, k)
-    # max-projection over z-stacks
-    d <- length(dim(x))
-    if (d == 4) a <- apply(a, c(1, 3, 4), max)
+    # 2D max-projection
+    a <- .project(x, a)
     # subset channels of interest
     a <- a[.ch_idx(x, ch),,,drop=FALSE]
     a <- .norm_ia(a, data_type(x))

R/plotLabel.R

@@ -60,6 +60,11 @@ NULL
 setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, 
     a=0.5, pal=NULL, nan=NA, assay=1, z=NULL) {
 
+    if (!is.null(z)) {
+        ok <- length(z) == 1 && is.numeric(z) && z == round(z) && z > 0
+        if (!ok) stop("invalid 'z'; should be a scalar integer > 0")
+    }
+    
     if (is.numeric(i)) i <- labelNames(x)[i]
     i <- match.arg(i, labelNames(x))
     y <- label(x, i)
@@ -71,18 +76,8 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL,
 
     # get array data
     ym <- .get_ms_data(y, k)
-    if (length(dim(ym)) > 2) {
-        if (is.null(z)) {
-            # max-projection across z-slices
-            nm <- vapply(axes(y), \(.) .$name, character(1))
-            yx <- match(c("y", "x"), nm)
-            ym <- apply(ym, yx, max)
-        } else {
-            # subset target z-slice
-            ym <- ym[z,,]
-        }
-    }
-  
+    ym <- .project(y, ym, z)
+    
     # keep only indices != 0 since labels might be sparse 
     # and thus save memory by not plotting all pixels
     idx <- BiocGenerics::which(ym != 0L, arr.ind=TRUE)

R/utils.R

@@ -59,6 +59,26 @@
     data(x, .guess_scale(x, w, h))
 }
 
+# x = image or label
+# y = high-dim. array
+# z = (optional) index
+.project <- \(x, y, z=NULL) {
+    ok <- c("x", "y", "c")
+    as <- axes(x, "name")
+    ok <- as %in% ok
+    if (all(ok)) return(y) # 2D
+    if (is.null(z)) { # project
+        y <- apply(y, which(ok), max)
+        return(y) 
+    }
+    # specific slice
+    i <- !logical(length(as))
+    i <- as.list(i)
+    i[as == "z"] <- z
+    arg <- c(list(y), i)
+    do.call(`[`, arg)
+}
+
 #' @importFrom utils tail
 .raw_wh <- \(x) {
     wh <- metadata(x)$wh