>2/3D arrays & multi-scale adjustment

.github/workflows/pkgdown.yaml

@@ -2,7 +2,7 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: [main]
   pull_request:
   release:
     types: [published]
@@ -28,6 +28,11 @@ jobs:
       - uses: r-lib/actions/setup-pandoc@v2
 
       - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: 'devel'
+          http-user-agent: 'release'
+          extra-repositories: 'https://bioc.r-universe.dev'
+          use-public-rspm: true
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
@@ -44,4 +49,4 @@ jobs:
         with:
           clean: false
           branch: gh-pages
-          folder: docs
+          folder: docs

.github/workflows/r-universe.yaml

@@ -0,0 +1,14 @@
+name: Test R-universe
+
+on:
+  push:
+    branches: [main]
+  pull_request:
+
+jobs:
+  build:
+    name: R-universe testing
+    uses: r-universe-org/workflows/.github/workflows/build.yml@v3
+    with:
+      universe: bioc
+      organization: bioconductor

.gitignore

@@ -5,3 +5,4 @@
 *.Rproj
 *html
 docs
+tests/testthat/Rplots.pdf

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SpatialData.plot
 Title: SpatialData visualization
 Depends: R (>= 4.6), spatialdataR
-Version: 0.99.6
+Version: 0.99.7
 Description: Visualization suit for 'spatialdataR'. Current functionality 
     includes handling of multiscale 'images', visualizing 'labels', 'points', 
     and 'shapes'. For the latter, POINT, POLYGON, and MULTIPOLYGON geometries 
@@ -35,19 +35,17 @@ Imports:
     rlang,
     sf,
     S4Vectors,
-    SingleCellExperiment,
-    Rarr,
-    ZarrArray
+    SingleCellExperiment
 Suggests:
     BiocStyle,
     ggnewscale,
     knitr,
     magick,
     patchwork,
-    Rgraphviz,
     SpatialData.data,
     testthat,
-    vdiffr
+    vdiffr,
+    ZarrArray
 Remotes:
     HelenaLC/spatialdataR,
     HelenaLC/SpatialData.data

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(plotSpatialData)
+export(scalebar)
 exportMethods(plotImage)
 exportMethods(plotLabel)
 exportMethods(plotPoint)
@@ -10,10 +11,9 @@ importFrom(DelayedArray,realize)
 importFrom(MatrixGenerics,rowQuantiles)
 importFrom(S4Vectors,metadata)
 importFrom(SingleCellExperiment,colData)
-importFrom(SingleCellExperiment,int_colData)
-importFrom(SingleCellExperiment,int_metadata)
 importFrom(ggforce,geom_circle)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,annotate)
 importFrom(ggplot2,annotation_raster)
 importFrom(ggplot2,coord_fixed)
 importFrom(ggplot2,coord_sf)
@@ -38,6 +38,7 @@ importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,unit)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,colorRampPalette)
+importFrom(grDevices,colors)
 importFrom(grDevices,hcl.colors)
 importFrom(methods,as)
 importFrom(methods,is)
@@ -46,6 +47,7 @@ importFrom(sf,st_as_sf)
 importFrom(sf,st_buffer)
 importFrom(sf,st_coordinates)
 importFrom(sf,st_geometry_type)
+importFrom(spatialdataR,"element<-")
 importFrom(spatialdataR,channels)
 importFrom(spatialdataR,data_type)
 importFrom(spatialdataR,transform)

R/plotFrame.R

@@ -4,9 +4,12 @@
 #'
 #' @param x \code{SpatialData} object.
 #' @param i character string or index; the label element to plot.
-#' @param assay character string; in case of \code{c} denoting a row name,
-#'   specifies which \code{assay} data to use (see \code{\link{valTable}}).
+#' @param j index or name of target coordinate system. 
+#' @param assay character string; in case of \code{c} 
+#'   denoting a row name, specifies which \code{assay} 
+#'   data to use (see \code{\link[spatialdataR]{getTable}}).
 #'   (ignored when \code{x} is a \code{SpatialDataPoint}).
+#' @param ... option aesthetic arguments passed \code{geom_sf}.
 #'
 #' @examples
 #' x <- file.path("extdata", "blobs.zarr")
@@ -36,25 +39,24 @@ NULL
 
 #' @importFrom sf st_as_sf st_coordinates st_geometry_type st_buffer
 #' @importFrom ggplot2 aes theme scale_type geom_sf coord_sf
-#' @importFrom spatialdataR transform
+#' @importFrom spatialdataR transform element<-
 #' @importFrom ggforce geom_circle
 #' @importFrom methods is
 #' @importFrom utils tail
-.plot <- \(x, y, key=NULL, n=Inf, assay=1, i=1, ...) {
+.plot <- \(x, y, key=NULL, n=NULL, assay=1, i=1, ...) {
     if (is(y, "SpatialDataPoint")) {
         if (!is.null(key)) {
+            stopifnot(is.character(key), nchar(key) > 0)
             fk <- feature_key(y)
-            y<- dplyr::filter(y, .data[[fk]] %in% key)
+            y <- dplyr::filter(y, .data[[fk]] %in% key)
+            if (!length(y)) stop("no instances of specified 'key'(s)")
         }
     }
-    if (is.finite(n)) {
+    if (!is.null(n)) {
+        stopifnot(is.numeric(n), length(n) == 1, n > 0)
         n <- min(length(y), n)
         y <- y[sample(length(y), n)]
-        if (is(y, "SpatialDataShape")) {
-            shape(x, i) <- y
-        } else {
-            point(x, i) <- y
-        }
+        element(x, i) <- y
     }
     df <- st_as_sf(data(y))
     aes <- aes()

R/plotImage.R

@@ -4,10 +4,10 @@
 #' 
 #' @description ...
 #'
-#' @param x \code{\link{SpatialData}} object.
+#' @param x \code{\link[spatialdataR]{SpatialData}} object.
 #' @param i element to use from a given layer.
-#' @param j name of target coordinate system. 
-#' @param k index of the scale of an image; by default (NULL), will auto-select 
+#' @param j index or name of target coordinate system. 
+#' @param k index of the scale to render; by default (NULL), will auto-select 
 #'   scale in order to minimize memory-usage and blurring for a target size of 
 #'   800 x 800px; use Inf to plot the lowest resolution available.
 #' @param ch image channel(s) to be used for plotting (defaults to 
@@ -18,6 +18,8 @@
 #'   specifies channel-wise contrast limits - defaults to [0, 1] for all 
 #'   (ignored when \code{image(x, i)} is an RGB image; 
 #'   for convenience, any NULL = [0, 1], and n = [0, n]).
+#' @param t,z integer scalar to indicate a specific time- or z-slice;
+#'   if left unspecified (default NULL), will perform a max-projection.
 #'
 #' @return ggplot
 #'
@@ -84,7 +86,7 @@ NULL
             n <- length(c)
             if (n < d) stop(
                 "Only ", n, " default colors available, ",
-                "but", d, " are needed; please specify 'c'")
+                "but ", d, " are needed; please specify 'c'")
             c <- c[seq_len(d)]
         }
     }
@@ -117,8 +119,8 @@ NULL
     if (dt %in% names(.DTYPE_MAX_VALUES)) {
         a <- a / .DTYPE_MAX_VALUES[dt]
     } else if (max(a) > 1) {
-        for (i in seq_len(d))
-            a[i,,] <- a[i,,] / max(a[i,,])
+        maxs <- apply(a, 1, max)
+        a <- sweep(a, MARGIN = 1, STATS = maxs, FUN = "/")
     }
   return(a)
 }
@@ -159,59 +161,75 @@ NULL
 #' @importFrom methods as
 #' @importFrom DelayedArray realize
 #' @importFrom spatialdataR data_type
-.df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) {
-    a <- .get_multiscale_data(x, k)
-    a <- a[.ch_idx(x, ch),,,drop=FALSE]
+.df_i <- \(x, k=NULL, ch=NULL, t=NULL, c=NULL, cl=NULL, z=NULL) {
+    a <- .get_ms_data(x, k)
+    axisNames <- axes(x, "name")
+    # 2D max-projection
+    a <- .project(x, a)
+    axisNames <- axisNames[axisNames != "z"]
+    ti <- which(axisNames == "t")
+    tn <- length(ti)
+    # subset channels and timepoint of interest
+    if (tn) {
+        if (is.null(t)) {
+            t <- 1
+        } else if (length(t) > 1) {
+            stop("Only a single timepoint can be selected")
+        }
+    }
+    a <- .subset_array_by_axes(a=a, axisNames=axisNames, 
+                               c=.ch_idx(x, ch), t=t, drop=FALSE)
+    # remove time axis if it exists
+    if (tn) {
+        dim(a) <- dim(a)[axisNames != "t"]
+        axisNames <- axisNames[-ti]
+    }
+    # if no channel axis, add dummy axis
+    if (!("c" %in% axisNames)) {
+        dim(a) <- c(1, dim(a))
+        axisNames <- c("c", axisNames)
+    }
     a <- .norm_ia(a, data_type(x))
+    # color merging & contrasts
     a <- .prep_ia(a, c, cl)
 }
 
-#' @importFrom spatialdataR transform
-.get_wh <- \(x) {
-    wh <- metadata(x)$wh
-    if (!is.null(wh)) {
-        df <- data.frame(x=wh[[1]], y=wh[[2]])
-    } else {
-        ds <- dim(data(x, 1))
-        df <- data.frame(x=c(0, ds[3]), y=c(0, ds[2]))
-    }
-    list(w=df[, 1], h=df[, 2])
-}
-
+#' @importFrom rlang .data
 #' @importFrom ggplot2 guides geom_point geom_blank annotation_raster 
 #' @importFrom ggplot2 scale_color_identity scale_x_continuous scale_y_reverse
 .gg_i <- \(x, w, h, pal=NULL) {
     l <- if (!is.null(names(pal))) list(
         guides(col=guide_legend(override.aes=list(alpha=1, size=2))),
         geom_point(aes(col=.data$foo), data.frame(foo=pal), x=0, y=0, alpha=0))
     list(l,
-        geom_blank(aes(x=x, y=y), data.frame(x=w, y=h)),
+        geom_blank(aes(x=.data$x, y=.data$y), data.frame(x=w, y=h)),
         annotation_raster(x, w[1],w[2], h[2],h[1], interpolate=FALSE),
         scale_color_identity(NULL, guide="legend", breaks=pal, labels=names(pal)),
         ggnewscale::new_scale_color())
 }
 
 #' @rdname plotImage
 #' @export
-setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL) {
+setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL, t=NULL, z=NULL) {
     if (is.numeric(i))
         i <- imageNames(x)[i]
     y <- image(x, i)
     if (is.numeric(j))
         j <- CTname(y)[j]
     y <- transform(y, j)
-    wh <- .get_wh(y)
     if (.is_rgb(y)) {
         # RGB: we plot everything by default and we don't normalize
         ch <- ch %||% channels(y)
         cl <- cl %||% c(0, 1/3)
     }
-    df <- .df_i(y, k, ch, c, cl)
+    df <- .df_i(y, k, ch, t, c, cl, z)
     pal <- c %||% .DEFAULT_COLORS
     if (dim(y)[1] > 1 && !.is_rgb(y)) {
         nms <- unlist(channels(y))[idx <- .ch_idx(y, ch)]
         pal <- pal[seq_along(idx)]; names(pal) <- nms
     }
+    # physical space mapping
+    wh <- .get_wh(y)
     .gg_i(df, wh$w, wh$h, pal)
 })
 
@@ -221,5 +239,5 @@ setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl
 plotSpatialData <- \() ggplot() + coord_sf(expand=FALSE, reverse="y") + .theme 
 # `annotation_raster` plots the array the same way it is printed, i.e., with the
 # row 1 at the top, which means we need to flip the y-axis to have the correct axis labels.
-# We tried flipping the image itself but it means everything gets out of alignement if
+# We tried flipping the image itself but it means everything gets out of alignment if
 # the user sets `scale_y_reverse()` themselves.