SingleR
Cell type Annotation
Sung Rye Park
2024-12-03
Packages
- SingleR (Good fit for Human, immune cell anntation)
SingleR
Processing
library(SingleR)
library(celldex)
library(SingleCellExperiment)
# SingleCellExperiment
count.mtx = obj.srt@assays$RNA@layers$counts
rownames(count.mtx) = rownames(obj.srt)
colnames(count.mtx) = colnames(obj.srt)
sce <- SingleCellExperiment(assays = list(counts = count.mtx))
# ls('package:celldex')
# ref <- HumanPrimaryCellAtlasData()
ref <- MouseRNAseqData()
# logcounts : to use MouseRNAseqData, count should be logcounts
assay(sce, "logcounts") <- log1p(assay(sce, "counts"))
# Annotation
# pred <- SingleR(test = sce, ref = ref, labels = ref$label.main)
pred2 <- SingleR(test = sce, ref = ref, labels = ref$label.fine)
# pred2$pruned.labels %>% table()
pred2 %>% saveRDS(paste0(dir,"rds/pred2_singleR.rds"))
obj.srt$singleR_label = pred2[colnames(obj.srt),]$labelspred2 = readRDS(paste0(dir,"rds/pred2_singleR.rds"))
obj.srt$singleR_label = pred2[colnames(obj.srt),]$labelsSingleR annotation
UMAP (split)
DimPlot(obj.srt, group.by = "singleR_label",
split.by = "singleR_label", ncol = 5, pt.size = 0.1) +theme_bw()
Selected Cell Types (split)
obj.tmp = subset(obj.srt, singleR_label %in% c("Neurons", "NPCs", "OPCs","aNSCs","Microglia"))
DimPlot(obj.tmp, group.by = "singleR_label",
split.by = "singleR_label", ncol = 5, pt.size = 0.1) +theme_bw()
Annotation Table
obj.srt@meta.data %>% select(RNA_snn_res.0.4, singleR_label) %>% table() %>% data.frame() %>% tidyr::spread(RNA_snn_res.0.4, Freq) %>%
DT::datatable(extensions = "Buttons",
width = "800px",
options = list(scrollX=TRUE,
dom="Bfrtip",
buttons=c("csv","excel")))Heatmap
df = obj.tmp@meta.data %>% select(RNA_snn_res.0.4, singleR_label) %>% table() %>% data.frame() %>% tidyr::spread(RNA_snn_res.0.4, Freq)
rownames(df) = df$singleR_label
df = df[,-1]
df %>% pheatmap::pheatmap(display_numbers = T, fontsize_number = "0f.%",
colorRampPalette(c("white", "#FF1493"))(75))
Score Heatmap
SingleR::plotScoreHeatmap(pred2)
Number of Cells
By SingleR annotation
res = "singleR_label"
obj.srt@meta.data %>% ggplot(aes(!!sym(res), fill=!!sym(res))) +
geom_bar(alpha=0.7, color="grey5", size=0.1) +
geom_text(stat="count", aes(label= ..count..), vjust=-0.5, size=3) +
xlab("") +
theme_classic() +
theme(legend.title = element_blank(),
legend.position = "none",
axis.text.x = element_text(angle = 45, vjust=1, hjust=1)) +
ggtitle(res)
By SingleR annotation (% of Cluster)
meta_data <- as.data.frame(obj.srt@meta.data)
res <- "singleR_label"
meta_data_filtered <- meta_data %>%
filter(singleR_label %in% c("Microglia", "Neurons", "NPCs", "OPCs")) %>%
group_by(singleR_label, RNA_snn_res.0.4) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(singleR_label) %>%
mutate(percentage = count / sum(count) * 100)
# ggplot
ggplot(meta_data_filtered, aes(x = singleR_label, y = percentage, fill = RNA_snn_res.0.4)) +
geom_bar(stat = "identity", alpha = 0.7, color = "black", position = "fill") +
geom_text(
aes(label = paste0(round(percentage, 1), "%")),
position = position_fill(vjust = 0.5), # 막대 중앙에 위치
size = 3
) +
xlab("") +
ylab("Percentage") +
theme_classic() +
theme(
legend.title = element_blank(),
axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)
) +
ggtitle(res)
By SingleR annotation (% of Cluster)
meta_data <- as.data.frame(obj.srt@meta.data)
res <- "singleR_label"
meta_data_filtered <- meta_data %>%
filter(singleR_label %in% c("Microglia", "Neurons", "NPCs", "OPCs")) %>%
group_by(RNA_snn_res.0.4, singleR_label) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(singleR_label) %>%
mutate(percentage = count / sum(count) * 100)
# ggplot 작성
ggplot(meta_data_filtered, aes(x = RNA_snn_res.0.4, y = percentage,
fill = singleR_label)) +
geom_bar(stat = "identity", alpha = 0.7, color = "black", position = "fill") +
geom_text(
aes(label = paste0(round(percentage, 1), "%")),
position = position_fill(vjust = 0.5), # 막대 중앙에 위치
size = 3
) +
xlab("") +
ylab("Percentage") +
theme_classic() +
theme(
legend.title = element_blank(),
axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)
) +
ggtitle(res)
Table
meta_data_filtered %>% DT::datatable()Additional Info
Comparison: NPCs, OPCs, Neurons
NPCs (Neural Progenitor Cells), OPCs (Oligodendrocyte
Progenitor Cells), Neurons의 역할과 발현 시기를 비교
Neural Progenitor Cells (NPCs)
• 역할: • 신경계 발달 초기에 발생하며, 뉴런, 별아교세포(Astrocytes), 희소돌기아교세포(Oligodendrocytes)로 분화할 수 있는 다능성 세포. • 신경계 재생과 유지에도 중요한 역할을 수행. • 발현 시기: • 발생 초기(Embryogenesis): 신경관(neural tube)이 형성된 후, 배아의 신경 발생 단계에서 NPCs는 가장 먼저 발현합니다. 뉴런 및 교세포로의 분화를 통해 초기 신경계를 형성합니다. • 성체(Adulthood): 신경생성(neurogenesis)이 유지되는 특정 영역(예: 해마의 치상회, 측뇌실 하부)에서 발견되며, 손상 복구 및 재생 과정에서 활성화됩니다. • 주요 발현 장소: • 발달 중인 신경관 및 성체 신경생성 영역.
Oligodendrocyte Progenitor Cells (OPCs)
• 역할: • 희소돌기아교세포(Oligodendrocytes)로 분화하여 중추신경계(CNS)에서 미엘린 형성을 담당. • 미엘린은 뉴런의 축삭(axon)을 감싸 신경 신호 전달 속도를 증가시킵니다. • 신경계 손상 시 미엘린 재생과 축삭 보호 역할. • 발현 시기: • 배아 후기(Late Embryogenesis): NPCs가 OPCs로 분화되기 시작하며, 신경 발생이 어느 정도 진행된 이후에 발현됩니다. • 출생 후(Postnatal): 신경계 성숙 과정에서 활발히 증식하며 미엘린화를 진행. • 성체(Adulthood): 신경 손상이나 탈수초(demyelination) 질환이 발생하면 다시 활성화되어 희소돌기아교세포로 분화합니다. • 주요 발현 장소: • 중추신경계 전반.
Neurons
• 역할: • 뉴런은 감각 정보 처리, 운동 신호 전달, 학습과 기억, 그리고 뇌의 고차원적 기능(인지 및 의사결정)을 담당. • 신경 신호를 전기적 및 화학적으로 생성, 전달. • 발현 시기: • 배아 중기(Mid-Embryogenesis): NPCs가 뉴런으로 분화하면서 신경계의 기본 구조가 형성되기 시작. • 출생 후(Postnatal): 성숙 과정을 통해 시냅스가 형성되고 뉴런 네트워크가 강화됨. • 성체(Adulthood): 기존 뉴런이 유지되며, 제한적이지만 성체 신경생성 영역에서는 새로운 뉴런 생성 가능. • 주요 발현 장소: • 중추신경계(뇌, 척수) 및 말초신경계.
발현 시기 비교
| 세포 유형 | 발생 초기 (Embryogenesis) | 출생 후 (Postnatal) | 성체 (Adulthood) |
|---|---|---|---|
| NPCs | 가장 먼저 발현 | 제한된 영역에서 유지 | 해마 등 신경생성 영역에서 활동 |
| OPCs | NPCs 이후 발현 | 미엘린화를 위해 활발히 활동 | 손상 시 활성화 및 미엘린 재생 |
| Neurons | NPCs가 분화하여 발현 | 시냅스 형성 및 뉴런 네트워크 강화 | 제한적으로 성체 신경생성 |
요약
• NPCs는 신경 발생 초기에 발생하여 뉴런 및 OPCs의 전구체 역할을 수행하며, 성체에서도 신경 재생의 원천으로 작용합니다.
• OPCs는 NPCs가 분화하여 형성되며, 신경계 성숙 단계에서 미엘린화를 통해 신경 신호 전달을 최적화합니다.
• Neurons는 NPCs에서 발생하며, 신경계의 주요 기능을 수행하는 최종 분화 세포로서 초기 발달 단계부터 성숙한 상태까지 지속적으로 활동합니다.sessionInfo()## R version 4.4.1 (2024-06-14)
## Platform: aarch64-apple-darwin20
## Running under: macOS Sonoma 14.6.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.0
##
## 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: America/Detroit
## tzcode source: internal
##
## attached base packages:
## [1] stats4 stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] SeuratWrappers_0.4.0 SingleCellExperiment_1.26.0
## [3] SummarizedExperiment_1.34.0 Biobase_2.64.0
## [5] GenomicRanges_1.56.1 GenomeInfoDb_1.40.1
## [7] IRanges_2.38.1 S4Vectors_0.42.1
## [9] BiocGenerics_0.50.0 MatrixGenerics_1.16.0
## [11] matrixStats_1.4.1 scCustomize_2.1.2
## [13] Seurat_5.1.0 SeuratObject_5.0.2
## [15] sp_2.1-4 dplyr_1.1.4
## [17] ggrepel_0.9.6 ggplot2_3.5.1
##
## loaded via a namespace (and not attached):
## [1] RcppAnnoy_0.0.22 splines_4.4.1
## [3] later_1.4.1 tibble_3.2.1
## [5] R.oo_1.27.0 polyclip_1.10-7
## [7] janitor_2.2.0 fastDummies_1.7.4
## [9] lifecycle_1.0.4 globals_0.16.3
## [11] lattice_0.22-6 MASS_7.3-60.2
## [13] crosstalk_1.2.1 magrittr_2.0.3
## [15] plotly_4.10.4 sass_0.4.9
## [17] rmarkdown_2.29 jquerylib_0.1.4
## [19] yaml_2.3.10 remotes_2.5.0
## [21] httpuv_1.6.15 sctransform_0.4.1
## [23] spam_2.11-0 spatstat.sparse_3.1-0
## [25] reticulate_1.40.0 cowplot_1.1.3
## [27] pbapply_1.7-2 RColorBrewer_1.1-3
## [29] lubridate_1.9.3 abind_1.4-8
## [31] zlibbioc_1.50.0 Rtsne_0.17
## [33] purrr_1.0.2 R.utils_2.12.3
## [35] SingleR_2.6.0 circlize_0.4.16
## [37] GenomeInfoDbData_1.2.12 irlba_2.3.5.1
## [39] listenv_0.9.1 spatstat.utils_3.1-1
## [41] pheatmap_1.0.12 goftest_1.2-3
## [43] RSpectra_0.16-2 spatstat.random_3.3-2
## [45] fitdistrplus_1.2-1 parallelly_1.39.0
## [47] DelayedMatrixStats_1.26.0 leiden_0.4.3.1
## [49] codetools_0.2-20 DelayedArray_0.30.1
## [51] DT_0.33 tidyselect_1.2.1
## [53] shape_1.4.6.1 UCSC.utils_1.0.0
## [55] farver_2.1.2 viridis_0.6.5
## [57] ScaledMatrix_1.10.0 spatstat.explore_3.3-3
## [59] jsonlite_1.8.9 progressr_0.15.1
## [61] ggridges_0.5.6 survival_3.6-4
## [63] tools_4.4.1 ica_1.0-3
## [65] Rcpp_1.0.13-1 glue_1.8.0
## [67] gridExtra_2.3 SparseArray_1.4.8
## [69] xfun_0.49 withr_3.0.2
## [71] BiocManager_1.30.25 fastmap_1.2.0
## [73] fansi_1.0.6 rsvd_1.0.5
## [75] digest_0.6.37 timechange_0.3.0
## [77] R6_2.5.1 mime_0.12
## [79] ggprism_1.0.5 colorspace_2.1-1
## [81] scattermore_1.2 tensor_1.5
## [83] spatstat.data_3.1-4 R.methodsS3_1.8.2
## [85] utf8_1.2.4 tidyr_1.3.1
## [87] generics_0.1.3 data.table_1.16.2
## [89] httr_1.4.7 htmlwidgets_1.6.4
## [91] S4Arrays_1.4.1 uwot_0.2.2
## [93] pkgconfig_2.0.3 gtable_0.3.6
## [95] lmtest_0.9-40 XVector_0.44.0
## [97] htmltools_0.5.8.1 dotCall64_1.2
## [99] scales_1.3.0 png_0.1-8
## [101] spatstat.univar_3.1-1 snakecase_0.11.1
## [103] knitr_1.49 rstudioapi_0.16.0
## [105] reshape2_1.4.4 nlme_3.1-164
## [107] cachem_1.1.0 zoo_1.8-12
## [109] GlobalOptions_0.1.2 stringr_1.5.1
## [111] KernSmooth_2.23-24 parallel_4.4.1
## [113] miniUI_0.1.1.1 vipor_0.4.7
## [115] ggrastr_1.0.2 pillar_1.9.0
## [117] grid_4.4.1 vctrs_0.6.5
## [119] RANN_2.6.2 promises_1.3.2
## [121] BiocSingular_1.18.0 beachmat_2.20.0
## [123] xtable_1.8-4 cluster_2.1.6
## [125] beeswarm_0.4.0 paletteer_1.6.0
## [127] evaluate_1.0.1 cli_3.6.3
## [129] compiler_4.4.1 rlang_1.1.4
## [131] crayon_1.5.3 future.apply_1.11.3
## [133] labeling_0.4.3 rematch2_2.1.2
## [135] plyr_1.8.9 forcats_1.0.0
## [137] ggbeeswarm_0.7.2 stringi_1.8.4
## [139] BiocParallel_1.38.0 viridisLite_0.4.2
## [141] deldir_2.0-4 munsell_0.5.1
## [143] lazyeval_0.2.2 spatstat.geom_3.3-4
## [145] Matrix_1.7-0 RcppHNSW_0.6.0
## [147] patchwork_1.3.0 sparseMatrixStats_1.16.0
## [149] future_1.34.0 shiny_1.9.1
## [151] ROCR_1.0-11 igraph_2.1.1
## [153] bslib_0.8.0