1 Import data

The scRNAseq package provides convenient access to several datasets. See the package Bioconductor page for more information.

# install BiocManager package if not installed yet.
# BiocManager is the package installer for Bioconductor software.
if (!requireNamespace("BiocManager", quietly = TRUE))
    install.packages("BiocManager")

# install packages if not yet installed.
pkgs <- c("SingleCellExperiment", "DropletUtils", "scRNAseq", "scater", "scuttle", "scran", "BiocSingular", "scDblFinder", "glmpca", "uwot")
notInstalled <- pkgs[!pkgs %in% installed.packages()[,1]]
if(length(notInstalled) > 0){
  BiocManager::install(notInstalled)
}

# Code below might ask you to create an ExperimentHub directory. 
# Type 'yes' and hit Enter, to allow this.
suppressPackageStartupMessages(library(scRNAseq))
sce <- MacoskoRetinaData()
## see ?scRNAseq and browseVignettes('scRNAseq') for documentation
## loading from cache
## see ?scRNAseq and browseVignettes('scRNAseq') for documentation
## loading from cache

2 A SingleCellExperiment object

sce
## class: SingleCellExperiment 
## dim: 24658 49300 
## metadata(0):
## assays(1): counts
## rownames(24658): KITL TMTC3 ... 1110059M19RIK GM20861
## rowData names(0):
## colnames(49300): r1_GGCCGCAGTCCG r1_CTTGTGCGGGAA ... p1_TAACGCGCTCCT
##   p1_ATTCTTGTTCTT
## colData names(2): cell.id cluster
## reducedDimNames(0):
## mainExpName: NULL
## altExpNames(0):

2.1 Accessing data from a SingleCellExperiment object

Please see Figure 4.1 in OSCA for an overview of a SingleCellExperiment object.

# Data: assays
assays(sce)
## List of length 1
## names(1): counts
assays(sce)$counts[1:5, 1:5]
## 5 x 5 sparse Matrix of class "dgCMatrix"
##               r1_GGCCGCAGTCCG r1_CTTGTGCGGGAA r1_GCGCAACTGCTC r1_GATTGGGAGGCA
## KITL                        .               .               1               .
## TMTC3                       3               .               .               .
## CEP290                      1               3               .               2
## 4930430F08RIK               2               1               2               .
## 1700017N19RIK               .               .               .               .
##               r1_CCTCCTAGTTGG
## KITL                        .
## TMTC3                       2
## CEP290                      1
## 4930430F08RIK               1
## 1700017N19RIK               .
# Feature metadata: rowData
rowData(sce) # empty for now
## DataFrame with 24658 rows and 0 columns
# Cell metadata: colData
colData(sce)
## DataFrame with 49300 rows and 2 columns
##                         cell.id   cluster
##                     <character> <integer>
## r1_GGCCGCAGTCCG r1_GGCCGCAGTCCG         2
## r1_CTTGTGCGGGAA r1_CTTGTGCGGGAA         2
## r1_GCGCAACTGCTC r1_GCGCAACTGCTC         2
## r1_GATTGGGAGGCA r1_GATTGGGAGGCA         2
## r1_CCTCCTAGTTGG r1_CCTCCTAGTTGG        NA
## ...                         ...       ...
## p1_TCAAAAGCCGGG p1_TCAAAAGCCGGG        24
## p1_ATTAAGTTCCAA p1_ATTAAGTTCCAA        34
## p1_CTGTCTGAGACC p1_CTGTCTGAGACC         2
## p1_TAACGCGCTCCT p1_TAACGCGCTCCT        24
## p1_ATTCTTGTTCTT p1_ATTCTTGTTCTT        24
# Reduced dimensions: reducedDims
reducedDims(sce) # empty for now
## List of length 0
## names(0):

2.2 Creating a new SingleCellExperiment object

sceNew <- SingleCellExperiment(assays = list(counts = assays(sce)$counts))
sceNew
## class: SingleCellExperiment 
## dim: 24658 49300 
## metadata(0):
## assays(1): counts
## rownames(24658): KITL TMTC3 ... 1110059M19RIK GM20861
## rowData names(0):
## colnames(49300): r1_GGCCGCAGTCCG r1_CTTGTGCGGGAA ... p1_TAACGCGCTCCT
##   p1_ATTCTTGTTCTT
## colData names(0):
## reducedDimNames(0):
## mainExpName: NULL
## altExpNames(0):
rm(sceNew)

2.3 Storing (meta)data in a SingleCellExperiment object

fakeGeneNames <- paste0("gene", 1:nrow(sce))
rowData(sce)$fakeName <- fakeGeneNames
head(rowData(sce))
## DataFrame with 6 rows and 1 column
##                  fakeName
##               <character>
## KITL                gene1
## TMTC3               gene2
## CEP290              gene3
## 4930430F08RIK       gene4
## 1700017N19RIK       gene5
## MGAT4C              gene6
# Remove again by setting to NULL
rowData(sce)$fakeName <- NULL

assays(sce)$logCounts <- log1p(assays(sce)$counts)
assays(sce)
## List of length 2
## names(2): counts logCounts
assays(sce)$logCounts[1:5, 1:5]
## 5 x 5 sparse Matrix of class "dgCMatrix"
##               r1_GGCCGCAGTCCG r1_CTTGTGCGGGAA r1_GCGCAACTGCTC r1_GATTGGGAGGCA
## KITL                .               .               0.6931472        .       
## TMTC3               1.3862944       .               .                .       
## CEP290              0.6931472       1.3862944       .                1.098612
## 4930430F08RIK       1.0986123       0.6931472       1.0986123        .       
## 1700017N19RIK       .               .               .                .       
##               r1_CCTCCTAGTTGG
## KITL                .        
## TMTC3               1.0986123
## CEP290              0.6931472
## 4930430F08RIK       0.6931472
## 1700017N19RIK       .
assays(sce)$logCounts <- NULL

3 Filtering non-informative genes

4 Quality control

4.1 Calculate QC variables

Note that the character string “^MT-” in the rownames of the sce object indicates mitochondrial genes.

4.2 EDA

High-quality cells should have many features expressed, and a low contribution of mitochondrial genes. Here, we see that several cells have a very low number of expressed genes, and where most of the molecules are derived from mitochondrial genes. This indicates likely damaged cells, presumably because of loss of cytoplasmic RNA from perforated cells, so we’d want to remove these for the downstream analysis.

4.3 QC using adaptive thresholds

Below, we remove cells that are outlying with respect to

  1. A low sequencing depth (number of UMIs);
  2. A low number of genes detected;
  3. A high percentage of reads from mitochondrial genes.

Also make plots to assess the impact of the removal of .

4.4 Identifying and removing empty droplets

Note that the removal of cells with low sequencing depth using the adaptive threshold procedure above is a way of removing empty droplets. Other approaches are possible, e.g., removing cells by statistical testing using emtpyDrops. This does require us to specify a lower bound on the total number of UMIs, below which all cells are considered to correspond to empty droplets. This lower bound may not be trivial to derive, but the barcodeRanks function can be useful to identify an elbow/knee point.

4.5 Identifying and removing doublets

We will use scDblFinder to detect doublet cells.

5 Normalization

For normalization, the size factors \(s_i\) computed here are simply scaled library sizes: \[ N_i = \sum_g Y_{gi} \] \[ s_i = N_i / \bar{N}_i \]

6 Feature selection

7 Dimension reduction

Note that, below, we color the cells using the known, true cell type label as defined in the metadata, to empirically evaluate the dimension reduction. In reality, we don’t know this yet at this stage.

7.1 Linear dimension reduction: PCA

We are able to recover quite some structure. However, many cell populations remain obscure, and the plot is overcrowded.

7.1.1 PCA without feature selection

7.2 A generalization of PCA for exponential family distributions.

7.3 Non-linear dimension reduction: UMAP

8 Clustering

# Build a shared nearest-neighbor graph from PCA space
#g <- buildSNNGraph(sce, use.dimred = 'PCA')

# Louvain clustering on the SNN graph, and add to sce
#colData(sce)$label <- factor(igraph::cluster_louvain(g)$membership)

# Visualization.
#plotUMAP(sce, colour_by="label")
LS0tCnRpdGxlOiAnc2NSTkEtc2VxIHdvcmtmbG93OiBNYWNvc2tvIGV0IGFsLicKYXV0aG9yOiAiS29lbiBWYW4gZGVuIEJlcmdlIgpkYXRlOiAiMTEvMTYvMjAyMCIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiB0cnVlCiAgICB0b2NfZmxvYXQ6IHRydWUKLS0tCgojIEltcG9ydCBkYXRhCgpUaGUgYHNjUk5Bc2VxYCBwYWNrYWdlIHByb3ZpZGVzIGNvbnZlbmllbnQgYWNjZXNzIHRvIHNldmVyYWwgZGF0YXNldHMuIFNlZSB0aGUgW3BhY2thZ2UgQmlvY29uZHVjdG9yIHBhZ2VdKGh0dHA6Ly9iaW9jb25kdWN0b3Iub3JnL3BhY2thZ2VzL3JlbGVhc2UvZGF0YS9leHBlcmltZW50L2h0bWwvc2NSTkFzZXEuaHRtbCkgZm9yIG1vcmUgaW5mb3JtYXRpb24uCgpgYGB7cn0KIyBpbnN0YWxsIEJpb2NNYW5hZ2VyIHBhY2thZ2UgaWYgbm90IGluc3RhbGxlZCB5ZXQuCiMgQmlvY01hbmFnZXIgaXMgdGhlIHBhY2thZ2UgaW5zdGFsbGVyIGZvciBCaW9jb25kdWN0b3Igc29mdHdhcmUuCmlmICghcmVxdWlyZU5hbWVzcGFjZSgiQmlvY01hbmFnZXIiLCBxdWlldGx5ID0gVFJVRSkpCiAgICBpbnN0YWxsLnBhY2thZ2VzKCJCaW9jTWFuYWdlciIpCgojIGluc3RhbGwgcGFja2FnZXMgaWYgbm90IHlldCBpbnN0YWxsZWQuCnBrZ3MgPC0gYygiU2luZ2xlQ2VsbEV4cGVyaW1lbnQiLCAiRHJvcGxldFV0aWxzIiwgInNjUk5Bc2VxIiwgInNjYXRlciIsICJzY3V0dGxlIiwgInNjcmFuIiwgIkJpb2NTaW5ndWxhciIsICJzY0RibEZpbmRlciIsICJnbG1wY2EiLCAidXdvdCIpCm5vdEluc3RhbGxlZCA8LSBwa2dzWyFwa2dzICVpbiUgaW5zdGFsbGVkLnBhY2thZ2VzKClbLDFdXQppZihsZW5ndGgobm90SW5zdGFsbGVkKSA+IDApewogIEJpb2NNYW5hZ2VyOjppbnN0YWxsKG5vdEluc3RhbGxlZCkKfQoKIyBDb2RlIGJlbG93IG1pZ2h0IGFzayB5b3UgdG8gY3JlYXRlIGFuIEV4cGVyaW1lbnRIdWIgZGlyZWN0b3J5LiAKIyBUeXBlICd5ZXMnIGFuZCBoaXQgRW50ZXIsIHRvIGFsbG93IHRoaXMuCnN1cHByZXNzUGFja2FnZVN0YXJ0dXBNZXNzYWdlcyhsaWJyYXJ5KHNjUk5Bc2VxKSkKc2NlIDwtIE1hY29za29SZXRpbmFEYXRhKCkKYGBgCgojIEEgYFNpbmdsZUNlbGxFeHBlcmltZW50YCBvYmplY3QKCgpgYGB7cn0Kc2NlCmBgYAoKIyMgQWNjZXNzaW5nIGRhdGEgZnJvbSBhIGBTaW5nbGVDZWxsRXhwZXJpbWVudGAgb2JqZWN0CgpQbGVhc2Ugc2VlIFtGaWd1cmUgNC4xIGluIE9TQ0FdKGh0dHA6Ly9iaW9jb25kdWN0b3Iub3JnL2Jvb2tzL3JlbGVhc2UvT1NDQS9kYXRhLWluZnJhc3RydWN0dXJlLmh0bWwpIGZvciBhbiBvdmVydmlldyBvZiBhIGBTaW5nbGVDZWxsRXhwZXJpbWVudGAgb2JqZWN0LgoKYGBge3J9CiMgRGF0YTogYXNzYXlzCmFzc2F5cyhzY2UpCmFzc2F5cyhzY2UpJGNvdW50c1sxOjUsIDE6NV0KCiMgRmVhdHVyZSBtZXRhZGF0YTogcm93RGF0YQpyb3dEYXRhKHNjZSkgIyBlbXB0eSBmb3Igbm93CgojIENlbGwgbWV0YWRhdGE6IGNvbERhdGEKY29sRGF0YShzY2UpCgojIFJlZHVjZWQgZGltZW5zaW9uczogcmVkdWNlZERpbXMKcmVkdWNlZERpbXMoc2NlKSAjIGVtcHR5IGZvciBub3cKYGBgCgojIyBDcmVhdGluZyBhIG5ldyBgU2luZ2xlQ2VsbEV4cGVyaW1lbnRgIG9iamVjdAoKYGBge3J9CnNjZU5ldyA8LSBTaW5nbGVDZWxsRXhwZXJpbWVudChhc3NheXMgPSBsaXN0KGNvdW50cyA9IGFzc2F5cyhzY2UpJGNvdW50cykpCnNjZU5ldwoKcm0oc2NlTmV3KQpgYGAKCiMjIFN0b3JpbmcgKG1ldGEpZGF0YSBpbiBhIGBTaW5nbGVDZWxsRXhwZXJpbWVudGAgb2JqZWN0CgpgYGB7cn0KZmFrZUdlbmVOYW1lcyA8LSBwYXN0ZTAoImdlbmUiLCAxOm5yb3coc2NlKSkKcm93RGF0YShzY2UpJGZha2VOYW1lIDwtIGZha2VHZW5lTmFtZXMKaGVhZChyb3dEYXRhKHNjZSkpCiMgUmVtb3ZlIGFnYWluIGJ5IHNldHRpbmcgdG8gTlVMTApyb3dEYXRhKHNjZSkkZmFrZU5hbWUgPC0gTlVMTAoKYXNzYXlzKHNjZSkkbG9nQ291bnRzIDwtIGxvZzFwKGFzc2F5cyhzY2UpJGNvdW50cykKYXNzYXlzKHNjZSkKYXNzYXlzKHNjZSkkbG9nQ291bnRzWzE6NSwgMTo1XQphc3NheXMoc2NlKSRsb2dDb3VudHMgPC0gTlVMTApgYGAKCiMgRmlsdGVyaW5nIG5vbi1pbmZvcm1hdGl2ZSBnZW5lcwoKCiMgUXVhbGl0eSBjb250cm9sCgojIyBDYWxjdWxhdGUgUUMgdmFyaWFibGVzCgpOb3RlIHRoYXQgdGhlIGNoYXJhY3RlciBzdHJpbmcgIl5NVC0iIGluIHRoZSByb3duYW1lcyBvZiB0aGUgc2NlIG9iamVjdCBpbmRpY2F0ZXMgbWl0b2Nob25kcmlhbCBnZW5lcy4gCgojIyBFREEKCkhpZ2gtcXVhbGl0eSBjZWxscyBzaG91bGQgaGF2ZSBtYW55IGZlYXR1cmVzIGV4cHJlc3NlZCwgYW5kIGEgbG93IGNvbnRyaWJ1dGlvbiBvZiBtaXRvY2hvbmRyaWFsIGdlbmVzLiBIZXJlLCB3ZSBzZWUgdGhhdCBzZXZlcmFsIGNlbGxzIGhhdmUgYSB2ZXJ5IGxvdyBudW1iZXIgb2YgZXhwcmVzc2VkIGdlbmVzLCBhbmQgd2hlcmUgbW9zdCBvZiB0aGUgbW9sZWN1bGVzIGFyZSBkZXJpdmVkIGZyb20gbWl0b2Nob25kcmlhbCBnZW5lcy4gVGhpcyBpbmRpY2F0ZXMgbGlrZWx5IGRhbWFnZWQgY2VsbHMsIHByZXN1bWFibHkgYmVjYXVzZSBvZiBsb3NzIG9mIGN5dG9wbGFzbWljIFJOQSBmcm9tIHBlcmZvcmF0ZWQgY2VsbHMsIHNvIHdlJ2Qgd2FudCB0byByZW1vdmUgdGhlc2UgZm9yIHRoZSBkb3duc3RyZWFtIGFuYWx5c2lzLgoKCiMjIFFDIHVzaW5nIGFkYXB0aXZlIHRocmVzaG9sZHMKCkJlbG93LCB3ZSByZW1vdmUgY2VsbHMgdGhhdCBhcmUgb3V0bHlpbmcgd2l0aCByZXNwZWN0IHRvCgogMS4gQSBsb3cgc2VxdWVuY2luZyBkZXB0aCAobnVtYmVyIG9mIFVNSXMpOwogMi4gQSBsb3cgbnVtYmVyIG9mIGdlbmVzIGRldGVjdGVkOwogMy4gQSBoaWdoIHBlcmNlbnRhZ2Ugb2YgcmVhZHMgZnJvbSBtaXRvY2hvbmRyaWFsIGdlbmVzLgoKQWxzbyBtYWtlIHBsb3RzIHRvIGFzc2VzcyB0aGUgaW1wYWN0IG9mIHRoZSByZW1vdmFsIG9mIC4gCgoKIyMgSWRlbnRpZnlpbmcgYW5kIHJlbW92aW5nIGVtcHR5IGRyb3BsZXRzCgpOb3RlIHRoYXQgdGhlIHJlbW92YWwgb2YgY2VsbHMgd2l0aCBsb3cgc2VxdWVuY2luZyBkZXB0aCB1c2luZyB0aGUgYWRhcHRpdmUgdGhyZXNob2xkIHByb2NlZHVyZSBhYm92ZSBpcyBhIHdheSBvZiByZW1vdmluZyBlbXB0eSBkcm9wbGV0cy4gCk90aGVyIGFwcHJvYWNoZXMgYXJlIHBvc3NpYmxlLCBlLmcuLCByZW1vdmluZyBjZWxscyBieSBzdGF0aXN0aWNhbCB0ZXN0aW5nIHVzaW5nIGBlbXRweURyb3BzYC4KVGhpcyBkb2VzIHJlcXVpcmUgdXMgdG8gc3BlY2lmeSBhIGxvd2VyIGJvdW5kIG9uIHRoZSB0b3RhbCBudW1iZXIgb2YgVU1JcywgYmVsb3cgd2hpY2ggYWxsIGNlbGxzIGFyZSBjb25zaWRlcmVkIHRvIGNvcnJlc3BvbmQgdG8gZW1wdHkgZHJvcGxldHMuClRoaXMgbG93ZXIgYm91bmQgbWF5IG5vdCBiZSB0cml2aWFsIHRvIGRlcml2ZSwgYnV0IHRoZSBgYmFyY29kZVJhbmtzYCBmdW5jdGlvbiBjYW4gYmUgdXNlZnVsIHRvIGlkZW50aWZ5IGFuIGVsYm93L2tuZWUgcG9pbnQuCgoKIyMgSWRlbnRpZnlpbmcgYW5kIHJlbW92aW5nIGRvdWJsZXRzCgpXZSB3aWxsIHVzZSBbc2NEYmxGaW5kZXJdKGh0dHBzOi8vYmlvY29uZHVjdG9yLm9yZy9wYWNrYWdlcy8zLjE0L2Jpb2MvaHRtbC9zY0RibEZpbmRlci5odG1sKSB0byBkZXRlY3QgZG91YmxldCBjZWxscy4KCgoKCiMgTm9ybWFsaXphdGlvbgoKRm9yIG5vcm1hbGl6YXRpb24sIHRoZSBzaXplIGZhY3RvcnMgJHNfaSQgY29tcHV0ZWQgaGVyZSBhcmUgc2ltcGx5IHNjYWxlZCBsaWJyYXJ5IHNpemVzOgpcWyBOX2kgPSBcc3VtX2cgWV97Z2l9IFxdClxbIHNfaSA9IE5faSAvIFxiYXJ7Tn1faSBcXQoKIyBGZWF0dXJlIHNlbGVjdGlvbgoKCiMgRGltZW5zaW9uIHJlZHVjdGlvbgoKTm90ZSB0aGF0LCBiZWxvdywgd2UgY29sb3IgdGhlIGNlbGxzIHVzaW5nIHRoZSBrbm93biwgdHJ1ZSBjZWxsIHR5cGUgbGFiZWwgYXMgZGVmaW5lZCBpbiB0aGUgbWV0YWRhdGEsIHRvIGVtcGlyaWNhbGx5IGV2YWx1YXRlIHRoZSBkaW1lbnNpb24gcmVkdWN0aW9uLiBJbiByZWFsaXR5LCB3ZSBkb24ndCBrbm93IHRoaXMgeWV0IGF0IHRoaXMgc3RhZ2UuCgojIyBMaW5lYXIgZGltZW5zaW9uIHJlZHVjdGlvbjogUENBCgpXZSBhcmUgYWJsZSB0byByZWNvdmVyIHF1aXRlIHNvbWUgc3RydWN0dXJlLiAKSG93ZXZlciwgbWFueSBjZWxsIHBvcHVsYXRpb25zIHJlbWFpbiBvYnNjdXJlLCBhbmQgdGhlIHBsb3QgaXMgb3ZlcmNyb3dkZWQuCgoKIyMjIFBDQSB3aXRob3V0IGZlYXR1cmUgc2VsZWN0aW9uCgoKIyMgQSBnZW5lcmFsaXphdGlvbiBvZiBQQ0EgZm9yIGV4cG9uZW50aWFsIGZhbWlseSBkaXN0cmlidXRpb25zLgoKCgoKIyMgTm9uLWxpbmVhciBkaW1lbnNpb24gcmVkdWN0aW9uOiBVTUFQCgoKIyBDbHVzdGVyaW5nCgpgYGB7cn0KIyBCdWlsZCBhIHNoYXJlZCBuZWFyZXN0LW5laWdoYm9yIGdyYXBoIGZyb20gUENBIHNwYWNlCiNnIDwtIGJ1aWxkU05OR3JhcGgoc2NlLCB1c2UuZGltcmVkID0gJ1BDQScpCgojIExvdXZhaW4gY2x1c3RlcmluZyBvbiB0aGUgU05OIGdyYXBoLCBhbmQgYWRkIHRvIHNjZQojY29sRGF0YShzY2UpJGxhYmVsIDwtIGZhY3RvcihpZ3JhcGg6OmNsdXN0ZXJfbG91dmFpbihnKSRtZW1iZXJzaGlwKQoKIyBWaXN1YWxpemF0aW9uLgojcGxvdFVNQVAoc2NlLCBjb2xvdXJfYnk9ImxhYmVsIikKYGBgCg==