From 8ce2cfc4306c39230e300b1d983a89e008706d30 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 23 Nov 2024 14:58:51 +0100 Subject: [PATCH 01/15] git/build ignore --- .Rbuildignore | 2 ++ .gitignore | 5 +++++ 2 files changed, 7 insertions(+) create mode 100644 .gitignore diff --git a/.Rbuildignore b/.Rbuildignore index c503c4f..d325fbf 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1 +1,3 @@ ^\.github$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..52c1c38 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata +*.Rproj \ No newline at end of file From b21a2139af07bb24635572eaf2044a63ed53a6c8 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 13:52:23 +0100 Subject: [PATCH 02/15] channel support for images --- NAMESPACE | 1 + R/plot.R | 121 ++++++++++++++++++++++++++++----- man/plotImage.Rd | 6 +- vignettes/SpatialData.plot.Rmd | 41 +++++++++++ 4 files changed, 151 insertions(+), 18 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4871a79..dc389a3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ import(SpatialData) importFrom(DelayedArray,realize) importFrom(S4Vectors,metadata) importFrom(SingleCellExperiment,int_metadata) +importFrom(SpatialData,getZarrArrayPath) importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(ggforce,geom_circle) diff --git a/R/plot.R b/R/plot.R index 2d19779..b5a9014 100644 --- a/R/plot.R +++ b/R/plot.R @@ -10,6 +10,8 @@ #' @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 ch the image channels to be used for plotting (default: first channel) +#' @param c plotting aesthetics; color #' #' @return ggplot #' @@ -47,6 +49,88 @@ NULL #' @export plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme +# merge image channels +#' @noRd +.manage_channels <- \(a, ch, c=NULL){ + default_colors <- c("red", "green", "blue", "gray", "cyan", "magenta", "yellow") + if(length(ch) > length(default_colors) && is.null(c)) + stop("You can only choose at most seven default colors!") + if(!is.null(c) || (is.null(c) && length(ch) > 1)) { + if(is.null(c)) + c <- default_colors[1:length(ch)] + c <- col2rgb(c)/255 + a_new <- array(0, dim = c(3,dim(a)[-1])) + for(i in 1:dim(a)[1]){ + a_new[1,,] <- a_new[1,,,drop = FALSE] + a[i,,,drop = FALSE]*c[1,i] + a_new[2,,] <- a_new[2,,,drop = FALSE] + a[i,,,drop = FALSE]*c[2,i] + a_new[3,,] <- a_new[3,,,drop = FALSE] + a[i,,,drop = FALSE]*c[3,i] + } + a <- pmin(a_new,1) + } else { + a <- a[rep(1,3),,] + } + a +} + +# check if an image is rgb or not +#' @noRd +.normalize_image_array <- \(a, dt){ + # TODO: add more cases from other data types + if (dt == "uint8") a <- a/255 + else if(dt == "uint16") a <- a/65535 + else if(dt == "uint32") a <- a/4294967295 + else if(max(a) > 1){ + for(i in 1:dim(a)[1]) + a[i,,] <- a[i,,]/max(a[i,,]) + } + a +} + +# check if an image is rgb or not +#' @noRd +.is.rgb <- \(x){ + if(!is.null(md <- x@meta)) + labels <- md[[2]]$channels$label + if(length(labels) == 3) + if(all(labels == c("r", "g", "b")) || all(labels == seq(0,2))) { + return(TRUE) + } + return(FALSE) +} + +# check if an image is rgb or not +#' @importFrom SpatialData getZarrArrayPath +#' @noRd +.get_image_dtype <- \(a){ + zarray_spec <- Rarr::zarr_overview(getZarrArrayPath(a), + as_data_frame = TRUE) + zarray_spec$data_type +} + +channelNames <- function(x){ + if(!is.null(md <- x@meta)) + return(md[[2]]$channels$label) + return(NULL) +} + +# check if channels are indices or channel names +#' @noRd +.ch_ind <- \(x, ch){ + if(is.null(ch)) + return(1) + lbs <- channelNames(x) + if(all(ch %in% lbs)){ + return(which(lbs %in% ch)) + } else if(!any(ch %in% lbs)){ + message("Some channels are not found, picking first one!") + return(1) + } else { + message("Channels are not found, picking first one!") + return(1) + } + return(NULL) +} + .guess_scale <- \(x, w, h) { n <- length(dim(x)) i <- ifelse(n == 3, -1, TRUE) @@ -63,14 +147,17 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @importFrom methods as #' @importFrom grDevices rgb #' @importFrom DelayedArray realize -.df_i <- \(x, k=NULL) { - a <- .get_plot_data(x, k) - a <- if (dim(a)[1] == 1) a[rep(1,3),,] else a - a <- realize(as(a, "DelayedArray")) - img <- rgb( - maxColorValue=max(a), - c(a[1,,]), c(a[2,,]), c(a[3,,])) - array(img, dim(a)[-1]) +.df_i <- \(x, k=NULL, ch=NULL, c=NULL) { + a <- .get_plot_data(x, k) + ch_i <- .ch_ind(x, ch) + dt <- .get_image_dtype(a) + if(!.is.rgb(x)) + a <- a[ch_i,,,drop = FALSE] + a <- realize(as(a, "DelayedArray")) + a <- .normalize_image_array(a, dt) + if(!.is.rgb(x)) + a <- .manage_channels(a, ch_i, c) + apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) } .get_wh <- \(x, i, j) { @@ -91,13 +178,13 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme #' @rdname plotImage #' @export -setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=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) - wh <- .get_wh(x, i, j) - .gg_i(df, wh$w, wh$h) +setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=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) + wh <- .get_wh(x, i, j) + .gg_i(df, wh$w, wh$h) }) \ No newline at end of file diff --git a/man/plotImage.Rd b/man/plotImage.Rd index ae8a64e..93ae0f6 100644 --- a/man/plotImage.Rd +++ b/man/plotImage.Rd @@ -8,7 +8,7 @@ \usage{ plotSpatialData() -\S4method{plotImage}{SpatialData}(x, i = 1, j = 1, k = NULL) +\S4method{plotImage}{SpatialData}(x, i = 1, j = 1, k = NULL, ch = NULL, c = NULL) } \arguments{ \item{x}{\code{\link{SpatialData}} object.} @@ -20,6 +20,10 @@ plotSpatialData() \item{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.} + +\item{ch}{the image channels to be used for plotting (default: first channel)} + +\item{c}{plotting aesthetics; color} } \value{ ggplot diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index 63c3d38..2d7debe 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -231,6 +231,47 @@ wrap_plots(nrow=1, lapply(seq(3), \(.) plot_layout(guides="collect") ``` +## CyCIF (MCMICRO) + +Small lung adenocarcinoma, 250 MB; 1 image, 2 labels, 2 tables. + +```{r mcmicro-read} +dir.create(td <- tempfile()) +pa <- unzip_spd_demo( + zipname="mcmicro_io.zip", + dest=td, source="biocOSN") +(x <- readSpatialData(pa)) +``` +Getting channel names for the image + +```{r mcmicro-channels} +channelNames(image(x,1)) +``` + +Plotting with multiple image channels. + +```{r mcmicro-plot} +plotSpatialData() + plotImage(x, 1, ch = c("DNA_6", "ELANE", "CD57"), c = c("blue", "cyan", "yellow")) +``` + +## IMC (Steinbock) + +4 different cancers (SCCHN, BCC, NSCLC, CRC), 820 MB; 14 images, 14 labels, 1 table. + +```{r steinbock-read} +dir.create(td <- tempfile()) +pa <- unzip_spd_demo( + zipname="steinbock_io.zip", + dest=td, source="biocOSN") +(x <- readSpatialData(pa)) +``` + +Plotting with multiple image channels. + +```{r steinbock-plot} +plotSpatialData() + plotImage(x, 1, ch = c(0,1,2), c = c("blue", "cyan", "yellow")) +``` + # Session info ```{r sessionInfo, echo=FALSE} From 315aebcf4cfbc1fb8f9c143d98fc68065d3cb2d0 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 13:55:58 +0100 Subject: [PATCH 03/15] update vignette --- vignettes/SpatialData.plot.Rmd | 1 + 1 file changed, 1 insertion(+) diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index 690a192..f99ffde 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -249,6 +249,7 @@ pa <- unzip_spd_demo( dest=td, source="biocOSN") (x <- readSpatialData(pa)) ``` + Getting channel names for the image ```{r mcmicro-channels} From 87086c10ef96cf3c498d2170037321ba4c6ef7a2 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 14:18:26 +0100 Subject: [PATCH 04/15] define default colors and data type max values --- R/plotImage.R | 31 ++++++++++++++----------------- R/utils.R | 13 ++++++++++++- vignettes/SpatialData.plot.Rmd | 1 + 3 files changed, 27 insertions(+), 18 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index 6c964ab..eb8c4e7 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -36,8 +36,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme # merge image channels #' @noRd .manage_channels <- \(a, ch, c=NULL){ - default_colors <- c("red", "green", "blue", "gray", "cyan", "magenta", "yellow") - if(length(ch) > length(default_colors) && is.null(c)) + if(length(ch) > length(.DEFAULT_COLORS) && is.null(c)) stop("You can only choose at most seven default colors!") if(!is.null(c) || (is.null(c) && length(ch) > 1)) { if(is.null(c)) @@ -56,13 +55,20 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme a } +# check if an image is rgb or not +#' @importFrom SpatialData getZarrArrayPath +#' @noRd +.get_image_dtype <- \(a){ + zarray_spec <- Rarr::zarr_overview(getZarrArrayPath(a), + as_data_frame = TRUE) + zarray_spec$data_type +} + # check if an image is rgb or not #' @noRd .normalize_image_array <- \(a, dt){ - # TODO: add more cases from other data types - if (dt == "uint8") a <- a/255 - else if(dt == "uint16") a <- a/65535 - else if(dt == "uint32") a <- a/4294967295 + dt <- .get_image_dtype(a) + if(dt %in% names(.DTYPE_MAX_VALUES)) a <- a/.DTYPE_MAX_VALUES[[dt]] else if(max(a) > 1){ for(i in 1:dim(a)[1]) a[i,,] <- a[i,,]/max(a[i,,]) @@ -71,26 +77,18 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme } # check if an image is rgb or not +# NOTE: some rgb channels are named as 0:2 #' @noRd .is.rgb <- \(x){ if(!is.null(md <- x@meta)) labels <- md[[2]]$channels$label if(length(labels) == 3) - if(all(labels == c("r", "g", "b")) || all(labels == seq(0,2))) { + if(all(labels %in% c("r", "g", "b")) || all(labels %in% seq(0,2))) { return(TRUE) } return(FALSE) } -# check if an image is rgb or not -#' @importFrom SpatialData getZarrArrayPath -#' @noRd -.get_image_dtype <- \(a){ - zarray_spec <- Rarr::zarr_overview(getZarrArrayPath(a), - as_data_frame = TRUE) - zarray_spec$data_type -} - channelNames <- function(x){ if(!is.null(md <- x@meta)) return(md[[2]]$channels$label) @@ -134,7 +132,6 @@ channelNames <- function(x){ .df_i <- \(x, k=NULL, ch=NULL, c=NULL) { a <- .get_plot_data(x, k) ch_i <- .ch_ind(x, ch) - dt <- .get_image_dtype(a) if(!.is.rgb(x)) a <- a[ch_i,,,drop = FALSE] a <- realize(as(a, "DelayedArray")) diff --git a/R/utils.R b/R/utils.R index efdbfef..6eca93e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -33,4 +33,15 @@ plot.title=element_text(hjust=0.5), axis.text=element_text(color="grey"), axis.ticks=element_line(color="grey")) -) \ No newline at end of file +) + +# default colors (from ImageJ/Fiji) +.DEFAULT_COLORS <- c("red", "green", "blue", "gray", "cyan", "magenta", "yellow") + +# image data type factors (max values) +# TODO: add more cases from other data types +# https://doc.embedded-wizard.de/uint-type +.DTYPE_MAX_VALUES <- list("uint8" = 255, + "uint16" = 65535, + "uint32" = 4294967295, + "uint64" = 2^64 - 1) \ No newline at end of file diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index f99ffde..d755882 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -278,6 +278,7 @@ Plotting with multiple image channels. ```{r steinbock-plot} plotSpatialData() + plotImage(x, 1, ch = c(0,1,2), c = c("blue", "cyan", "yellow")) +# plotSpatialData() + plotImage(x, 1, ch = c(0,1,2), c = c("blue", "cyan", "yellow")) ``` # Masking From a07f88cd0e8e095362b7c38d5a4b62d25bdd8991 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 14:51:36 +0100 Subject: [PATCH 05/15] define some tests and correct behaviour --- R/plotImage.R | 21 +++++++++++++-------- tests/testthat/test-plotImage.R | 22 ++++++++++++++++++++++ 2 files changed, 35 insertions(+), 8 deletions(-) create mode 100644 tests/testthat/test-plotImage.R diff --git a/R/plotImage.R b/R/plotImage.R index eb8c4e7..6ae239f 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -33,7 +33,8 @@ NULL #' @export plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme -# merge image channels +# merge/manage image channels +# if no colors and channels defined, return the first channel #' @noRd .manage_channels <- \(a, ch, c=NULL){ if(length(ch) > length(.DEFAULT_COLORS) && is.null(c)) @@ -61,13 +62,14 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme .get_image_dtype <- \(a){ zarray_spec <- Rarr::zarr_overview(getZarrArrayPath(a), as_data_frame = TRUE) - zarray_spec$data_type + if("data_type" %in% names(zarray_spec)) + return(zarray_spec$data_type) + return(NULL) } -# check if an image is rgb or not +# normalize the image data given its data type #' @noRd .normalize_image_array <- \(a, dt){ - dt <- .get_image_dtype(a) if(dt %in% names(.DTYPE_MAX_VALUES)) a <- a/.DTYPE_MAX_VALUES[[dt]] else if(max(a) > 1){ for(i in 1:dim(a)[1]) @@ -89,8 +91,10 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme return(FALSE) } +#' get channel names +#' @export channelNames <- function(x){ - if(!is.null(md <- x@meta)) + if(!is.null(md <- attr(x, "meta"))) return(md[[2]]$channels$label) return(NULL) } @@ -102,12 +106,12 @@ channelNames <- function(x){ return(1) lbs <- channelNames(x) if(all(ch %in% lbs)){ - return(which(lbs %in% ch)) + return(match(ch,lbs)) } else if(!any(ch %in% lbs)){ - message("Some channels are not found, picking first one!") + warning("Some channels are not found, picking first one!") return(1) } else { - message("Channels are not found, picking first one!") + warning("Channels are not found, picking first one!") return(1) } return(NULL) @@ -134,6 +138,7 @@ channelNames <- function(x){ ch_i <- .ch_ind(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)) diff --git a/tests/testthat/test-plotImage.R b/tests/testthat/test-plotImage.R new file mode 100644 index 0000000..aa8e473 --- /dev/null +++ b/tests/testthat/test-plotImage.R @@ -0,0 +1,22 @@ +require(SpatialData, quietly=TRUE) +x <- file.path("extdata", "blobs.zarr") +x <- system.file(x, package="SpatialData") +x <- readSpatialData(x, tables=FALSE) + +test_that("get/check channel names", { + + # get channel names + expect_equal(channelNames(image(x,1)), c(0,1,2)) + + # get indices of channels + expect_equal(.ch_ind(image(x,1), ch = c(2,0,1)), c(3,1,2)) + expect_warning(expect_equal(.ch_ind(image(x,1), ch = 45), 1)) # return first if no matching channel + + # .is.rgb + expect_true(.is.rgb(image(x,1))) +}) + +# TODO: any tests for image array normalization ? +test_that(".normalize_image_array", { + skip() +}) From 3638fb88f24f92bb2aded0fed9ae9f39d4104339 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 15:32:29 +0100 Subject: [PATCH 06/15] check, test and run examples --- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/plotImage.R | 5 ++--- tests/testthat/Rplots.pdf | Bin 0 -> 4271 bytes vignettes/SpatialData.plot.Rmd | 4 ++-- 5 files changed, 7 insertions(+), 6 deletions(-) create mode 100644 tests/testthat/Rplots.pdf diff --git a/DESCRIPTION b/DESCRIPTION index 5960769..e35dbac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,8 @@ Imports: rlang, sf, S4Vectors, - SingleCellExperiment + SingleCellExperiment, + Rarr Suggests: BiocStyle, ggnewscale, diff --git a/NAMESPACE b/NAMESPACE index 4275200..e5188d0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ exportMethods(scale) exportMethods(translation) import(SpatialData) importFrom(DelayedArray,realize) +importFrom(Rarr,zarr_overview) importFrom(S4Vectors,metadata) importFrom(SingleCellExperiment,int_colData) importFrom(SingleCellExperiment,int_metadata) diff --git a/R/plotImage.R b/R/plotImage.R index 6ae239f..2f7bd3d 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -41,7 +41,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme stop("You can only choose at most seven default colors!") if(!is.null(c) || (is.null(c) && length(ch) > 1)) { if(is.null(c)) - c <- default_colors[1:length(ch)] + c <- .DEFAULT_COLORS[1:length(ch)] c <- col2rgb(c)/255 a_new <- array(0, dim = c(3,dim(a)[-1])) for(i in 1:dim(a)[1]){ @@ -58,6 +58,7 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme # check if an image is rgb or not #' @importFrom SpatialData getZarrArrayPath +#' @importFrom Rarr zarr_overview #' @noRd .get_image_dtype <- \(a){ zarray_spec <- Rarr::zarr_overview(getZarrArrayPath(a), @@ -91,8 +92,6 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme return(FALSE) } -#' get channel names -#' @export channelNames <- function(x){ if(!is.null(md <- attr(x, "meta"))) return(md[[2]]$channels$label) diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..27de6dc7904a6e5959c03d13a86d357c7e73e2a1 GIT binary patch literal 4271 zcmbtYc|25q+ZG|yB3qhY$|1`r95cpPqQqFTgdsbb#=-m=Gt(?tGWHPih7x7X*7A5H zWQ&q4CB~LgiqtP6OHqXCJ>zM6>sj8<`<~CtALshs_xHZO_qopJb6-c%7H_JCR>vX~ zBSs=#L~tW|-5CfppaIYh{fW@mM}Wo*h{z(-sCXg^0#JB8j0OgaMq{+lTACP)h6)0- zrg{I%H3u?_0%s8bGX|0FMP`o=x}r*5A(dZ>gd+{u9@gi2oni)i7C^ zPyv_U$fAGf;(y1M_v8q`zv(Rc$FoI%|F_ouOSU{!{G$;+lVt*+CE1$^xB)zs5CGl- zAOI^TBLE(-v}o)ViGbFSH<@Te3k2MFJ=fB}^8Ow_sf?$RZ;ghO^}&O9 zMclxB#>PfOCgcs^cu^kT0(f`dPPvz-M=Gxfh=-1nNf2*Sa6c^g@4eO1#r;#^@;H4L zZdO`=gZ;p!SZ=*`y=}_I_|sj7{RsT#>+8*v)pwvpHd@>|#V3!$JJ9iV$wg~0sNwK@ zf}37EJjw_(L8gQZghKr0Z)p03Vlj^zKP) zWVicCVL^JN7pRWU>cN2QLKG2hAp(0Wyp~II6hR$p!zGO zy*EXTl!C%Us=Wx}8#cdtaHa=zzR#6t7j5pm@2W1YP#lL;a<`8;nJSU+oXfQyO=!Na zu|fOf_7U`>45W+9a|WLeciBZU$RBx4e%B)%T^$X7HU9=wUzo@8`IPyiX`azxQ%Jn* zLemGQ(2VtbSBs#^fyG#VvJ{`k#46jmPq7_dAYc5o2KENdk!`gho`gFis=hm~3=XcL zwn=PRp&<@DZGvwvvI4BqD&5*7;si5{Vhk5@&Mk;GeJ&WNNjvd)L98pynZHo(55v%H ze5f5_fXFfLon6zMwJl}>A3GAdGt#q`xRIYZPSsYQ+cqhLC6UbVm}+sm&Nt_lUHP#9 zpNXNsxZ##D0f}3yuip}@<`W$j;NOdiTYba}Jsc@{Y84)kmJF}V-F!N-#7p_25Ia{4 z8-=59W<`*Ou{y%)5$#^92Uig^He`pZ%pmR?Zj3(Owo!@@%L0tsWUd`|KDFhgfS|FM zt<32)ipECf{8EM!xrB={mt)5Be8$|yP^>>{`PLg(<=Xj)FG>XqZ`TkhYIMCSMiDIc zve8+S6fNC&cLt*)s~%Z(>kM5WWaCt{P1D(7F=xb{h+?tujbeHi5;Vj%-8MB!4pa~k zle=>9zM{rH+qWNXv7~!{uML6SmE|xV!H_ zAL>uUdogR%!xuWbJIDA~s(Q$*1a(uV-1A*q$I8dV=5!XNgrf3DiRh%wVOBCqQsw;R z$nq_{NxH|8Es4aUGUvbP^~+4euWx2tJw!oYM;zODO#GPOt|U&>_7N8Sy3Rp&{rzz} z?;IF*r7P2&=n~b)8{*G4PA7^s&(5^Jg%(UhL_^o?Ny?E!NhFH=J=)x82T?6ArOQ;u zvf46muY&mdxcztN7s9J!ocHPD^=)Jn8x-x#eH3si5ejnta+Atg@=xXKfz-RE-l7bB z7prGRRHYobA?2HPxjUS9tVYd9I_~U4v39uI1s26QVIAfi-2awd>YNvdKVts&lDOwx z^Aja^>|6^S@>veAV|pqu2L?=a9dwO@${7jo1phLVRBetMF@A0rk6J?cqDT(Wmu(>X znm%@)>A1_d&U$0bBEc>Kxv+xf7geDm6(65vQDKp7aq`{~DV42xTe=0tUe93`iHq#T zT?f<-*c@mWS9*YZu=8^1gI5=WF1~$W(f9a)Y2UL;nthzU-oC0!0hfk)4aw=`=)*7n zeABISs#m5fv%jbRUGKe~%RPGe?;XzneKIfW za=r0V^oN2C2U@Moa?6cJ3pz8AJ+2j%PDW>#f;>kmaxXo;&0me~tgGQ$| zRjc8!5$=e#i%*XiqeGH(4`Z$Q)IWG&9j;v45`6`|1ryt`^}gV%x{g@2u1)(l86^lM zY_SsWP0eVcKuNAWYEf!y)#_ApT#(MqZvN%tRf~T9v@GgVKTd1RAqhWwzh2Vpm68m# zhu2#^Ja&KQK2&pM^eC4@^`*8}Js}13X8$RB=w@TX!_QGs`B80o9mJmQTj=hx{rc4799(UUdfH4OI&k3#CY zDtuKvl@Q<&kaR3+NkEh%nr)Wa8eM$J_wwjouCHgmr+n##(uWk^4;CL(Xm_4)>+T%u ziXD;o%YKqMvd`Km%BJ9)`+?Oq@TvrW-zY4!(*m~M=-N_|u+2mXyN%s9 z!)v|nMy3gt%Gb-c%TMDo@cS+V=S$^FTsWV9ur;vtbgMb3iY)bp6KNc{3N=b+lnpG7T0hIy<%jB)@aGwaH;^cJX3ye__M^ zwboB^KByQd)f)($O-?`JU@lf9vV^JBoW;bJ-!G3ZFKEv^JL!&7M2Kra#sdl0>YA|w z+`jNT_-me+b1%~DQ)iX5_2$j98QB^%ubP2(*6qsgII}lBBU~Fjy4`Z!u3q3zBcd|8l6*J}RiUm5hSaG0c-SO6cAvXY_C9pNEkP>Yq*)tR zO}Y3a?lJ0-PBnR|=(4q}WuT(8Wr^iZiy_)8YQw^r4yQ8*Ige8+psV-uC|t+;j?eoi zo(xuPMLDT+LD?tUuGKSzNoIGG&h9$<=7ufN$*wBls^v9HSET!Z2V`4WInH5Qyf;7T zWPPl}XR_$=!@8il(l>7(^*RNh1m9fj6v~f@=cIFVm$uGsrGWj;>vm)NP+(Z^(-z7VT5;9cZTztcvD?DV zFHF8~+8cZ9zpf@#aC{d${Dmv?3na$fpXok0)1x?AAuEBt%b!ejwR1hmL*RJok30IMF62RA4@OcIkI(@MGFWd^Kq%RM-)bsjy4q&8_^RO@>P`$*>Jj zr_xy7kPiSdR!EZId7nZd{)GFnslG%8+n+*YvjC9hOQS-E;cCQ{oteDR-Q%Z8J&*zU zAT$6p7NPO|0&rSdnp%Jl@EwDFg0@Qf>Vgvem6bX8Lqt%*=nG_f&7{5RWC=THCu literal 0 HcmV?d00001 diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index d755882..d41bf9b 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -253,7 +253,8 @@ pa <- unzip_spd_demo( Getting channel names for the image ```{r mcmicro-channels} -channelNames(image(x,1)) +# TODO: add this to SpatialData as an ImageArray method +# channelNames(image(x,1)) ``` Plotting with multiple image channels. @@ -278,7 +279,6 @@ Plotting with multiple image channels. ```{r steinbock-plot} plotSpatialData() + plotImage(x, 1, ch = c(0,1,2), c = c("blue", "cyan", "yellow")) -# plotSpatialData() + plotImage(x, 1, ch = c(0,1,2), c = c("blue", "cyan", "yellow")) ``` # Masking From 8601647d48cdeee96f940f522b2b9f7939ac452d Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 15:38:14 +0100 Subject: [PATCH 07/15] remove redundant files --- tests/testthat/Rplots.pdf | Bin 4271 -> 0 bytes 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 tests/testthat/Rplots.pdf diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf deleted file mode 100644 index 27de6dc7904a6e5959c03d13a86d357c7e73e2a1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4271 zcmbtYc|25q+ZG|yB3qhY$|1`r95cpPqQqFTgdsbb#=-m=Gt(?tGWHPih7x7X*7A5H zWQ&q4CB~LgiqtP6OHqXCJ>zM6>sj8<`<~CtALshs_xHZO_qopJb6-c%7H_JCR>vX~ zBSs=#L~tW|-5CfppaIYh{fW@mM}Wo*h{z(-sCXg^0#JB8j0OgaMq{+lTACP)h6)0- zrg{I%H3u?_0%s8bGX|0FMP`o=x}r*5A(dZ>gd+{u9@gi2oni)i7C^ zPyv_U$fAGf;(y1M_v8q`zv(Rc$FoI%|F_ouOSU{!{G$;+lVt*+CE1$^xB)zs5CGl- zAOI^TBLE(-v}o)ViGbFSH<@Te3k2MFJ=fB}^8Ow_sf?$RZ;ghO^}&O9 zMclxB#>PfOCgcs^cu^kT0(f`dPPvz-M=Gxfh=-1nNf2*Sa6c^g@4eO1#r;#^@;H4L zZdO`=gZ;p!SZ=*`y=}_I_|sj7{RsT#>+8*v)pwvpHd@>|#V3!$JJ9iV$wg~0sNwK@ zf}37EJjw_(L8gQZghKr0Z)p03Vlj^zKP) zWVicCVL^JN7pRWU>cN2QLKG2hAp(0Wyp~II6hR$p!zGO zy*EXTl!C%Us=Wx}8#cdtaHa=zzR#6t7j5pm@2W1YP#lL;a<`8;nJSU+oXfQyO=!Na zu|fOf_7U`>45W+9a|WLeciBZU$RBx4e%B)%T^$X7HU9=wUzo@8`IPyiX`azxQ%Jn* zLemGQ(2VtbSBs#^fyG#VvJ{`k#46jmPq7_dAYc5o2KENdk!`gho`gFis=hm~3=XcL zwn=PRp&<@DZGvwvvI4BqD&5*7;si5{Vhk5@&Mk;GeJ&WNNjvd)L98pynZHo(55v%H ze5f5_fXFfLon6zMwJl}>A3GAdGt#q`xRIYZPSsYQ+cqhLC6UbVm}+sm&Nt_lUHP#9 zpNXNsxZ##D0f}3yuip}@<`W$j;NOdiTYba}Jsc@{Y84)kmJF}V-F!N-#7p_25Ia{4 z8-=59W<`*Ou{y%)5$#^92Uig^He`pZ%pmR?Zj3(Owo!@@%L0tsWUd`|KDFhgfS|FM zt<32)ipECf{8EM!xrB={mt)5Be8$|yP^>>{`PLg(<=Xj)FG>XqZ`TkhYIMCSMiDIc zve8+S6fNC&cLt*)s~%Z(>kM5WWaCt{P1D(7F=xb{h+?tujbeHi5;Vj%-8MB!4pa~k zle=>9zM{rH+qWNXv7~!{uML6SmE|xV!H_ zAL>uUdogR%!xuWbJIDA~s(Q$*1a(uV-1A*q$I8dV=5!XNgrf3DiRh%wVOBCqQsw;R z$nq_{NxH|8Es4aUGUvbP^~+4euWx2tJw!oYM;zODO#GPOt|U&>_7N8Sy3Rp&{rzz} z?;IF*r7P2&=n~b)8{*G4PA7^s&(5^Jg%(UhL_^o?Ny?E!NhFH=J=)x82T?6ArOQ;u zvf46muY&mdxcztN7s9J!ocHPD^=)Jn8x-x#eH3si5ejnta+Atg@=xXKfz-RE-l7bB z7prGRRHYobA?2HPxjUS9tVYd9I_~U4v39uI1s26QVIAfi-2awd>YNvdKVts&lDOwx z^Aja^>|6^S@>veAV|pqu2L?=a9dwO@${7jo1phLVRBetMF@A0rk6J?cqDT(Wmu(>X znm%@)>A1_d&U$0bBEc>Kxv+xf7geDm6(65vQDKp7aq`{~DV42xTe=0tUe93`iHq#T zT?f<-*c@mWS9*YZu=8^1gI5=WF1~$W(f9a)Y2UL;nthzU-oC0!0hfk)4aw=`=)*7n zeABISs#m5fv%jbRUGKe~%RPGe?;XzneKIfW za=r0V^oN2C2U@Moa?6cJ3pz8AJ+2j%PDW>#f;>kmaxXo;&0me~tgGQ$| zRjc8!5$=e#i%*XiqeGH(4`Z$Q)IWG&9j;v45`6`|1ryt`^}gV%x{g@2u1)(l86^lM zY_SsWP0eVcKuNAWYEf!y)#_ApT#(MqZvN%tRf~T9v@GgVKTd1RAqhWwzh2Vpm68m# zhu2#^Ja&KQK2&pM^eC4@^`*8}Js}13X8$RB=w@TX!_QGs`B80o9mJmQTj=hx{rc4799(UUdfH4OI&k3#CY zDtuKvl@Q<&kaR3+NkEh%nr)Wa8eM$J_wwjouCHgmr+n##(uWk^4;CL(Xm_4)>+T%u ziXD;o%YKqMvd`Km%BJ9)`+?Oq@TvrW-zY4!(*m~M=-N_|u+2mXyN%s9 z!)v|nMy3gt%Gb-c%TMDo@cS+V=S$^FTsWV9ur;vtbgMb3iY)bp6KNc{3N=b+lnpG7T0hIy<%jB)@aGwaH;^cJX3ye__M^ zwboB^KByQd)f)($O-?`JU@lf9vV^JBoW;bJ-!G3ZFKEv^JL!&7M2Kra#sdl0>YA|w z+`jNT_-me+b1%~DQ)iX5_2$j98QB^%ubP2(*6qsgII}lBBU~Fjy4`Z!u3q3zBcd|8l6*J}RiUm5hSaG0c-SO6cAvXY_C9pNEkP>Yq*)tR zO}Y3a?lJ0-PBnR|=(4q}WuT(8Wr^iZiy_)8YQw^r4yQ8*Ige8+psV-uC|t+;j?eoi zo(xuPMLDT+LD?tUuGKSzNoIGG&h9$<=7ufN$*wBls^v9HSET!Z2V`4WInH5Qyf;7T zWPPl}XR_$=!@8il(l>7(^*RNh1m9fj6v~f@=cIFVm$uGsrGWj;>vm)NP+(Z^(-z7VT5;9cZTztcvD?DV zFHF8~+8cZ9zpf@#aC{d${Dmv?3na$fpXok0)1x?AAuEBt%b!ejwR1hmL*RJok30IMF62RA4@OcIkI(@MGFWd^Kq%RM-)bsjy4q&8_^RO@>P`$*>Jj zr_xy7kPiSdR!EZId7nZd{)GFnslG%8+n+*YvjC9hOQS-E;cCQ{oteDR-Q%Z8J&*zU zAT$6p7NPO|0&rSdnp%Jl@EwDFg0@Qf>Vgvem6bX8Lqt%*=nG_f&7{5RWC=THCu From c8d3640af3c9a4e2568f2f4bc33d973b8fd68f5f Mon Sep 17 00:00:00 2001 From: Artur-man Date: Mon, 25 Nov 2024 16:16:17 +0100 Subject: [PATCH 08/15] add anndataR=FALSE --- vignettes/SpatialData.plot.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index d41bf9b..bff6cce 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -247,7 +247,7 @@ dir.create(td <- tempfile()) pa <- unzip_spd_demo( zipname="mcmicro_io.zip", dest=td, source="biocOSN") -(x <- readSpatialData(pa)) +(x <- readSpatialData(pa, anndataR=FALSE)) ``` Getting channel names for the image @@ -272,7 +272,7 @@ dir.create(td <- tempfile()) pa <- unzip_spd_demo( zipname="steinbock_io.zip", dest=td, source="biocOSN") -(x <- readSpatialData(pa)) +(x <- readSpatialData(pa, anndataR=FALSE)) ``` Plotting with multiple image channels. From 7ce3ae7eb540cdc0dcd278b15245268d53542852 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:47:04 +0100 Subject: [PATCH 09/15] for images, include multi-channels examples --- vignettes/SpatialData.plot.Rmd | 18 +++++--- vignettes/SpatialData.plot.html | 78 ++++++++++++++++++++++++++------- 2 files changed, 74 insertions(+), 22 deletions(-) diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index bff6cce..1c0f4f4 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -250,17 +250,18 @@ pa <- unzip_spd_demo( (x <- readSpatialData(pa, anndataR=FALSE)) ``` -Getting channel names for the image +Getting channel names for the image: ```{r mcmicro-channels} -# TODO: add this to SpatialData as an ImageArray method -# channelNames(image(x,1)) +channels(image(x)) ``` -Plotting with multiple image channels. +Plotting with multiple image channels: ```{r mcmicro-plot} -plotSpatialData() + plotImage(x, 1, ch = c("DNA_6", "ELANE", "CD57"), c = c("blue", "cyan", "yellow")) +plotSpatialData() + plotImage(x, + ch=c("DNA_6", "CD45", "CD57"), + c=c("blue", "cyan", "yellow")) ``` ## IMC (Steinbock) @@ -272,13 +273,16 @@ dir.create(td <- tempfile()) pa <- unzip_spd_demo( zipname="steinbock_io.zip", dest=td, source="biocOSN") -(x <- readSpatialData(pa, anndataR=FALSE)) +x <- readSpatialData(pa, anndataR=FALSE) ``` Plotting with multiple image channels. ```{r steinbock-plot} -plotSpatialData() + plotImage(x, 1, ch = c(0,1,2), c = c("blue", "cyan", "yellow")) +plotSpatialData() + plotImage(x, + i="Patient3_003_image", + ch=c(6, 22, 39), + c=c("blue", "cyan", "yellow")) ``` # Masking diff --git a/vignettes/SpatialData.plot.html b/vignettes/SpatialData.plot.html index d2e0f47..bb22a3b 100644 --- a/vignettes/SpatialData.plot.html +++ b/vignettes/SpatialData.plot.html @@ -10,7 +10,7 @@ - + SpatialData.plot @@ -702,9 +702,9 @@

SpatialData.plot

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

-

November 24, 2024

+

November 25, 2024

Package

-

SpatialData.plot 0.99.0

+

SpatialData.plot 0.99.1

@@ -725,6 +725,8 @@

Contents

  • 3.1 MERFISH
  • 3.2 VisiumHD
  • 3.3 MibiTOF
    • +
  • 3.4 CyCIF (MCMICRO)
    • +
  • 3.5 IMC (Steinbock)
  • 4 Masking
  • 5 Session info
    • @@ -798,7 +800,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

    @@ -819,7 +821,7 @@

    2.0.2 Labels

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

    +

    2.0.3 Points

    @@ -835,7 +837,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

    @@ -850,7 +852,7 @@

    2.0.4 Shapes

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

    +

    2.0.5 Layering

    @@ -872,7 +874,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) -

    +

    @@ -916,13 +918,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

    @@ -949,7 +951,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

    @@ -981,7 +983,53 @@

    3.3 MibiTOF

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

    +

    +
    +
    +

    3.4 CyCIF (MCMICRO)

    +

    Small lung adenocarcinoma, 250 MB; 1 image, 2 labels, 2 tables.

    +
    dir.create(td <- tempfile())
+pa <- unzip_spd_demo(
+    zipname="mcmicro_io.zip", 
+    dest=td, source="biocOSN")
+(x <- readSpatialData(pa, anndataR=FALSE))
    +
    ## class: SpatialData
+## - images(1):
+##   - exemplar-001_image (12,3139,2511)
+## - labels(2):
+##   - exemplar-001_cell (3139,2511)
+##   - exemplar-001_nuclei (3139,2511)
+## - points(0):
+## - shapes(0):
+## - tables(2):
+##   - exemplar-001--ilastik_cell (12,11607)
+##   - exemplar-001--unmicst_cell (12,11170)
+## coordinate systems:
+## - global(3): exemplar-001_image exemplar-001_cell exemplar-001_nuclei
    +

    Getting channel names for the image:

    +
    channels(image(x))
    +
    ##  [1] "DNA_6" "ELANE" "CD57"  "CD45"  "DNA_7" "CD11B" "SMA"   "CD16"  "DNA_8"
+## [10] "ECAD"  "FOXP3" "NCAM"
    +

    Plotting with multiple image channels:

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

    +
    +
    +

    3.5 IMC (Steinbock)

    +

    4 different cancers (SCCHN, BCC, NSCLC, CRC), 820 MB; 14 images, 14 labels, 1 table.

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

    Plotting with multiple image channels.

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

    @@ -1014,7 +1062,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)
@@ -1039,7 +1087,7 @@ 
    4 Masking
    
     legend.title=element_blank(),
     legend.key.width=unit(1, "lines"),
     legend.key.height=unit(0.5, "lines"))
    -

    +

    5 Session info

    @@ -1067,7 +1115,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.0 SpatialData_0.99.20 +## [11] SpatialData.plot_0.99.1 SpatialData_0.99.20 ## [13] ggnewscale_0.5.0 patchwork_1.3.0 ## [15] ggplot2_3.5.1 BiocStyle_2.34.0 ## From 2ae6dd1670272d27fc20e7a071d426b27394dbd6 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:47:33 +0100 Subject: [PATCH 10/15] tests for multi-channels --- tests/testthat/test-plotImage.R | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-plotImage.R b/tests/testthat/test-plotImage.R index aa8e473..e32b304 100644 --- a/tests/testthat/test-plotImage.R +++ b/tests/testthat/test-plotImage.R @@ -3,20 +3,28 @@ x <- file.path("extdata", "blobs.zarr") x <- system.file(x, package="SpatialData") x <- readSpatialData(x, tables=FALSE) -test_that("get/check channel names", { - - # get channel names - expect_equal(channelNames(image(x,1)), c(0,1,2)) +test_that(".is_rgb()", { + # valid integer vector + expect_false(.is_rgb(c(0, 1, 1))) + expect_true(.is_rgb(. <- seq(0, 2))) + expect_true(.is_rgb(rev(.))) + # valid character vector + expect_false(.is_rgb(c("r", "g", "g"))) + expect_true(.is_rgb(. <- c("r", "g", "b"))) + expect_true(.is_rgb(rev(.))) + # only works for 'ImageArray' + expect_true(.is_rgb(image(x, 1))) + expect_error(.is_rgb(label(x, 1))) +}) +test_that(".ch_idx()", { # get indices of channels - expect_equal(.ch_ind(image(x,1), ch = c(2,0,1)), c(3,1,2)) - expect_warning(expect_equal(.ch_ind(image(x,1), ch = 45), 1)) # return first if no matching channel - - # .is.rgb - expect_true(.is.rgb(image(x,1))) + expect_equal(.ch_idx(image(x,1), ch=c(2,0,1)), c(3,1,2)) + # return first if no matching channel + 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() + skip() }) From d617bca48f1dfd19293b76a6914468579900611e Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:47:42 +0100 Subject: [PATCH 11/15] track v0.99.2 changes --- inst/NEWS | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/inst/NEWS b/inst/NEWS index f939f1e..74e32f1 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -1,3 +1,8 @@ +changes in version 0.99.2 + +- in 'plotImage', added support to visualize channels of choice +- updated vignette to include corresponding examples + changes in version 0.99.1 - various fixes related to moving 'instance/region_key' to 'int_colData' From c656413be2824d31f05336e290a3d4e11b2ca7e6 Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:48:02 +0100 Subject: [PATCH 12/15] +internal variables for .DEFAULT_COLORS and .DTYPE_MAX_VALUES --- R/utils.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index 6eca93e..7b15f97 100644 --- a/R/utils.R +++ b/R/utils.R @@ -41,7 +41,7 @@ # image data type factors (max values) # TODO: add more cases from other data types # https://doc.embedded-wizard.de/uint-type -.DTYPE_MAX_VALUES <- list("uint8" = 255, - "uint16" = 65535, - "uint32" = 4294967295, - "uint64" = 2^64 - 1) \ No newline at end of file +.DTYPE_MAX_VALUES <- c("uint8" = 255, + "uint16" = 65535, + "uint32" = 4294967295, + "uint64" = 2^64 - 1) \ No newline at end of file From a3eef4a456d3564ddbeae5eca069d5f017cea05e Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:48:17 +0100 Subject: [PATCH 13/15] multi-channels support --- R/plotImage.R | 152 +++++++++++++++++++++++------------------------ man/plotImage.Rd | 4 +- 2 files changed, 79 insertions(+), 77 deletions(-) diff --git a/R/plotImage.R b/R/plotImage.R index 2f7bd3d..63a1672 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -10,7 +10,10 @@ #' @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 ch the image channels to be used for plotting (default: first channel) +#' @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 #' #' @return ggplot @@ -35,85 +38,82 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme # merge/manage image channels # if no colors and channels defined, return the first channel +#' @importFrom grDevices col2rgb #' @noRd .manage_channels <- \(a, ch, c=NULL){ - if(length(ch) > length(.DEFAULT_COLORS) && is.null(c)) - stop("You can only choose at most seven default colors!") - if(!is.null(c) || (is.null(c) && length(ch) > 1)) { - if(is.null(c)) - c <- .DEFAULT_COLORS[1:length(ch)] - c <- col2rgb(c)/255 - a_new <- array(0, dim = c(3,dim(a)[-1])) - for(i in 1:dim(a)[1]){ - a_new[1,,] <- a_new[1,,,drop = FALSE] + a[i,,,drop = FALSE]*c[1,i] - a_new[2,,] <- a_new[2,,,drop = FALSE] + a[i,,,drop = FALSE]*c[2,i] - a_new[3,,] <- a_new[3,,,drop = FALSE] + a[i,,,drop = FALSE]*c[3,i] + if (length(ch) > (n <- length(.DEFAULT_COLORS)) && is.null(c)) + stop("Only ", n, " default colors available, but", + length(ch), " are needed; please specify 'c'") + if (!is.null(c) || (is.null(c) && length(ch) > 1)) { + 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] + 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] + } + a <- pmin(b, 1) + } else { + a <- a[rep(1, 3), , ] } - a <- pmin(a_new,1) - } else { - a <- a[rep(1,3),,] - } - a + return(a) } # check if an image is rgb or not #' @importFrom SpatialData getZarrArrayPath #' @importFrom Rarr zarr_overview #' @noRd -.get_image_dtype <- \(a){ - zarray_spec <- Rarr::zarr_overview(getZarrArrayPath(a), - as_data_frame = TRUE) - if("data_type" %in% names(zarray_spec)) - return(zarray_spec$data_type) - return(NULL) +.get_image_dtype <- \(a) { + pa <- getZarrArrayPath(a) + df <- zarr_overview(pa, as_data_frame=TRUE) + if (!is.null(dt <- df$data_type)) return(dt) } # 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 1:dim(a)[1]) - a[i,,] <- a[i,,]/max(a[i,,]) + 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,,]) } - a + return(a) } -# check if an image is rgb or not -# NOTE: some rgb channels are named as 0:2 +# check if an image is RGB or not +# (NOTE: some RGB channels are named 0, 1, 2) +#' @importFrom methods is #' @noRd -.is.rgb <- \(x){ - if(!is.null(md <- x@meta)) - labels <- md[[2]]$channels$label - if(length(labels) == 3) - if(all(labels %in% c("r", "g", "b")) || all(labels %in% seq(0,2))) { - return(TRUE) - } - return(FALSE) -} - -channelNames <- function(x){ - if(!is.null(md <- attr(x, "meta"))) - return(md[[2]]$channels$label) - return(NULL) +.is_rgb <- \(x) { + if (is(x, "ImageArray") && + !is.null(md <- meta(x))) + x <- md$omero$channels$label + if (!is.vector(x)) stop("invalid 'x'") + is_len <- length(x) == 3 + is_012 <- setequal(x, seq(0, 2)) + is_rgb <- setequal(x, c("r", "g", "b")) + return(is_len && (is_012 || is_rgb)) } # check if channels are indices or channel names +#' @importFrom SpatialData channels #' @noRd -.ch_ind <- \(x, ch){ - if(is.null(ch)) - return(1) - lbs <- channelNames(x) - if(all(ch %in% lbs)){ - return(match(ch,lbs)) - } else if(!any(ch %in% lbs)){ - warning("Some channels are not found, picking first one!") - return(1) - } else { - warning("Channels are not found, picking first one!") - return(1) - } - return(NULL) +.ch_idx <- \(x, ch) { + if (is.null(ch)) + return(1) + lbs <- channels(x) + if (all(ch %in% lbs)) { + return(match(ch, lbs)) + } else if (!any(ch %in% lbs)) { + warning("Couldn't find some channels; picking first one(s)!") + return(1) + } else { + warning("Couldn't find channels; picking first one(s)!") + return(1) + } + return(NULL) } .guess_scale <- \(x, w, h) { @@ -133,16 +133,16 @@ channelNames <- function(x){ #' @importFrom grDevices rgb #' @importFrom DelayedArray realize .df_i <- \(x, k=NULL, ch=NULL, c=NULL) { - a <- .get_plot_data(x, k) - ch_i <- .ch_ind(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 <- .manage_channels(a, ch_i, c) - apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) + a <- .get_plot_data(x, k) + ch_i <- .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 <- .manage_channels(a, ch_i, c) + apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) } .get_wh <- \(x, i, j) { @@ -164,12 +164,12 @@ channelNames <- function(x){ #' @rdname plotImage #' @export setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=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) - wh <- .get_wh(x, i, j) - .gg_i(df, wh$w, wh$h) + 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) + wh <- .get_wh(x, i, j) + .gg_i(df, wh$w, wh$h) }) \ No newline at end of file diff --git a/man/plotImage.Rd b/man/plotImage.Rd index daca083..3f11df9 100644 --- a/man/plotImage.Rd +++ b/man/plotImage.Rd @@ -21,7 +21,9 @@ plotSpatialData() 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.} -\item{ch}{the image channels to be used for plotting (default: first channel)} +\item{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}} \item{c}{plotting aesthetics; color} } From 2345a53626419f8194deb94fc1c1d813761bccde Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:48:31 +0100 Subject: [PATCH 14/15] update imports --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index e5188d0..d3199a4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ importFrom(Rarr,zarr_overview) importFrom(S4Vectors,metadata) importFrom(SingleCellExperiment,int_colData) importFrom(SingleCellExperiment,int_metadata) +importFrom(SpatialData,channels) importFrom(SpatialData,getZarrArrayPath) importFrom(dplyr,mutate) importFrom(dplyr,select) From daf678aa7e511c5f08357655ec8cae4e0c6f1dec Mon Sep 17 00:00:00 2001 From: HelenaLC Date: Mon, 25 Nov 2024 20:49:21 +0100 Subject: [PATCH 15/15] v0.99.2 (fix #85; fix #86) --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e35dbac..cffc294 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SpatialData.plot Title: SpatialData visualization Depends: R (>= 4.4), SpatialData -Version: 0.99.1 +Version: 0.99.2 Description: Visualization suit for 'SpatialData' (R). Current functionality includes handling of multiscale 'images', visualizing 'labels', 'points', and 'shapes'. For the latter, POINT, POLYGON, and MULTIPOLYGON geometries