09-Cluster-Analysis.Rmd

---
title: "09-Cluster-Analysis"
output: html_document
---

# Feature Selection and Cluster Analysis

## Abstract

Many methods have been used to determine differential gene expression from single-cell RNA (scRNA)-seq data. We evaluated 36 approaches using experimental and synthetic data and found considerable differences in the number and characteristics of the genes that are called differentially expressed. Prefiltering of lowly expressed genes has important effects, particularly for some of the methods developed for bulk RNA-seq data analysis. However, we found that bulk RNA-seq analysis methods do not generally perform worse than those developed specifically for scRNA-seq. We also present conquer, a repository of consistently processed, analysis-ready public scRNA-seq data sets that is aimed at simplifying method evaluation and reanalysis of published results. Each data set provides abundance estimates for both genes and transcripts, as well as quality control and exploratory analysis reports. [@soneson2018bias]



Cells are the basic building blocks of organisms and each cell is unique. Single-cell RNA sequencing has emerged as an indispensable tool to dissect the cellular heterogeneity and decompose tissues into cell types and/or cell states, which offers enormous potential for de novo discovery. Single-cell transcriptomic atlases provide unprecedented resolution to reveal complex cellular events and deepen our understanding of biological systems. In this review, we summarize and compare single-cell RNA sequencing technologies, that were developed since 2009, to facilitate a well-informed choice of method. The applications of these methods in different biological contexts are also discussed. We anticipate an ever-increasing role of single-cell RNA sequencing in biology with further improvement in providing spatial information and coupling to other cellular modalities. In the future, such biological findings will greatly benefit medical research. [@hedlund2018single]



## Seurat Tutorial Redo

For this tutorial, we will be analyzing the a dataset of Non-Small Cell Lung Cancer Cells (NSCLC) freely available from 10X Genomics (https://support.10xgenomics.com/single-cell-vdj/datasets/2.2.0/vdj_v1_hs_nsclc_5gex), using the Seurat R package (http://satijalab.org/seurat/), a popular and powerful set of tools to conduct scRNA-seq analysis in R. In this dataset, there are 7802 single cells that were sequenced on the Illumina NovaSeq 6000. Please note this tutorial borrows heavily from Seurat's tutorials, so feel free to go through them in more detail.


```{bash get_data, eval = FALSE, include = FALSE}
wget https://s3-us-west-2.amazonaws.com/10x.files/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_matrices.tar.gz -O data/pbmc3k_filtered_gene_bc_matrices.tar.gz
cd data; tar -xzf pbmc3k_filtered_gene_bc_matrices.tar.gz
cd ..
```

**Task: Check the dirname to directory where you saved your data**
```{r read_data_clust}
knitr::opts_knit$set(progress=FALSE, verbose=FALSE)

library(Seurat)
library(dplyr)
library(ggplot2)
library(CountClust)

dirname <- "data/"

counts_matrix_filename = paste0(dirname, "filtered_gene_bc_matrices/GRCh38/")
counts <- Read10X(data.dir = counts_matrix_filename)  # Seurat function to read in 10x count data

```

```{r create_seurat_clust}

## Using the first 1000 cells for computational efficiency
seurat <- CreateSeuratObject(counts = counts, min.cells = 3, min.features = 350, project = "10X_NSCLC")
```



### Preprocessing Steps

This was all covered in Dana's Lab!

```{r pt_mito_clust}
# The number of genes and UMIs (nFeature_RNA nCount_RNA) are automatically calculated
# for every object by Seurat.  For non-UMI data, nCount_RNA represents the sum of
# the non-normalized values within a cell We calculate the percentage of
# mitochondrial genes here and store it in percent.mito using AddMetaData.
# We use object@raw.data since this represents non-transformed and
# non-log-normalized counts The % of UMI mapping to MT-genes is a common
# scRNA-seq QC metric.
# Load the the list of house keeping genes
hkgenes <- read.table("data/resources/tirosh_house_keeping.txt", skip = 2)
hkgenes <- as.vector(hkgenes$V1)

# remove hkgenes that were not found
hkgenes.found <- which(toupper(rownames(seurat@assays$RNA@data)) %in% hkgenes)
n.expressed.hkgenes <- sum(seurat@assays$RNA@data[hkgenes.found, ] > 0)

## Add to Seurat Meta Data
seurat <- AddMetaData(object = seurat, metadata = n.expressed.hkgenes, col.name = "n.exp.hkgenes")

seurat[["percent.mito"]] <- PercentageFeatureSet(object = seurat, pattern = "^MT-")
##VlnPlot(object = seurat, features = c("nFeature_RNA", "nCount_RNA", "percent.mt"), ncol = 3)
```


```{r scatter_plot_v3}
# FeatureScatter is typically used to visualize gene-gene relationships, but can
# be used for anything calculated by the object, i.e. columns in
# object@meta.data, PC scores etc.  Since there is a rare subset of cells
# with an outlier level of high mitochondrial percentage and also low UMI
# content, we filter these as well
par(mfrow = c(1, 2))
FeatureScatter(object = seurat, feature1 = "nCount_RNA", feature2 = "percent.mito")
FeatureScatter(object = seurat, feature1 = "nCount_RNA", feature2 = "nFeature_RNA")
```


```{r subset_data_clust}
# We filter out cells that have unique gene counts over 4,000 or less than
# 350 Note that low thresholds and high thresholds are used to define a
# 'gate'.  -Inf and Inf should be used if you don't want a lower or upper
# threshold.


seurat <- subset(seurat, subset = nFeature_RNA > 350 & 
                   nFeature_RNA < 4000 & 
                   percent.mito < 15 & 
                   n.exp.hkgenes > 55)
```




```{r norm_data_clust}
seurat <- NormalizeData(object = seurat, normalization.method = "LogNormalize", scale.factor = 10000)
```


```{r cell_cycle_genes_clust}
# Read in a list of cell cycle markers, from Tirosh et al, 2015.
# We can segregate this list into markers of G2/M phase and markers of S phase.
s.genes <- Seurat::cc.genes$s.genes
s.genes <- s.genes[s.genes %in% rownames(seurat)] # genes in dataset
g2m.genes <- Seurat::cc.genes$g2m.genes
g2m.genes <- g2m.genes[g2m.genes %in% rownames(seurat)] # genes in dataset

seurat <- CellCycleScoring(object = seurat, 
                           s.features = s.genes, 
                           g2m.features = g2m.genes, 
                           set.ident = TRUE)
```

```{r var_genes_clust}

seurat <- FindVariableFeatures(object = seurat, selection.method = "vst", nfeatures = 2000)
```



### Start of Identifying Cell Types

#### Scaling

This part is where you mean center the data, substract the mean.  You also divide by the standard deviation to make everything to a 'standard normal', where the mean is zero and the standard deviation is 1.

```{r regress_clust}
seurat <- ScaleData(object = seurat, vars.to.regress = c("percent.mito"))
```

**Task: Try Regressing Other Variables**
```{r regrress_other, eval = FALSE}
set.seed(2020) ## used for reporducibility

## randomly making a batch id data.frame
batch_ids <- data.frame(barcode = rownames(seurat@meta.data), 
                        batch_id = sample(0:2, NROW(seurat@meta.data), replace = TRUE),
                        stringsAsFactors = FALSE)

## naming batch ids by cell names
row.names(batch_ids) <- row.names(seurat@meta.data)

## adding batch ids to the meta data
seurat <- AddMetaData(object = seurat, metadata = batch_ids, col.name = NULL)


## try different variables to regress
seurat <- ScaleData(object = seurat, vars.to.regress = '??')
```


#### Perform linear dimensional reduction (PCA)

This will run pca on the just the variable features found.

```{r run_pca_clust}
seurat <- RunPCA(object = seurat, 
               features = seurat@assays$RNA@var.features, 
               ndims.print = 1:5, 
               nfeatures.print = 5)
```


#### Visualizing PCA in Different Ways

```{r plot_pca_clust}
DimPlot(seurat, reduction = "pca")
```

#### Perform linear dimensional reduction (ICA)

**Task:** Try running Independent Component Analysis.  If you need help with the inputs try using the ?RunICA menu.  


```{r run_ica, eval = FALSE}
seurat <- RunICA()
```


#### Visualizing ICA in Different Ways

```{r plot_ica, eval = FALSE}
DimPlot()
```



```{r project_pca_clust}
# ProjectDim scores each gene in the dataset (including genes not included
# in the PCA) based on their correlation with the calculated components.
# Though we don't use this further here, it can be used to identify markers
# that are strongly correlated with cellular heterogeneity, but may not have
# passed through variable gene selection.  The results of the projected PCA
# can be explored by setting use.full=T in the functions above
seurat <- ProjectDim(object = seurat, reduction = "pca")
```

#### Genes by PCs

```{r pca_heatmap_clust}
DimHeatmap(object = seurat, 
          dims = 1:6, 
          cells = 50, 
          reduction = "pca",
          balanced = TRUE)
```


Check other PCs to plot

**Task: Check other PCs**
```{r pca_heatmap2, eval = FALSE}
DimHeatmap()
```


```{r jack_straw, eval = FALSE}
seurat <- JackStraw(object = seurat, reduction = "pca")
seurat <- ScoreJackStraw(seurat, dims = 1:20)
```



```{r jack_straw_plot, eval = FALSE}
JackStrawPlot(seurat, dims = 1:20)
```


```{r pcsiggenes, eval = FALSE}
PCASigGenes(object = seurat, pcs.use = 1, pval.cut = 0.001)[1:20]
```




```{r pca_elbow_clust}
ElbowPlot(object = seurat, ndims = 30, reduction = "pca")
```



```{r find_clusters}
# save.SNN = T saves the SNN so that the clustering algorithm can be rerun
# using the same graph but with a different resolution value (see docs for
# full details)
set.seed(2020)
seurat <- FindNeighbors(object = seurat, dims = 1:10)
seurat <- FindClusters(object = seurat, 
                       reduction = "pca", 
                       dims = 1:10, 
                       resolution = 0.6,
                       random.seed = 2020)
```


### Run non-linear dimensional reduction (UMAP/tSNE)

Seurat offers several non-linear dimensional reduction techniques, such as tSNE and UMAP, to visualize and explore these datasets. The goal of these algorithms is to learn the underlying manifold of the data in order to place similar cells together in low-dimensional space. Cells within the graph-based clusters determined above should co-localize on these dimension reduction plots. As input to the UMAP and tSNE, we suggest using the same PCs as input to the clustering analysis.

**Task: Look up and tune hyperparameters of the tSNE. (hint: `?RunTSNE`)**
```{r run_tsne_clust}

seurat <- RunTSNE(seurat, reduction.use = "pca", dims.use = 1:10, perplexity=10)

# note that you can set do.label=T to help label individual clusters
DimPlot(object = seurat, reduction = "tsne")
```


**Task: Try using UMAP for the non-linear dimension reduction technique (hint: `?RunUMAP`)**
```{r run_umap, eval = FALSE}
set.seed(2020)
seurat <- RunUMAP()

# note that you can set label=TRUE to help label individual clusters
DimPlot()
```


#### Finding differentially expressed features (cluster biomarkers)

Seurat can help you find markers that define clusters via differential expression. By default, it identifes positive and negative markers of a single cluster (specified in ident.1), compared to all other cells. FindAllMarkers automates this process for all clusters, but you can also test groups of clusters vs. each other, or against all cells.

The min.pct argument requires a feature to be detected at a minimum percentage in either of the two groups of cells, and the thresh.test argument requires a feature to be differentially expressed (on average) by some amount between the two groups. You can set both of these to 0, but with a dramatic increase in time - since this will test a large number of features that are unlikely to be highly discriminatory. As another option to speed up these computations, max.cells.per.ident can be set. This will downsample each identity class to have no more cells than whatever this is set to. While there is generally going to be a loss in power, the speed increases can be significiant and the most highly differentially expressed features will likely still rise to the top.

```{r find_cluster1, eval = FALSE}
# find all markers of cluster 1 using default parameters
cluster1.markers <- FindMarkers(object = seurat, 
                                ident.1 = 1,
                                min.pct = 0.1)

head(cluster1.markers)
```


**Task: Try tuning different parameters. How does that affect results?**

```{r find_cluster5, eval = FALSE}
# find all markers distinguishing cluster 5 from clusters 0 and 1
cluster5.markers <- FindMarkers(object = seurat, 
                                ident.1 = 5, ident.2 = c(0, 1), 
                                min.pct = ?? 
                                only.pos = ??)

head(cluster5.markers)
```


```{r cluster3_markers, eval = FALSE}
cluster3.markers <- FindMarkers(object = seurat, 
                                ident.1 = 3, 
                                thresh.use = 0.25, 
                                only.pos = TRUE)

head(cluster3.markers)
```


```{r plot_cluster3_markers, eval = FALSE}
VlnPlot(object = seurat, features = c("MS4A1", "CD79A"))
```


```{r plot_by_umi, eval = FALSE}
# you can plot raw UMI counts as well
VlnPlot(object = seurat, 
        features = c("NKG7", "PF4"), 
        log = TRUE)
```


```{r find_markers, eval = FALSE}
# find markers for every cluster compared to all remaining cells, report
# only the positive ones
nsclc.markers <- FindAllMarkers(object = seurat, only.pos = TRUE, min.pct = 0.25, thresh.use = 0.25)
nsclc.markers %>% group_by(cluster) %>% top_n(2, avg_logFC)
```


```{r gene_tsne, eval = FALSE}
FeaturePlot(object = seurat, 
            features = c("MS4A1", "GNLY", "CD3E", "CD14", "FCER1A", "FCGR3A", "LYZ", "PPBP", "CD8A"),
            cols = c("grey", "blue"), 
            reduction = "tsne")
```



```{r do_heatmap, eval = FALSE}
top10 <- nsclc.markers %>% group_by(cluster) %>% top_n(10, avg_logFC)
# setting slim.col.label to TRUE will print just the cluster IDS instead of
# every cell name
DoHeatmap(object = seurat, features = top10$gene, label = TRUE)
```

```{r new_names, eval = FALSE}
## pbmc markers
# new.cluster.ids <- c("Memory CD4 T", "Naive CD4 T", "CD14+ Mono", "B", "CD8 T", 
#                      "FCGR3A+ Mono", "NK", "DC", "Mk")

## making generic cell type names
new.cluster.ids <- paste0("CellType", levels(seurat@active.ident))
names(x = new.cluster.ids) <- levels(x = seurat)
seurat <- RenameIdents(object = seurat, new.cluster.ids)

DimPlot(object = seurat, reduction = 'tsne', label = TRUE, pt.size = 0.5) + NoLegend()
```



#### Further subdivisions within cell types

If you perturb some of our parameter choices above (for example, setting resolution=0.8 or changing the number of PCs), you might see cells subdivide into two groups. You can explore this subdivision to find markers separating the two cell subsets. However, before reclustering (which will overwrite object@ident), we can stash our renamed identities to be easily recovered later.

```{r tune_params}
# First lets stash our identities for later
seurat[["ClusterNames_0.6"]] <- Idents(object = seurat)

# Note that if you set save.snn=T above, you don't need to recalculate the
# SNN, and can simply put: seurat <- FindClusters(seurat, resolution = 0.8)
seurat <- FindClusters(object = seurat, 
                       reduction = "pca", 
                       dims = 1:10, 
                       resolution = 0.8)
```


```{r compare_params}

## Warning in BuildSNN(object = object, genes.use = genes.use, reduction.type
## = reduction.type, : Build parameters exactly match those of already
## computed and stored SNN. To force recalculation, set force.recalc to TRUE.
# Demonstration of how to plot two tSNE plots side by side, and how to color
# points based on different criteria
plot1 <- DimPlot(object = seurat, 
                 reduction= "tsne",
                 label = TRUE) + NoLegend()

plot2 <- DimPlot(object = seurat, 
                  reduction = "tsne", 
                  group.by = "ClusterNames_0.6",
                  label = TRUE) + NoLegend()

# patchwork system
plot1 + plot2
```



```{r cell_markers, eval = FALSE}
# Find discriminating markers
cell.markers <- FindMarkers(object = seurat, ident.1 = 0, ident.2 = 1)

# Checking some markers found
FeaturePlot(object = seurat, features = c("S100A4", "CCR7"), cols = c("green", "blue"))
```


## Feature Selection

### Differential Expression Analysis

#### Differential Expression Tests

  One of the most commonly performed tasks for RNA-seq data is differential gene expression (DE) analysis. Although well-established tools exist for such analysis in bulk RNA-seq data, methods for scRNA-seq data are just emerging. Given the special characteristics of scRNA-seq data, including generally low library sizes, high noise levels and a large fraction of so-called ‘dropout’ events, it is unclear whether DE methods that have been developed for bulk RNA-seq are suitable also for scRNA-seq.  Check the help page out for the FindMarkers function by using <code> ?FindMarkers </code>

```{r difftest, eval = FALSE}
## Differential expression using t-test
FindMarkers(object = seurat, ident.1 = 0, ident.2 = 1, test.use = "t")
```


**Task:** Try to use different test for diffential expression analysis (hint: `?FindMarkers`)
```{r, eval = FALSE}
## Use the help function and run other tests.  Do they find similar markers?
FindMarkers(object = seurat, ident.1 = 0, ident.2 = 1, test.use = ??)
```


### Check Clusters

How do we test the cell types identified?  How do we know how reliable they are?

Use Classifier to predict cell cluster.  See how it predicts using hold out data.
[reference](https://satijalab.org/seurat/v3.0/integration.html)

```{r check_clusters}
# Assign the test object a three level attribute
groups <- sample(c("train", "test"), size = NROW(seurat@meta.data), replace = TRUE, prob = c(0.8, 0.2))
names(groups) <- colnames(seurat)
seurat <- AddMetaData(object = seurat, metadata = groups, col.name = "group")

# Find Anchors
seurat.list <- SplitObject(seurat, split.by = "group")
seurat.anchors <- FindIntegrationAnchors(object.list = seurat.list, dims = 1:30)
seurat.integrated <- IntegrateData(anchorset = seurat.anchors, dims = 1:30)

seurat.query <- seurat.list[["train"]]
seurat.anchors <- FindTransferAnchors(reference = seurat.integrated, 
                                      query = seurat.query, 
                                      dims = 1:30)

predictions <- TransferData(anchorset = seurat.anchors, 
                            refdata = seurat.integrated$ClusterNames_0.6, 
                            dims = 1:30)

seurat.query <- AddMetaData(seurat.query, metadata = predictions)
table(seurat.query@meta.data$ClusterNames_0.6, seurat.query@meta.data$predicted.id)
```


### View Entire Object Structure

Notice all the slots and elements added to the object.  

```{r review_str, eval = FALSE}
str(seurat)
```


## Probabilistic (LDA) Clustering

Another type of clustering we can do is a fuzzy or probablistic clustering.  This is where cells are not assigned to specifically only one cluster.  They get assigned a score for how much the cells belong to each of the clusters (sometimes called topics).  This can be helpful for when your dataset continuous processes and/or cellular states as opposed to distinct cell types.

### Example LDA in Bulk

```{r example_lda}
data("MouseDeng2014.FitGoM")
names(MouseDeng2014.FitGoM)
omega <- MouseDeng2014.FitGoM$clust_6$omega


annotation <- data.frame(
  sample_id = paste0("X", c(1:NROW(omega))),
  tissue_label = factor(rownames(omega),
                        levels = rev(c("zy", "early2cell", "mid2cell", "late2cell",
                                        "4cell", "8cell", "16cell", "earlyblast", "midblast", "lateblast")))
  )

rownames(omega) <- annotation$sample_id;

StructureGGplot(omega = omega,
                annotation = annotation,
                palette = RColorBrewer::brewer.pal(8, "Accent"),
                yaxis_label = "Amplification batch",
                order_sample = TRUE,
                axis_tick = list(axis_ticks_length = .1,
                                 axis_ticks_lwd_y = .1,
                                 axis_ticks_lwd_x = .1,
                                 axis_label_size = 7,
                                 axis_label_face = "bold"))
```

### PBMC LDA

#### Fitting the Model

```{r pbmc_lda}
set.seed(2020)

## Preprocessing Steps
pbmc_small <- NormalizeData(object = pbmc_small, normalization.method = "LogNormalize", scale.factor = 10000)
pbmc_small <- RunPCA(object = pbmc_small)
pbmc_small <- FindClusters(object = pbmc_small, 
                           reduction = "pca", 
                           dims.use = 1:10, 
                           resolution = 1, 
                           print.output = 0)

## Grab the Raw Count Matrix from Seurat Object
## Needs count matrix
pbmc_counts <- as.matrix(pbmc_small@assays$RNA@counts)
pbmc_meta <- pbmc_small@meta.data
gene_names <- rownames(pbmc_counts)


## Fit LDA  Model, called GoM for this R pacakge
## Number of topics to fit is K=4
pbmc_FitGoM <- FitGoM(t(pbmc_counts), K=4)

## Grab topic scores
omega <- data.frame(pbmc_FitGoM$fit$omega)

## Annotate topics, if identies known
annotation <- data.frame(sample_id = rownames(omega),
                         tissue_label = paste0("cluster", pbmc_small@active.ident))

colnames(omega) <- paste0("topic", 1:4)
rownames(omega) <- annotation$sample_id;

## Make plot to see topic contribution
StructureGGplot(omega = omega,
                annotation = annotation,
                palette = RColorBrewer::brewer.pal(4, "Dark2"),
                yaxis_label = "Cells",
                order_sample = TRUE,
                axis_tick = list(axis_ticks_length = .1,
                                 axis_ticks_lwd_y = .1,
                                 axis_ticks_lwd_x = .1,
                                 axis_label_size = 7,
                                 axis_label_face = "bold"))


# ## Add Topic Scores to Meta Data Part of the Seurat Object
pbmc_small <- AddMetaData(pbmc_small, omega)
```

#### Summarizing Topic By Cluster

```{r topic_summary}
pbmc_small@meta.data %>% 
  group_by(RNA_snn_res.1) %>% 
  summarise(topic1 = mean(topic1),
            topic2 = mean(topic2),
            topic3 = mean(topic3),
            topic4 = mean(topic4))
```


#### Visualizing Topic Scores

```{r tsne_plot_pbmc}
## ggplot object, you can add layers
p1 <- DimPlot(pbmc_small, reduction = "tsne") + labs(title = "Resolution 1") ## return ggplot object
p1
```

```{r topic_plot}
p2 <- FeaturePlot(object = pbmc_small, 
                  features = c("topic1", "topic2", "topic3", "topic4"), 
                  cols = c("grey", "blue"), 
                  reduction = "tsne") ## return ggplot object

p2
```

```{r combine_topic_plot}
p1 + p2
```

#### Extract Top Feature

```{r topic_genes}
## Gene scores for each topics
theta_mat <- pbmc_FitGoM$fit$theta

top_features <- ExtractTopFeatures(theta_mat, 
                                   top_features=100,
                                   method="poisson", 
                                   options="min")

gene_list <- do.call(rbind, 
                     lapply(1:dim(top_features$indices)[1],
                            function(x) gene_names[top_features$indices[x,]]))
```


We tabulate the top `5` genes for these `4` topics

```{r topic_genes_by_cluster, eval = FALSE}
out_table <- do.call(rbind, lapply(1:4, function(i) toString(gene_list[i,1:5])))
rownames(out_table) <- paste("Topic", c(1:4))
out_table
```



### Practice Visualizing/Embedding

#### tSNE

Change the parameter settings for tSNE

```{r, eval = FALSE}
RunTSNE()
```

#### UMAP

Change the parameter settings for UMAP

```{r, eval = FALSE}
RunUMAP()
```




## Other Options For Analysis

  - [More Seurat Vignettes](https://satijalab.org/seurat/vignettes.html)
  - [Single Cell Analysis Workshop](https://broadinstitute.github.io/2019_scWorkshop/)
  - [Hemberg Lab Course](https://scrnaseq-course.cog.sanger.ac.uk/website/index.html)
  - [SingleCellExperiment](https://bioconductor.org/packages/release/bioc/vignettes/SingleCellExperiment/inst/doc/intro.html)
  - [Scanpy](https://scanpy-tutorials.readthedocs.io/en/latest/pbmc3k.html)
  - [Pegasus](https://github.com/klarman-cell-observatory/pegasus/blob/master/notebooks/Pegasus%20Tutorial%20in%20Workshop.ipynb)