Background

David went over a series of steps involved in processing scRNA-seq data in general. The aims of these steps included loading, filtering, normalizing for differences between cells, visualizing and clustering the data. He used the data from this study that aimed to understand the effects of stromal cells in developing tumors.

To further illustrate and develop the ideas, methods and steps, I will use a subset of cells from this melanoma data - cells marked by CD45- GFP+ CD31- or inferred as cancer-associated fibroblasts at the 5 day and 11 day time-points. The main reason for choosing this subset is so that we have data of a managable size to perform the planned analyses in this section in the alloted time. You should be able to extend the methods/code to data with larger number of cells and/or variables.

Biological question:

Identify a set of genes whose mean (across sampled animals, note: I don’t say sampled cells) expression changes from the 5 day to the 11 day time-point in tumor cancer-associated fibroblast cells given the experiment design.

Experimental Design: At each time-point (5 day or 11 day) cancer associated fibroblast cells are randomly sampled from two mice that are in turn randomly sampled from a pool of C57BL/6 mice. The expression of all genes within each of the cells are assayed using the SMART-Seq2 protocol.

We are interested in the effect of time on gene expression in cancer-associated fibroblasts. However, the expression of gene in a cell is variable not just because of biological reasons like cell-to-cell (intra-animal) and animal-to-animal (inter-animal) variability but also due to technical reasons like the differences in sequencing depth from cell-to-cell, library preparation, animal handling etc. If we don’t fully account for these sources of variation then our results/interpretation may be incorrect. For example, the clustering of cells may be driven by some techninal factors.

Ideally, the claim we would like to make would be as generalizable as possible, i.e., if somebody else were to repeat the experiment above, go back and randomly sample animals, randomly sample cells from each of these animals at two time-points and sequence the RNA in these cells they would make similar claims. So we would like to demonstrate to a sceptical reviewer that despite all the variability in expression we can claim that the fact that we observe mean expression of a gene at day 11 is x times higher than its expression at day 5 is unlikely to driven by random chance. Therefore, in arriving at our conclusions we would formally need to account for the different sources of variation. We will do so in two steps:

  1. Normalization
  2. Differential expression

The first step will be performed using an R bioconductor package called zinbwave while the second will use a combination of zinbwave and edgeR (a package that should be familiar to someone who has performed differential expression using bulk rna-seq).

Normalization is aimed at reducing the bias and amount variation of the measurement without information about the variable of interest (time in our case). It typically has been used with high-dimensional data (microarrays, bulk rna-seq, mass spec) where multiple features (genes, proteins) are assayed per sample. They are all based on the assumption that “most” features (e.g., levels of expression of genes) should not be different from one sample to another irrespective of the underlying the condition (e.g. in our case irrespective of whether a cell is taken from an animal at the 5 day time-point or the 11 day time-point).

We will a relatively sophisticated method called zinbwave for this. This method has been developed to explicitly account for an important characteristic of scRNA-seq data: a disproportionate number of zeros as compared with bulk rna-seq data. This characteristic is more formally called zero inflation, also called gene dropout and denotes the observation that for a given gene we do not observe any counts/reads assigned to it for a relatively large proportion of cells in the experiment. This could be due to biological or technical reasons.

The default log normalization in Seurat does not either take into account this zero inflation or the underlying probability distribution of the data while zinbwave jointly models the observed counts (greater than zero) and the zero counts. More formally, zinbwave models the expression of a given gene across all cells in the study as coming from a mixture of two probability distributions - a bernoulli (coin-toss) distribution that models that probability that a given gene’s reads dropout in a given cell and negative binomial distribution that models the counts of reads of this gene assigned to the given cell. The zinbwave program has additional flexibility allowing the mean levels to modified by sample/cell level covariates (e.g., processing batch) and gene level covariates (e.g., gene length and GC content). This is particularly useful as it has been shown (see Hicks et al) that proportion of genes detected per cell in a study is a good surrogate for technical variation (e.g., batch). Two additional features of the zinbwave program makes its particularly useful for our purposes today:

  1. It computes a lower (e.g. 2) dimensional (like Principal Component Analyses (PCA) for those of you who have heard of it) of the data for each cell after accounting for the variation as accounted for the sample-level variation. This would help us visualize the data.
  2. It computes a weight for each gene and cell combination that is intented to capture the fact whether a given gene is a dropout in a given cell or not. These weights can then be using for differential expression using edgeR to allow for correct estimates of dispersion/variation of the underlying negative binomial distribution of the counts of genes in cells. The edgeR framework allows to include more complicated experimental designs in the process of estimating differential expression. Specifically, we need to account for the fact that all the cells in the study are not independent, they dependent on their animal of origin. We would also like for our inference to be enhanced with information about the cluster of cells or cell-type. For example, may be certain genes are associated with time in only some clusters.

So lets get started with first loading the necessary libraries and the associated data for the subset of cells we are going to be working with.

##remove all data: start from scratch
rm(list = ls())
#Load the libraries.
require(Seurat)
## Loading required package: Seurat
require(zinbwave)
## Loading required package: zinbwave
## Loading required package: SummarizedExperiment
## Loading required package: GenomicRanges
## Loading required package: stats4
## Loading required package: BiocGenerics
## Loading required package: parallel
## 
## Attaching package: 'BiocGenerics'
## The following objects are masked from 'package:parallel':
## 
##     clusterApply, clusterApplyLB, clusterCall, clusterEvalQ,
##     clusterExport, clusterMap, parApply, parCapply, parLapply,
##     parLapplyLB, parRapply, parSapply, parSapplyLB
## The following objects are masked from 'package:stats':
## 
##     IQR, mad, sd, var, xtabs
## The following objects are masked from 'package:base':
## 
##     anyDuplicated, append, as.data.frame, basename, cbind,
##     colMeans, colnames, colSums, dirname, do.call, duplicated,
##     eval, evalq, Filter, Find, get, grep, grepl, intersect,
##     is.unsorted, lapply, lengths, Map, mapply, match, mget, order,
##     paste, pmax, pmax.int, pmin, pmin.int, Position, rank, rbind,
##     Reduce, rowMeans, rownames, rowSums, sapply, setdiff, sort,
##     table, tapply, union, unique, unsplit, which, which.max,
##     which.min
## Loading required package: S4Vectors
## 
## Attaching package: 'S4Vectors'
## The following object is masked from 'package:base':
## 
##     expand.grid
## Loading required package: IRanges
## Loading required package: GenomeInfoDb
## Loading required package: Biobase
## Welcome to Bioconductor
## 
##     Vignettes contain introductory material; view with
##     'browseVignettes()'. To cite Bioconductor, see
##     'citation("Biobase")', and for packages 'citation("pkgname")'.
## Loading required package: DelayedArray
## Loading required package: matrixStats
## 
## Attaching package: 'matrixStats'
## The following objects are masked from 'package:Biobase':
## 
##     anyMissing, rowMedians
## Loading required package: BiocParallel
## 
## Attaching package: 'DelayedArray'
## The following objects are masked from 'package:matrixStats':
## 
##     colMaxs, colMins, colRanges, rowMaxs, rowMins, rowRanges
## The following objects are masked from 'package:base':
## 
##     aperm, apply
## Loading required package: SingleCellExperiment
require(SummarizedExperiment)
require(edgeR)
## Loading required package: edgeR
## Loading required package: limma
## 
## Attaching package: 'limma'
## The following object is masked from 'package:BiocGenerics':
## 
##     plotMA
## 
## Attaching package: 'edgeR'
## The following object is masked from 'package:SingleCellExperiment':
## 
##     cpm
require(hopach)
## Loading required package: hopach
## Loading required package: cluster
require(pheatmap)
## Loading required package: pheatmap
require(ggplot2)
## Loading required package: ggplot2
raw_data <- read.csv("rawCounts.csv", header = T)
pheno_data <- read.csv("sub_pheno_data.csv", header = T)
print(dim(raw_data))
## [1] 38293   314
print(dim(pheno_data))
## [1] 313   7
head(pheno_data)
##             X       FacsMarker Individual             InferredCellType
## 1 22028_3_121 CD45- GFP+ CD31-       1197 cancer associated fibroblast
## 2 22028_3_123 CD45- GFP+ CD31-       1197 cancer associated fibroblast
## 3 22028_3_125 CD45- GFP+ CD31-       1197 cancer associated fibroblast
## 4 22028_3_129 CD45- GFP+ CD31-       1197 cancer associated fibroblast
## 5 22028_3_131 CD45- GFP+ CD31-       1197 cancer associated fibroblast
## 6 22028_3_133 CD45- GFP+ CD31-       1197 cancer associated fibroblast
##   Organ SamplingSite  Time
## 1  skin        tumor 5 day
## 2  skin        tumor 5 day
## 3  skin        tumor 5 day
## 4  skin        tumor 5 day
## 5  skin        tumor 5 day
## 6  skin        tumor 5 day

Like before, we will map the ensembl ids to gene symbols and load the data as a Seurat object. Seurat provides convenient functions to filter the cells and visualize the data. We will then use the data from the filtered cells for the zinbwave/normalization and edgeR/differential expression analyses. This section of the code is mostly based on what you had seen in David’s session.

mm10_genes <- read.csv("mm10_genes.tsv", header=FALSE, sep='\t', stringsAsFactors=FALSE,
                       col.names=c("ensembl_id", "gene_symbol"))

gene_ids <- as.character(raw_data$Geneid)

raw_data <- raw_data[,-1]
row.names(raw_data) <- gene_ids

# Map ENSEMBL Ids to their gene symbols
TempIndices <- match(gene_ids, mm10_genes$ensembl_id)
raw_data <- raw_data[!is.na(TempIndices), ]
CheckIds <- row.names(raw_data)[1:5]
NonUniqueGeneSymbols <-  mm10_genes$gene_symbol[TempIndices[!is.na(TempIndices)]]
UniqueGeneSymbols <- paste(NonUniqueGeneSymbols, 1:length(NonUniqueGeneSymbols), sep="_")
row.names(raw_data) <- UniqueGeneSymbols
colnames(raw_data) <- pheno_data$X

row.names(pheno_data) <- as.character(pheno_data$X)
pheno_data <- pheno_data[,-1]

# Finally, wrap this matrix up in a Seurat Object
data <- CreateSeuratObject(counts=raw_data,
                           project="basic_analysis",
                           min.cells=3,
                           min.features=200,
                           names.delim=NULL,
                           meta.data = pheno_data)
## Warning: Feature names cannot have underscores ('_'), replacing with dashes
## ('-')
# First, find all mitochondrial genes, and count them as a percentage of total reads/cell
# In mouse, mitochondrial genes start with "mt-" so find all genes that match that pattern
# If you were doing this in a human dataset the pattern would be "^MT-"
data[["percent_mt"]] <- PercentageFeatureSet(object=data, pattern="^mt-")


# Typically, you would use much lower thresholds for mitochondrial genes (< 5%)
# This data set has lots of highly expressed mitochondrial genes though, so we'll leave them
quantnCountRNA <- quantile(data@meta.data$nCount_RNA, 0.05)
data <- subset(x=data, subset=nFeature_RNA > 200 & nCount_RNA > quantnCountRNA & percent_mt < 20)

print(sprintf("After filtering outliers: %d cells and %d genes", ncol(data), nrow(data)))
## [1] "After filtering outliers: 297 cells and 16148 genes"
# For raw count data, we would typically do LogNormalization:
data <- NormalizeData(object=data, normalization.method="LogNormalize", scale.factor=10000)
# Again, these are the defaults, generate 2000 features using the "vst" feature selection method
data <- FindVariableFeatures(object=data, selection.method="vst", nfeatures=2000)


# Rescale all the genes
scale_genes <- rownames(data)
# If this takes too long, you can only rescale the variable genes
# scale_genes <- VariableFeatures(object=data)
data <- ScaleData(object=data, features=scale_genes)
## Centering and scaling data matrix
# Use the highly variable genes to find principal components
data <- RunPCA(object=data, features=VariableFeatures(object=data))
## PC_ 1 
## Positive:  Ifi205-1136, Dcn-2135, Mnda-1133, Gpx3-2938, Ly6a-7443, Sod3-16613, Dpt-996, Lum-2136, Mndal-1132, C3-9726 
##     Gsn-11656, Ly6c1-7444, Mmp2-21816, C1ra-18639, Adgrd1-17330, Htra3-16534, Igfbp6-7942, Gpc3-24011, Ogn-5614, Gfpt2-2829 
##     Tgfbr2-23477, Ly6c2-7445, Cd34-1311, Il11ra1-14773, Ifi204-1131, Prelp-780, Mgst1-18851, Col14a1-7345, Adamts5-8592, Pdpn-15974 
## Negative:  Slc24a5-12605, Tyrp1-15102, Pmel-2378, Dct-7104, Syngr1-7597, Slc45a2-7201, Chchd10-1770, Cpe-21484, Mlana-10896, Arhgdib-18843 
##     Syt4-10032, Car14-14082, Fabp5-13482, Ldhb-18878, Ptgds-11407, Fkbp6-17389, Tyr-20178, Tspan10-4370, Slc38a1-7787, Pianp-18666 
##     Glrb-13779, Insc-20609, Mpzl1-1005, Rab38-20182, Tpi1-18654, Eps8-18847, Fam60a-18945, Aph1c-22996, Gsta1-23088, Bfsp2-23257 
## PC_ 2 
## Positive:  Pdgfrb-10287, Acta2-10930, Myo1b-223, Itga1-6119, S1pr3-5628, Mfge8-20058, Sept4-3632, Col4a1-21108, Tusc5-3428, Gnb4-13571 
##     Mcam-22675, F2r-5978, Col4a2-21109, Rasl12-22970, Igfbp7-16751, Col18a1-1797, Rgs16-896, Rgs5-1034, Adgre5-21707, Heyl-15552 
##     Mylk-8348, Prkacb-14519, Atp1b2-3213, Rasgrp2-10601, Rgs4-1035, Ptp4a3-7419, Cspg4-22852, Esam-22536, Itga7-2390, Epas1-9877 
## Negative:  Apoe-19286, Sfn-15765, Perp-1401, Sbsn-19641, Lgals7-19560, Dsp-5529, Anxa8-6470, Cst6-10533, Epcam-9891, Dmkn-19642 
##     Psapl1-16540, Tacstd2-18176, Aadac-13705, Ckmt1-12565, S100a14-13939, Krt15-3919, Lypd3-19426, Fam84a-4502, Serpinb5-648, Fxyd3-19660 
##     Ly6d-7433, Apoc1-19285, Plet1-22767, Krt79-7935, Scel-7085, Trim29-22665, Rab25-13862, Pkib-1618, Krt14-3922, Plbd1-18833 
## PC_ 3 
## Positive:  Sdc1-4478, Jup-3931, Fam84a-4502, Sfn-15765, Emp2-8053, Psapl1-16540, Dsp-5529, Tacstd2-18176, Perp-1401, Epcam-9891 
##     Krt79-7935, Aadac-13705, Lypd3-19426, Ly6d-7433, Lgals7-19560, Gcnt2-5542, Hspb1-17403, Aldh3b2-10466, Pof1b-24394, Ly6g6e-9334 
##     Defb6-21188, Gm9817-5573, Plbd1-18833, Apoc1-19285, Plet1-22767, Ly6g6c-9332, S100a14-13939, Tpm2-14832, Rab25-13862, Krt77-7932 
## Negative:  Gpnmb-18034, Pmel-2378, Tyrp1-15102, Slc45a2-7201, Dct-7104, Mlana-10896, Met-17738, Car14-14082, Tyr-20178, Syt4-10032 
##     Ptgds-11407, Tspan10-4370, Atp6v0e2-18013, Fam174b-20038, Glrb-13779, Fkbp6-17389, Slc38a1-7787, Syngr1-7597, Insc-20609, Gsta1-23088 
##     Fbln5-4998, Trpm1-19993, Snca-18149, Bfsp2-23257, Nrcam-4632, Pax3-443, Nckap5l-7855, Gpr137b-5246, Pianp-18666, Sox10-7567 
## PC_ 4 
## Positive:  Emcn-14445, Icam2-4112, Gimap1-18024, Cdh13-22088, Cd300lg-4006, Pecam1-4115, Ramp3-2541, Gimap4-18022, Gimap6-18023, Cdh5-21886 
##     Gpihbp1-7451, Mmrn2-6479, Cd93-12846, Ednrb-7088, Adgrl4-14523, Afap1l1-10299, Ptprb-2225, Myct1-1332, Egfl7-11458, Gimap5-18026 
##     Ctla2a-5746, 8430408G22Rik-18549, Tspan8-2222, Vwa1-16211, Kdr-16726, Igfbp3-2545, S1pr1-14324, Gm12002-2566, Btnl9-2815, Ushbp1-21598 
## Negative:  Ckap2l-12682, H2afx-22684, Cdk1-1727, Kif22-20750, Mki67-20873, Anln-22444, Tacc3-16501, Tnc-15066, Pbk-6925, Ccna2-13599 
##     Kpna2-4123, Gm10184-9904, Cthrc1-7293, Prc1-20085, Kif20a-10075, Tpx2-12948, Timp1-23815, Cdca8-15585, Birc5-4313, Kif11-10958 
##     Ccnb1-6041, Spc25-11853, Cenpi-24457, Top2a-3849, Spc24-22418, Tpbg-23130, Hmmr-2736, Lhfpl2-5963, Asf1b-21711, Ndc80-9787 
## PC_ 5 
## Positive:  Krt5-7925, Ptn-17883, Col17a1-11124, Tgm5-12555, Nrtn-9703, Urah-20930, Gm973-292, Grem1-12454, Krt24-3855, Moxd1-1455 
##     Lgr5-2220, Cck-23526, Krt6a-7924, Tnc-15066, S100a4-13943, Sytl1-15753, Krt15-3919, Tenm2-2728, Dapk2-22987, Ltbp2-4884 
##     Tfap2b-71, Aqp3-14756, Tgfbi-5710, Tbx1-8179, Krt16-3923, Egfl6-24701, Fgf1-10167, Fam132a-16227, Mertk-12665, Gm15406-17648 
## Negative:  Mall-12654, Sh3bgrl2-23123, Tspan15-1677, Insig2-688, Ly6g6e-9334, Dcbld1-1597, Dsg1a-9992, Plbd1-18833, Tacstd2-18176, Psapl1-16540 
##     Aldh3b2-10466, Gsdma-3835, Pof1b-24394, 4833423E24Rik-12040, Adgrg1-21860, Pkib-1618, Gsdma2-3834, Dsg1b-9993, Dsg1c-9991, Tinagl1-15693 
##     Sh3gl2-15127, Nfe2l3-18050, Gltp-17107, Elovl4-23124, Atp6v1c2-4515, Cldn4-17375, Aadac-13705, Grhl1-4542, Mgll-18357, Gas7-3157
data <- RunTSNE(object=data, dims=1:15)
data <- FindNeighbors(data, dims = 1:15)
## Computing nearest neighbor graph
## Computing SNN
data <- FindClusters(object = data, resolution = 0.5)
## Modularity Optimizer version 1.3.0 by Ludo Waltman and Nees Jan van Eck
## 
## Number of nodes: 297
## Number of edges: 8050
## 
## Running Louvain algorithm...
## Maximum modularity in 10 random starts: 0.8163
## Number of communities: 5
## Elapsed time: 0 seconds

Now let us visualize the data by time,

DimPlot(object = data, reduction = "tsne", group.by = "Time")

by individual replicate,

DimPlot(object = data, reduction = "tsne", group.by = "Individual")

by the identified clusters,

DimPlot(object = data, reduction = "tsne")

Now, we get to the hero of this session, zinbwave. We will load the data in a fashion (i.e., as a SummarizedExperiment object) that zinbwave understands.

##zinbwave analyses
rawData <- ((as.matrix(data@assays$RNA@counts)))
PhenoData <- data.frame(data@meta.data)
row.names(PhenoData) <- colnames(rawData)
demoSE <- SummarizedExperiment(assays=list(counts=rawData), colData=PhenoData)

So far you have filtered the cells in Seurat. Now, we are going to filter out genes that may be less informative. I am going to use a pretty stringent threshold in this session. A gene is included for further analyses if it has a count of at least 30 in at least 30 cells. This is so that things run in a reasonably fast today. Please alter this threshold when you run your own analyses.

filter <- rowSums(assay(demoSE)>30)>30
table(filter)
## filter
## FALSE  TRUE 
##  8450  7698
demoSE <- demoSE[filter,]
assayNames(demoSE)[1] <- "counts"

Now we will run (or not,:)) the main analyses associated with zinbwave. Each of these commands takes around 15 minutes. So we will not run these today. I have provided the resulting output as an R object that you can load for further analyses. Note, these commands can work quicker if you have multiple cores on your machine. If you don’t then do not include the BPPARAM option in the command. Also, it is important to note that this normalization takes into account variation is gene detection rate (as nFeature_RNA) to potentially model (out) potential technical sources of variation

# ###if you have multiple cores on your machine you can run the following commands to use 4 cores
# default <- registered()
# register(SnowParam(workers = 4), default = TRUE)
# names(registered())
# 
# ###this command provides all the model parameter estimates. It is useful when you want to estimate the model fit. This is specifically where you want to decide on the best low-dimensional representation of your data. That is, the best choice for the parameter K. We will run this only for the K=0 option during this session 
# demoModel <- zinbFit(demoSE, X="~nFeature_RNA", K=0, BPPARAM = BiocParallel::bpparam())
# 
# ###This command provides a low-dimensional representation of the normalized data. We chose K=2 here. But ideally, you want to choose K based on the Akaike Information Criterion (AIC) using the above model fits for different values of K
# demo_2 <- zinbwave(demoSE, X="~nFeature_RNA", K=2, BPPARAM = BiocParallel::bpparam())
# 
# ###This command will have the weights we will use in the edgeR-based gene expression analyses
# demo_0 <- zinbwave(demoSE, X="~nFeature_RNA", K=0, BPPARAM = BiocParallel::bpparam())
# 
# save.image(file = "demo_Model_K_0_and_2.RData")
load("demo_Model_K_0_and_2.RData")

We can now ask Seurat to use the normalized data from znbwave to visualize,

require(Seurat)
##Use zinb normalized/reduced-dimension data in seurat
data <- as.Seurat(x = demo_2, counts = "counts", data = "counts")
##reduction="zinbwave" is how we tell Seurat to work with the zinbwave data
data <- FindNeighbors(data, reduction = "zinbwave",
                     dims = 1:2 #this should match K
)
## Computing nearest neighbor graph
## Computing SNN
data <- FindClusters(object = data, resolution = 0.5)
## Modularity Optimizer version 1.3.0 by Ludo Waltman and Nees Jan van Eck
## 
## Number of nodes: 297
## Number of edges: 6610
## 
## Running Louvain algorithm...
## Maximum modularity in 10 random starts: 0.8430
## Number of communities: 4
## Elapsed time: 0 seconds
data <- RunTSNE(object=data, dims=1:2, reduction = "zinbwave")

Now again, let us visualize the normalized data by time,

DimPlot(object = data, reduction = "tsne", group.by = "Time")

by individual replicate,

DimPlot(object = data, reduction = "tsne", group.by = "Individual")

by the identified clusters,

DimPlot(object = data, reduction = "tsne")

We are now going to perform gene expression association analyses. Before, doing that we need to ensure that we have defined all the variables of interest - time, cluster, individual/replicate..

Clusters <- data@active.ident
NClusters <- length(unique(Clusters))

##add cluster variable to the phenotype matrix
PhenoData <- cbind(PhenoData, Clusters)
print(levels(PhenoData$Clusters))
## [1] "0" "1" "2" "3"
##check the reference level of the time variable and we are making sure to have Day 5 as the reference level
print(levels(PhenoData$Time))
## [1] "11 day" "5 day"
PhenoData$Time <- relevel(PhenoData$Time, ref = "5 day")
print(levels(PhenoData$Time))
## [1] "5 day"  "11 day"
###The experimental design that the researchers chose, had two replicates per time-point in these facs sorted cells. So we have a hierarchical design - for a given time-point, two individuals are chosen. We are therefore going to relabel the individuals to reflect this.
##rename the individuals
Individuals01 <- PhenoData$Individual
##Day 5 individuals
Day5Individuals <- unique(PhenoData$Individual[PhenoData$Time=="5 day"])
for(i in 1:length(Day5Individuals)) {
  Individuals01[PhenoData$Individual == Day5Individuals[i]] <- i-1
}
##Day 5 individuals
Day11Individuals <- unique(PhenoData$Individual[PhenoData$Time=="11 day"])
for(i in 1:length(Day11Individuals)) {
  Individuals01[PhenoData$Individual == Day11Individuals[i]] <- i-1
}

##Add this to the PhenoData matrix
PhenoData <- data.frame(PhenoData, Individuals01)

Let us now define our model for variation of gene expression,

design <- model.matrix(~nFeature_RNA + Clusters +  Time:Individuals01 + Time + Clusters:Time, data = PhenoData)

We are modeling the variation of expression as a function of time, the underlying heterogenity of the cells types as captured by the cluster membership, the interaction between these two variables, the individuals from which these cells are drawn and of course potential technical sources of variation as capture by the gene detection rate.

Now, we are ready to bring in our supporting hero, edgeR.

##association analyses with DiffTime
require(edgeR)
##get the weights from the zinbwave model fit
weights <- assay(demo_0, "weights")
##get the raw counts
FullCounts <- assay(demo_0)

##define the edgeR object
dge <- DGEList(FullCounts)
##normalize the gene counts across cells
dge <- calcNormFactors(dge)

dge$weights <- weights

##estimate dispersion (variance of expression across cells taking into account the underlying experiment design and using the weights output from zinbwave)
dge <- estimateDisp(dge, design)

##fit the linear model
fit <- glmFit(dge, design)

save(fit, dge, PhenoData, design, file = "demo_edgeR_zinbwave_data.RData")

Now we need to decide on a composite set of null hypothesis to test,

load("demo_edgeR_zinbwave_data.RData")
Coef <-  fit$coefficients
head(Coef)
##            (Intercept)  nFeature_RNA  Clusters1  Clusters2   Clusters3
## Mrpl15-5     -7.779449 -4.751778e-05 -1.0613326 -1.6051696 -0.78178168
## Lypla1-6     -8.640014  6.522438e-05 -0.8470387 -0.6909305 -0.04599329
## Tcea1-7      -8.275792 -8.486999e-06 -0.3937849 -0.2279253 -0.24790387
## Atp6v1h-10   -7.930578 -2.333361e-05 -0.4721440 -0.7752748 -0.86097747
## Rb1cc1-13    -7.961600 -2.692627e-04 -0.2844882 -0.3400442  0.21464388
## Pcmtd1-17    -6.937072 -2.220689e-04 -0.7805309 -0.8805969 -1.25209418
##             Time11 day Time5 day:Individuals01 Time11 day:Individuals01
## Mrpl15-5   -1.02181619              -0.4405701               0.32179474
## Lypla1-6   -0.79085454              -0.1657279              -0.08418160
## Tcea1-7    -0.61033166              -0.4802350              -0.05434911
## Atp6v1h-10 -0.90173335              -0.3527641               0.07687263
## Rb1cc1-13   0.02062364               0.3802402              -0.57400884
## Pcmtd1-17  -1.14090321              -0.5063789              -0.44790668
##            Clusters1:Time11 day Clusters2:Time11 day Clusters3:Time11 day
## Mrpl15-5              0.2443207            1.1609487         -0.082145925
## Lypla1-6              0.7641074            0.4946317         -0.003797203
## Tcea1-7               0.2557501            0.1172133          0.055672533
## Atp6v1h-10            0.6707745            0.5180059          0.474968267
## Rb1cc1-13             0.6605374            0.9014563          0.031325966
## Pcmtd1-17            -0.1156259            0.9092156          0.818760500
UseCoefIndices <- c(6, 9, 10, 11)
lrt <- glmWeightedF(fit, coef = UseCoefIndices)

top <- (topTags(lrt, n=nrow(FullCounts)))$table
write.csv(top, "DiffTimeAssociation_demo.csv")

We are now going to further parse out the pattern of behavior of genes that passed the statistical significance threshold (FDR < 0.05). We will use the normalized data from zinbwave and cluster these data using hopach.

##generate heatmap of differentially expressed genes
DiffExpResults <- read.csv("DiffTimeAssociation_demo.csv", header = T)

ChooseGenes <- (DiffExpResults$FDR < 0.05)
sum(ChooseGenes)
## [1] 978
##Normalized data from zinbwave
NormData <- computeDevianceResiduals(demoModel, t(assay(demo_2)), ignoreW = TRUE)
NormData <- t(NormData)
TempIndices <- match((DiffExpResults$X)[ChooseGenes], row.names(NormData))
NormData <- NormData[TempIndices, ]

Time <- PhenoData$Time
Clusters <- PhenoData$Clusters
TimeClusters <- paste(Time, Clusters, sep="_")


NormDataReorder <- NormData[,order(TimeClusters)]
NormDataReorder <- NormDataReorder[complete.cases(NormDataReorder),]

##Use hopach to cluster the genes
require(hopach)
ClusterD <- NormDataReorder
pept.dist <- distancematrix(ClusterD,"cosangle")
pept.hobj <- hopach(ClusterD, dmat=pept.dist, clusters="best", initord="clust")
NClust <- pept.hobj$clust$k
Sizes <- pept.hobj$clust$sizes
MedoidPeps <- pept.hobj$clust$medoids
Order <- pept.hobj$clust$order

makeoutput(ClusterD,pept.hobj,file="HopachOutput_demo.txt")
ClusterInfo <- read.table("HopachOutput_demo.txt", header = TRUE)

We are now to visulize the patterns in resulting clusters using pheatmap and ggplot2.

Gaps <- vector(mode = "numeric")
Gaps[1] <- Sizes[1] + 1
if(NClust > 2) {
  for(i in 2:(NClust-1)) {
    Gaps[i] <- Gaps[i-1] + Sizes[i]
  }
}

GeneExpression2View <- ClusterD[order(ClusterInfo$Final.Level.Order), ]
simpleredbluecols = colorRampPalette(c("blue","white","red"))(200)
ClustersHeatMap <- Clusters[order(TimeClusters)]
TimeHeatMap <- Time[order(TimeClusters)]

df <- data.frame(Clusters=ClustersHeatMap, Time=TimeHeatMap)
GeneExpression2View_Center <- GeneExpression2View
row.names(df) <- colnames(GeneExpression2View_Center)

require(pheatmap)
paletteLength <- 200
GeneExpression2View_Center_Limit <- GeneExpression2View_Center
GeneExpression2View_Center_Limit[GeneExpression2View_Center_Limit > 3] <- 3
GeneExpression2View_Center_Limit[GeneExpression2View_Center_Limit < -3] <- -3

# myBreaks <- c(seq(min(GeneExpression2View_Center, na.rm = TRUE), 0, length.out=ceiling(paletteLength/2) + 1),
#               seq(max(GeneExpression2View_Center, na.rm = TRUE)/paletteLength, max(GeneExpression2View_Center, na.rm=TRUE), length.out=floor(paletteLength/2)))

myBreaks <- c(seq(min(GeneExpression2View_Center_Limit, na.rm = TRUE), 0, length.out=ceiling(paletteLength/2) + 1), 
              seq(max(GeneExpression2View_Center_Limit, na.rm = TRUE)/paletteLength, max(GeneExpression2View_Center_Limit, na.rm=TRUE), length.out=floor(paletteLength/2)))

##View the results using pheatmap
# pdf("demo_heatmap_diff_exp_genes.pdf")
pheatmap(GeneExpression2View_Center_Limit, cluster_rows=FALSE, show_rownames=FALSE, show_colnames=FALSE, cluster_cols=FALSE, annotation_col=df, color = simpleredbluecols, breaks = myBreaks, gaps_row=Gaps)

# dev.off()

# pdf("HOPACH_cluster_profiles_demo.pdf")
for(i in 1:NClust) {
  print(i)
  PlotData  <- data.frame(cbind(y=(ClusterD[MedoidPeps[i],])))
  PlotData <- cbind(TimeClusters=TimeClusters[order(TimeClusters)], PlotData)
  p <- ggplot(PlotData, aes(TimeClusters, y)) + geom_boxplot()  + xlab("Condition") + ylab("Mediod gene expression") + ggtitle(paste("Cluster", i, "; Size = ", Sizes[i])) 
  
  p <- p + coord_flip()
  print(p)
}
## [1] 1

## [1] 2

## [1] 3

## [1] 4

## [1] 5

## [1] 6

## [1] 7

## [1] 8

## [1] 9

# dev.off()

Cd34 one of the markers of the cancer associated fibroblasts that is highlighted in the manuscript makes the list of genes whose expression is associated with time. Let us find out which cluster it belongs to.

print(ClusterInfo$Cluster.Label[grep("Cd34", ClusterInfo$UID)])
## [1] 9