library(ggplot2)
library(scrapper)
library(patchwork)
library(SpatialData)
library(SpatialData.data)
library(SpatialData.plot)
library(SingleCellExperiment)Visium
preamble
(sd <- MouseBrainVis())class: SpatialData
- images(4):
- ST8059048_hires_image (3,2000,1969)
- ST8059048_lowres_image (3,600,591)
- ST8059050_hires_image (3,2000,1968)
- ST8059050_lowres_image (3,600,590)
- labels(0):
- points(0):
- shapes(2):
- ST8059048 (2987,circle)
- ST8059050 (3497,circle)
- tables(1):
- table (31053,6484) [ST8059048,ST8059050]
coordinate systems(2):
- ST8059048(2): ST8059048_hires_image ST8059048
- ST8059050(2): ST8059050_hires_image ST8059050analysis
Unfortunately, coordinate transformations are unspecified for the low-resolution version of these data; we’ll add these here based on a (visual) guesstimate:
ct <- "lowres"
for (s in c("ST8059048", "ST8059050")) {
i <- grepv(paste0(s, "_lowres"), imageNames(sd))
image(sd, i) <- addCT(image(sd, i), name=ct, type="identity")
shape(sd, s) <- addCT(shape(sd, s), name=ct, type="scale", data=list(0.0345, 0.0345))
print(
plotSpatialData() +
plotImage(sd, i, j=ct) +
plotShape(sd, s, j=ct) +
ggtitle(s)
)
}
The resulting graph of coordinate transformations looks as follows; here, source nodes = spatial elements, and target nodes = coordinate spaces.
CTplot(CTgraph(sd))
Alternatively, we can use the high-resolution data as is:
n <- length(s <- shape(sd))
shape(sd, "spots") <- s[sample(n, 333)]
plotSpatialData() +
plotImage(sd) +
plotShape(sd, "spots", col="red")
bb <- list(xmin=800, xmax=1600, ymin=500, ymax=900)
sp <- crop(sd[c("images", "shapes"), list(1, 1)], bb)
plotSpatialData() +
plotImage(sp) +
plotShape(sp, col="white", fill=NA)
(se <- tables(sd)[[1]])class: SingleCellExperiment
dim: 31053 6484
metadata(0):
assays(1): X
rownames(31053): Xkr4 Gm1992 ... Vmn2r122 CAAA01147332.1
rowData names(0):
colnames(6484): AAACAAGTATCTCCCA-1 AAACACCAATAACTGC-1 ...
TTGTTTCCATACAACT-1-1 TTGTTTGTGTAAATTC-1
colData names(3): in_tissue array_row array_col
reducedDimNames(1): spatial
mainExpName: NULL
altExpNames(0):plotSpatialData() + plotShape(sd, fill="array_col") +
plotSpatialData() + plotShape(sd, fill="Map2") +
plot_layout(nrow=1) & scale_fill_viridis_c()
# perform standard processing:
# - log-library size normalization
# - highly variable gene selection
# - principal component analysis
# - shared-nearest neighbor graph construction
# - community detection using Leiden algorithm
assayNames(se) <- "counts"
se <- normalizeRnaCounts.se(se)
se <- chooseRnaHvgs.se(se)
se <- runPca.se(se, rowData(se)$hvg)
se <- clusterGraph.se(se, method="leiden", resolution=0.5)
base::table(se$clusters)
1 2 3 4 5 6 7 8 9 10 11
810 527 774 414 1115 546 596 1026 174 85 417 pc <- reducedDim(se, "PCA")
colnames(pc) <- paste0("PC", seq_len(ncol(pc)))
colData(se) <- cbind(colData(se), pc)
# overwrite table in copy
sp <- sd; table(sp) <- se# visualize PCs 1-3 spatially
lapply(head(colnames(pc), 3), \(.) {
plotSpatialData() +
plotShape(sp, col=NA, fill=.) + ggtitle(.) +
scale_fill_gradient2(low="blue", high="red")
}) |>
wrap_plots(nrow=1) &
theme(legend.position="none")
i <- "ST8059050"
plotSpatialData() +
plotShape(sp, i, col=NA, fill="clusters") + ggtitle(i) +
scale_fill_manual(values=rainbow(nlevels(se$clusters)))
appendix
session
sessionInfo()R version 4.6.0 (2026-04-24)
Platform: aarch64-apple-darwin23
Running under: macOS Sequoia 15.6.1
Matrix products: default
BLAS: /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.6/Resources/lib/libRlapack.dylib; LAPACK version 3.12.1
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: Europe/Madrid
tzcode source: internal
attached base packages:
[1] stats4 stats graphics grDevices utils datasets methods
[8] base
other attached packages:
[1] SingleCellExperiment_1.35.0 SummarizedExperiment_1.43.0
[3] Biobase_2.73.1 GenomicRanges_1.65.0
[5] Seqinfo_1.3.0 IRanges_2.47.0
[7] S4Vectors_0.51.1 BiocGenerics_0.59.0
[9] generics_0.1.4 MatrixGenerics_1.25.0
[11] matrixStats_1.5.0 SpatialData.plot_0.99.6
[13] SpatialData.data_0.99.6 SpatialData_0.99.35
[15] patchwork_1.3.2 scrapper_1.7.0
[17] ggplot2_4.0.3
loaded via a namespace (and not attached):
[1] DBI_1.3.0 bitops_1.0-9 RBGL_1.89.0
[4] httr2_1.2.2 anndataR_1.3.0 rlang_1.2.0
[7] magrittr_2.0.5 Rarr_2.1.7 otel_0.2.0
[10] e1071_1.7-17 compiler_4.6.0 RSQLite_2.4.6
[13] dir.expiry_1.21.0 paws.storage_0.9.0 png_0.1-9
[16] fftwtools_0.9-11 vctrs_0.7.3 pkgconfig_2.0.3
[19] wk_0.9.5 crayon_1.5.3 fastmap_1.2.0
[22] dbplyr_2.5.2 XVector_0.53.0 labeling_0.4.3
[25] paws.common_0.8.9 rmarkdown_2.31 graph_1.91.0
[28] bit_4.6.0 purrr_1.2.2 xfun_0.57
[31] cachem_1.1.0 beachmat_2.29.0 grumpy_0.1.0
[34] jsonlite_2.0.0 blob_1.3.0 DelayedArray_0.39.1
[37] uuid_1.2-2 tweenr_2.0.3 jpeg_0.1-11
[40] tiff_0.1-12 parallel_4.6.0 R6_2.6.1
[43] RColorBrewer_1.1-3 reticulate_1.46.0 assertthat_0.2.1
[46] Rcpp_1.1.1-1.1 knitr_1.51 R.utils_2.13.0
[49] Matrix_1.7-5 tidyselect_1.2.1 duckspatial_1.0.0
[52] rstudioapi_0.18.0 dichromat_2.0-0.1 abind_1.4-8
[55] yaml_2.3.12 EBImage_4.55.0 curl_7.1.0
[58] lattice_0.22-9 tibble_3.3.1 withr_3.0.2
[61] S7_0.2.2 evaluate_1.0.5 sf_1.1-1
[64] units_1.0-1 proxy_0.4-29 polyclip_1.10-7
[67] BiocFileCache_3.3.0 pillar_1.11.1 filelock_1.0.3
[70] KernSmooth_2.23-26 RCurl_1.98-1.18 nanoarrow_0.8.0
[73] scales_1.4.0 class_7.3-23 glue_1.8.1
[76] tools_4.6.0 ggnewscale_0.5.2 BiocNeighbors_2.7.0
[79] locfit_1.5-9.12 grid_4.6.0 duckdb_1.5.2
[82] basilisk_1.25.0 ggforce_0.5.0 cli_3.6.6
[85] rappdirs_0.3.4 viridisLite_0.4.3 S4Arrays_1.13.0
[88] arrow_24.0.0 dplyr_1.2.1 Rgraphviz_2.57.0
[91] geoarrow_0.4.2 gtable_0.3.6 R.methodsS3_1.8.2
[94] digest_0.6.39 classInt_0.4-11 SparseArray_1.13.2
[97] ZarrArray_1.1.0 htmlwidgets_1.6.4 farver_2.1.2
[100] memoise_2.0.1 htmltools_0.5.9 R.oo_1.27.1
[103] lifecycle_1.0.5 bit64_4.8.0 MASS_7.3-65