From f0593104feab5da43891a50e228f1d0f1ecd7570 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 22:10:23 +0100 Subject: [PATCH 1/9] add 'lim' and 'sat' --- inst/NEWS | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/inst/NEWS b/inst/NEWS index 74e32f1..39ed12c 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,6 +1,7 @@ changes in version 0.99.2 -- in 'plotImage', added support to visualize channels of choice +- in 'plotImage', added support to visualize channels of choice, as well as + 'lim' and 'sat' to control constrast limits and saturation, repsectively - updated vignette to include corresponding examples changes in version 0.99.1 From 92489864cd4bc6fdeb4d225b6066a9d2f92aad52 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 22:10:39 +0100 Subject: [PATCH 2/9] R/plotImage.R --- man/plotImage.Rd | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/man/plotImage.Rd b/man/plotImage.Rd index 3f11df9..0721818 100644 --- a/man/plotImage.Rd +++ b/man/plotImage.Rd @@ -8,7 +8,16 @@ \usage{ plotSpatialData() -\S4method{plotImage}{SpatialData}(x, i = 1, j = 1, k = NULL, ch = NULL, c = NULL) +\S4method{plotImage}{SpatialData}( + x, + i = 1, + j = 1, + k = NULL, + ch = NULL, + c = NULL, + lim = NULL, + sat = NULL +) } \arguments{ \item{x}{\code{\link{SpatialData}} object.} @@ -25,7 +34,14 @@ scale in order to minimize memory-usage and blurring for a target size of the first channel(s) available); use \code{channels()} to see which channels are available for a given \code{ImageArray}} -\item{c}{plotting aesthetics; color} +\item{c}{character vector; colors to use for each channel.} + +\item{lim}{list of length-2 (non-negative) numeric vectors; +contrast limits for each channel - defaults to [0, 1] for all.} + +\item{sat}{(non-negative) numeric vector; +saturation of each channel - defaults to 1 for all +(note: \code{sat=2} is equivalent to \code{lim=c(0, 0.5)})} } \value{ ggplot From 0959ccfa35fc8c756525d22645f655c0586d3b40 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 22:11:17 +0100 Subject: [PATCH 3/9] +lim/sat to control contrast limits/saturation --- R/plotImage.R | 46 ++++++++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index 63a1672..8b853ff 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -12,9 +12,13 @@ #' 800 x 800px; use Inf to plot the lowest resolution available. #' @param ch image channel(s) to be used for plotting (defaults to #' the first channel(s) available); use \code{channels()} to see -#' which channels are available for a given \code{ImageArray} -#' -#' @param c plotting aesthetics; color +#' which channels are available for a given \code{ImageArray} +#' @param c character vector; colors to use for each channel. +#' @param lim list of length-2 (non-negative) numeric vectors; +#' contrast limits for each channel - defaults to [0, 1] for all. +#' @param sat (non-negative) numeric vector; +#' saturation of each channel - defaults to 1 for all +#' (note: \code{sat=2} is equivalent to \code{lim=c(0, 0.5)}) #' #' @return ggplot #' @@ -40,7 +44,9 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme # if no colors and channels defined, return the first channel #' @importFrom grDevices col2rgb #' @noRd -.manage_channels <- \(a, ch, c=NULL){ +.manage_channels <- \(a, ch, c=NULL, lim=NULL, sat=NULL) { + if (is.null(lim)) lim <- replicate(dim(a)[1], c(0, 1), FALSE) + if (is.null(sat)) sat <- rep(1, dim(a)[1]) if (length(ch) > (n <- length(.DEFAULT_COLORS)) && is.null(c)) stop("Only ", n, " default colors available, but", length(ch), " are needed; please specify 'c'") @@ -49,9 +55,12 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme c <- col2rgb(c)/255 b <- array(0, dim=c(3, dim(a)[-1])) for (i in seq_len(dim(a)[1])) { - b[1,,] <- b[1,,,drop=FALSE] + a[i,,,drop=FALSE]*c[1,i] - b[2,,] <- b[2,,,drop=FALSE] + a[i,,,drop=FALSE]*c[2,i] - b[3,,] <- b[3,,,drop=FALSE] + a[i,,,drop=FALSE]*c[3,i] + b[1,,] <- b[1,,,drop=FALSE] + a[i,,,drop=FALSE]*c[1,i]*(1/lim[[i]][2])*sat[i] + b[2,,] <- b[2,,,drop=FALSE] + a[i,,,drop=FALSE]*c[2,i]*(1/lim[[i]][2])*sat[i] + b[3,,] <- b[3,,,drop=FALSE] + a[i,,,drop=FALSE]*c[3,i]*(1/lim[[i]][2])*sat[i] + b[1,,][b[1,,] < lim[[i]][1]] <- 0 + b[2,,][b[2,,] < lim[[i]][1]] <- 0 + b[3,,][b[3,,] < lim[[i]][1]] <- 0 } a <- pmin(b, 1) } else { @@ -72,13 +81,14 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme # normalize the image data given its data type #' @noRd -.normalize_image_array <- \(a, dt){ - if (dt %in% names(.DTYPE_MAX_VALUES)) { - a <- a/.DTYPE_MAX_VALUES[dt] - } else if (max(a) > 1) { - for (i in seq_len(dim(a)[1])) - a[i,,] <- a[i,,]/max(a[i,,]) - } +.normalize_image_array <- \(a, dt) { + d <- dim(a)[1] + 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,,]) + } return(a) } @@ -132,7 +142,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @importFrom methods as #' @importFrom grDevices rgb #' @importFrom DelayedArray realize -.df_i <- \(x, k=NULL, ch=NULL, c=NULL) { +.df_i <- \(x, k=NULL, ch=NULL, c=NULL, lim=NULL, sat=NULL) { a <- .get_plot_data(x, k) ch_i <- .ch_idx(x, ch) if (!.is_rgb(x)) @@ -141,7 +151,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme a <- realize(as(a, "DelayedArray")) a <- .normalize_image_array(a, dt) if (!.is_rgb(x)) - a <- .manage_channels(a, ch_i, c) + a <- .manage_channels(a, ch_i, c, lim, sat) apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) } @@ -163,13 +173,13 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @rdname plotImage #' @export -setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL) { +setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, lim=NULL, sat=NULL) { if (is.numeric(i)) i <- imageNames(x)[i] y <- image(x, i) if (is.numeric(j)) j <- CTname(y)[j] - df <- .df_i(y, k, ch, c) + df <- .df_i(y, k, ch, c, lim, sat) wh <- .get_wh(x, i, j) .gg_i(df, wh$w, wh$h) }) \ No newline at end of file From 683ea4234881f7fd9bf3f489d476b2872ec914cb Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 22:11:30 +0100 Subject: [PATCH 4/9] +contrasts/saturation examples --- vignettes/SpatialData.plot.Rmd | 22 +++++++++++++- vignettes/SpatialData.plot.html | 54 ++++++++++++++++++++++----------- 2 files changed, 58 insertions(+), 18 deletions(-) diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index 1c0f4f4..c06bef3 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -279,12 +279,32 @@ x <- readSpatialData(pa, anndataR=FALSE) Plotting with multiple image channels. ```{r steinbock-plot} -plotSpatialData() + plotImage(x, +plotSpatialData() + plotImage(x, i="Patient3_003_image", ch=c(6, 22, 39), c=c("blue", "cyan", "yellow")) ``` +### aesthetics + +```{r saturation, fig.width=9, fig.height=3} +p <- plotSpatialData() +i <- image(x, "Patient3_003_image") +image(x, "crop") <- i[, 200:400, 200:400] +lapply(c(1, 0.7, 0.4), \(.) { + p + plotImage(x, "crop", sat=c(1.4, 1.2, .), + ch=c(6, 22, 39), c=c("blue", "cyan", "yellow")) +}) |> wrap_plots(nrow=1) +``` + +```{r contrasts, fig.width=9, fig.height=3} +lapply(list(c(0, 1), c(0.2, 1), c(0, 0.8)), \(.) { + p + plotImage(x, "crop", + lim=list(c(0, 1), c(0, 1), .), + ch=c(6, 22, 39), c=c("blue", "cyan", "yellow")) +}) |> wrap_plots(nrow=1) +``` + # Masking Back to blobs... diff --git a/vignettes/SpatialData.plot.html b/vignettes/SpatialData.plot.html index bb22a3b..6c9b7e5 100644 --- a/vignettes/SpatialData.plot.html +++ b/vignettes/SpatialData.plot.html @@ -704,7 +704,7 @@

SpatialData.plot

Helena Lucia Crowell, Louise Deconinck, Artür Manukyan, Dario Righelli, Estella Dong and Vince Carey

November 25, 2024

Package

-

SpatialData.plot 0.99.1

+

SpatialData.plot 0.99.2

@@ -726,7 +726,10 @@

Contents

  • 3.2 VisiumHD
  • 3.3 MibiTOF
  • 3.4 CyCIF (MCMICRO)
    • -
  • 3.5 IMC (Steinbock)
    • +
  • 3.5 IMC (Steinbock) +
  • 4 Masking
  • 5 Session info
    • @@ -800,7 +803,7 @@

    2.0.1 Images

    where k specifies the target scale. This also works for plotting:

    wrap_plots(nrow=1, lapply(seq(3), \(.) 
     plotSpatialData() + plotImage(x, i=2, k=.)))
    -

    +

    2.0.2 Labels

    @@ -821,7 +824,7 @@

    2.0.2 Labels

    (a | b | c) + plot_layout(guides="collect") & theme(legend.position="bottom") -

    +

    2.0.3 Points

    @@ -837,7 +840,7 @@

    2.0.3 Points

    b <- p + plotPoint(y, i, "letters") # discrete coloring c <- p + plotPoint(y, i, "numbers") # continuous coloring a | b | c -

    +

    2.0.4 Shapes

    @@ -852,7 +855,7 @@

    2.0.4 Shapes

    ggtitle("circles") + plotShape(x, "blobs_circles") wrap_plots(a, b, c) -

    +

    2.0.5 Layering

    @@ -874,7 +877,7 @@

    2.0.5 Layering

    p + plotShape(x, 3) + ggtitle("polygons"), p + plotPoint(x, c="genes") + ggtitle("points")) wrap_plots(c(list(all), one), nrow=2) -

    +

    @@ -918,13 +921,13 @@

    3.1 MERFISH

    new_scale_color() + plotShape(x, i="anatomical") + scale_color_manual(values=hcl.colors(6, "Spectral")) -

    +

    # bounding-box query
 qu <- list(xmin=1800, xmax=2400, ymin=5000, ymax=5400)
 bb <- geom_rect(do.call(aes, qu), data.frame(qu), col="yellow", fill=NA)
 y <- SpatialData(images=list("."=do.call(query, c(list(x=image(x)), qu))))
 plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y)
    -

    +

    3.2 VisiumHD

    @@ -951,7 +954,7 @@

    3.2 VisiumHD

    bb <- geom_rect(do.call(aes, qu), data.frame(qu), col="black", fill=NA) y <- SpatialData(images=list("."=do.call(query, c(list(x=image(x)), qu)))) plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y) -

    +

    3.3 MibiTOF

    @@ -983,7 +986,7 @@

    3.3 MibiTOF

    plotSpatialData() + plotImage(x, .) + plotLabel(x, ., "Cluster", pal=pal))) + plot_layout(guides="collect") -

    +

    3.4 CyCIF (MCMICRO)

    @@ -1014,7 +1017,7 @@

    3.4 CyCIF (MCMICRO)

    plotSpatialData() + plotImage(x,
     ch=c("DNA_6", "CD45", "CD57"), 
     c=c("blue", "cyan", "yellow"))
    -

    +

    3.5 IMC (Steinbock)

    @@ -1025,11 +1028,28 @@

    3.5 IMC (Steinbock)

    dest=td, source="biocOSN") x <- readSpatialData(pa, anndataR=FALSE)

    Plotting with multiple image channels.

    -
    plotSpatialData() + plotImage(x, 
+
    plotSpatialData() + plotImage(x,
     i="Patient3_003_image",
     ch=c(6, 22, 39),
     c=c("blue", "cyan", "yellow"))
    
-
    
+
    
+
    
+
    3.5.1 aesthetics
    
+
    p <- plotSpatialData()
+i <- image(x, "Patient3_003_image")
+image(x, "crop") <- i[, 200:400, 200:400]
+lapply(c(1, 0.7, 0.4), \(.) {
+    p + plotImage(x, "crop", sat=c(1.4, 1.2, .), 
+        ch=c(6, 22, 39), c=c("blue", "cyan", "yellow"))
+}) |> wrap_plots(nrow=1)
    
+
    
+
    lapply(list(c(0, 1), c(0.2, 1), c(0, 0.8)), \(.) {
+    p + plotImage(x, "crop", 
+        lim=list(c(0, 1), c(0, 1), .),
+        ch=c(6, 22, 39), c=c("blue", "cyan", "yellow"))
+}) |> wrap_plots(nrow=1)
    
+
    
+
    @@ -1062,7 +1082,7 @@

    4 Masking

    low="grey", high=c[.], limits=c(0, 8), n.breaks=5)) |> wrap_plots() + plot_layout(guides="collect")     -

    +

    # compute channel-wise means
 i <- "blobs_labels"
 x <- mask(x, "blobs_image", i, fun=mean)
@@ -1087,7 +1107,7 @@ 
    4 Masking
    
     legend.title=element_blank(),
     legend.key.width=unit(1, "lines"),
     legend.key.height=unit(0.5, "lines"))
    -

    +

    5 Session info

    @@ -1115,7 +1135,7 @@

    5 Session info

    ## [5] GenomeInfoDb_1.42.0 IRanges_2.40.0 ## [7] S4Vectors_0.44.0 BiocGenerics_0.52.0 ## [9] MatrixGenerics_1.18.0 matrixStats_1.4.1 -## [11] SpatialData.plot_0.99.1 SpatialData_0.99.20 +## [11] SpatialData.plot_0.99.2 SpatialData_0.99.20 ## [13] ggnewscale_0.5.0 patchwork_1.3.0 ## [15] ggplot2_3.5.1 BiocStyle_2.34.0 ## From 97fd518c669bb95a627c4d50da945ef82ea3469c Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Tue, 26 Nov 2024 09:46:49 +0100 Subject: [PATCH 5/9] drop 'sat'; simplify code; added unit tests for contrast limits (argument 'cl') --- R/plotImage.R | 63 +++++++++++++++++++++++---------- inst/NEWS | 4 +-- man/plotImage.Rd | 21 +++-------- tests/testthat/test-plotImage.R | 29 +++++++++++++++ vignettes/SpatialData.plot.Rmd | 27 ++++++-------- 5 files changed, 91 insertions(+), 53 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index 8b853ff..f818724 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -14,11 +14,10 @@ #' the first channel(s) available); use \code{channels()} to see #' which channels are available for a given \code{ImageArray} #' @param c character vector; colors to use for each channel. -#' @param lim list of length-2 (non-negative) numeric vectors; -#' contrast limits for each channel - defaults to [0, 1] for all. -#' @param sat (non-negative) numeric vector; -#' saturation of each channel - defaults to 1 for all -#' (note: \code{sat=2} is equivalent to \code{lim=c(0, 0.5)}) +#' @param cl list of length-2 numeric vectors (non-negative, increasing); +#' 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]). #' #' @return ggplot #' @@ -40,13 +39,37 @@ NULL #' @export plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme +.check_cl <- \(cl, d) { + if (is.null(cl)) { + # default to [0, 1] for all channels + cl <- replicate(d, c(0, 1), FALSE) + } else { + # should be a list with as many elements as channels + if (!is.list(cl)) stop("'cl' should be a list") + if (length(cl) != d) stop("'cl' should be of length ", d) + for (. in seq_len(d)) { + # replace NULL by [0, 1] & n by [0, n] + if (is.null(cl[[.]])) cl[[.]] <- c(0, 1) + if (length(cl[[.]]) == 1) { + if (cl[[.]] < 0) stop("scalar 'cl' can't be < 0") + cl[[.]] <- c(0, cl[[.]]) + } + } + # elements should be length-2, numeric, non-negative, increasing + .f <- \(.) length(.) == 2 && is.numeric(.) && all(. >= 0) && .[2] > .[1] + if (!all(vapply(cl, .f, logical(1)))) + stop("elements of 'cl' should be length-2,", + " non-negative, increasing numeric vectors") + } + return(cl) +} + # merge/manage image channels # if no colors and channels defined, return the first channel #' @importFrom grDevices col2rgb #' @noRd -.manage_channels <- \(a, ch, c=NULL, lim=NULL, sat=NULL) { - if (is.null(lim)) lim <- replicate(dim(a)[1], c(0, 1), FALSE) - if (is.null(sat)) sat <- rep(1, dim(a)[1]) +.chs2rgb <- \(a, ch, c=NULL, cl=NULL) { + cl <- .check_cl(cl, d <- dim(a)[1]) if (length(ch) > (n <- length(.DEFAULT_COLORS)) && is.null(c)) stop("Only ", n, " default colors available, but", length(ch), " are needed; please specify 'c'") @@ -54,13 +77,15 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme if (is.null(c)) c <- .DEFAULT_COLORS[seq_along(ch)] c <- col2rgb(c)/255 b <- array(0, dim=c(3, dim(a)[-1])) - for (i in seq_len(dim(a)[1])) { - b[1,,] <- b[1,,,drop=FALSE] + a[i,,,drop=FALSE]*c[1,i]*(1/lim[[i]][2])*sat[i] - b[2,,] <- b[2,,,drop=FALSE] + a[i,,,drop=FALSE]*c[2,i]*(1/lim[[i]][2])*sat[i] - b[3,,] <- b[3,,,drop=FALSE] + a[i,,,drop=FALSE]*c[3,i]*(1/lim[[i]][2])*sat[i] - b[1,,][b[1,,] < lim[[i]][1]] <- 0 - b[2,,][b[2,,] < lim[[i]][1]] <- 0 - b[3,,][b[3,,] < lim[[i]][1]] <- 0 + for (i in seq_len(d)) { + for (j in seq_len(3)) { + rgb <- a[i,,,drop=FALSE]*c[j,i] + # apply upper contrast lim. + rgb <- rgb*(1/cl[[i]][2]) + b[j,,] <- b[j,,,drop=FALSE] + rgb + # apply lower contrast lim. + b[j,,][b[j,,] < cl[[i]][1]] <- 0 + } } a <- pmin(b, 1) } else { @@ -142,7 +167,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @importFrom methods as #' @importFrom grDevices rgb #' @importFrom DelayedArray realize -.df_i <- \(x, k=NULL, ch=NULL, c=NULL, lim=NULL, sat=NULL) { +.df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) { a <- .get_plot_data(x, k) ch_i <- .ch_idx(x, ch) if (!.is_rgb(x)) @@ -151,7 +176,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme a <- realize(as(a, "DelayedArray")) a <- .normalize_image_array(a, dt) if (!.is_rgb(x)) - a <- .manage_channels(a, ch_i, c, lim, sat) + a <- .chs2rgb(a, ch_i, c, cl) apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) } @@ -173,13 +198,13 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @rdname plotImage #' @export -setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, lim=NULL, sat=NULL) { +setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL) { if (is.numeric(i)) i <- imageNames(x)[i] y <- image(x, i) if (is.numeric(j)) j <- CTname(y)[j] - df <- .df_i(y, k, ch, c, lim, sat) + df <- .df_i(y, k, ch, c, cl) wh <- .get_wh(x, i, j) .gg_i(df, wh$w, wh$h) }) \ No newline at end of file diff --git a/inst/NEWS b/inst/NEWS index 39ed12c..0827b76 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,7 +1,7 @@ changes in version 0.99.2 -- in 'plotImage', added support to visualize channels of choice, as well as - 'lim' and 'sat' to control constrast limits and saturation, repsectively +- in 'plotImage', added support to visualize channels of choice, + as well as 'cl' argument to control constrast limits - updated vignette to include corresponding examples changes in version 0.99.1 diff --git a/man/plotImage.Rd b/man/plotImage.Rd index 0721818..814ad03 100644 --- a/man/plotImage.Rd +++ b/man/plotImage.Rd @@ -8,16 +8,7 @@ \usage{ plotSpatialData() -\S4method{plotImage}{SpatialData}( - x, - i = 1, - j = 1, - k = NULL, - ch = NULL, - c = NULL, - lim = NULL, - sat = NULL -) +\S4method{plotImage}{SpatialData}(x, i = 1, j = 1, k = NULL, ch = NULL, c = NULL, cl = NULL) } \arguments{ \item{x}{\code{\link{SpatialData}} object.} @@ -36,12 +27,10 @@ which channels are available for a given \code{ImageArray}} \item{c}{character vector; colors to use for each channel.} -\item{lim}{list of length-2 (non-negative) numeric vectors; -contrast limits for each channel - defaults to [0, 1] for all.} - -\item{sat}{(non-negative) numeric vector; -saturation of each channel - defaults to 1 for all -(note: \code{sat=2} is equivalent to \code{lim=c(0, 0.5)})} +\item{cl}{list of length-2 numeric vectors (non-negative, increasing); +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]).} } \value{ ggplot diff --git a/tests/testthat/test-plotImage.R b/tests/testthat/test-plotImage.R index e32b304..68be0c9 100644 --- a/tests/testthat/test-plotImage.R +++ b/tests/testthat/test-plotImage.R @@ -28,3 +28,32 @@ test_that(".ch_idx()", { test_that(".normalize_image_array", { skip() }) + +test_that(".check_cl", { + # valid + n <- sample(seq(3, 9), 1) + v <- replicate(n, sort(runif(2)), FALSE) + expect_identical(.check_cl(v, n), v) + # single NULL + n <- sample(seq(3, 9), 1) + l <- .check_cl(NULL, n) + expect_is(l, "list") + expect_identical(l, replicate(n, c(0, 1), FALSE)) + # one NULL, rest scalar + n <- sample(seq(3, 9), 1) + i <- sample(n, 1) + . <- replicate(n, NULL, FALSE) + .[[i]] <- v <- c(0.2, 0.8) + l <- .check_cl(., n) + expect_is(l, "list") + expect_identical(l[[i]], v) + expect_identical(l[-i], replicate(n-1, c(0, 1), FALSE)) + # invalid + expect_error(.check_cl(c(0.2, 0.4, 0.6), 3)) # non-list + expect_error(.check_cl(as.list(seq_len(4)), 3)) # wrong length + expect_error(.check_cl(list(NULL, NULL, c(-1, 1)), 3)) # negative entry + expect_error(.check_cl(as.list(letters[seq_len(3)]), 3)) # non-numeric + expect_error(.check_cl(list(NULL, NULL, c(1, 0)), 3)) # decreasing + expect_error(.check_cl(list(NULL, NULL, -1), 3)) # negative scalar + expect_error(.check_cl(list(NULL, NULL, 0), 3)) # zero scalar +}) diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index c06bef3..4158f9d 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -276,32 +276,27 @@ pa <- unzip_spd_demo( x <- readSpatialData(pa, anndataR=FALSE) ``` -Plotting with multiple image channels. +### channels -```{r steinbock-plot} +```{r steinbock-ch} plotSpatialData() + plotImage(x, i="Patient3_003_image", ch=c(6, 22, 39), c=c("blue", "cyan", "yellow")) ``` -### aesthetics +### contrasts -```{r saturation, fig.width=9, fig.height=3} -p <- plotSpatialData() +```{r steinbock-cl, fig.width=9, fig.height=3} i <- image(x, "Patient3_003_image") image(x, "crop") <- i[, 200:400, 200:400] -lapply(c(1, 0.7, 0.4), \(.) { - p + plotImage(x, "crop", sat=c(1.4, 1.2, .), - ch=c(6, 22, 39), c=c("blue", "cyan", "yellow")) -}) |> wrap_plots(nrow=1) -``` - -```{r contrasts, fig.width=9, fig.height=3} -lapply(list(c(0, 1), c(0.2, 1), c(0, 0.8)), \(.) { - p + plotImage(x, "crop", - lim=list(c(0, 1), c(0, 1), .), - ch=c(6, 22, 39), c=c("blue", "cyan", "yellow")) +lapply(list(c(0.2, 1), c(0, 0.8), c(0, 1.2)), \(.) { + plotSpatialData() + plotImage(x, + i="crop", + ch=c(6, 22, 39), + cl=list(1, 1, .), + c=c("blue", "cyan", "yellow")) + + ggtitle(sprintf("[%s, %s]", .[1], .[2])) }) |> wrap_plots(nrow=1) ``` From 98d9706cbb61c49ade0d422280072e04f450102c Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Wed, 27 Nov 2024 09:52:36 +0100 Subject: [PATCH 6/9] added tests for multichannels handling --- tests/testthat/test-plotArray.R | 8 ++--- tests/testthat/test-plotImage.R | 58 ++++++++++++++++++++++++++++++--- 2 files changed, 57 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-plotArray.R b/tests/testthat/test-plotArray.R index d0c2a16..da13cc4 100644 --- a/tests/testthat/test-plotArray.R +++ b/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_plot_data(img, k=1), lys[[1]]) - expect_identical(.get_plot_data(img, k=2), lys[[2]]) + expect_identical(.get_img_data(img, k=1), lys[[1]]) + expect_identical(.get_img_data(img, k=2), lys[[2]]) # automatic scale - expect_identical(.get_plot_data(img, k=NULL, w=5, h=7), lys[[1]]) - expect_identical(.get_plot_data(img, k=NULL, w=2, h=2), lys[[2]]) + 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]]) }) test_that("plotImage()", { diff --git a/tests/testthat/test-plotImage.R b/tests/testthat/test-plotImage.R index 68be0c9..37b96b8 100644 --- a/tests/testthat/test-plotImage.R +++ b/tests/testthat/test-plotImage.R @@ -24,11 +24,6 @@ test_that(".ch_idx()", { expect_warning(expect_equal(.ch_idx(image(x,1), ch=99), 1)) }) -# TODO: any tests for image array normalization ? -test_that(".normalize_image_array", { - skip() -}) - test_that(".check_cl", { # valid n <- sample(seq(3, 9), 1) @@ -57,3 +52,56 @@ test_that(".check_cl", { expect_error(.check_cl(list(NULL, NULL, -1), 3)) # negative scalar expect_error(.check_cl(list(NULL, NULL, 0), 3)) # zero scalar }) + +dir.create(td <- tempfile()) +pa <- unzip_spd_demo(zipname="steinbock_io.zip", dest=td, source="biocOSN") +x <- readSpatialData(pa, images=1, labels=FALSE, points=FALSE, shapes=FALSE, tables=FALSE) +a <- data(image(x)[seq_len(3), seq_len(100), seq_len(100)], 1) + +test_that(".get_img_dt", { + da <- (za <- data(image(x)))[1,,] + dt_za <- .get_img_dt(za) # from 'ZarrArray' + dt_da <- .get_img_dt(da) # from 'DelayedArray' + expect_is(dt_za, "character") + expect_identical(dt_za, dt_da) +}) + +test_that(".norm_ia", { + # valid data type + dt <- .get_img_dt(a) + b <- .norm_ia(realize(a), dt) + expect_equal( + apply(b, 1, range), + replicate(3, c(0, 1))) + # invalid data type + b <- .norm_ia(realize(a), "") + expect_equal( + apply(b, 1, range), + replicate(3, c(0, 1))) +}) + +test_that(".chs2rgb", { + dt <- .get_img_dt(a) + ch <- seq_len(d <- dim(a)[1]) + a <- .norm_ia(realize(a), dt) + # no colors, no contrasts + b <- .chs2rgb(a, ch) + expect_identical(a, b) + # colors + cmy <- c("cyan", "magenta", "yellow") + b <- .chs2rgb(a, ch, c=cmy) + expect_equal(dim(a), dim(b)) + expect_equal( + apply(b, 1, range), + replicate(d, c(0, 1))) + # lower contrast lim. + lim <- list(c(0.5, 1), NULL, NULL) + b <- .chs2rgb(a, ch, cl=lim) + expect_identical(b[-1,,], a[-1,,]) + expect_true(sum(b[1,,] == 0) > sum(a[1,,] == 0)) + # upper contrast lim. + lim <- list(c(0, 0.5), NULL, NULL) + b <- .chs2rgb(a, ch, cl=lim) + fac <- mean(b[1,,]/a[1,,], na.rm=TRUE) + expect_equal(fac, 2, tolerance=0.05) +}) \ No newline at end of file From e751450c067e813ad02ac95b42eb15929e1ea1c5 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Wed, 27 Nov 2024 09:52:53 +0100 Subject: [PATCH 7/9] styling --- R/plotImage.R | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index f818724..c900b6f 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -98,7 +98,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @importFrom SpatialData getZarrArrayPath #' @importFrom Rarr zarr_overview #' @noRd -.get_image_dtype <- \(a) { +.get_img_dt <- \(a) { pa <- getZarrArrayPath(a) df <- zarr_overview(pa, as_data_frame=TRUE) if (!is.null(dt <- df$data_type)) return(dt) @@ -106,7 +106,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme # normalize the image data given its data type #' @noRd -.normalize_image_array <- \(a, dt) { +.norm_ia <- \(a, dt) { d <- dim(a)[1] if (dt %in% names(.DTYPE_MAX_VALUES)) { a <- a / .DTYPE_MAX_VALUES[dt] @@ -159,7 +159,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme which.min(d) } -.get_plot_data <- \(x, k=NULL, w=800, h=800) { +.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)) } @@ -168,15 +168,17 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @importFrom grDevices rgb #' @importFrom DelayedArray realize .df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) { - a <- .get_plot_data(x, k) - ch_i <- .ch_idx(x, ch) + a <- .get_img_data(x, k) + ch <- .ch_idx(x, ch) if (!.is_rgb(x)) - a <- a[ch_i, , , drop=FALSE] - dt <- .get_image_dtype(a) - a <- realize(as(a, "DelayedArray")) - a <- .normalize_image_array(a, dt) - if (!.is_rgb(x)) - a <- .chs2rgb(a, ch_i, c, cl) + a <- a[ch, , , drop=FALSE] + dt <- .get_img_dt(a) + a <- as(a, "DelayedArray") + a <- .norm_ia(realize(a), dt) + # enter when image isn't RGB already, either + # custom colors or contrasts are specified + if (!.is_rgb(x) || !is.null(c) || !is.null(cl)) + a <- .chs2rgb(a, ch, c, cl) apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) } From ae49eede43fffe2d478403e07bcb23b94e03d47b Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Wed, 27 Nov 2024 10:21:41 +0100 Subject: [PATCH 8/9] add 'c' and 'cl' examples in 'ImageArray' doc; git push --- R/plotImage.R | 8 ++++++++ man/plotImage.Rd | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/R/plotImage.R b/R/plotImage.R index c900b6f..95a608f 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -31,6 +31,14 @@ #' plotImage(x, i=2, k=.)) #' patchwork::wrap_plots(ms) #' +#' # custom colors +#' cmy <- c("cyan", "magenta", "yellow") +#' plotSpatialData() + plotImage(x, c=cmy) +#' +#' # contrast limits +#' plotSpatialData() + plotImage(x, c=cmy, +#' cl=list(c(0.2,1), c(0,0.8), c(0,1))) +#' #' @import SpatialData NULL diff --git a/man/plotImage.Rd b/man/plotImage.Rd index 814ad03..691e3b6 100644 --- a/man/plotImage.Rd +++ b/man/plotImage.Rd @@ -48,4 +48,12 @@ ms <- lapply(seq(3), \(.) plotImage(x, i=2, k=.)) patchwork::wrap_plots(ms) +# custom colors +cmy <- c("cyan", "magenta", "yellow") +plotSpatialData() + plotImage(x, c=cmy) + +# contrast limits +plotSpatialData() + plotImage(x, c=cmy, + cl=list(c(0.2,1), c(0,0.8), c(0,1))) + } From 1f3465807c1ecc7fd5128a9eec2335c2228090f7 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Wed, 27 Nov 2024 11:21:28 +0100 Subject: [PATCH 9/9] rebuild vignette --- vignettes/SpatialData.plot.html | 64 ++++++++++++++++----------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/vignettes/SpatialData.plot.html b/vignettes/SpatialData.plot.html index 6c9b7e5..a6b94ee 100644 --- a/vignettes/SpatialData.plot.html +++ b/vignettes/SpatialData.plot.html @@ -10,7 +10,7 @@ - + SpatialData.plot @@ -702,7 +702,7 @@

    SpatialData.plot

    Helena Lucia Crowell, Louise Deconinck, Artür Manukyan, Dario Righelli, Estella Dong and Vince Carey

    -

    November 25, 2024

    +

    November 27, 2024

    Package

    SpatialData.plot 0.99.2

    @@ -728,7 +728,8 @@

    Contents

  • 3.4 CyCIF (MCMICRO)
  • 3.5 IMC (Steinbock)
  • 4 Masking
    • @@ -803,7 +804,7 @@

    2.0.1 Images

    where k specifies the target scale. This also works for plotting:

    wrap_plots(nrow=1, lapply(seq(3), \(.) 
     plotSpatialData() + plotImage(x, i=2, k=.)))
    -

    +

    2.0.2 Labels

    @@ -824,7 +825,7 @@

    2.0.2 Labels

    (a | b | c) + plot_layout(guides="collect") & theme(legend.position="bottom") -

    +

    2.0.3 Points

    @@ -840,7 +841,7 @@

    2.0.3 Points

    b <- p + plotPoint(y, i, "letters") # discrete coloring c <- p + plotPoint(y, i, "numbers") # continuous coloring a | b | c -

    +

    2.0.4 Shapes

    @@ -855,7 +856,7 @@

    2.0.4 Shapes

    ggtitle("circles") + plotShape(x, "blobs_circles") wrap_plots(a, b, c) -

    +

    2.0.5 Layering

    @@ -877,7 +878,7 @@

    2.0.5 Layering

    p + plotShape(x, 3) + ggtitle("polygons"), p + plotPoint(x, c="genes") + ggtitle("points")) wrap_plots(c(list(all), one), nrow=2) -

    +

    @@ -921,13 +922,13 @@

    3.1 MERFISH

    new_scale_color() + plotShape(x, i="anatomical") + scale_color_manual(values=hcl.colors(6, "Spectral")) -

    +

    # bounding-box query
 qu <- list(xmin=1800, xmax=2400, ymin=5000, ymax=5400)
 bb <- geom_rect(do.call(aes, qu), data.frame(qu), col="yellow", fill=NA)
 y <- SpatialData(images=list("."=do.call(query, c(list(x=image(x)), qu))))
 plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y)
    -

    +

    3.2 VisiumHD

    @@ -954,7 +955,7 @@

    3.2 VisiumHD

    bb <- geom_rect(do.call(aes, qu), data.frame(qu), col="black", fill=NA) y <- SpatialData(images=list("."=do.call(query, c(list(x=image(x)), qu)))) plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y) -

    +

    3.3 MibiTOF

    @@ -986,7 +987,7 @@

    3.3 MibiTOF

    plotSpatialData() + plotImage(x, .) + plotLabel(x, ., "Cluster", pal=pal))) + plot_layout(guides="collect") -

    +

    3.4 CyCIF (MCMICRO)

    @@ -1017,7 +1018,7 @@

    3.4 CyCIF (MCMICRO)

    plotSpatialData() + plotImage(x,
     ch=c("DNA_6", "CD45", "CD57"), 
     c=c("blue", "cyan", "yellow"))
    -

    +

    3.5 IMC (Steinbock)

    @@ -1027,28 +1028,27 @@

    3.5 IMC (Steinbock)

    zipname="steinbock_io.zip", dest=td, source="biocOSN") x <- readSpatialData(pa, anndataR=FALSE) -

    Plotting with multiple image channels.

    +
    +

    3.5.1 channels

    plotSpatialData() + plotImage(x,
     i="Patient3_003_image",
     ch=c(6, 22, 39),
     c=c("blue", "cyan", "yellow"))
    -

    -
    -

    3.5.1 aesthetics

    -
    p <- plotSpatialData()
-i <- image(x, "Patient3_003_image")
+
    
+
    +
    +

    3.5.2 contrasts

    +
    i <- image(x, "Patient3_003_image")
 image(x, "crop") <- i[, 200:400, 200:400]
-lapply(c(1, 0.7, 0.4), \(.) {
-    p + plotImage(x, "crop", sat=c(1.4, 1.2, .), 
-        ch=c(6, 22, 39), c=c("blue", "cyan", "yellow"))
-}) |> wrap_plots(nrow=1)
    -

    -
    lapply(list(c(0, 1), c(0.2, 1), c(0, 0.8)), \(.) {
-    p + plotImage(x, "crop", 
-        lim=list(c(0, 1), c(0, 1), .),
-        ch=c(6, 22, 39), c=c("blue", "cyan", "yellow"))
+lapply(list(c(0.2, 1), c(0, 0.8), c(0, 1.2)), \(.) {
+    plotSpatialData() + plotImage(x, 
+        i="crop", 
+        ch=c(6, 22, 39), 
+        cl=list(1, 1, .),
+        c=c("blue", "cyan", "yellow")) +
+        ggtitle(sprintf("[%s, %s]", .[1], .[2]))
 }) |> wrap_plots(nrow=1)
    -

    +

    @@ -1082,7 +1082,7 @@

    4 Masking

    low="grey", high=c[.], limits=c(0, 8), n.breaks=5)) |> wrap_plots() + plot_layout(guides="collect")     -

    +

    # compute channel-wise means
 i <- "blobs_labels"
 x <- mask(x, "blobs_image", i, fun=mean)
@@ -1107,7 +1107,7 @@ 
    4 Masking
    
     legend.title=element_blank(),
     legend.key.width=unit(1, "lines"),
     legend.key.height=unit(0.5, "lines"))
    -

    +

    5 Session info

    @@ -1130,7 +1130,7 @@

    5 Session info

    ## [8] base ## ## other attached packages: -## [1] SingleCellExperiment_1.28.0 SummarizedExperiment_1.36.0 +## [1] SingleCellExperiment_1.28.1 SummarizedExperiment_1.36.0 ## [3] Biobase_2.66.0 GenomicRanges_1.58.0 ## [5] GenomeInfoDb_1.42.0 IRanges_2.40.0 ## [7] S4Vectors_0.44.0 BiocGenerics_0.52.0