From 97fd518c669bb95a627c4d50da945ef82ea3469c Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Tue, 26 Nov 2024 09:46:49 +0100 Subject: [PATCH] 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) ```