diff --git a/.gitignore b/.gitignore index 655a68f..a6cfcaa 100644 --- a/.gitignore +++ b/.gitignore @@ -3,4 +3,5 @@ .RData .Ruserdata *.Rproj +*html docs diff --git a/DESCRIPTION b/DESCRIPTION index 2194d94..3c91813 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,26 +12,18 @@ Authors@R: c( role=c("aut", "cre"), email="helena@crowell.eu", comment=c(ORCID="0000-0002-4801-1767")), - person("Vince", "Carey", - role=c("aut"), - email="stvjc@channing.harvard.edu", - comment=c(ORCID="0000-0003-4046-0063")), - person("Yixing E.", "Dong", - role=c("aut"), - email="estelladong729@gmail.com", - comment=c(ORCID="0009-0003-5115-5686")), person("Artür", "Manukyan", role=c("aut"), email="artur-man@hotmail.com", comment=c(ORCID="0000-0002-0441-9517")), - person("Dario", "Righelli", - role=c("aut"), - email="dario.righelli@gmail.com", - comment=c(ORCID="0000-0003-1504-3583")), - person("Louise", "Deconinck", + person("Hugo", "Gruson", role=c("aut"), - email="louise.deconinck@gmail.com", - comment=c(ORCID="0000-0001-8100-6823"))) + email="charlotte.soneson@fmi.ch", + comment=c(ORCID="0000-0002-4094-1476")), + person("Vince", "Carey", + role=c("aut"), + email="stvjc@channing.harvard.edu", + comment=c(ORCID="0000-0003-4046-0063"))) Imports: DelayedArray, dplyr, diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index 60ae178..7233994 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -3,11 +3,9 @@ title: "`SpatialData.plot`" date: "`r format(Sys.Date(), '%B %d, %Y')`" package: "`r BiocStyle::pkg_ver('SpatialData.plot')`" author: - - name: Helena Lucia Crowell - - name: Louise Deconinck + - name: Helena L. Crowell - name: Artür Manukyan - - name: Dario Righelli - - name: Estella Dong + - name: Hugo Gruson - name: Vince Carey output: BiocStyle::html_document @@ -69,7 +67,7 @@ Internally, multiscale `ImageArray`s are stored as a list of `ZarrArray`, e.g.: ```{r ms-dims} i <- image(x, "blobs_multiscale_image") -vapply(i@data, dim, numeric(3)) +vapply(data(i, k=NULL), dim, numeric(3)) ``` To retrieve a specific scale's `ZarrArray`, we can use `data(., k)`, @@ -82,7 +80,7 @@ wrap_plots(nrow=1, lapply(seq(3), \(.) ### Labels -```{r plotLabel, fig.width=8, fig.height=3.5} +```{r plotLabel, fig.width=9, fig.height=3.5} i <- "blobs_labels" t <- getTable(x, i) t$id <- sample(letters, ncol(t)) @@ -92,10 +90,9 @@ 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, c = "id", pal=pal_d) # 'colData' -c <- p + plotLabel(x, i, c = "channel_1_sum", pal=pal_c) + - theme(legend.key.width=unit(1, "lines")) # 'assay' +a <- p + plotLabel(x, i, pal="grey") # binary +b <- p + plotLabel(x, i, c="id", pal=pal_d) # metadata +c <- p + plotLabel(x, i, c="channel_1_sum", pal=pal_c) # assay (a | b | c) + plot_layout(guides="collect") & @@ -105,24 +102,17 @@ c <- p + plotLabel(x, i, c = "channel_1_sum", pal=pal_c) + ### Points -```{r plotPoint, eval=FALSE, fig.width=8, fig.height=2.5} +```{r plotPoint, fig.width=10, fig.height=3} i <- "blobs_points" -p <- plotSpatialData() -# mock up a 'table' -f <- list( - numbers=\(n) runif(n), - letters=\(n) sample(letters, n, TRUE)) -y <- setTable(x, i, f) -# demo. viz. capabilities -a <- p + plotPoint(y, i) -b <- p + plotPoint(y, i, "letters") # discrete coloring -c <- p + plotPoint(y, i, "numbers") # continuous coloring -a | b | c +a <- p + plotPoint(x, i) +b <- p + plotPoint(x, i, col="genes") # discrete +c <- p + plotPoint(x, i, col="instance_id") # continuous +(a | b | c) ``` ### Shapes -```{r plotShape, fig.width=6, fig.height=2.5} +```{r plotShape, fig.width=8, fig.height=3} p <- plotSpatialData() a <- p + ggtitle("polygons") + @@ -133,7 +123,7 @@ b <- p + c <- p + ggtitle("circles") + plotShape(x, "blobs_circles") -wrap_plots(a, b, c) +(a | b | c) ``` ### Layering @@ -147,7 +137,7 @@ all <- p + plotShape(x, 1) + plotShape(x, 3) + new_scale_color() + - plotPoint(x, c="genes") + + plotPoint(x, col="genes") + ggtitle("layered") # split one <- list( @@ -155,7 +145,7 @@ one <- list( p + plotLabel(x) + ggtitle("labels"), p + plotShape(x, 1) + ggtitle("circles"), p + plotShape(x, 3) + ggtitle("polygons"), - p + plotPoint(x, c="genes") + ggtitle("points")) + p + plotPoint(x, col="genes") + ggtitle("points")) wrap_plots(c(list(all), one), nrow=2) ``` @@ -176,48 +166,30 @@ There are only `r length(SpatialData::shape(x, "cells"))` cells, but `r format(length(SpatialData::point(x, "single_molecule")), big.mark=",")` molecules, so that we downsample a random subset of 1,000 for visualization: -```{r merfish-plot} -# downsample 1,000 points -n <- length(p <- point(x)) -q <- p[sample(n, 1e3)] -(point(x, "1k") <- q) +```{r merfish-plot, fig.width=6, fig.height=4} # layered visualization plotSpatialData() + plotImage(x, c="white") + - new_scale_color() + - plotPoint(x, i="1k", c="cell_type", size=0.2) + - new_scale_color() + - plotShape(x, i="anatomical") + - scale_color_manual(values=hcl.colors(6, "Spectral")) -``` - -```{r include=FALSE} -knitr::opts_chunk$set(eval=FALSE) -``` - -```{r merfish-box} -# 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 - -Mouse intestine, 1GB; 4 image resolutions and 3 shapes at 2, 8, and 16 $\mu$m. - -```{r visiumhd-read, eval=FALSE} -dir.create(td <- tempfile()) -pa <- MouseIntestineVisHD(target=td) -(x <- readSpatialData(pa, images=4, shapes=3)) -``` - -```{r visiumhd-plot, eval=FALSE} -qu <- list(xmin=100, xmax=300, ymin=200, ymax=400) -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) + plotPoint(x, n=1e3, col="cell_type", size=0.5) + + scale_color_manual(values=rainbow(8)) + + guides(col=guide_legend(override.aes=list(size=2))) + + plotShape(x, i="anatomical", fill=NA, col="white", linewidth=1) +``` + +```{r merfish-box, fig.width=7, fig.height=6} +# subset & downsample for speed +y <- x[c("images", "points"), ] +n <- length(point(y)) +i <- sample(n, 1e5) +point(y) <- point(y)[i] +# polygon queries +lapply(seq_along(shape(x)), \(s) { + df <- data(shape(x)[s, ]) + z <- crop(y, sf::st_as_sf(df)) + plotSpatialData() + + plotImage(z) + + plotPoint(z, n=1e3, size=1/3, col="cyan") +}) |> wrap_plots(nrow=2) & theme(axis.text.x=element_text(angle=45, hjust=1)) ``` ## MibiTOF @@ -225,127 +197,21 @@ plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y) Colorectal carcinoma, 25 MB; no shapes, no points. ```{r mibitof-read} -dir.create(td <- tempfile()) -pa <- SpatialData.data:::.unzip_spd_demo( - zipname="mibitof.zip", - dest=td, source="biocOSN") -(x <- readSpatialData(pa)) -``` - -```{r mibitof-plot, fig.width=10, fig.height=3} -pal <- hcl.colors(8, "Spectral") -wrap_plots(nrow=1, lapply(seq(3), \(.) - plotSpatialData() + plotImage(x, .) + - plotLabel(x, ., c = "Cluster", pal=pal))) + - 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 <- SpatialData.data:::.unzip_spd_demo( - zipname="mcmicro_io.zip", - dest=td, source="biocOSN") -(x <- readSpatialData(pa)) +(x <- ColorectalCarcinomaMIBITOF()) ``` -Getting channel names for the image: - -```{r mcmicro-channels} -chs <- channels(image(x)) -``` - -Plotting with multiple image channels: - -```{r mcmicro-plot} -plotSpatialData() + plotImage(x, - ch=chs, - c=grDevices::palette.colors(length(chs), palette = "Polychrome 36") -) -``` - -We can specify contrast limits for each channel via the `cl` argument, but if not provided, they will be automatically computed as the 5th and 95th percentiles of the pixel intensities for each channel. - -## 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 <- SpatialData.data:::.unzip_spd_demo( - zipname="steinbock_io.zip", - dest=td, source="biocOSN") -x <- readSpatialData(pa) -``` - -### channels - -```{r steinbock-ch} -plotSpatialData() + plotImage(x, - i="Patient3_003_image", - ch=c(6, 22, 39), - c=c("blue", "cyan", "yellow")) +```{r mibitof-plot, fig.width=9, fig.height=3.5} +ps <- lapply(imageNames(x), \(i) plotSpatialData() + plotImage(x, i) + ggtitle(i)) +wrap_plots(ps, nrow=1) ``` -### contrasts - -```{r steinbock-cl, fig.width=9, fig.height=3} -i <- image(x, "Patient3_003_image") -image(x, "crop") <- i[, 200:400, 200:400] -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) + 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" -table(x) <- NULL -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, c = .) + - 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")) +```{r fig.width=8, fig.height=4} +# bounding-box query +bb <- list( + xmin=0, xmax=800, + ymin=500, ymax=900) +y <- crop(x["images", 1], bb) +plotSpatialData() + plotImage(y) ``` # Session info