From c6f8bcd4e08231131f223566d9bcbe55e3afdfbd Mon Sep 17 00:00:00 2001
From: HelenaLC
Date: Sun, 24 Nov 2024 12:44:14 +0100
Subject: [PATCH 1/5] tables support
---
R/plotShape.R | 20 +++++++++++++-------
1 file changed, 13 insertions(+), 7 deletions(-)
diff --git a/R/plotShape.R b/R/plotShape.R
index 2caef8a..eb4b491 100644
--- a/R/plotShape.R
+++ b/R/plotShape.R
@@ -37,6 +37,7 @@ NULL
#' @importFrom utils tail
#' @export
setMethod("plotShape", "SpatialData", \(x, i=1, c=NULL, f="white", s="radius", a=0.2, assay=1) {
+ if (is.numeric(i)) i <- shapeNames(x)[i]
df <- data(shape(x, i))
df <- st_as_sf(df)
xy <- st_coordinates(df)
@@ -44,7 +45,6 @@ setMethod("plotShape", "SpatialData", \(x, i=1, c=NULL, f="white", s="radius", a
typ <- as.character(typ[1])
aes <- aes(.data[["x"]], .data[["y"]])
dot <- list(fill=f, alpha=a)
- # TODO: tables support
# TODO: need separate plotting for different types of shapes
switch(typ,
# POINT means circle
@@ -52,12 +52,6 @@ setMethod("plotShape", "SpatialData", \(x, i=1, c=NULL, f="white", s="radius", a
names(xs) <- xs <- setdiff(names(df), "geometry")
df <- data.frame(xy, lapply(xs, \(.) df[[.]]))
names(df) <- c("x", "y", xs)
- if (.str_is_col(c)) {
- dot$col <- c
- } else if (is.character(c)) {
- if (!c %in% names(df)) stop("invalid 'c'")
- aes$colour <- aes(.data[[c]])[[1]]
- }
if (is.numeric(s)) {
geo <- geom_point
dot$size <- s
@@ -67,6 +61,18 @@ setMethod("plotShape", "SpatialData", \(x, i=1, c=NULL, f="white", s="radius", a
aes$y0 <- df$y
aes$r <- aes(.data[[s]])[[1]]
} else stop("invalid 's'")
+ if (.str_is_col(c)) {
+ dot$col <- c
+ } else if (is.character(c)) {
+ if (c %in% names(df)) {
+ aes$colour <- aes(.data[[c]])[[1]]
+ } else {
+ df[[c]] <- valTable(x, i, c, assay=assay)
+ if (scale_type(df[[c]]) == "discrete")
+ df[[c]] <- factor(df[[c]])
+ aes$colour <- aes(.data[[c]])[[1]]
+ }
+ } else stop("invalid 'c'")
},{
geo <- geom_polygon
df <- data.frame(xy)
From c3930308085bbd33985fd5fd5bd8963c884df60f Mon Sep 17 00:00:00 2001
From: HelenaLC
Date: Sun, 24 Nov 2024 18:54:13 +0100
Subject: [PATCH 2/5] int_colData-related fixes; added examples of 'mask'ing
---
NAMESPACE | 1 +
R/{plot.R => plotImage.R} | 16 ---
R/plotLabel.R | 15 ++-
R/plotPoint.R | 6 +-
R/utils.R | 36 ++++++
man/plotImage.Rd | 2 +-
man/plotLabel.Rd | 9 +-
tests/testthat/test-plotPoint.R | 4 +-
vignettes/SpatialData.plot.Rmd | 53 ++++++++-
vignettes/SpatialData.plot.html | 111 ++++++++++++++----
.../figure-html/blobs-plot-1.png | Bin 0 -> 217409 bytes
.../figure-html/merfish-box-1.png | Bin 0 -> 364626 bytes
.../figure-html/merfish-plot-1.png | Bin 0 -> 528565 bytes
.../figure-html/ms-plot-1.png | Bin 0 -> 42171 bytes
.../figure-html/plotLabel-1.png | Bin 0 -> 38571 bytes
.../figure-html/plotPoint-1.png | Bin 0 -> 138066 bytes
.../figure-html/plotShape-1.png | Bin 0 -> 75142 bytes
.../figure-html/visiumhd-plot-1.png | Bin 0 -> 803837 bytes
18 files changed, 200 insertions(+), 53 deletions(-)
rename R/{plot.R => plotImage.R} (82%)
create mode 100644 R/utils.R
create mode 100644 vignettes/SpatialData.plot_files/figure-html/blobs-plot-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/merfish-box-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/merfish-plot-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/ms-plot-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/plotLabel-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/plotPoint-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/plotShape-1.png
create mode 100644 vignettes/SpatialData.plot_files/figure-html/visiumhd-plot-1.png
diff --git a/NAMESPACE b/NAMESPACE
index 4871a79..c8ecce5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -11,6 +11,7 @@ exportMethods(translation)
import(SpatialData)
importFrom(DelayedArray,realize)
importFrom(S4Vectors,metadata)
+importFrom(SingleCellExperiment,int_colData)
importFrom(SingleCellExperiment,int_metadata)
importFrom(dplyr,mutate)
importFrom(dplyr,select)
diff --git a/R/plot.R b/R/plotImage.R
similarity index 82%
rename from R/plot.R
rename to R/plotImage.R
index 2d19779..77d3b54 100644
--- a/R/plot.R
+++ b/R/plotImage.R
@@ -26,22 +26,6 @@
#' @import SpatialData
NULL
-#' @importFrom grDevices col2rgb
-.str_is_col <- \(x) !inherits(tryCatch(error=\(e) e, col2rgb(x)), "error")
-
-#' @importFrom ggplot2
-#' coord_equal theme_bw theme
-#' element_blank element_text element_line
-.theme <- list(
- coord_equal(), theme_bw(), theme(
- panel.grid=element_blank(),
- legend.key=element_blank(),
- legend.background=element_blank(),
- plot.title=element_text(hjust=0.5),
- axis.text=element_text(color="grey"),
- axis.ticks=element_line(color="grey"))
-)
-
#' @rdname plotImage
#' @importFrom ggplot2 ggplot scale_y_reverse
#' @export
diff --git a/R/plotLabel.R b/R/plotLabel.R
index 2996d82..d9c61fc 100644
--- a/R/plotLabel.R
+++ b/R/plotLabel.R
@@ -24,8 +24,15 @@
#' # simple binary image
#' p + plotLabel(x, i)
#'
+#' # mock up some extra data
+#' t <- getTable(x, i)
+#' t$id <- sample(letters, ncol(t))
+#' table(x) <- t
+#'
#' # coloring by 'colData'
-#' p + plotLabel(x, i, "instance_id")
+#' n <- length(unique(t$id))
+#' pal <- hcl.colors(n, "Spectral")
+#' p + plotLabel(x, i, "id", pal=pal)
#'
#' # coloring by 'assay' data
#' p + plotLabel(x, i, "channel_1_sum")
@@ -50,10 +57,10 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, c=NULL,
if (!is.null(c)) {
stopifnot(length(c) == 1, is.character(c))
t <- table(x, hasTable(x, i, name=TRUE))
- md <- int_metadata(t)$spatialdata_attrs
- idx <- match(df$z, t[[md$instance_key]])
+ ik <- .instance_key(t)
+ idx <- match(df$z, int_colData(t)[[ik]])
df$z <- valTable(x, i, c, assay=assay)[idx]
- if (c == md$instance_key) df$z <- factor(df$z)
+ if (c == ik) df$z <- factor(df$z)
aes$fill <- aes(.data[["z"]])[[1]]
switch(scale_type(df$z),
discrete={
diff --git a/R/plotPoint.R b/R/plotPoint.R
index f7e0e7c..82eb519 100644
--- a/R/plotPoint.R
+++ b/R/plotPoint.R
@@ -56,8 +56,8 @@ NULL
if (is.null(ik)) stop("missing 'instance_key' in 'table' annotating 'i'")
stopifnot(length(c) == 1, is.character(c))
t <- table(x, hasTable(x, i, name=TRUE))
- md <- int_metadata(t)$spatialdata_attrs
- idx <- match(df[[ik]], t[[md$instance_key]])
+ ik <- .instance_key(t)
+ idx <- match(df[[ik]], int_colData(t)[[ik]])
df[[c]] <- valTable(x, i, c, assay=assay)[idx]
aes$colour <- aes(.data[[c]])[[1]]
}
@@ -88,7 +88,7 @@ NULL
#' @rdname plotPoint
#' @export
setMethod("plotPoint", "SpatialData", \(x, i=1, c=NULL, s=1, a=1, assay=1) {
- ik <- meta(point(x, i))$spatialdata_attrs$instance_key
+ ik <- .instance_key(point(x, i))
.gg_p(x, c, s, a, i=i, ik=ik, assay=assay)
})
diff --git a/R/utils.R b/R/utils.R
new file mode 100644
index 0000000..efdbfef
--- /dev/null
+++ b/R/utils.R
@@ -0,0 +1,36 @@
+# convenience functions until this is fixed/exported by 'SpatialData'
+
+#' @importFrom methods is
+#' @importFrom SingleCellExperiment int_metadata
+.spatialdata_attrs <- \(x) {
+ if (is(x, "SingleCellExperiment")) {
+ int_metadata(x)$spatialdata_attrs
+ } else if (is(x, "SpatialDataElement")) {
+ meta(x)$spatialdata_attrs
+ } else if (is(x, "Zattrs")) {
+ x$spatialdata_attrs
+ } else stop("invalid 'x'")
+}
+
+.instance_key <- \(x) .spatialdata_attrs(x)$instance_key
+.region_key <- \(x) .spatialdata_attrs(x)$region_key
+.region <- \(x) .spatialdata_attrs(x)$region
+
+#' @importFrom SingleCellExperiment int_colData
+.instance_ids <- \(x) int_colData(x)[[.instance_key(x)]]
+
+#' @importFrom grDevices col2rgb
+.str_is_col <- \(x) !inherits(tryCatch(error=\(e) e, col2rgb(x)), "error")
+
+#' @importFrom ggplot2
+#' coord_equal theme_bw theme
+#' element_blank element_text element_line
+.theme <- list(
+ coord_equal(), theme_bw(), theme(
+ panel.grid=element_blank(),
+ legend.key=element_blank(),
+ legend.background=element_blank(),
+ 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
diff --git a/man/plotImage.Rd b/man/plotImage.Rd
index ae8a64e..96f65be 100644
--- a/man/plotImage.Rd
+++ b/man/plotImage.Rd
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/plot.R
+% Please edit documentation in R/plotImage.R
\name{plotImage}
\alias{plotImage}
\alias{plotSpatialData}
diff --git a/man/plotLabel.Rd b/man/plotLabel.Rd
index 70dc460..cb5c012 100644
--- a/man/plotLabel.Rd
+++ b/man/plotLabel.Rd
@@ -48,8 +48,15 @@ p <- plotSpatialData()
# simple binary image
p + plotLabel(x, i)
+# mock up some extra data
+t <- getTable(x, i)
+t$id <- sample(letters, ncol(t))
+table(x) <- t
+
# coloring by 'colData'
-p + plotLabel(x, i, "instance_id")
+n <- length(unique(t$id))
+pal <- hcl.colors(n, "Spectral")
+p + plotLabel(x, i, "id", pal=pal)
# coloring by 'assay' data
p + plotLabel(x, i, "channel_1_sum")
diff --git a/tests/testthat/test-plotPoint.R b/tests/testthat/test-plotPoint.R
index f3c3085..6141871 100644
--- a/tests/testthat/test-plotPoint.R
+++ b/tests/testthat/test-plotPoint.R
@@ -40,8 +40,7 @@ test_that("plotPoint(),SpatialData", {
.test <- \(p, t) {
expect_s3_class(p, "ggplot")
df <- p$layers[[1]]$data
- ik <- meta(t)$instance_key
- cs <- match(df[[ik]], t[[ik]])
+ cs <- match(df[[.instance_key(t)]], .instance_ids(t))
expect_identical(df[[.]], t[[.]][cs])
expect_is(p$layers[[1]]$mapping$colour, "quosure")
}
@@ -66,4 +65,3 @@ test_that("plotPoint(),PointFrame", {
# invalid
expect_error(plotPoint(y, c="."))
})
-
diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd
index 63c3d38..4a770d1 100644
--- a/vignettes/SpatialData.plot.Rmd
+++ b/vignettes/SpatialData.plot.Rmd
@@ -83,12 +83,19 @@ wrap_plots(nrow=1, lapply(seq(3), \(.)
```{r plotLabel, fig.width=8, fig.height=3.5}
i <- "blobs_labels"
+t <- getTable(x, i)
+t$id <- sample(letters, ncol(t))
+table(x) <- t
+
p <- plotSpatialData()
pal_d <- hcl.colors(10, "Spectral")
pal_c <- hcl.colors(9, "Inferno")[-9]
+
a <- p + plotLabel(x, i) # simple binary image
-b <- p + plotLabel(x, i, "instance_id", pal=pal_d) # 'colData'
-c <- p + plotLabel(x, i, "channel_1_sum", pal=pal_c) # 'assay'
+b <- p + plotLabel(x, i, "id", pal=pal_d) # 'colData'
+c <- p + plotLabel(x, i, "channel_1_sum", pal=pal_c) +
+ theme(legend.key.width=unit(1, "lines")) # 'assay'
+
(a | b | c) +
plot_layout(guides="collect") &
theme(legend.position="bottom")
@@ -231,6 +238,48 @@ wrap_plots(nrow=1, lapply(seq(3), \(.)
plot_layout(guides="collect")
```
+# Masking
+
+Back to blobs...
+
+```{r read-mask}
+x <- file.path("extdata", "blobs.zarr")
+x <- system.file(x, package="SpatialData")
+x <- readSpatialData(x, tables=FALSE)
+```
+
+```{r plot-mask-one, fig.width=8, fig.height=3.5}
+i <- "blobs_circles"
+x <- mask(x, "blobs_points", i)
+(t <- getTable(x, i))
+p <- plotSpatialData() +
+ plotPoint(x, c="genes") +
+ scale_color_manual(values=c("tomato", "cornflowerblue")) +
+ new_scale_color()
+lapply(names(c <- c(a="red", b="blue")), \(.)
+ p + plotShape(x, i, c=paste0("gene_", .)) +
+ scale_color_gradient2(
+ low="grey", high=c[.],
+ limits=c(0, 8), n.breaks=5)) |>
+ wrap_plots() + plot_layout(guides="collect")
+```
+
+```{r plot-mask-two, fig.width=8, fig.height=3.5}
+# compute channel-wise means
+i <- "blobs_labels"
+x <- mask(x, "blobs_image", i, fun=mean)
+(t <- getTable(x, i))
+# visualize side-by-side
+ps <- lapply(paste(seq_len(3)), \(.)
+ plotSpatialData() + plotLabel(x, i, .) +
+ ggtitle(paste("channel", ., "sum")))
+wrap_plots(ps, nrow=1) & theme(
+ legend.position="bottom",
+ legend.title=element_blank(),
+ legend.key.width=unit(1, "lines"),
+ legend.key.height=unit(0.5, "lines"))
+```
+
# Session info
```{r sessionInfo, echo=FALSE}
diff --git a/vignettes/SpatialData.plot.html b/vignettes/SpatialData.plot.html
index 5fd378e..631135c 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 23, 2024
+November 24, 2024
Package
SpatialData.plot 0.99.0
@@ -726,7 +726,8 @@ Contents
3.2 VisiumHD
3.3 MibiTOF
-4 Session info
+4 Annotations
+5 Session info
@@ -797,21 +798,28 @@ Images
where k specifies the target scale. This also works for plotting:
Labels
i <- "blobs_labels"
+t <- getTable(x, i)
+t$id <- sample(letters, ncol(t))
+table(x) <- t
+
p <- plotSpatialData()
pal_d <- hcl.colors(10, "Spectral")
pal_c <- hcl.colors(9, "Inferno")[-9]
+
a <- p + plotLabel(x, i) # simple binary image
-b <- p + plotLabel(x, i, "instance_id", pal=pal_d) # 'colData'
-c <- p + plotLabel(x, i, "channel_1_sum", pal=pal_c) # 'assay'
+b <- p + plotLabel(x, i, "id", pal=pal_d) # 'colData'
+c <- p + plotLabel(x, i, "channel_1_sum", pal=pal_c) +
+ theme(legend.key.width=unit(1, "lines")) # 'assay'
+
(a | b | c) +
plot_layout(guides="collect") &
theme(legend.position="bottom")
-

+

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

+

@@ -908,13 +916,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
@@ -941,7 +949,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)
-

+

+
Annotations
+
Back to blobs…
+
x <- file.path("extdata", "blobs.zarr")
+x <- system.file(x, package="SpatialData")
+x <- readSpatialData(x, tables=FALSE)
+
i <- "blobs_circles"
+x <- mask(x, "blobs_points", i)
+(t <- getTable(x, i))
+
## class: SingleCellExperiment
+## dim: 2 5
+## metadata(0):
+## assays(1): counts
+## rownames(2): gene_a gene_b
+## rowData names(0):
+## colnames(5): 1 2 3 4 5
+## colData names(0):
+## reducedDimNames(0):
+## mainExpName: NULL
+## altExpNames(0):
+
p <- plotSpatialData() +
+ plotPoint(x, c="genes") +
+ scale_color_manual(values=c("tomato", "cornflowerblue")) +
+ new_scale_color()
+lapply(names(c <- c(a="red", b="blue")), \(.)
+ p + plotShape(x, i, c=paste0("gene_", .)) +
+ scale_color_gradient2(
+ low="grey", high=c[.],
+ limits=c(0, NA), n.breaks=3)) |>
+ wrap_plots() + plot_layout(guides="collect")
+

+
# compute channel-wise means
+i <- "blobs_labels"
+x <- mask(x, "blobs_image", i, fun=mean)
+(t <- getTable(x, i))
+
## class: SingleCellExperiment
+## dim: 3 10
+## metadata(0):
+## assays(1): counts
+## rownames(3): 1 2 3
+## rowData names(0):
+## colnames(10): 12 11 ... 16 4
+## colData names(0):
+## reducedDimNames(0):
+## mainExpName: NULL
+## altExpNames(0):
+
# visualize side-by-side
+ps <- lapply(paste(seq_len(3)), \(.)
+ plotSpatialData() + plotLabel(x, i, .) +
+ ggtitle(paste("channel", ., "sum")))
+wrap_plots(ps, nrow=1) & theme(
+ legend.position="bottom",
+ legend.title=element_blank(),
+ legend.key.width=unit(1, "lines"),
+ legend.key.height=unit(0.5, "lines"))
+

-