implement multiscale label visualization

NAMESPACE

@@ -13,6 +13,7 @@ importFrom(DelayedArray,path)
 importFrom(DelayedArray,realize)
 importFrom(Rarr,zarr_overview)
 importFrom(S4Vectors,metadata)
+importFrom(SingleCellExperiment,colData)
 importFrom(SingleCellExperiment,int_colData)
 importFrom(SingleCellExperiment,int_metadata)
 importFrom(SpatialData,channels)
@@ -27,7 +28,7 @@ importFrom(ggplot2,element_line)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,geom_polygon)
-importFrom(ggplot2,geom_tile)
+importFrom(ggplot2,geom_raster)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,guide_legend)
 importFrom(ggplot2,guides)

R/AllGenerics.R

@@ -5,13 +5,6 @@ setGeneric("rotate", \(x, t, ...) standardGeneric("rotate"))
 setGeneric("transform", \(x, ...) standardGeneric("transform"))
 setGeneric("translation", \(x, t, ...) standardGeneric("translation"))
 
-# tbl ----
-
-setGeneric("hasTable", \(x, i, ...) standardGeneric("hasTable"))
-setGeneric("getTable", \(x, i, ...) standardGeneric("getTable"))
-setGeneric("setTable", \(x, i, ...) standardGeneric("setTable"))
-setGeneric("valTable", \(x, i, ...) standardGeneric("valTable"))
-
 # plt ----
 
 setGeneric("plotImage", \(x, ...) standardGeneric("plotImage"))

R/plotImage.R

@@ -159,24 +159,11 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme
     return(NULL)
 }
 
-.guess_scale <- \(x, w, h) {
-    n <- length(dim(x))
-    i <- ifelse(n == 3, -1, TRUE)
-    d <- vapply(x@data, dim, numeric(n))
-    d <- apply(d, 2, \(.) sum(abs(.[i]-c(h, w))))
-    which.min(d)
-}
-
-.get_img_data <- \(x, k=NULL, w=800, h=800) {
-    if (!is.null(k)) return(data(x, k))
-    data(x, .guess_scale(x, w, h))
-}
-
 #' @importFrom methods as
 #' @importFrom grDevices rgb
 #' @importFrom DelayedArray realize
 .df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) {
-    a <- .get_img_data(x, k)
+    a <- .get_multiscale_data(x, k)
     ch <- .ch_idx(x, ch)
     if (!.is_rgb(x))
         a <- a[ch, , , drop=FALSE]

R/plotLabel.R

@@ -3,6 +3,10 @@
 #' 
 #' @param x \code{SpatialData} object.
 #' @param i character string or index; the label element to plot.
+#' @param j name of target coordinate system. 
+#' @param k index of the scale of an image; 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 c the default, NULL, gives a binary image of whether or not 
 #'   a given pixel is non-zero; alternatively, a character string specifying
 #'   a \code{colData} column or row name in a \code{table} annotating \code{i}.
@@ -34,10 +38,10 @@
 #' # TODO: did a small fix to color scheme below, will fix example later
 #' # pal <- hcl.colors(n, "Spectral")
 #' pal_d <- hcl.colors(10, "Spectral")
-#' p + plotLabel(x, i, "id", pal=pal_d)
+#' p + plotLabel(x, i, c = "id", pal=pal_d)
 #' 
 #' # coloring by 'assay' data
-#' p + plotLabel(x, i, "channel_1_sum")
+#' p + plotLabel(x, i, c = "channel_1_sum")
 NULL
 
 #' @rdname plotLabel
@@ -47,20 +51,35 @@ NULL
 #' @importFrom methods as
 #' @importFrom ggplot2 
 #'   scale_fill_manual scale_fill_gradientn
-#'   aes geom_tile theme unit guides guide_legend
+#'   aes geom_raster theme unit guides guide_legend
+#' @importFrom SingleCellExperiment colData
 #' @export
-setMethod("plotLabel", "SpatialData", \(x, i=1, c=NULL, 
+setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, 
     a=0.5, pal=c("red", "green"), nan=NA, assay=1) {
     if (is.numeric(i)) i <- labelNames(x)[i]
     i <- match.arg(i, labelNames(x))
-    y <- as.matrix(as(data(label(x, i)), "DelayedArray"))
-    df <- data.frame(x=c(col(y)), y=c(row(y)), z=c(y))
+    y <- label(x, i)
+    ym <- as.matrix(.get_multiscale_data(label(x, i), k))
+    df <- data.frame(x=c(col(ym)), y=c(row(ym)), z=c(ym))
+    # transformation
+    if (is.numeric(j))
+      j <- CTname(y)[j]
+    ts <- CTpath(x, i, j)
+    df[,c("x", "y")] <- .trans_xy(df[,c("x", "y")], ts)
     aes <- aes(.data[["x"]], .data[["y"]])
     if (!is.null(c)) {
         stopifnot(length(c) == 1, is.character(c))
         t <- table(x, hasTable(x, i, name=TRUE))
         ik <- .instance_key(t)
-        idx <- match(df$z, int_colData(t)[[ik]])
+        # TODO: search ik in both internal and regular colData for now
+        # thus perhaps update, SpatialData::valTable instead
+        # idx <- match(df$z, int_colData(t)[[ik]])
+        if(ik %in% names(int_colData(t))){
+          coldata <- int_colData(t)[[ik]]
+        } else {
+          coldata <- colData(t)[[ik]]
+        }
+        idx <- match(df$z, coldata)
         df$z <- valTable(x, i, c, assay=assay)[idx]
         if (c == ik) df$z <- factor(df$z)
         aes$fill <- aes(.data[["z"]])[[1]]
@@ -83,5 +102,5 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, c=NULL,
             theme(legend.position="none"),
             scale_fill_manual(NULL, values=pal))
     }
-    list(thm, do.call(geom_tile, list(data=df, mapping=aes, alpha=a)))
+    list(thm, do.call(geom_raster, list(data=df, mapping=aes, alpha=a)))
 })

R/utils.R

@@ -45,4 +45,19 @@
 .DTYPE_MAX_VALUES <- c("uint8" = 255,
                        "uint16" = 65535,
                        "uint32" = 4294967295,
-                       "uint64" = 2^64 - 1)
+                       "uint64" = 2^64 - 1)
+
+# guess scale of image or label
+.guess_scale <- \(x, w, h) {
+  n <- length(dim(x))
+  i <- ifelse(n == 3, -1, TRUE)
+  d <- vapply(x@data, dim, numeric(n))
+  d <- apply(d, 2, \(.) sum(abs(.[i]-c(h, w))))
+  which.min(d)
+}
+
+# get multiscale
+.get_multiscale_data <- \(x, k=NULL, w=800, h=800) {
+  if (!is.null(k)) return(data(x, k))
+  data(x, .guess_scale(x, w, h))
+}

tests/testthat/test-plotArray.R

@@ -22,11 +22,11 @@ test_that(".guess_scale", {
             dim <- lapply(c(6, 3), \(.) c(3, rep(., 2))), \(.) 
             array(sample(seq_len(255), prod(.), replace=TRUE), dim=.)))
     # manual scale
-    expect_identical(.get_img_data(img, k=1), lys[[1]]) 
-    expect_identical(.get_img_data(img, k=2), lys[[2]])
+    expect_identical(.get_multiscale_data(img, k=1), lys[[1]]) 
+    expect_identical(.get_multiscale_data(img, k=2), lys[[2]])
     # automatic scale
-    expect_identical(.get_img_data(img, k=NULL, w=5, h=7), lys[[1]]) 
-    expect_identical(.get_img_data(img, k=NULL, w=2, h=2), lys[[2]])
+    expect_identical(.get_multiscale_data(img, k=NULL, w=5, h=7), lys[[1]]) 
+    expect_identical(.get_multiscale_data(img, k=NULL, w=2, h=2), lys[[2]])
 })
 
 test_that("plotImage()", {
@@ -61,11 +61,13 @@ test_that("plotLabel()", {
     expect_s3_class(q, "ggplot")
     expect_equal(q$coordinates$ratio, 1)
     expect_is(q$layers[[1]]$mapping$fill, "quosure")
+    # multiscale
+    y <- label(x, "blobs_multiscale_labels")
+    y <- y[,seq_len(32)] # same thing but different
     # alpha
     q <- p + plotLabel(x, i, a=a <- runif(1))
     expect_identical(q$layers[[1]]$aes_params$alpha, a)
     expect_error(show(plotSpatialData() + plotLabel(x, i, a=".....")))
     expect_error(show(plotSpatialData() + plotLabel(x, i, a=c(1, 2))))
-    # TODO: use 'annotation_raster'
-    # TODO: multiscale plotting
+    # TODO: should we use 'annotation_raster' ?
 })

vignettes/SpatialData.plot.Rmd

@@ -93,8 +93,8 @@ pal_d <- hcl.colors(10, "Spectral")
 pal_c <- hcl.colors(9, "Inferno")[-9]
 
 a <- p + plotLabel(x, i) # simple binary image
-b <- p + plotLabel(x, i, "id", pal=pal_d) # 'colData'
-c <- p + plotLabel(x, i, "channel_1_sum", pal=pal_c) + 
+b <- p + plotLabel(x, i, c = "id", pal=pal_d) # 'colData'
+c <- p + plotLabel(x, i, c = "channel_1_sum", pal=pal_c) + 
     theme(legend.key.width=unit(1, "lines")) # 'assay'
 
 (a | b | c) + 
@@ -224,7 +224,7 @@ Colorectal carcinoma, 25 MB; no shapes, no points.
 pal <- hcl.colors(8, "Spectral")
 wrap_plots(nrow=1, lapply(seq(3), \(.)
     plotSpatialData() + plotImage(x, .) +
-    plotLabel(x, ., "Cluster", pal=pal))) +
+    plotLabel(x, ., c = "Cluster", pal=pal))) +
     plot_layout(guides="collect")
 ```
 
@@ -317,7 +317,7 @@ x <- mask(x, "blobs_image", i, fun=mean)
 (t <- getTable(x, i))
 # visualize side-by-side
 ps <- lapply(paste(seq_len(3)), \(.) 
-    plotSpatialData() + plotLabel(x, i, .) + 
+    plotSpatialData() + plotLabel(x, i, c = .) + 
     ggtitle(paste("channel", ., "sum"))) 
 wrap_plots(ps, nrow=1) & theme(
     legend.position="bottom",