Interpretation of the decidual immune microenvironment in RPL patients
Compiled: November 06, 2023
Source:vignettes/mapQuery_immune_RPL.Rmd
mapQuery_immune_RPL.RmdIn this tutorial, we utilized ProjetSVR to project
decidual immune cells from both healthy individuals and patients with
recurrent pregnancy loss (RPL) 1 onto a previously reported human
maternal-fetal interface atlas 2.
Download Reference Models and Query Data
library(Seurat)
library(ProjectSVR)
library(tidyverse)
options(timeout = max(3600, getOption("timeout")))
# reference model
if (!dir.exists("models")) dir.create("models")
download.file(url = "https://zenodo.org/record/8350732/files/model.Vento2018.MFI.rds",
destfile = "models/model.Vento2018.MFI.rds")
# query data
if (!dir.exists("query")) dir.create("query")
download.file(url = "https://zenodo.org/record/8350748/files/Guo2021.MFI.seurat.slim.qs",
destfile = "query/Guo2021.MFI.seurat.slim.qs")Map Query to Reference
Reference mapping
reference <- readRDS("models/model.Vento2018.MFI.rds")
seu.q <- qs::qread("query/Guo2021.MFI.seurat.slim.qs")
seu.q$sample_id <- seu.q$orig.ident
seu.q$group <- factor(sub("[0-9]", "", seu.q$orig.ident), levels = c("Ctrl", "RPL"))
seu.q <- ProjectSVR::MapQuery(seu.q, reference = reference, add.map.qual = T, ncores = 10)
DimPlot(seu.q, reduction = "ref.umap", group.by = "sample_id", pt.size = .1)
Maping quality
## cutoff by adjusted p value
MapQCPlot(seu.q, map.q.cutoff = 2)
Visualize the projected query cells onto the reference atlas.
PlotProjection(seu.q, reference, split.by = "group", ref.color.by = "cell_type",
ref.size = .5, ref.alpha = .3, query.size = 1, query.alpha = .5,
n.row = 1, legend.ncol = 2)
Label transfer
seu.q <- subset(seu.q, mean.knn.dist < 2)
seu.q <- ProjectSVR::LabelTransfer(seu.q, reference, ref.label.col = "cell_type")
DimPlot(seu.q, group.by = "knn.pred.celltype", split.by = "group") +
scale_color_manual(values = reference$ref.cellmeta$colors)
When we focus on the dNK population, we found that the dNK cells in RPL were shifted to dNK3 population, as reported in the original paper 1.
seu.q.dNK <- subset(seu.q, knn.pred.celltype %in% c("dNK p", "dNK1", "dNK2", "dNK3") )
PlotProjection(seu.q.dNK, reference, split.by = "group", ref.color.by = "cell_type",
ref.size = .5, ref.alpha = .3, query.size = .1, query.alpha = .1,
n.row = 1, legend.ncol = 2)
Alluvia plot
AlluviaPlot(seu.q.dNK@meta.data, by = "group",
fill = "knn.pred.celltype",
bar.width = .5, legend.ncol = 1)
Compare the predicted labels vs the mannually annotated labels
data.stat <- table(seu.q$cell_type, seu.q$knn.pred.celltype)
data.stat <- data.stat[, colSums(data.stat) > 0]
pheatmap::pheatmap(data.stat, display_numbers = T, number_format = "%.0f",
cluster_rows = F, cluster_cols = F, number_color = "black")
Session Info
## R version 4.1.2 (2021-11-01)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 22.04.2 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0
##
## locale:
## [1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
## [4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
## [7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
## [10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] lubridate_1.9.2 forcats_1.0.0 stringr_1.5.0 dplyr_1.1.3
## [5] purrr_1.0.2 readr_2.1.4 tidyr_1.3.0 tibble_3.2.1
## [9] ggplot2_3.4.3 tidyverse_2.0.0 ProjectSVR_0.2.0 SeuratObject_4.1.3
## [13] Seurat_4.3.0.1
##
## loaded via a namespace (and not attached):
## [1] utf8_1.2.3 spatstat.explore_3.2-3 reticulate_1.31
## [4] tidyselect_1.2.0 mlr3learners_0.5.6 htmlwidgets_1.6.2
## [7] BiocParallel_1.28.3 grid_4.1.2 Rtsne_0.16
## [10] mlr3misc_0.12.0 munsell_0.5.0 codetools_0.2-18
## [13] bbotk_0.7.2 ragg_1.2.5 ica_1.0-3
## [16] future_1.33.0 miniUI_0.1.1.1 mlr3verse_0.2.8
## [19] withr_2.5.0 spatstat.random_3.1-6 colorspace_2.1-0
## [22] progressr_0.14.0 highr_0.10 knitr_1.43
## [25] uuid_1.1-1 rstudioapi_0.15.0 stats4_4.1.2
## [28] ROCR_1.0-11 robustbase_0.99-0 tensor_1.5
## [31] listenv_0.9.0 labeling_0.4.3 mlr3tuning_0.19.0
## [34] lgr_0.4.4 polyclip_1.10-4 pheatmap_1.0.12
## [37] farver_2.1.1 rprojroot_2.0.3 parallelly_1.36.0
## [40] vctrs_0.6.3 generics_0.1.3 xfun_0.40
## [43] timechange_0.2.0 diptest_0.76-0 R6_2.5.1
## [46] doParallel_1.0.17 clue_0.3-64 isoband_0.2.7
## [49] flexmix_2.3-19 spatstat.utils_3.0-3 cachem_1.0.8
## [52] promises_1.2.1 scales_1.2.1 nnet_7.3-17
## [55] gtable_0.3.4 globals_0.16.2 mlr3hyperband_0.4.5
## [58] goftest_1.2-3 mlr3mbo_0.2.1 rlang_1.1.1
## [61] systemfonts_1.0.4 GlobalOptions_0.1.2 splines_4.1.2
## [64] lazyeval_0.2.2 paradox_0.11.1 spatstat.geom_3.2-5
## [67] checkmate_2.2.0 yaml_2.3.7 reshape2_1.4.4
## [70] abind_1.4-5 mlr3_0.16.1 backports_1.4.1
## [73] httpuv_1.6.11 tools_4.1.2 ellipsis_0.3.2
## [76] jquerylib_0.1.4 RColorBrewer_1.1-3 BiocGenerics_0.40.0
## [79] ggridges_0.5.4 Rcpp_1.0.11 plyr_1.8.8
## [82] deldir_1.0-9 pbapply_1.7-2 GetoptLong_1.0.5
## [85] cowplot_1.1.1 S4Vectors_0.32.4 zoo_1.8-12
## [88] ggrepel_0.9.3 cluster_2.1.2 here_1.0.1
## [91] fs_1.6.3 magrittr_2.0.3 data.table_1.14.8
## [94] scattermore_1.2 circlize_0.4.15 lmtest_0.9-40
## [97] RANN_2.6.1 fitdistrplus_1.1-11 matrixStats_1.0.0
## [100] stringfish_0.15.8 qs_0.25.5 hms_1.1.3
## [103] patchwork_1.1.3 mime_0.12 evaluate_0.21
## [106] xtable_1.8-4 mclust_6.0.0 IRanges_2.28.0
## [109] gridExtra_2.3 shape_1.4.6 UCell_1.3.1
## [112] compiler_4.1.2 mlr3cluster_0.1.8 KernSmooth_2.23-20
## [115] crayon_1.5.2 htmltools_0.5.6 tzdb_0.4.0
## [118] later_1.3.1 RcppParallel_5.1.7 RApiSerialize_0.1.2
## [121] ComplexHeatmap_2.10.0 rappdirs_0.3.3 MASS_7.3-55
## [124] fpc_2.2-10 mlr3data_0.7.0 Matrix_1.6-1
## [127] cli_3.6.1 parallel_4.1.2 igraph_1.5.1
## [130] pkgconfig_2.0.3 pkgdown_2.0.7 sp_2.0-0
## [133] plotly_4.10.2 spatstat.sparse_3.0-2 foreach_1.5.2
## [136] bslib_0.5.1 mlr3fselect_0.11.0 digest_0.6.33
## [139] sctransform_0.3.5 RcppAnnoy_0.0.21 mlr3filters_0.7.1
## [142] spatstat.data_3.0-1 rmarkdown_2.24 leiden_0.4.3
## [145] uwot_0.1.16 kernlab_0.9-32 shiny_1.7.5
## [148] modeltools_0.2-23 rjson_0.2.21 lifecycle_1.0.3
## [151] nlme_3.1-155 jsonlite_1.8.7 mlr3tuningspaces_0.4.0
## [154] desc_1.4.2 viridisLite_0.4.2 fansi_1.0.4
## [157] pillar_1.9.0 lattice_0.20-45 fastmap_1.1.1
## [160] httr_1.4.7 DEoptimR_1.1-2 survival_3.2-13
## [163] glue_1.6.2 mlr3viz_0.6.1 png_0.1-8
## [166] prabclus_2.3-2 iterators_1.0.14 spacefillr_0.3.2
## [169] class_7.3-20 stringi_1.7.12 sass_0.4.7
## [172] mlr3pipelines_0.5.0-1 palmerpenguins_0.1.1 textshaping_0.3.6
## [175] memoise_2.0.1 irlba_2.3.5.1 future.apply_1.11.0