Chapter 9 Cross-annotating mouse brains
9.1 Loading the data
We load the classic Zeisel et al. (2015) dataset as our reference. Here, we’ll rely on the fact that the authors have already performed quality control.
We compute log-expression values for use in marker detection inside SingleR()
.
We examine the distribution of labels in this reference.
##
## (none) Astro1 Astro2 CA1Pyr1 CA1Pyr2 CA1PyrInt CA2Pyr2 Choroid
## 189 68 61 380 447 49 41 10
## ClauPyr Epend Int1 Int10 Int11 Int12 Int13 Int14
## 5 20 12 21 10 21 15 22
## Int15 Int16 Int2 Int3 Int4 Int5 Int6 Int7
## 18 20 24 10 15 20 22 23
## Int8 Int9 Mgl1 Mgl2 Oligo1 Oligo2 Oligo3 Oligo4
## 26 11 17 16 45 98 87 106
## Oligo5 Oligo6 Peric Pvm1 Pvm2 S1PyrDL S1PyrL23 S1PyrL4
## 125 359 21 32 33 81 74 26
## S1PyrL5 S1PyrL5a S1PyrL6 S1PyrL6b SubPyr Vend1 Vend2 Vsmc
## 16 28 39 21 22 32 105 62
We load the Tasic et al. (2016) dataset as our test. While not strictly necessary, we remove putative low-quality cells to simplify later interpretation.
sceT <- TasicBrainData()
sceT <- addPerCellQC(sceT, subsets=list(mito=grep("^mt_", rownames(sceT))))
qc <- quickPerCellQC(colData(sceT),
percent_subsets=c("subsets_mito_percent", "altexps_ERCC_percent"))
sceT <- sceT[,which(!qc$discard)]
The Tasic dataset was generated using read-based technologies so we need to adjust for the transcript length.
library(AnnotationHub)
mm.db <- AnnotationHub()[["AH73905"]]
mm.exons <- exonsBy(mm.db, by="gene")
mm.exons <- reduce(mm.exons)
mm.len <- sum(width(mm.exons))
mm.symb <- mapIds(mm.db, keys=names(mm.len), keytype="GENEID", column="SYMBOL")
names(mm.len) <- mm.symb
library(scater)
keep <- intersect(names(mm.len), rownames(sceT))
sceT <- sceT[keep,]
assay(sceT, "TPM") <- calculateTPM(sceT, lengths=mm.len[keep])
9.2 Applying the annotation
We apply SingleR()
with Wilcoxon rank sum test-based marker detection to annotate the Tasic dataset with the Zeisel labels.
library(SingleR)
pred.tasic <- SingleR(test=sceT, ref=sceZ, labels=sceZ$level2class,
assay.type.test="TPM", de.method="wilcox")
We examine the distribution of predicted labels:
##
## Astro1 Astro2 CA2Pyr2 Epend Int1 Int10 Int11 Int12
## 1 6 5 1 89 64 2 6
## Int13 Int14 Int15 Int16 Int2 Int3 Int4 Int6
## 9 17 25 8 130 179 30 12
## Int7 Int8 Int9 Oligo1 Oligo2 Oligo3 Oligo4 Oligo6
## 1 77 31 7 1 6 1 1
## Peric S1PyrDL S1PyrL23 S1PyrL4 S1PyrL5a S1PyrL6 S1PyrL6b SubPyr
## 1 354 8 19 200 7 145 4
We can also examine the number of discarded cells for each label:
## Lost
## Label FALSE TRUE
## Astro1 1 0
## Astro2 6 0
## CA2Pyr2 4 1
## Epend 1 0
## Int1 89 0
## Int10 64 0
## Int11 2 0
## Int12 5 1
## Int13 9 0
## Int14 17 0
## Int15 25 0
## Int16 8 0
## Int2 129 1
## Int3 176 3
## Int4 29 1
## Int6 12 0
## Int7 1 0
## Int8 77 0
## Int9 31 0
## Oligo1 6 1
## Oligo2 1 0
## Oligo3 6 0
## Oligo4 1 0
## Oligo6 1 0
## Peric 1 0
## S1PyrDL 339 15
## S1PyrL23 8 0
## S1PyrL4 19 0
## S1PyrL5a 200 0
## S1PyrL6 6 1
## S1PyrL6b 145 0
## SubPyr 3 1
9.3 Diagnostics
We visualize the assignment scores for each label in Figure 9.1.
The delta for each cell is visualized in Figure 9.2.
Finally, we visualize the heatmaps of the marker genes for the most frequent label in Figure 9.3. We could show these for all labels but I wouldn’t want to bore you with a parade of large heatmaps.
library(scater)
collected <- list()
all.markers <- metadata(pred.tasic)$de.genes
sceT <- logNormCounts(sceT)
top.label <- names(sort(table(pred.tasic$labels), decreasing=TRUE))[1]
per.label <- sumCountsAcrossCells(logcounts(sceT),
ids=pred.tasic$labels, average=TRUE)
per.label <- assay(per.label)[unique(unlist(all.markers[[top.label]])),]
pheatmap::pheatmap(per.label, main=top.label)
9.4 Comparison to clusters
For comparison, we will perform a quick unsupervised analysis of the Grun dataset. We model the variances using the spike-in data and we perform graph-based clustering.
library(scran)
decT <- modelGeneVarWithSpikes(sceT, "ERCC")
set.seed(1000100)
sceT <- denoisePCA(sceT, decT, subset.row=getTopHVGs(decT, n=2500))
library(bluster)
sceT$cluster <- clusterRows(reducedDim(sceT, "PCA"), NNGraphParam())
We do not observe a clean 1:1 mapping between clusters and labels in Figure 9.4, probably because many of the labels represent closely related cell types that are difficult to distinguish.
We proceed to the most important part of the analysis. Yes, that’s right, the \(t\)-SNE plot (Figure 9.5).
set.seed(101010100)
sceT <- runTSNE(sceT, dimred="PCA")
plotTSNE(sceT, colour_by="cluster", text_colour="red",
text_by=I(pred.tasic$labels))
Session information
R Under development (unstable) (2024-10-21 r87258)
Platform: x86_64-pc-linux-gnu
Running under: Ubuntu 24.04.1 LTS
Matrix products: default
BLAS: /home/biocbuild/bbs-3.21-bioc/R/lib/libRblas.so
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.12.0
locale:
[1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_GB 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: America/New_York
tzcode source: system (glibc)
attached base packages:
[1] stats4 stats graphics grDevices utils datasets methods
[8] base
other attached packages:
[1] bluster_1.17.0 scran_1.35.0
[3] SingleR_2.9.1 ensembldb_2.31.0
[5] AnnotationFilter_1.31.0 GenomicFeatures_1.59.1
[7] AnnotationDbi_1.69.0 AnnotationHub_3.15.0
[9] BiocFileCache_2.15.0 dbplyr_2.5.0
[11] scater_1.35.0 ggplot2_3.5.1
[13] scuttle_1.17.0 scRNAseq_2.21.0
[15] SingleCellExperiment_1.29.1 SummarizedExperiment_1.37.0
[17] Biobase_2.67.0 GenomicRanges_1.59.1
[19] GenomeInfoDb_1.43.1 IRanges_2.41.1
[21] S4Vectors_0.45.2 BiocGenerics_0.53.3
[23] generics_0.1.3 MatrixGenerics_1.19.0
[25] matrixStats_1.4.1 BiocStyle_2.35.0
[27] rebook_1.17.0
loaded via a namespace (and not attached):
[1] RColorBrewer_1.1-3 jsonlite_1.8.9
[3] CodeDepends_0.6.6 magrittr_2.0.3
[5] ggbeeswarm_0.7.2 gypsum_1.3.0
[7] farver_2.1.2 rmarkdown_2.29
[9] BiocIO_1.17.0 zlibbioc_1.53.0
[11] vctrs_0.6.5 DelayedMatrixStats_1.29.0
[13] memoise_2.0.1 Rsamtools_2.23.0
[15] RCurl_1.98-1.16 htmltools_0.5.8.1
[17] S4Arrays_1.7.1 curl_6.0.1
[19] BiocNeighbors_2.1.0 Rhdf5lib_1.29.0
[21] SparseArray_1.7.2 rhdf5_2.51.0
[23] sass_0.4.9 alabaster.base_1.7.2
[25] bslib_0.8.0 alabaster.sce_1.7.0
[27] httr2_1.0.6 cachem_1.1.0
[29] GenomicAlignments_1.43.0 igraph_2.1.1
[31] mime_0.12 lifecycle_1.0.4
[33] pkgconfig_2.0.3 rsvd_1.0.5
[35] Matrix_1.7-1 R6_2.5.1
[37] fastmap_1.2.0 GenomeInfoDbData_1.2.13
[39] digest_0.6.37 colorspace_2.1-1
[41] dqrng_0.4.1 irlba_2.3.5.1
[43] ExperimentHub_2.15.0 RSQLite_2.3.8
[45] beachmat_2.23.1 labeling_0.4.3
[47] filelock_1.0.3 fansi_1.0.6
[49] httr_1.4.7 abind_1.4-8
[51] compiler_4.5.0 bit64_4.5.2
[53] withr_3.0.2 BiocParallel_1.41.0
[55] viridis_0.6.5 DBI_1.2.3
[57] HDF5Array_1.35.1 alabaster.ranges_1.7.0
[59] alabaster.schemas_1.7.0 rappdirs_0.3.3
[61] DelayedArray_0.33.2 rjson_0.2.23
[63] tools_4.5.0 vipor_0.4.7
[65] beeswarm_0.4.0 glue_1.8.0
[67] restfulr_0.0.15 rhdf5filters_1.19.0
[69] grid_4.5.0 Rtsne_0.17
[71] cluster_2.1.6 gtable_0.3.6
[73] metapod_1.15.0 BiocSingular_1.23.0
[75] ScaledMatrix_1.15.0 utf8_1.2.4
[77] XVector_0.47.0 ggrepel_0.9.6
[79] BiocVersion_3.21.1 pillar_1.9.0
[81] limma_3.63.2 dplyr_1.1.4
[83] lattice_0.22-6 rtracklayer_1.67.0
[85] bit_4.5.0 tidyselect_1.2.1
[87] locfit_1.5-9.10 Biostrings_2.75.1
[89] knitr_1.49 gridExtra_2.3
[91] scrapper_1.1.4 bookdown_0.41
[93] ProtGenerics_1.39.0 edgeR_4.5.0
[95] xfun_0.49 statmod_1.5.0
[97] pheatmap_1.0.12 UCSC.utils_1.3.0
[99] lazyeval_0.2.2 yaml_2.3.10
[101] evaluate_1.0.1 codetools_0.2-20
[103] tibble_3.2.1 alabaster.matrix_1.7.0
[105] BiocManager_1.30.25 graph_1.85.0
[107] cli_3.6.3 munsell_0.5.1
[109] jquerylib_0.1.4 Rcpp_1.0.13-1
[111] dir.expiry_1.15.0 png_0.1-8
[113] XML_3.99-0.17 parallel_4.5.0
[115] blob_1.2.4 sparseMatrixStats_1.19.0
[117] bitops_1.0-9 viridisLite_0.4.2
[119] alabaster.se_1.7.0 scales_1.3.0
[121] purrr_1.0.2 crayon_1.5.3
[123] rlang_1.1.4 cowplot_1.1.3
[125] KEGGREST_1.47.0