diff --git a/DESCRIPTION b/DESCRIPTION
index 99b5086..5960769 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: SpatialData.plot
Title: SpatialData visualization
Depends: R (>= 4.4), SpatialData
-Version: 0.99.0
+Version: 0.99.1
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
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/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)
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/inst/NEWS b/inst/NEWS
index cf56122..f939f1e 100644
--- a/inst/NEWS
+++ b/inst/NEWS
@@ -1,3 +1,8 @@
+changes in version 0.99.1
+
+- various fixes related to moving 'instance/region_key' to 'int_colData'
+- added examples of 'mask'ing in the vignette
+
changes in version 0.99.0
- initialization of 'SpatialData.plot' package
\ 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..d2e0f47 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 Masking
+5 Session info
@@ -797,21 +798,28 @@ 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
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")
-
+
Points
@@ -827,7 +835,7 @@
Points
b <- p + plotPoint(y, i, "letters") # discrete coloring
c <- p + plotPoint(y, i, "numbers") # continuous coloring
a | b | c
-
+
Shapes
@@ -842,7 +850,7 @@
Shapes
ggtitle("circles") +
plotShape(x, "blobs_circles")
wrap_plots(a, b, c)
-
+
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)
-
+
MibiTOF
@@ -973,11 +981,68 @@
MibiTOF
plotSpatialData() + plotImage(x, .) +
plotLabel(x, ., "Cluster", pal=pal))) +
plot_layout(guides="collect")
-
+
+
+
+
Masking
+
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, 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)
+(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"))
+
-
Session info
+
+
Session info
## R version 4.4.1 Patched (2024-07-08 r86893)
## Platform: aarch64-apple-darwin20
## Running under: macOS Sonoma 14.2.1
@@ -1002,7 +1067,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.19
+## [11] SpatialData.plot_0.99.0 SpatialData_0.99.20
## [13] ggnewscale_0.5.0 patchwork_1.3.0
## [15] ggplot2_3.5.1 BiocStyle_2.34.0
##
@@ -1035,12 +1100,12 @@ Session info
## [76] grid_4.4.1 colorspace_2.1-1 GenomeInfoDbData_1.2.13
## [79] basilisk_1.18.0 ggforce_0.4.2 cli_3.6.3
## [82] fansi_1.0.6 S4Arrays_1.6.0 arrow_17.0.0.1
-## [85] dplyr_1.1.4 geoarrow_0.2.1 Rgraphviz_2.50.0
-## [88] gtable_0.3.6 R.methodsS3_1.8.2 sass_0.4.9
-## [91] digest_0.6.37 classInt_0.4-10 SparseArray_1.6.0
-## [94] farver_2.1.2 memoise_2.0.1 htmltools_0.5.8.1
-## [97] R.oo_1.27.0 lifecycle_1.0.4 httr_1.4.7
-## [100] MASS_7.3-61 bit64_4.5.2
+## [85] dplyr_1.1.4 geoarrow_0.2.1 gtable_0.3.6
+## [88] R.methodsS3_1.8.2 sass_0.4.9 digest_0.6.37
+## [91] classInt_0.4-10 SparseArray_1.6.0 farver_2.1.2
+## [94] memoise_2.0.1 htmltools_0.5.8.1 R.oo_1.27.0
+## [97] lifecycle_1.0.4 httr_1.4.7 MASS_7.3-61
+## [100] bit64_4.5.2