From 70ed8e5d8268e9c6d7de644f70c1c28bcd41a808 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Wed, 3 Jun 2026 12:11:11 +0200 Subject: [PATCH 1/4] init >2/3d support --- R/plotImage.R | 10 +++++++++- R/plotLabel.R | 27 +++++++++++++++++++++------ R/utils.R | 5 ++--- man/plotLabel.Rd | 7 ++++++- 4 files changed, 38 insertions(+), 11 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index ac115bb..a1357d9 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -161,11 +161,17 @@ NULL #' @importFrom spatialdataR data_type .df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) { a <- .get_multiscale_data(x, k) + # max-projection over z-stacks + d <- length(dim(x)) + if (d == 4) a <- apply(a, c(1, 3, 4), max) + # subset channels of interest a <- a[.ch_idx(x, ch),,,drop=FALSE] a <- .norm_ia(a, data_type(x)) + # color merging & contrasts a <- .prep_ia(a, c, cl) } +#' @importFrom utils tail #' @importFrom spatialdataR transform .get_wh <- \(x) { wh <- metadata(x)$wh @@ -173,7 +179,9 @@ NULL 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])) + df <- data.frame( + x=c(0, tail(ds, 1)), + y=c(0, tail(ds, 2)[1])) } list(w=df[, 1], h=df[, 2]) } diff --git a/R/plotLabel.R b/R/plotLabel.R index 534c7dc..98addac 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -16,6 +16,9 @@ #' @param pal character vector; color for discrete/continuous values #' (interpolated automatically when insufficient values are provided). #' @param nan character string; color for missing values (hidden by default). +#' @param z scalar integer; +#' specifies which z-slice to plot when \code{label(x, i)} is 3D; +#' by default (NULL), will apply a max-projection across all z-slices. #' #' @examples #' x <- system.file("extdata", "blobs.zarr", package="spatialdataR") @@ -54,20 +57,32 @@ NULL #' @importFrom SingleCellExperiment colData #' @export setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, - a=0.5, pal=c("red", "green"), nan=NA, assay=1) { + a=0.5, pal=c("red", "green"), nan=NA, assay=1, z=NULL) { if (is.numeric(i)) i <- labelNames(x)[i] i <- match.arg(i, labelNames(x)) y <- label(x, i) + # transformation if (is.numeric(j)) j <- CTname(y)[j] y <- transform(y, j) - ym <- .get_multiscale_data(y, k) wh <- .get_wh(y) + + # get array data + ym <- .get_multiscale_data(y, k) + if (length(dim(ym)) > 2) { + if (is.null(z)) { + ym <- apply(ym, c(2, 3), max) + } else { + ym <- ym[z,,] + } + } - # Keep only indices != 0 since labels might be sparse and thus save memory by not plotting all pixels + # 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) - # All other SD elements are flipped when plotted. Let's keep the same convention here. + # all other SD elements are flipped when plotted; + # let's keep the same convention here df <- data.frame(x=idx[,2L]+wh$w[1], y=idx[,1L]+wh$h[1], z=ym[idx]) aes <- aes(.data[["x"]], .data[["y"]]) if (!is.null(c)) { @@ -77,7 +92,7 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, # TODO: search ik in both internal and regular colData for now # thus perhaps update, spatialdataR::valTable instead # idx <- match(df$z, int_colData(t)[[ik]]) - if(ik %in% names(int_colData(t))){ + if (ik %in% names(int_colData(t))){ coldata <- int_colData(t)[[ik]] } else { coldata <- colData(t)[[ik]] @@ -105,4 +120,4 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, scale_fill_manual(NULL, values=pal)) } list(thm, do.call(geom_tile, list(data=df, mapping=aes, alpha=a))) -}) \ No newline at end of file +}) diff --git a/R/utils.R b/R/utils.R index e4b7f0c..76fd367 100644 --- a/R/utils.R +++ b/R/utils.R @@ -47,9 +47,8 @@ # 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)) + i <- match(c("y", "x"), vapply(axes(x), \(.) .$name, character(1))) + d <- vapply(x@data, dim, numeric(length(dim(x)))) d <- apply(d, 2, \(.) sum(abs(.[i]-c(h, w)))) which.min(d) } diff --git a/man/plotLabel.Rd b/man/plotLabel.Rd index cef3af7..eb54847 100644 --- a/man/plotLabel.Rd +++ b/man/plotLabel.Rd @@ -14,7 +14,8 @@ a = 0.5, pal = c("red", "green"), nan = NA, - assay = 1 + assay = 1, + z = NULL ) } \arguments{ @@ -41,6 +42,10 @@ a \code{colData} column or row name in a \code{table} annotating \code{i}.} \item{assay}{character string; in case of \code{c} denoting a row name, specifies which \code{assay} data to use (see \code{\link{valTable}}).} + +\item{z}{scalar integer; +specifies which z-slice to plot when \code{label(x, i)} is 3D; +by default (NULL), will apply a max-projection across all z-slices.} } \description{ \code{SpatialData} label viz. From b83bf26484ab5661466ae9aa0ade7140c0ffd848 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 10:30:34 +0200 Subject: [PATCH 2/4] multi-scale adjustment --- NAMESPACE | 1 + R/plotImage.R | 7 ++++++- R/plotLabel.R | 24 ++++++++++++++++++------ R/utils.R | 10 +++++++++- 4 files changed, 34 insertions(+), 8 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 459ac95..5536319 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,5 +48,6 @@ importFrom(sf,st_coordinates) importFrom(sf,st_geometry_type) importFrom(spatialdataR,channels) importFrom(spatialdataR,data_type) +importFrom(spatialdataR,meta) importFrom(spatialdataR,transform) importFrom(utils,tail) diff --git a/R/plotImage.R b/R/plotImage.R index a1357d9..120d2c7 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -183,7 +183,12 @@ NULL x=c(0, tail(ds, 1)), y=c(0, tail(ds, 2)[1])) } - list(w=df[, 1], h=df[, 2]) + wh <- list(w=df$x, h=df$y) + # multi-scale adjustment + t <- .get_multiscale_scale(x) + wh$w[2] <- wh$w[2]*t[length(t)] + wh$h[2] <- wh$h[2]*t[length(t)-1] + return(wh) } #' @importFrom ggplot2 guides geom_point geom_blank annotation_raster diff --git a/R/plotLabel.R b/R/plotLabel.R index 98addac..1e4e2a4 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -58,6 +58,7 @@ NULL #' @export setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, a=0.5, pal=c("red", "green"), nan=NA, assay=1, z=NULL) { + if (is.numeric(i)) i <- labelNames(x)[i] i <- match.arg(i, labelNames(x)) y <- label(x, i) @@ -66,13 +67,14 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, if (is.numeric(j)) j <- CTname(y)[j] y <- transform(y, j) - wh <- .get_wh(y) - + # get array data ym <- .get_multiscale_data(y, k) if (length(dim(ym)) > 2) { if (is.null(z)) { - ym <- apply(ym, c(2, 3), max) + nm <- vapply(axes(y), \(.) .$name, character(1)) + yx <- match(c("y", "x"), nm) + ym <- apply(ym, yx, max) } else { ym <- ym[z,,] } @@ -81,9 +83,19 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, # 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) - # all other SD elements are flipped when plotted; - # let's keep the same convention here - df <- data.frame(x=idx[,2L]+wh$w[1], y=idx[,1L]+wh$h[1], z=ym[idx]) + + # offset & multi-scale adjustment + wh <- .get_wh(y) + t <- .get_multiscale_scale(y) + tx <- t[length(t)] + ty <- t[length(t)-1L] + .x <- tx*idx[, 2L] + .y <- ty*idx[, 1L] + df <- data.frame( + x = .x*(wh$w[2]/max(.x))+wh$w[1], + y = .y*(wh$h[2]/max(.y))+wh$h[1], + z = ym[idx]) + aes <- aes(.data[["x"]], .data[["y"]]) if (!is.null(c)) { stopifnot(length(c) == 1, is.character(c)) diff --git a/R/utils.R b/R/utils.R index 76fd367..216d918 100644 --- a/R/utils.R +++ b/R/utils.R @@ -57,4 +57,12 @@ .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)) -} \ No newline at end of file +} + +#' @importFrom spatialdataR meta +.get_multiscale_scale <- \(x) { + ms <- spatialdataR:::multiscales(meta(x))[[1]] + ds <- ms$datasets[[1]] + ct <- ds$coordinateTransformations[[1]] + return(unlist(ct$scale)) +} From 2da47cf3f149673b48d0ecb9671fcebfdee30500 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 10:37:00 +0200 Subject: [PATCH 3/4] avoid max() to get scale factors --- R/plotLabel.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/plotLabel.R b/R/plotLabel.R index 1e4e2a4..19fa3b6 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -91,9 +91,11 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, ty <- t[length(t)-1L] .x <- tx*idx[, 2L] .y <- ty*idx[, 1L] + mx <- dim(ym)[2]*tx + my <- dim(ym)[1]*ty df <- data.frame( - x = .x*(wh$w[2]/max(.x))+wh$w[1], - y = .y*(wh$h[2]/max(.y))+wh$h[1], + x = .x*(wh$w[2]/mx)+wh$w[1], + y = .y*(wh$h[2]/my)+wh$h[1], z = ym[idx]) aes <- aes(.data[["x"]], .data[["y"]]) From fa70d706a783b755cc9aa5f71caddffd95c85c8f Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Thu, 4 Jun 2026 22:30:01 +0200 Subject: [PATCH 4/4] make multiscale adjustments --- R/plotImage.R | 16 ++++++++++------ R/plotLabel.R | 29 +++++++++++++++++------------ 2 files changed, 27 insertions(+), 18 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index 120d2c7..86cbfa6 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -172,7 +172,6 @@ NULL } #' @importFrom utils tail -#' @importFrom spatialdataR transform .get_wh <- \(x) { wh <- metadata(x)$wh if (!is.null(wh)) { @@ -184,10 +183,6 @@ NULL y=c(0, tail(ds, 2)[1])) } wh <- list(w=df$x, h=df$y) - # multi-scale adjustment - t <- .get_multiscale_scale(x) - wh$w[2] <- wh$w[2]*t[length(t)] - wh$h[2] <- wh$h[2]*t[length(t)-1] return(wh) } @@ -213,7 +208,6 @@ setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl 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) @@ -225,6 +219,16 @@ setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl nms <- unlist(channels(y))[idx <- .ch_idx(y, ch)] pal <- pal[seq_along(idx)]; names(pal) <- nms } + # multi-scale adjustment + wh <- .get_wh(y) + if (wh$w[2] == tail(dim(y), 1) || + wh$h[2] == tail(dim(y), 2)[1]) { + ts <- .get_multiscale_scale(y) + tx <- tail(ts, 1) + ty <- tail(ts, 2)[1] + } else tx <- ty <- 1 + wh$w[2] <- wh$w[2]*tx + wh$h[2] <- wh$h[2]*ty .gg_i(df, wh$w, wh$h, pal) }) diff --git a/R/plotLabel.R b/R/plotLabel.R index 19fa3b6..f337def 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -58,7 +58,6 @@ NULL #' @export setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, a=0.5, pal=c("red", "green"), nan=NA, assay=1, z=NULL) { - if (is.numeric(i)) i <- labelNames(x)[i] i <- match.arg(i, labelNames(x)) y <- label(x, i) @@ -72,10 +71,12 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, ym <- .get_multiscale_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,,] } } @@ -84,19 +85,23 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, # and thus save memory by not plotting all pixels idx <- BiocGenerics::which(ym != 0L, arr.ind=TRUE) - # offset & multi-scale adjustment + # offset & multi-scale adjustment + ds <- dim(ym) wh <- .get_wh(y) - t <- .get_multiscale_scale(y) - tx <- t[length(t)] - ty <- t[length(t)-1L] - .x <- tx*idx[, 2L] - .y <- ty*idx[, 1L] - mx <- dim(ym)[2]*tx - my <- dim(ym)[1]*ty + if (wh$w[2] == tail(dim(y), 1) || + wh$h[2] == tail(dim(y), 2)[1]) { + ts <- .get_multiscale_scale(y) + tx <- tail(ts, 1) + ty <- tail(ts, 2)[1] + } else tx <- ty <- 1 + nx <- tail(ds, 1) + ny <- tail(ds, 2)[1] + sx <- (diff(wh$w)/nx)*tx + sy <- (diff(wh$h)/ny)*ty df <- data.frame( - x = .x*(wh$w[2]/mx)+wh$w[1], - y = .y*(wh$h[2]/my)+wh$h[1], - z = ym[idx]) + x=wh$w[1]+idx[,2L]*sx, + y=wh$h[1]+idx[,1L]*sy, + z=ym[idx]) aes <- aes(.data[["x"]], .data[["y"]]) if (!is.null(c)) {