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
diff --git a/DESCRIPTION b/DESCRIPTION
index 5960769..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
@@ -41,7 +41,8 @@ Imports:
rlang,
sf,
S4Vectors,
- SingleCellExperiment
+ SingleCellExperiment,
+ Rarr
Suggests:
BiocStyle,
ggnewscale,
diff --git a/NAMESPACE b/NAMESPACE
index c8ecce5..d3199a4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -10,9 +10,12 @@ exportMethods(scale)
exportMethods(translation)
import(SpatialData)
importFrom(DelayedArray,realize)
+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)
importFrom(ggforce,geom_circle)
diff --git a/R/plotImage.R b/R/plotImage.R
index 77d3b54..63a1672 100644
--- a/R/plotImage.R
+++ b/R/plotImage.R
@@ -10,6 +10,11 @@
#' @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 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
#'
@@ -31,6 +36,86 @@ NULL
#' @export
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) > (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), , ]
+ }
+ return(a)
+}
+
+# check if an image is rgb or not
+#' @importFrom SpatialData getZarrArrayPath
+#' @importFrom Rarr zarr_overview
+#' @noRd
+.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 seq_len(dim(a)[1]))
+ a[i,,] <- a[i,,]/max(a[i,,])
+ }
+ return(a)
+}
+
+# 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(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_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) {
n <- length(dim(x))
i <- ifelse(n == 3, -1, TRUE)
@@ -47,14 +132,17 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme
#' @importFrom methods as
#' @importFrom grDevices rgb
#' @importFrom DelayedArray realize
-.df_i <- \(x, k=NULL) {
+.df_i <- \(x, k=NULL, ch=NULL, c=NULL) {
a <- .get_plot_data(x, k)
- a <- if (dim(a)[1] == 1) a[rep(1,3),,] else a
+ 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"))
- img <- rgb(
- maxColorValue=max(a),
- c(a[1,,]), c(a[2,,]), c(a[3,,]))
- array(img, dim(a)[-1])
+ 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) {
@@ -75,13 +163,13 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme
#' @rdname plotImage
#' @export
-setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL) {
- if (is.numeric(i))
+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))
+ if (is.numeric(j))
j <- CTname(y)[j]
- df <- .df_i(y, k)
+ 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/R/utils.R b/R/utils.R
index efdbfef..7b15f97 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 <- c("uint8" = 255,
+ "uint16" = 65535,
+ "uint32" = 4294967295,
+ "uint64" = 2^64 - 1)
\ No newline at end of file
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'
diff --git a/man/plotImage.Rd b/man/plotImage.Rd
index 96f65be..3f11df9 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,12 @@ 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}{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}
}
\value{
ggplot
diff --git a/tests/testthat/test-plotImage.R b/tests/testthat/test-plotImage.R
new file mode 100644
index 0000000..e32b304
--- /dev/null
+++ b/tests/testthat/test-plotImage.R
@@ -0,0 +1,30 @@
+require(SpatialData, quietly=TRUE)
+x <- file.path("extdata", "blobs.zarr")
+x <- system.file(x, package="SpatialData")
+x <- readSpatialData(x, tables=FALSE)
+
+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_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()
+})
diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd
index 4a770d1..1c0f4f4 100644
--- a/vignettes/SpatialData.plot.Rmd
+++ b/vignettes/SpatialData.plot.Rmd
@@ -238,6 +238,53 @@ 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, anndataR=FALSE))
+```
+
+Getting channel names for the image:
+
+```{r mcmicro-channels}
+channels(image(x))
+```
+
+Plotting with multiple image channels:
+
+```{r mcmicro-plot}
+plotSpatialData() + plotImage(x,
+ ch=c("DNA_6", "CD45", "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, anndataR=FALSE)
+```
+
+Plotting with multiple image channels.
+
+```{r steinbock-plot}
+plotSpatialData() + plotImage(x,
+ i="Patient3_003_image",
+ ch=c(6, 22, 39),
+ c=c("blue", "cyan", "yellow"))
+```
+
# Masking
Back to blobs...
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 @@ 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=.)))
-
+
Labels
@@ -819,7 +821,7 @@
Labels
(a | b | c) +
plot_layout(guides="collect") &
theme(legend.position="bottom")
-
+
Points
@@ -835,7 +837,7 @@
Points
b <- p + plotPoint(y, i, "letters") # discrete coloring
c <- p + plotPoint(y, i, "numbers") # continuous coloring
a | b | c
-
+
Shapes
@@ -850,7 +852,7 @@
Shapes
ggtitle("circles") +
plotShape(x, "blobs_circles")
wrap_plots(a, b, c)
-
+
Layering
@@ -872,7 +874,7 @@
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 @@
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)
-
+
VisiumHD
@@ -949,7 +951,7 @@
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)
-
+
MibiTOF
@@ -981,7 +983,53 @@
MibiTOF
plotSpatialData() + plotImage(x, .) +
plotLabel(x, ., "Cluster", pal=pal))) +
plot_layout(guides="collect")
-
+
+
+
+
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"))
+
+
+
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 @@
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 @@ Masking
legend.title=element_blank(),
legend.key.width=unit(1, "lines"),
legend.key.height=unit(0.5, "lines"))
-
+
Session info
@@ -1067,7 +1115,7 @@ 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
##