Spatial data integration with Harmony (10x Visium Human DLPFC)
Here, we demonstrate how BANKSY can be used with Harmony for integrating multiple spatial omics datasets in the presence of strong batch effects. We use 10x Visium data of the human dorsolateral prefrontal cortex from Maynard et al (2018). The data comprise 12 samples obtained from 3 subjects, with manual annotation of the layers in each sample.
library(Banksy)
library(SummarizedExperiment)
library(SpatialExperiment)
library(Seurat)
library(scran)
library(data.table)
library(harmony)
library(scater)
library(cowplot)
library(ggplot2)
SEED <- 1000Loading the data
We fetch the data for all 12 DLPFC samples with the spatialLIBD package. This might take awhile.
library(spatialLIBD)
library(ExperimentHub)
ehub <- ExperimentHub::ExperimentHub()
spe <- spatialLIBD::fetch_data(type = "spe", eh = ehub)After the download is completed, we trim the SpatialExperiment object, retaining only the counts and some metadata such as the sample identifier and pathology annotations. This saves some memory.
#' Remove NA spots
na_id <- which(is.na(spe$layer_guess_reordered_short))
spe <- spe[, -na_id]
#' Trim
imgData(spe) <- NULL
assay(spe, "logcounts") <- NULL
reducedDims(spe) <- NULL
rowData(spe) <- NULL
colData(spe) <- DataFrame(
sample_id = spe$sample_id,
subject_id = factor(spe$sample_id, labels = rep(paste0("Subject", 1:3), each = 4)),
clust_annotation = factor(as.numeric(spe$layer_guess_reordered_short)),
in_tissue = spe$in_tissue,
row.names = colnames(spe)
)
colnames(spe) <- paste0(colnames(spe), "_", spe$sample_id)
invisible(gc())We analyse the first sample of each subject due to vignette runtime constraints.
spe <- spe[, spe$sample_id %in% c("151507", "151669", "151673")]
sample_names <- unique(spe$sample_id)Next, stagger the spatial coordinates across the samples so that spots from different samples do not overlap.
#' Stagger spatial coordinates
locs <- spatialCoords(spe)
locs <- cbind(locs, sample_id = factor(spe$sample_id))
locs_dt <- data.table(locs)
colnames(locs_dt) <- c("sdimx", "sdimy", "group")
locs_dt[, sdimx := sdimx - min(sdimx), by = group]
global_max <- max(locs_dt$sdimx) * 1.5
locs_dt[, sdimx := sdimx + group * global_max]
locs <- as.matrix(locs_dt[, 1:2])
rownames(locs) <- colnames(spe)
spatialCoords(spe) <- locsData preprocessing
Find highly variable features and normalize counts. Here we use
Seurat, but other methods may also be used
(e.g. scran::getTopHVGs).
#' Get HVGs
seu <- as.Seurat(spe, data = NULL)
seu <- FindVariableFeatures(seu, nfeatures = 2000)
#' Normalize data
scale_factor <- median(colSums(assay(spe, "counts")))
seu <- NormalizeData(seu, scale.factor = scale_factor, normalization.method = "RC")
#' Add data to SpatialExperiment and subset to HVGs
aname <- "normcounts"
assay(spe, aname) <- GetAssayData(seu)
spe <- spe[VariableFeatures(seu),]Running BANKSY
Compute BANKSY neighborhood matrices. We use k_geom=18
corresponding to first and second-order neighbors in 10x Visium.
compute_agf <- TRUE
k_geom <- 18
spe <- computeBanksy(spe, assay_name = aname, compute_agf = compute_agf, k_geom = k_geom)Run PCA on the BANKSY matrix:
Run Harmony on BANKSY’s embedding
We run Harmony on the PCs of the BANKSY matrix:
set.seed(SEED)
harmony_embedding <- HarmonyMatrix(
data_mat = reducedDim(spe, "PCA_M1_lam0.2"),
meta_data = colData(spe),
vars_use = c("sample_id", "subject_id"),
do_pca = FALSE,
max.iter.harmony = 20,
verbose = FALSE
)
reducedDim(spe, "Harmony_BANKSY") <- harmony_embeddingNext, run UMAP on the ‘raw’ and Harmony corrected PCA embeddings:
spe <- runBanksyUMAP(spe, use_agf = TRUE, lambda = lambda, npcs = npcs)
spe <- runBanksyUMAP(spe, dimred = "Harmony_BANKSY")Visualize the UMAPs annotated by subject ID:
plot_grid(
plotReducedDim(spe, "UMAP_M1_lam0.2",
point_size = 0.1,
point_alpha = 0.5,
color_by = "subject_id") +
theme(legend.position = "none"),
plotReducedDim(spe, "UMAP_Harmony_BANKSY",
point_size = 0.1,
point_alpha = 0.5,
color_by = "subject_id") +
theme(legend.title = element_blank()) +
guides(colour = guide_legend(override.aes = list(size = 5, alpha = 1))),
nrow = 1,
rel_widths = c(1, 1.2)
)
Cluster the Harmony corrected PCA embedding:
spe <- clusterBanksy(spe, dimred = "Harmony_BANKSY", resolution = 0.55, seed = SEED)
spe <- connectClusters(spe, map_to = "clust_annotation")Generate spatial plots:
cnm <- clusterNames(spe)[2]
spatial_plots <- lapply(sample_names, function(snm) {
x <- spe[, spe$sample_id == snm]
ari <- aricode::ARI(x$clust_annotation, colData(x)[, cnm])
df <- cbind.data.frame(clust=colData(x)[[cnm]], spatialCoords(x))
ggplot(df, aes(x=sdimy, y=sdimx, col=clust)) +
geom_point(size = 0.5) +
scale_color_manual(values = pals::kelly()[-1]) +
theme_classic() +
theme(
legend.position = "none",
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank()) +
labs(title = sprintf("Sample %s - ARI: %s", snm, round(ari, 3))) +
coord_equal()
})
plot_grid(plotlist = spatial_plots, ncol = 3, byrow = FALSE)
Session information
Vignette runtime:
#> Time difference of 1.722205 minssessionInfo()
#> R version 4.4.1 (2024-06-14)
#> Platform: x86_64-pc-linux-gnu
#> Running under: Ubuntu 24.04.1 LTS
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
#> LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so; LAPACK version 3.12.0
#>
#> locale:
#> [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=en_US.UTF-8 LC_COLLATE=C
#> [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
#> [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
#>
#> time zone: Etc/UTC
#> tzcode source: system (glibc)
#>
#> attached base packages:
#> [1] stats4 stats graphics grDevices utils datasets methods
#> [8] base
#>
#> other attached packages:
#> [1] ExperimentHub_2.13.1 AnnotationHub_3.13.3
#> [3] BiocFileCache_2.13.2 dbplyr_2.5.0
#> [5] spatialLIBD_1.17.8 cowplot_1.1.3
#> [7] scater_1.33.4 ggplot2_3.5.1
#> [9] harmony_1.2.1 Rcpp_1.0.13
#> [11] data.table_1.16.2 scran_1.33.2
#> [13] scuttle_1.15.5 Seurat_5.1.0
#> [15] SeuratObject_5.0.2 sp_2.1-4
#> [17] SpatialExperiment_1.15.1 SingleCellExperiment_1.27.2
#> [19] SummarizedExperiment_1.35.5 Biobase_2.65.1
#> [21] GenomicRanges_1.57.2 GenomeInfoDb_1.41.2
#> [23] IRanges_2.39.2 S4Vectors_0.43.2
#> [25] BiocGenerics_0.51.3 MatrixGenerics_1.17.1
#> [27] matrixStats_1.4.1 Banksy_1.3.0
#> [29] BiocStyle_2.33.1
#>
#> loaded via a namespace (and not attached):
#> [1] bitops_1.0-9 spatstat.sparse_3.1-0 doParallel_1.0.17
#> [4] httr_1.4.7 RColorBrewer_1.1-3 tools_4.4.1
#> [7] sctransform_0.4.1 DT_0.33 utf8_1.2.4
#> [10] R6_2.5.1 lazyeval_0.2.2 uwot_0.2.2
#> [13] withr_3.0.2 gridExtra_2.3 progressr_0.15.0
#> [16] cli_3.6.3 spatstat.explore_3.3-3 fastDummies_1.7.4
#> [19] labeling_0.4.3 sass_0.4.9 spatstat.data_3.1-2
#> [22] ggridges_0.5.6 pbapply_1.7-2 Rsamtools_2.21.2
#> [25] dbscan_1.2-0 aricode_1.0.3 dichromat_2.0-0.1
#> [28] sessioninfo_1.2.2 parallelly_1.38.0 attempt_0.3.1
#> [31] maps_3.4.2 limma_3.61.12 pals_1.9
#> [34] RSQLite_2.3.7 BiocIO_1.15.2 generics_0.1.3
#> [37] ica_1.0-3 spatstat.random_3.3-2 dplyr_1.1.4
#> [40] Matrix_1.7-1 ggbeeswarm_0.7.2 fansi_1.0.6
#> [43] abind_1.4-8 lifecycle_1.0.4 yaml_2.3.10
#> [46] edgeR_4.3.21 SparseArray_1.5.45 Rtsne_0.17
#> [49] paletteer_1.6.0 grid_4.4.1 blob_1.2.4
#> [52] promises_1.3.0 dqrng_0.4.1 crayon_1.5.3
#> [55] miniUI_0.1.1.1 lattice_0.22-6 beachmat_2.21.9
#> [58] mapproj_1.2.11 KEGGREST_1.45.1 magick_2.8.5
#> [61] sys_3.4.3 maketools_1.3.1 pillar_1.9.0
#> [64] knitr_1.48 metapod_1.13.0 rjson_0.2.23
#> [67] future.apply_1.11.3 codetools_0.2-20 leiden_0.4.3.1
#> [70] glue_1.8.0 spatstat.univar_3.0-1 vctrs_0.6.5
#> [73] png_0.1-8 spam_2.11-0 gtable_0.3.6
#> [76] rematch2_2.1.2 cachem_1.1.0 xfun_0.48
#> [79] S4Arrays_1.5.11 mime_0.12 survival_3.7-0
#> [82] RcppHungarian_0.3 iterators_1.0.14 fields_16.3
#> [85] statmod_1.5.0 bluster_1.15.1 fitdistrplus_1.2-1
#> [88] ROCR_1.0-11 nlme_3.1-166 bit64_4.5.2
#> [91] filelock_1.0.3 RcppAnnoy_0.0.22 bslib_0.8.0
#> [94] irlba_2.3.5.1 vipor_0.4.7 KernSmooth_2.23-24
#> [97] colorspace_2.1-1 DBI_1.2.3 tidyselect_1.2.1
#> [100] bit_4.5.0 compiler_4.4.1 curl_5.2.3
#> [103] BiocNeighbors_1.99.3 DelayedArray_0.31.14 plotly_4.10.4
#> [106] rtracklayer_1.65.0 scales_1.3.0 lmtest_0.9-40
#> [109] rappdirs_0.3.3 stringr_1.5.1 digest_0.6.37
#> [112] goftest_1.2-3 spatstat.utils_3.1-0 rmarkdown_2.28
#> [115] benchmarkmeData_1.0.4 RhpcBLASctl_0.23-42 XVector_0.45.0
#> [118] htmltools_0.5.8.1 pkgconfig_2.0.3 highr_0.11
#> [121] fastmap_1.2.0 rlang_1.1.4 htmlwidgets_1.6.4
#> [124] UCSC.utils_1.1.0 shiny_1.9.1 farver_2.1.2
#> [127] jquerylib_0.1.4 zoo_1.8-12 jsonlite_1.8.9
#> [130] BiocParallel_1.39.0 mclust_6.1.1 config_0.3.2
#> [133] RCurl_1.98-1.16 BiocSingular_1.21.4 magrittr_2.0.3
#> [136] GenomeInfoDbData_1.2.13 dotCall64_1.2 patchwork_1.3.0
#> [139] munsell_0.5.1 viridis_0.6.5 reticulate_1.39.0
#> [142] leidenAlg_1.1.4 stringi_1.8.4 zlibbioc_1.51.2
#> [145] MASS_7.3-61 plyr_1.8.9 parallel_4.4.1
#> [148] listenv_0.9.1 ggrepel_0.9.6 deldir_2.0-4
#> [151] Biostrings_2.73.2 sccore_1.0.5 splines_4.4.1
#> [154] tensor_1.5 locfit_1.5-9.10 igraph_2.1.1
#> [157] spatstat.geom_3.3-3 RcppHNSW_0.6.0 buildtools_1.0.0
#> [160] reshape2_1.4.4 ScaledMatrix_1.13.0 XML_3.99-0.17
#> [163] BiocVersion_3.20.0 evaluate_1.0.1 golem_0.5.1
#> [166] BiocManager_1.30.25 foreach_1.5.2 httpuv_1.6.15
#> [169] RANN_2.6.2 tidyr_1.3.1 purrr_1.0.2
#> [172] polyclip_1.10-7 benchmarkme_1.0.8 future_1.34.0
#> [175] scattermore_1.2 rsvd_1.0.5 xtable_1.8-4
#> [178] restfulr_0.0.15 RSpectra_0.16-2 later_1.3.2
#> [181] viridisLite_0.4.2 tibble_3.2.1 GenomicAlignments_1.41.0
#> [184] memoise_2.0.1 beeswarm_0.4.0 AnnotationDbi_1.67.0
#> [187] cluster_2.1.6 shinyWidgets_0.8.7 globals_0.16.3