Chapter 1 Lun 416B cell line (Smart-seq2)
1.1 Introduction
The Lun et al. (2017) dataset contains two 96-well plates of 416B cells (an immortalized mouse myeloid progenitor cell line), processed using the Smart-seq2 protocol (Picelli et al. 2014). A constant amount of spike-in RNA from the External RNA Controls Consortium (ERCC) was also added to each cell’s lysate prior to library preparation. High-throughput sequencing was performed and the expression of each gene was quantified by counting the total number of reads mapped to its exonic regions. Similarly, the quantity of each spike-in transcript was measured by counting the number of reads mapped to the spike-in reference sequences.
1.2 Data loading
We convert the blocking factor to a factor
so that downstream steps do not treat it as an integer.
We rename the rows of our SingleCellExperiment
with the symbols, reverting to Ensembl identifiers for missing or duplicate symbols.
library(AnnotationHub)
ens.mm.v97 <- AnnotationHub()[["AH73905"]]
rowData(sce.416b)$ENSEMBL <- rownames(sce.416b)
rowData(sce.416b)$SYMBOL <- mapIds(ens.mm.v97, keys=rownames(sce.416b),
keytype="GENEID", column="SYMBOL")
rowData(sce.416b)$SEQNAME <- mapIds(ens.mm.v97, keys=rownames(sce.416b),
keytype="GENEID", column="SEQNAME")
library(scater)
rownames(sce.416b) <- uniquifyFeatureNames(rowData(sce.416b)$ENSEMBL,
rowData(sce.416b)$SYMBOL)
1.3 Quality control
We save an unfiltered copy of the SingleCellExperiment
for later use.
Technically, we do not need to use the mitochondrial proportions as we already have the spike-in proportions (which serve a similar purpose) for this dataset. However, it probably doesn’t do any harm to include it anyway.
mito <- which(rowData(sce.416b)$SEQNAME=="MT")
stats <- perCellQCMetrics(sce.416b, subsets=list(Mt=mito))
qc <- quickPerCellQC(stats, percent_subsets=c("subsets_Mt_percent",
"altexps_ERCC_percent"), batch=sce.416b$block)
sce.416b <- sce.416b[,!qc$discard]
colData(unfiltered) <- cbind(colData(unfiltered), stats)
unfiltered$block <- factor(unfiltered$block)
unfiltered$discard <- qc$discard
gridExtra::grid.arrange(
plotColData(unfiltered, x="block", y="sum",
colour_by="discard") + scale_y_log10() + ggtitle("Total count"),
plotColData(unfiltered, x="block", y="detected",
colour_by="discard") + scale_y_log10() + ggtitle("Detected features"),
plotColData(unfiltered, x="block", y="subsets_Mt_percent",
colour_by="discard") + ggtitle("Mito percent"),
plotColData(unfiltered, x="block", y="altexps_ERCC_percent",
colour_by="discard") + ggtitle("ERCC percent"),
nrow=2,
ncol=2
)
gridExtra::grid.arrange(
plotColData(unfiltered, x="sum", y="subsets_Mt_percent",
colour_by="discard") + scale_x_log10(),
plotColData(unfiltered, x="altexps_ERCC_percent", y="subsets_Mt_percent",
colour_by="discard"),
ncol=2
)
We also examine the number of cells removed for each reason.
## low_lib_size low_n_features high_subsets_Mt_percent
## 5 0 2
## high_altexps_ERCC_percent discard
## 2 7
1.4 Normalization
No pre-clustering is performed here, as the dataset is small and all cells are derived from the same cell line anyway.
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.347 0.711 0.921 1.000 1.152 3.604
We see that the induced cells have size factors that are systematically shifted from the uninduced cells, consistent with the presence of a composition bias (Figure 1.3).
plot(librarySizeFactors(sce.416b), sizeFactors(sce.416b), pch=16,
xlab="Library size factors", ylab="Deconvolution factors",
col=c("black", "red")[grepl("induced", sce.416b$phenotype)+1],
log="xy")
1.5 Variance modelling
We block on the plate of origin to minimize plate effects, and then we take the top 10% of genes with the largest biological components.
dec.416b <- modelGeneVarWithSpikes(sce.416b, "ERCC", block=sce.416b$block)
chosen.hvgs <- getTopHVGs(dec.416b, prop=0.1)
par(mfrow=c(1,2))
blocked.stats <- dec.416b$per.block
for (i in colnames(blocked.stats)) {
current <- blocked.stats[[i]]
plot(current$mean, current$total, main=i, pch=16, cex=0.5,
xlab="Mean of log-expression", ylab="Variance of log-expression")
curfit <- metadata(current)
points(curfit$mean, curfit$var, col="red", pch=16)
curve(curfit$trend(x), col='dodgerblue', add=TRUE, lwd=2)
}
1.6 Batch correction
The composition of cells is expected to be the same across the two plates,
hence the use of removeBatchEffect()
rather than more complex methods.
For larger datasets, consider using regressBatches()
from the batchelor package.
1.7 Dimensionality reduction
We do not expect a great deal of heterogeneity in this dataset, so we only request 10 PCs. We use an exact SVD to avoid warnings from irlba about handling small datasets.
1.8 Clustering
my.dist <- dist(reducedDim(sce.416b, "PCA"))
my.tree <- hclust(my.dist, method="ward.D2")
library(dynamicTreeCut)
my.clusters <- unname(cutreeDynamic(my.tree, distM=as.matrix(my.dist),
minClusterSize=10, verbose=0))
colLabels(sce.416b) <- factor(my.clusters)
We compare the clusters to the plate of origin. Each cluster is comprised of cells from both batches, indicating that the clustering is not driven by a batch effect.
## Plate
## Cluster 20160113 20160325
## 1 40 38
## 2 37 32
## 3 10 14
## 4 6 8
We compare the clusters to the oncogene induction status. We observe differences in in the composition of each cluster, consistent with a biological effect of oncogene induction.
## Oncogene
## Cluster induced CBFB-MYH11 oncogene expression wild type phenotype
## 1 78 0
## 2 0 69
## 3 1 23
## 4 14 0
Most cells have relatively small positive widths in Figure 1.6, indicating that the separation between clusters is weak. This may be symptomatic of over-clustering where clusters that are clearly defined on oncogene induction status are further split into subsets that are less well separated. Nonetheless, we will proceed with the current clustering scheme as it provides reasonable partitions for further characterization of heterogeneity.
library(cluster)
clust.col <- scater:::.get_palette("tableau10medium") # hidden scater colours
sil <- silhouette(my.clusters, dist = my.dist)
sil.cols <- clust.col[ifelse(sil[,3] > 0, sil[,1], sil[,2])]
sil.cols <- sil.cols[order(-sil[,1], sil[,3])]
plot(sil, main = paste(length(unique(my.clusters)), "clusters"),
border=sil.cols, col=sil.cols, do.col.sort=FALSE)
1.9 Interpretation
markers <- findMarkers(sce.416b, my.clusters, block=sce.416b$block)
marker.set <- markers[["1"]]
head(marker.set, 10)
## DataFrame with 10 rows and 7 columns
## Top p.value FDR summary.logFC logFC.2 logFC.3
## <integer> <numeric> <numeric> <numeric> <numeric> <numeric>
## Ccna2 1 9.85422e-67 4.59246e-62 -7.13310 -7.13310 -2.20632
## Cdca8 1 1.01449e-41 1.52514e-38 -7.26175 -6.00378 -2.03841
## Pirb 1 4.16555e-33 1.95516e-30 5.87820 5.28149 5.87820
## Cks1b 2 2.98233e-40 3.23229e-37 -6.43381 -6.43381 -4.15385
## Aurkb 2 2.41436e-64 5.62593e-60 -6.94063 -6.94063 -1.65534
## Myh11 2 1.28865e-46 3.75353e-43 4.38182 4.38182 4.29290
## Mcm6 3 1.15877e-28 3.69887e-26 -5.44558 -5.44558 -5.82130
## Cdca3 3 5.02047e-45 1.23144e-41 -6.22179 -6.22179 -2.10502
## Top2a 3 7.25965e-61 1.12776e-56 -7.07811 -7.07811 -2.39123
## Mcm2 4 1.50854e-33 7.98908e-31 -5.54197 -5.54197 -6.09178
## logFC.4
## <numeric>
## Ccna2 -7.3451052
## Cdca8 -7.2617478
## Pirb 0.0352849
## Cks1b -6.4385323
## Aurkb -6.4162126
## Myh11 0.9410499
## Mcm6 -3.5804973
## Cdca3 -7.0539510
## Top2a -6.8297343
## Mcm2 -3.8238103
We visualize the expression profiles of the top candidates in Figure 1.7 to verify that the DE signature is robust. Most of the top markers have strong and consistent up- or downregulation in cells of cluster 1 compared to some or all of the other clusters. A cursory examination of the heatmap indicates that cluster 1 contains oncogene-induced cells with strong downregulation of DNA replication and cell cycle genes. This is consistent with the potential induction of senescence as an anti-tumorigenic response (Wajapeyee et al. 2010).
top.markers <- rownames(marker.set)[marker.set$Top <= 10]
plotHeatmap(sce.416b, features=top.markers, order_columns_by="label",
colour_columns_by=c("label", "block", "phenotype"),
center=TRUE, symmetric=TRUE, zlim=c(-5, 5))
Session Info
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] cluster_2.1.6 dynamicTreeCut_1.63-1
[3] limma_3.63.2 scran_1.35.0
[5] scater_1.35.0 ggplot2_3.5.1
[7] scuttle_1.17.0 AnnotationHub_3.15.0
[9] BiocFileCache_2.15.0 dbplyr_2.5.0
[11] ensembldb_2.31.0 AnnotationFilter_1.31.0
[13] GenomicFeatures_1.59.1 AnnotationDbi_1.69.0
[15] scRNAseq_2.21.0 SingleCellExperiment_1.29.1
[17] SummarizedExperiment_1.37.0 Biobase_2.67.0
[19] GenomicRanges_1.59.0 GenomeInfoDb_1.43.0
[21] IRanges_2.41.0 S4Vectors_0.45.1
[23] BiocGenerics_0.53.1 generics_0.1.3
[25] MatrixGenerics_1.19.0 matrixStats_1.4.1
[27] BiocStyle_2.35.0 rebook_1.17.0
loaded via a namespace (and not attached):
[1] RColorBrewer_1.1-3 jsonlite_1.8.9 CodeDepends_0.6.6
[4] magrittr_2.0.3 ggbeeswarm_0.7.2 gypsum_1.3.0
[7] farver_2.1.2 rmarkdown_2.29 BiocIO_1.17.0
[10] zlibbioc_1.53.0 vctrs_0.6.5 memoise_2.0.1
[13] Rsamtools_2.23.0 RCurl_1.98-1.16 htmltools_0.5.8.1
[16] S4Arrays_1.7.1 curl_6.0.0 BiocNeighbors_2.1.0
[19] Rhdf5lib_1.29.0 SparseArray_1.7.1 rhdf5_2.51.0
[22] sass_0.4.9 alabaster.base_1.7.1 bslib_0.8.0
[25] alabaster.sce_1.7.0 httr2_1.0.6 cachem_1.1.0
[28] GenomicAlignments_1.43.0 igraph_2.1.1 mime_0.12
[31] lifecycle_1.0.4 pkgconfig_2.0.3 rsvd_1.0.5
[34] Matrix_1.7-1 R6_2.5.1 fastmap_1.2.0
[37] GenomeInfoDbData_1.2.13 digest_0.6.37 colorspace_2.1-1
[40] dqrng_0.4.1 irlba_2.3.5.1 ExperimentHub_2.15.0
[43] RSQLite_2.3.7 beachmat_2.23.0 labeling_0.4.3
[46] filelock_1.0.3 fansi_1.0.6 httr_1.4.7
[49] abind_1.4-8 compiler_4.5.0 bit64_4.5.2
[52] withr_3.0.2 BiocParallel_1.41.0 viridis_0.6.5
[55] DBI_1.2.3 HDF5Array_1.35.1 alabaster.ranges_1.7.0
[58] alabaster.schemas_1.7.0 rappdirs_0.3.3 DelayedArray_0.33.1
[61] bluster_1.17.0 rjson_0.2.23 tools_4.5.0
[64] vipor_0.4.7 beeswarm_0.4.0 glue_1.8.0
[67] restfulr_0.0.15 rhdf5filters_1.19.0 grid_4.5.0
[70] Rtsne_0.17 gtable_0.3.6 metapod_1.15.0
[73] BiocSingular_1.23.0 ScaledMatrix_1.15.0 utf8_1.2.4
[76] XVector_0.47.0 ggrepel_0.9.6 BiocVersion_3.21.1
[79] pillar_1.9.0 dplyr_1.1.4 lattice_0.22-6
[82] rtracklayer_1.67.0 bit_4.5.0 tidyselect_1.2.1
[85] locfit_1.5-9.10 Biostrings_2.75.1 knitr_1.49
[88] gridExtra_2.3 bookdown_0.41 ProtGenerics_1.39.0
[91] edgeR_4.5.0 xfun_0.49 statmod_1.5.0
[94] pheatmap_1.0.12 UCSC.utils_1.3.0 lazyeval_0.2.2
[97] yaml_2.3.10 evaluate_1.0.1 codetools_0.2-20
[100] tibble_3.2.1 alabaster.matrix_1.7.0 BiocManager_1.30.25
[103] graph_1.85.0 cli_3.6.3 munsell_0.5.1
[106] jquerylib_0.1.4 Rcpp_1.0.13-1 dir.expiry_1.15.0
[109] png_0.1-8 XML_3.99-0.17 parallel_4.5.0
[112] blob_1.2.4 bitops_1.0-9 viridisLite_0.4.2
[115] alabaster.se_1.7.0 scales_1.3.0 purrr_1.0.2
[118] crayon_1.5.3 rlang_1.1.4 cowplot_1.1.3
[121] KEGGREST_1.47.0