Chapter 36 Nestorowa mouse HSC (Smart-seq2)
36.1 Introduction
This performs an analysis of the mouse haematopoietic stem cell (HSC) dataset generated with Smart-seq2 (Nestorowa et al. 2016).
36.2 Data loading
library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
anno <- select(ens.mm.v97, keys=rownames(sce.nest),
keytype="GENEID", columns=c("SYMBOL", "SEQNAME"))
rowData(sce.nest) <- anno[match(rownames(sce.nest), anno$GENEID),]After loading and annotation, we inspect the resulting SingleCellExperiment object:
## class: SingleCellExperiment
## dim: 46078 1920
## metadata(0):
## assays(1): counts
## rownames(46078): ENSMUSG00000000001 ENSMUSG00000000003 ...
## ENSMUSG00000107391 ENSMUSG00000107392
## rowData names(3): GENEID SYMBOL SEQNAME
## colnames(1920): HSPC_007 HSPC_013 ... Prog_852 Prog_810
## colData names(2): cell.type FACS
## reducedDimNames(1): diffusion
## altExpNames(1): ERCC36.3 Quality control
For some reason, no mitochondrial transcripts are available, so we will perform quality control using the spike-in proportions only.
library(scater)
stats <- perCellQCMetrics(sce.nest)
qc <- quickPerCellQC(stats, percent_subsets="altexps_ERCC_percent")
sce.nest <- sce.nest[,!qc$discard]We examine the number of cells discarded for each reason.
## low_lib_size low_n_features high_altexps_ERCC_percent
## 146 28 241
## discard
## 264We create some diagnostic plots for each metric (Figure 36.1).
colData(unfiltered) <- cbind(colData(unfiltered), stats)
unfiltered$discard <- qc$discard
gridExtra::grid.arrange(
plotColData(unfiltered, y="sum", colour_by="discard") +
scale_y_log10() + ggtitle("Total count"),
plotColData(unfiltered, y="detected", colour_by="discard") +
scale_y_log10() + ggtitle("Detected features"),
plotColData(unfiltered, y="altexps_ERCC_percent",
colour_by="discard") + ggtitle("ERCC percent"),
ncol=2
)
Figure 36.1: Distribution of each QC metric across cells in the Nestorowa HSC dataset. Each point represents a cell and is colored according to whether that cell was discarded.
36.4 Normalization
library(scran)
set.seed(101000110)
clusters <- quickCluster(sce.nest)
sce.nest <- computeSumFactors(sce.nest, clusters=clusters)
sce.nest <- logNormCounts(sce.nest)We examine some key metrics for the distribution of size factors, and compare it to the library sizes as a sanity check (Figure 36.2).
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.044 0.422 0.748 1.000 1.249 15.927plot(librarySizeFactors(sce.nest), sizeFactors(sce.nest), pch=16,
xlab="Library size factors", ylab="Deconvolution factors", log="xy")
Figure 36.2: Relationship between the library size factors and the deconvolution size factors in the Nestorowa HSC dataset.
36.5 Variance modelling
We use the spike-in transcripts to model the technical noise as a function of the mean (Figure 36.3).
set.seed(00010101)
dec.nest <- modelGeneVarWithSpikes(sce.nest, "ERCC")
top.nest <- getTopHVGs(dec.nest, prop=0.1)plot(dec.nest$mean, dec.nest$total, pch=16, cex=0.5,
xlab="Mean of log-expression", ylab="Variance of log-expression")
curfit <- metadata(dec.nest)
curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)
points(curfit$mean, curfit$var, col="red")
Figure 36.3: Per-gene variance as a function of the mean for the log-expression values in the Nestorowa HSC dataset. Each point represents a gene (black) with the mean-variance trend (blue) fitted to the spike-ins (red).
36.6 Dimensionality reduction
set.seed(101010011)
sce.nest <- denoisePCA(sce.nest, technical=dec.nest, subset.row=top.nest)
sce.nest <- runTSNE(sce.nest, dimred="PCA")We check that the number of retained PCs is sensible.
## [1] 936.7 Clustering
snn.gr <- buildSNNGraph(sce.nest, use.dimred="PCA")
colLabels(sce.nest) <- factor(igraph::cluster_walktrap(snn.gr)$membership)##
## 1 2 3 4 5 6 7 8 9
## 203 472 258 175 142 229 20 83 74
Figure 36.4: Obligatory \(t\)-SNE plot of the Nestorowa HSC dataset, where each point represents a cell and is colored according to the assigned cluster.
36.8 Marker gene detection
markers <- findMarkers(sce.nest, colLabels(sce.nest),
test.type="wilcox", direction="up", lfc=0.5,
row.data=rowData(sce.nest)[,"SYMBOL",drop=FALSE])To illustrate the manual annotation process, we examine the marker genes for one of the clusters. Upregulation of Car2, Hebp1 amd hemoglobins indicates that cluster 8 contains erythroid precursors.
chosen <- markers[['8']]
best <- chosen[chosen$Top <= 10,]
aucs <- getMarkerEffects(best, prefix="AUC")
rownames(aucs) <- best$SYMBOL
library(pheatmap)
pheatmap(aucs, color=viridis::plasma(100))
Figure 36.5: Heatmap of the AUCs for the top marker genes in cluster 8 compared to all other clusters.
36.9 Cell type annotation
library(SingleR)
mm.ref <- MouseRNAseqData()
# Renaming to symbols to match with reference row names.
renamed <- sce.nest
rownames(renamed) <- uniquifyFeatureNames(rownames(renamed),
rowData(sce.nest)$SYMBOL)
labels <- SingleR(renamed, mm.ref, labels=mm.ref$label.fine)Most clusters are not assigned to any single lineage (Figure 36.6), which is perhaps unsurprising given that HSCs are quite different from their terminal fates. Cluster 8 is considered to contain erythrocytes, which is roughly consistent with our conclusions from the marker gene analysis above.
tab <- table(labels$labels, colLabels(sce.nest))
pheatmap(log10(tab+10), color=viridis::viridis(100))
Figure 36.6: Heatmap of the distribution of cells for each cluster in the Nestorowa HSC dataset, based on their assignment to each label in the mouse RNA-seq references from the SingleR package.
36.10 Miscellaneous analyses
This dataset also contains information about the protein abundances in each cell from FACS. There is barely any heterogeneity in the chosen markers across the clusters (Figure 36.7); this is perhaps unsurprising given that all cells should be HSCs of some sort.
Y <- colData(sce.nest)$FACS
keep <- rowSums(is.na(Y))==0 # Removing NA intensities.
se.averaged <- sumCountsAcrossCells(t(Y[keep,]),
colLabels(sce.nest)[keep], average=TRUE)
averaged <- assay(se.averaged)
log.intensities <- log2(averaged+1)
centered <- log.intensities - rowMeans(log.intensities)
pheatmap(centered, breaks=seq(-1, 1, length.out=101))
Figure 36.7: Heatmap of the centered log-average intensity for each target protein quantified by FACS in the Nestorowa HSC dataset.
Session Info
R version 4.0.4 (2021-02-15)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 20.04.2 LTS
Matrix products: default
BLAS: /home/biocbuild/bbs-3.12-books/R/lib/libRblas.so
LAPACK: /home/biocbuild/bbs-3.12-books/R/lib/libRlapack.so
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
attached base packages:
[1] parallel stats4 stats graphics grDevices utils datasets
[8] methods base
other attached packages:
[1] celldex_1.0.0 SingleR_1.4.1
[3] pheatmap_1.0.12 scran_1.18.5
[5] scater_1.18.6 ggplot2_3.3.3
[7] AnnotationHub_2.22.0 BiocFileCache_1.14.0
[9] dbplyr_2.1.0 ensembldb_2.14.0
[11] AnnotationFilter_1.14.0 GenomicFeatures_1.42.2
[13] AnnotationDbi_1.52.0 scRNAseq_2.4.0
[15] SingleCellExperiment_1.12.0 SummarizedExperiment_1.20.0
[17] Biobase_2.50.0 GenomicRanges_1.42.0
[19] GenomeInfoDb_1.26.4 IRanges_2.24.1
[21] S4Vectors_0.28.1 BiocGenerics_0.36.0
[23] MatrixGenerics_1.2.1 matrixStats_0.58.0
[25] BiocStyle_2.18.1 rebook_1.0.0
loaded via a namespace (and not attached):
[1] igraph_1.2.6 lazyeval_0.2.2
[3] BiocParallel_1.24.1 digest_0.6.27
[5] htmltools_0.5.1.1 viridis_0.5.1
[7] fansi_0.4.2 magrittr_2.0.1
[9] memoise_2.0.0 limma_3.46.0
[11] Biostrings_2.58.0 askpass_1.1
[13] prettyunits_1.1.1 colorspace_2.0-0
[15] blob_1.2.1 rappdirs_0.3.3
[17] xfun_0.22 dplyr_1.0.5
[19] callr_3.5.1 crayon_1.4.1
[21] RCurl_1.98-1.3 jsonlite_1.7.2
[23] graph_1.68.0 glue_1.4.2
[25] gtable_0.3.0 zlibbioc_1.36.0
[27] XVector_0.30.0 DelayedArray_0.16.2
[29] BiocSingular_1.6.0 scales_1.1.1
[31] edgeR_3.32.1 DBI_1.1.1
[33] Rcpp_1.0.6 viridisLite_0.3.0
[35] xtable_1.8-4 progress_1.2.2
[37] dqrng_0.2.1 bit_4.0.4
[39] rsvd_1.0.3 httr_1.4.2
[41] RColorBrewer_1.1-2 ellipsis_0.3.1
[43] pkgconfig_2.0.3 XML_3.99-0.6
[45] farver_2.1.0 scuttle_1.0.4
[47] CodeDepends_0.6.5 sass_0.3.1
[49] locfit_1.5-9.4 utf8_1.2.1
[51] tidyselect_1.1.0 labeling_0.4.2
[53] rlang_0.4.10 later_1.1.0.1
[55] munsell_0.5.0 BiocVersion_3.12.0
[57] tools_4.0.4 cachem_1.0.4
[59] generics_0.1.0 RSQLite_2.2.4
[61] ExperimentHub_1.16.0 evaluate_0.14
[63] stringr_1.4.0 fastmap_1.1.0
[65] yaml_2.2.1 processx_3.4.5
[67] knitr_1.31 bit64_4.0.5
[69] purrr_0.3.4 sparseMatrixStats_1.2.1
[71] mime_0.10 xml2_1.3.2
[73] biomaRt_2.46.3 compiler_4.0.4
[75] beeswarm_0.3.1 curl_4.3
[77] interactiveDisplayBase_1.28.0 statmod_1.4.35
[79] tibble_3.1.0 bslib_0.2.4
[81] stringi_1.5.3 highr_0.8
[83] ps_1.6.0 lattice_0.20-41
[85] bluster_1.0.0 ProtGenerics_1.22.0
[87] Matrix_1.3-2 vctrs_0.3.6
[89] pillar_1.5.1 lifecycle_1.0.0
[91] BiocManager_1.30.10 jquerylib_0.1.3
[93] BiocNeighbors_1.8.2 cowplot_1.1.1
[95] bitops_1.0-6 irlba_2.3.3
[97] httpuv_1.5.5 rtracklayer_1.50.0
[99] R6_2.5.0 bookdown_0.21
[101] promises_1.2.0.1 gridExtra_2.3
[103] vipor_0.4.5 codetools_0.2-18
[105] assertthat_0.2.1 openssl_1.4.3
[107] withr_2.4.1 GenomicAlignments_1.26.0
[109] Rsamtools_2.6.0 GenomeInfoDbData_1.2.4
[111] hms_1.0.0 grid_4.0.4
[113] beachmat_2.6.4 rmarkdown_2.7
[115] DelayedMatrixStats_1.12.3 Rtsne_0.15
[117] shiny_1.6.0 ggbeeswarm_0.6.0 Bibliography
Nestorowa, S., F. K. Hamey, B. Pijuan Sala, E. Diamanti, M. Shepherd, E. Laurenti, N. K. Wilson, D. G. Kent, and B. Gottgens. 2016. “A single-cell resolution map of mouse hematopoietic stem and progenitor cell differentiation.” Blood 128 (8): 20–31.