Chapter 9 Mouse HSC (multiple technologies)

9.1 Introduction

The blood is probably the most well-studied tissue in the single-cell field, mostly because everything is already dissociated “for free”. Of particular interest has been the use of single-cell genomics to study cell fate decisions in haematopoeisis. Indeed, it was not long ago that dueling interpretations of haematopoeitic stem cell (HSC) datasets were a mainstay of single-cell conferences. Sadly, these times have mostly passed so we will instead entertain ourselves by combining a small number of these datasets into a single analysis.

9.2 Data loading

#--- data-loading ---#
library(scRNAseq)
sce.nest <- NestorowaHSCData()

#--- gene-annotation ---#
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),]

#--- quality-control ---#
library(scater)
stats <- perCellQCMetrics(sce.nest)
qc <- quickPerCellQC(stats, percent_subsets="altexps_ERCC_percent")
sce.nest <- sce.nest[,!qc$discard]

#--- normalization ---#
library(scran)
set.seed(101000110)
clusters <- quickCluster(sce.nest)
sce.nest <- computeSumFactors(sce.nest, clusters=clusters)
sce.nest <- logNormCounts(sce.nest)

#--- variance-modelling ---#
set.seed(00010101)
dec.nest <- modelGeneVarWithSpikes(sce.nest, "ERCC")
top.nest <- getTopHVGs(dec.nest, prop=0.1)
sce.nest
## class: SingleCellExperiment 
## dim: 46078 1656 
## metadata(0):
## assays(2): counts logcounts
## rownames(46078): ENSMUSG00000000001 ENSMUSG00000000003 ...
##   ENSMUSG00000107391 ENSMUSG00000107392
## rowData names(3): GENEID SYMBOL SEQNAME
## colnames(1656): HSPC_025 HSPC_031 ... Prog_852 Prog_810
## colData names(10): gate broad ... metrics sizeFactor
## reducedDimNames(1): diffusion
## mainExpName: endogenous
## altExpNames(2): ERCC FACS

The Grun dataset requires a little bit of subsetting and re-analysis to only consider the sorted HSCs.

#--- data-loading ---#
library(scRNAseq)
sce.grun.hsc <- GrunHSCData(ensembl=TRUE)

#--- gene-annotation ---#
library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
anno <- select(ens.mm.v97, keys=rownames(sce.grun.hsc), 
    keytype="GENEID", columns=c("SYMBOL", "SEQNAME"))
rowData(sce.grun.hsc) <- anno[match(rownames(sce.grun.hsc), anno$GENEID),]

#--- quality-control ---#
library(scuttle)
stats <- perCellQCMetrics(sce.grun.hsc)
qc <- quickPerCellQC(stats, batch=sce.grun.hsc$protocol,
    subset=grepl("sorted", sce.grun.hsc$protocol))
sce.grun.hsc <- sce.grun.hsc[,!qc$discard]
library(scuttle)
sce.grun.hsc <- sce.grun.hsc[,sce.grun.hsc$protocol=="sorted hematopoietic stem cells"]
sce.grun.hsc <- logNormCounts(sce.grun.hsc)

set.seed(11001)
library(scran)
dec.grun.hsc <- modelGeneVarByPoisson(sce.grun.hsc) 

Finally, we will grab the Paul dataset, which we will also subset to only consider the unsorted myeloid population. This removes the various knockout conditions that just complicates matters.

#--- data-loading ---#
library(scRNAseq)
sce.paul <- PaulHSCData(ensembl=TRUE)

#--- gene-annotation ---#
library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
anno <- select(ens.mm.v97, keys=rownames(sce.paul), 
    keytype="GENEID", columns=c("SYMBOL", "SEQNAME"))
rowData(sce.paul) <- anno[match(rownames(sce.paul), anno$GENEID),]

#--- quality-control ---#
library(scater)
stats <- perCellQCMetrics(sce.paul) 
qc <- quickPerCellQC(stats, batch=sce.paul$Plate_ID)

# Detecting batches with unusually low threshold values.
lib.thresholds <- attr(qc$low_lib_size, "thresholds")["lower",]
nfeat.thresholds <- attr(qc$low_n_features, "thresholds")["lower",]
ignore <- union(names(lib.thresholds)[lib.thresholds < 100],
    names(nfeat.thresholds)[nfeat.thresholds < 100])

# Repeating the QC using only the "high-quality" batches.
qc2 <- quickPerCellQC(stats, batch=sce.paul$Plate_ID,
    subset=!sce.paul$Plate_ID %in% ignore)
sce.paul <- sce.paul[,!qc2$discard]
sce.paul <- sce.paul[,sce.paul$Batch_desc=="Unsorted myeloid"]
sce.paul <- logNormCounts(sce.paul)

set.seed(00010010)
dec.paul <- modelGeneVarByPoisson(sce.paul) 

9.3 Setting up the merge

common <- Reduce(intersect, list(rownames(sce.nest),
    rownames(sce.grun.hsc), rownames(sce.paul)))
length(common)
## [1] 17147

Combining variances to obtain a single set of HVGs.

combined.dec <- combineVar(
    dec.nest[common,], 
    dec.grun.hsc[common,], 
    dec.paul[common,]
)
hvgs <- getTopHVGs(combined.dec, n=5000)

Adjusting for gross differences in sequencing depth.

library(batchelor)
normed.sce <- multiBatchNorm(
    Nestorowa=sce.nest[common,],
    Grun=sce.grun.hsc[common,],
    Paul=sce.paul[common,]
)

9.4 Merging the datasets

We turn on auto.merge=TRUE to instruct fastMNN() to merge the batch that offers the largest number of MNNs. This aims to perform the “easiest” merges first, i.e., between the most replicate-like batches, before tackling merges between batches that have greater differences in their population composition.

set.seed(1000010)
merged <- fastMNN(normed.sce, subset.row=hvgs, auto.merge=TRUE)

Not too much variance lost inside each batch, hopefully. We also observe that the algorithm chose to merge the more diverse Nestorowa and Paul datasets before dealing with the HSC-only Grun dataset.

metadata(merged)$merge.info[,c("left", "right", "lost.var")]
## DataFrame with 2 rows and 3 columns
##             left     right                        lost.var
##           <List>    <List>                        <matrix>
## 1           Paul Nestorowa 0.01082734:0.0000000:0.00745166
## 2 Paul,Nestorowa      Grun 0.00570326:0.0178387:0.00708292

9.5 Combined analyses

The Grun dataset does not contribute to many clusters, consistent with a pure undifferentiated HSC population. Most of the other clusters contain contributions from the Nestorowa and Paul datasets, though some are unique to the Paul dataset. This may be due to incomplete correction though we tend to think that this are Paul-specific subpopulations, given that the Nestorowa dataset does not have similarly sized unique clusters that might represent their uncorrected counterparts.

library(bluster)
colLabels(merged) <- clusterRows(reducedDim(merged), 
    NNGraphParam(cluster.fun="louvain"))
table(Cluster=colLabels(merged), Batch=merged$batch)
##        Batch
## Cluster Grun Nestorowa Paul
##      1    34       497  161
##      2   112       397   48
##      3    14       101   46
##      4     0        44  204
##      5     0       149  494
##      6     0       214  462
##      7   130        90  373
##      8     0         6   29
##      9     1       139  211
##      10    0        19    0
##      11    0         0  394
##      12    0         0  383

While I prefer \(t\)-SNE plots, we’ll switch to a UMAP plot to highlight some of the trajectory-like structure across clusters (Figure 9.1).

library(scater)
set.seed(101010101)
merged <- runUMAP(merged, dimred="corrected")
gridExtra::grid.arrange(
    plotUMAP(merged, colour_by="label"),
    plotUMAP(merged, colour_by="batch"),
    ncol=2
)
Obligatory UMAP plot of the merged HSC datasets, where each point represents a cell and is colored by the batch of origin (left) or its assigned cluster (right).

Figure 9.1: Obligatory UMAP plot of the merged HSC datasets, where each point represents a cell and is colored by the batch of origin (left) or its assigned cluster (right).

In fact, we might as well compute a trajectory right now. TSCAN constructs a reasonable minimum spanning tree but the path choices are somewhat incongruent with the UMAP coordinates (Figure 9.2). This is most likely due to the fact that TSCAN operates on cluster centroids, which is simple and efficient but does not consider the variance of cells within each cluster. It is entirely possible for two well-separated clusters to be closer than two adjacent clusters if the latter span a wider region of the coordinate space.

library(TSCAN)
pseudo.out <- quickPseudotime(merged, use.dimred="corrected", outgroup=TRUE)
common.pseudo <- averagePseudotime(pseudo.out$ordering)
plotUMAP(merged, colour_by=I(common.pseudo), 
        text_by="label", text_colour="red") +
    geom_line(data=pseudo.out$connected$UMAP, 
        mapping=aes(x=UMAP1, y=UMAP2, group=edge))
Another UMAP plot of the merged HSC datasets, where each point represents a cell and is colored by its _TSCAN_ pseudotime. The lines correspond to the edges of the MST across cluster centers.

Figure 9.2: Another UMAP plot of the merged HSC datasets, where each point represents a cell and is colored by its TSCAN pseudotime. The lines correspond to the edges of the MST across cluster centers.

To fix this, we construct the minimum spanning tree using distances based on pairs of mutual nearest neighbors between clusters. This focuses on the closeness of the boundaries of each pair of clusters rather than their centroids, ensuring that adjacent clusters are connected even if their centroids are far apart. Doing so yields a trajectory that is more consistent with the visual connections on the UMAP plot (Figure 9.3).

pseudo.out2 <- quickPseudotime(merged, use.dimred="corrected", 
    dist.method="mnn", outgroup=TRUE)

common.pseudo2 <- averagePseudotime(pseudo.out2$ordering)
plotUMAP(merged, colour_by=I(common.pseudo2), 
        text_by="label", text_colour="red") +
    geom_line(data=pseudo.out2$connected$UMAP, 
        mapping=aes(x=UMAP1, y=UMAP2, group=edge))
Yet another UMAP plot of the merged HSC datasets, where each point represents a cell and is colored by its _TSCAN_ pseudotime. The lines correspond to the edges of the MST across cluster centers.

Figure 9.3: Yet another UMAP plot of the merged HSC datasets, where each point represents a cell and is colored by its TSCAN pseudotime. The lines correspond to the edges of the MST across cluster centers.

Session Info

R version 4.4.0 beta (2024-04-15 r86425)
Platform: x86_64-pc-linux-gnu
Running under: Ubuntu 22.04.4 LTS

Matrix products: default
BLAS:   /home/biocbuild/bbs-3.19-bioc/R/lib/libRblas.so 
LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.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] TSCAN_1.42.0                TrajectoryUtils_1.12.0     
 [3] scater_1.32.0               ggplot2_3.5.1              
 [5] bluster_1.14.0              batchelor_1.20.0           
 [7] scran_1.32.0                scuttle_1.14.0             
 [9] SingleCellExperiment_1.26.0 SummarizedExperiment_1.34.0
[11] Biobase_2.64.0              GenomicRanges_1.56.0       
[13] GenomeInfoDb_1.40.0         IRanges_2.38.0             
[15] S4Vectors_0.42.0            BiocGenerics_0.50.0        
[17] MatrixGenerics_1.16.0       matrixStats_1.3.0          
[19] BiocStyle_2.32.0            rebook_1.14.0              

loaded via a namespace (and not attached):
  [1] bitops_1.0-7              gridExtra_2.3            
  [3] CodeDepends_0.6.6         rlang_1.1.3              
  [5] magrittr_2.0.3            RcppAnnoy_0.0.22         
  [7] compiler_4.4.0            mgcv_1.9-1               
  [9] dir.expiry_1.12.0         DelayedMatrixStats_1.26.0
 [11] vctrs_0.6.5               combinat_0.0-8           
 [13] pkgconfig_2.0.3           crayon_1.5.2             
 [15] fastmap_1.1.1             XVector_0.44.0           
 [17] labeling_0.4.3            caTools_1.18.2           
 [19] utf8_1.2.4                promises_1.3.0           
 [21] rmarkdown_2.26            graph_1.82.0             
 [23] UCSC.utils_1.0.0          ggbeeswarm_0.7.2         
 [25] xfun_0.43                 zlibbioc_1.50.0          
 [27] cachem_1.0.8              beachmat_2.20.0          
 [29] jsonlite_1.8.8            later_1.3.2              
 [31] highr_0.10                DelayedArray_0.30.0      
 [33] BiocParallel_1.38.0       irlba_2.3.5.1            
 [35] parallel_4.4.0            cluster_2.1.6            
 [37] R6_2.5.1                  bslib_0.7.0              
 [39] limma_3.60.0              jquerylib_0.1.4          
 [41] Rcpp_1.0.12               bookdown_0.39            
 [43] knitr_1.46                httpuv_1.6.15            
 [45] splines_4.4.0             Matrix_1.7-0             
 [47] igraph_2.0.3              tidyselect_1.2.1         
 [49] abind_1.4-5               yaml_2.3.8               
 [51] viridis_0.6.5             gplots_3.1.3.1           
 [53] codetools_0.2-20          plyr_1.8.9               
 [55] lattice_0.22-6            tibble_3.2.1             
 [57] shiny_1.8.1.1             withr_3.0.0              
 [59] evaluate_0.23             mclust_6.1.1             
 [61] pillar_1.9.0              BiocManager_1.30.22      
 [63] filelock_1.0.3            KernSmooth_2.23-22       
 [65] generics_0.1.3            fastICA_1.2-4            
 [67] sparseMatrixStats_1.16.0  munsell_0.5.1            
 [69] scales_1.3.0              xtable_1.8-4             
 [71] gtools_3.9.5              glue_1.7.0               
 [73] metapod_1.12.0            tools_4.4.0              
 [75] BiocNeighbors_1.22.0      ScaledMatrix_1.12.0      
 [77] locfit_1.5-9.9            XML_3.99-0.16.1          
 [79] cowplot_1.1.3             grid_4.4.0               
 [81] edgeR_4.2.0               colorspace_2.1-0         
 [83] nlme_3.1-164              GenomeInfoDbData_1.2.12  
 [85] beeswarm_0.4.0            BiocSingular_1.20.0      
 [87] vipor_0.4.7               cli_3.6.2                
 [89] rsvd_1.0.5                rappdirs_0.3.3           
 [91] fansi_1.0.6               S4Arrays_1.4.0           
 [93] viridisLite_0.4.2         dplyr_1.1.4              
 [95] uwot_0.2.2                ResidualMatrix_1.14.0    
 [97] gtable_0.3.5              sass_0.4.9               
 [99] digest_0.6.35             SparseArray_1.4.0        
[101] ggrepel_0.9.5             dqrng_0.3.2              
[103] farver_2.1.1              htmltools_0.5.8.1        
[105] lifecycle_1.0.4           httr_1.4.7               
[107] mime_0.12                 statmod_1.5.0