VisiumHD

preamble

library(sf)
library(ggplot2)
library(scrapper)
library(patchwork)
library(SpatialData)
library(SpatialData.data)
library(SpatialData.plot)
library(SingleCellExperiment)

# load & simplify naming
sd <- MouseIntestineVisHD()
pat <- "Visium_HD_Mouse_Small_Intestine_"
imageNames(sd) <- gsub(pat, "", imageNames(sd))
shapeNames(sd) <- gsub(pat, "bin_", shapeNames(sd))
sd

class: SpatialData
- images(4):
  - cytassist_image (3,3000,3200)
  - full_image (3,21943,23618)
  - hires_image (3,5575,6000)
  - lowres_image (3,558,600)
- labels(0):
- points(0):
- shapes(3):
  - bin_square_002um (5479660,circle)
  - bin_square_008um (351817,circle)
  - bin_square_016um (91033,circle)
- tables(3):
  - square_002um (19059,5479660) [bin_square_002um]
  - square_008um (19059,351817) [bin_square_008um]
  - square_016um (19059,91033) [bin_square_016um]
coordinate systems(3):
- global(5): cytassist_image full_image bin_square_002um
  bin_square_008um bin_square_016um
- downscaled_hires(4): hires_image bin_square_002um bin_square_008um
  bin_square_016um
- downscaled_lowres(4): lowres_image bin_square_002um bin_square_008um
  bin_square_016um

analysis

# low-resolution image & shape
i <- grepv("lowres", imageNames(sd))
s <- grepv("_016um", shapeNames(sd))

plotSpatialData() + plotImage(sd, i)

# target coordinate space
ct <- "downscaled_lowres" 
# bounding box query
bb <- list(xmin=100, xmax=200, ymin=200, ymax=300)
# apply crop
sp <- crop(sd, bb, j=ct)

# visualize gene counts spatially
plotSpatialData() +
    plotImage(sp, i=i, j=ct) + 
    plotShape(sp, i=s, j=ct, fill="Cd74", col=NA) +
    scale_fill_gradientn(colors=rev(hcl.colors(9, "RdPu")))

# rasterization
(ex <- extent(shape(sd, s), ct))

$x
[1]   3.335033 597.183846

$y
[1]  -1.828888 610.786174

tri <- with(ex, rbind(
    c(x[1], y[1]),
    c(x[2], y[1]),
    c(x[2], y[2]),
    c(x[1], y[1]))
) |> list() |> st_polygon() |> st_sfc()
plot(hex <- st_make_grid(tri, cellsize=10, square=FALSE))

# aggregate gene counts by bin
t <- SpatialDataShape(st_sf(geometry=hex))
t <- addCT(t, name=ct, type="identity", data=NULL)
shape(sd, "hex") <- t
sq <- mask(sd, 
    i=s, j="hex", k=ct, 
    how="sum", name="hex_sum")
(sf <- tables(sq)[["hex_sum"]])

class: SingleCellExperiment 
dim: 19059 4357 
metadata(0):
assays(1): sum
rownames(19059): Xkr4 Rp1 ... mt-Cytb Vamp7
rowData names(0):
colnames(4357): 0 1 ... 4355 4356
colData names(1): n_instances
reducedDimNames(0):
mainExpName: NULL
altExpNames(0):

# visualize binned counts spatially
plotSpatialData() +
    plotShape(sq, i="hex", j=ct, fill="Fabp2", col=NA) +
    scale_fill_gradientn(
        trans="log10", na.value="white",
        colors=rev(hcl.colors(9, "RdPu")))

# perform standard processing:
# - log-library size normalization
# - highly variable gene selection
# - principal component analysis
# - shared-nearest neighbor graph construction
# - community detection using Leiden algorithm
t <- grepv("16", tableNames(sd))
se <- tables(sd)[[t]]
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 
 9160 10631  9069  6642 10313  8532 15662  7898  9011  3961   154 

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, t) <- se
sp <- crop(sp, bb, j=ct)

# visualize PCs 1-3 spatially
lapply(head(colnames(pc), 3), \(.) {
    plotSpatialData() + ggtitle(.) +
        plotShape(sp, i=s, j=ct, col=NA, fill=.) + 
        scale_fill_gradient2(low="blue", high="red")
    }) |> 
    wrap_plots(nrow=1) &
    theme(legend.position="none")

# visualize histopathology & clusters side-by-side
plotSpatialData() + 
    plotImage(sp, i=i, j=ct) +
    theme(legend.position="none") +
plotSpatialData() + 
    plotShape(sp, i=s, j=ct, fill="clusters", col=NA) +
    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               sf_1.1-1                   

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] RSQLite_2.4.6       e1071_1.7-17        compiler_4.6.0     
 [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] EBImage_4.55.0      curl_7.1.0          lattice_0.22-9     
 [58] tibble_3.3.1        withr_3.0.2         S7_0.2.2           
 [61] evaluate_1.0.5      BiocFileCache_3.3.0 units_1.0-1        
 [64] proxy_0.4-29        polyclip_1.10-7     pillar_1.11.1      
 [67] filelock_1.0.3      KernSmooth_2.23-26  RCurl_1.98-1.18    
 [70] nanoarrow_0.8.0     scales_1.4.0        class_7.3-23       
 [73] glue_1.8.1          tools_4.6.0         ggnewscale_0.5.2   
 [76] BiocNeighbors_2.7.0 locfit_1.5-9.12     grid_4.6.0         
 [79] duckdb_1.5.2        basilisk_1.25.0     ggforce_0.5.0      
 [82] cli_3.6.6           rappdirs_0.3.4      S4Arrays_1.13.0    
 [85] arrow_24.0.0        dplyr_1.2.1         geoarrow_0.4.2     
 [88] gtable_0.3.6        R.methodsS3_1.8.2   digest_0.6.39      
 [91] classInt_0.4-11     SparseArray_1.13.2  ZarrArray_1.1.0    
 [94] htmlwidgets_1.6.4   farver_2.1.2        memoise_2.0.1      
 [97] htmltools_0.5.9     R.oo_1.27.1         lifecycle_1.0.5    
[100] bit64_4.8.0         MASS_7.3-65