參考：
測試所用的數據鏈接: https://pan.baidu.com/s/1TUysqHHbXrWGi7QGt-6L1g 提取碼: uqgh
Monocle[7]是一個基于pseudotime分析的軟件包。它通過從一系列差異表達的基因來描述細胞間的距離遠近，由此得到類似樹狀的分叉圖象來表示細胞間的差異性。 提供了聚類，pseudotime, 差異分析等多種功能，該項目的網址如下
主要內容
1. 讀取數據
2.預處理過濾細胞
3. 細胞分群/聚類
? ? step1：dispersionTable()
? ? step2：plot_pc_variance_explained() 耗時
? ? step3: 進行降維和聚類
4.篩選基因(用于擬分析時序)
? ? 4.1 一般過濾標準
? ? 4.2 使用差異表達基因BEAM分析
5.推斷發育軌跡
? ? 5.1. 選合適基因
? ? 5.2 降維
? ? 5.3 細胞排序
小結：
主要介紹使用該R包進行pseudotime分析的步驟.
Tips : pseudotime分析本質上就是輸入基因及其表達量矩陣，計算擬時序的值。并且選取一些基因，用于降維可視化。聚類只是降維后顏色填充而已.
1. 讀取數據
monocle包有很多種讀取數據的方式 ，這里只展示其中三種：（I）直接讀取;（II）來源于seurat2 包; （III）來源于seurat3包。
Tips : 由于版本更替較快，seurat2 可以直接導入monocle2.但是seurat3卻要手動寫代碼導入.
library(monocle)
library(DDRTree)
library(pheatmap)
library(data.table)
library(plyr)
下面以10x 數據為例，最好通過seurat對象直接讀入monocle2 方便一些.
（1）直接讀取： 當有三個文件，expr_matrix ; sample_info ;gene_annotation.
expr_matrix <- read.delim(nUMI.summary.file)
sample_info <- data.frame(sampleID=colnames(expr_matrix))
gene_annotation <- data.frame(symbol=rownames(expr_matrix))
pd <- new("AnnotatedDataFrame", data = sample_info)
fd <- new("AnnotatedDataFrame", data = gene_annotation)
d <- newCellDataSet(as.matrix(expr_matrix), phenoData = pd, featureData = fd)
（2）來源于seurat2 包，數據如下：
## 切換到工作目錄，讀入三個文本文件.
pbmc.data <- Read10X(data.dir = ".")
pbmc <- CreateSeuratObject(counts = pbmc.data, project = "10XPBMC")
## seurat2 可以直接讀入
sce <- importCDS(pbmc)
（3） 來源于seurat3包：
差別之處，不能直接用importCDS 導入.
## 由seurat3 導入函數newimport 替代上面的importCDS功能.
newimport <- function(otherCDS, import_all = FALSE) {
if(class(otherCDS)[1] == 'Seurat') {
requireNamespace("Seurat")
data <- otherCDS@assays$RNA@counts
if(class(data) == "data.frame") {
data <- as(as.matrix(data), "sparseMatrix")
}
pd <- tryCatch( {
pd <- new("AnnotatedDataFrame", data = otherCDS@meta.data)
pd
},
#warning = function(w) { },
error = function(e) {
pData <- data.frame(cell_id = colnames(data), row.names = colnames(data))
pd <- new("AnnotatedDataFrame", data = pData)
message("This Seurat object doesn't provide any meta data");
pd
})
# remove filtered cells from Seurat
if(length(setdiff(colnames(data), rownames(pd))) > 0) {
data <- data[, rownames(pd)]
}
fData <- data.frame(gene_short_name = row.names(data), row.names = row.names(data))
fd <- new("AnnotatedDataFrame", data = fData)
lowerDetectionLimit <- 0
if(all(data == floor(data))) {
expressionFamily <- negbinomial.size()
} else if(any(data < 0)){
expressionFamily <- uninormal()
} else {
expressionFamily <- tobit()
}
valid_data <- data[, row.names(pd)]
monocle_cds <- newCellDataSet(data,
phenoData = pd,
featureData = fd,
lowerDetectionLimit=lowerDetectionLimit,
expressionFamily=expressionFamily)
if(import_all) {
if("Monocle" %in% names(otherCDS@misc)) {
otherCDS@misc$Monocle@auxClusteringData$seurat <- NULL
otherCDS@misc$Monocle@auxClusteringData$scran <- NULL
monocle_cds <- otherCDS@misc$Monocle
mist_list <- otherCDS
} else {
# mist_list <- list(ident = ident)
mist_list <- otherCDS
}
} else {
mist_list <- list()
}
if(1==1) {
var.genes <- setOrderingFilter(monocle_cds, otherCDS@assays$RNA@var.features)
}
monocle_cds@auxClusteringData$seurat <- mist_list
} else if (class(otherCDS)[1] == 'SCESet') {
requireNamespace("scater")
message('Converting the exprs data in log scale back to original scale ...')
data <- 2^otherCDS@assayData$exprs - otherCDS@logExprsOffset
fd <- otherCDS@featureData
pd <- otherCDS@phenoData
experimentData = otherCDS@experimentData
if("is.expr" %in% slotNames(otherCDS))
lowerDetectionLimit <- otherCDS@is.expr
else
lowerDetectionLimit <- 1
if(all(data == floor(data))) {
expressionFamily <- negbinomial.size()
} else if(any(data < 0)){
expressionFamily <- uninormal()
} else {
expressionFamily <- tobit()
}
if(import_all) {
# mist_list <- list(iotherCDS@sc3,
# otherCDS@reducedDimension)
mist_list <- otherCDS
} else {
mist_list <- list()
}
monocle_cds <- newCellDataSet(data,
phenoData = pd,
featureData = fd,
lowerDetectionLimit=lowerDetectionLimit,
expressionFamily=expressionFamily)
# monocle_cds@auxClusteringData$sc3 <- otherCDS@sc3
# monocle_cds@auxOrderingData$scran <- mist_list
monocle_cds@auxOrderingData$scran <- mist_list
} else {
stop('the object type you want to export to is not supported yet')
}
return(monocle_cds)
}
導入monocle2
## 讀入seurat3
pbmc.data <- Read10X(data.dir = ".")
pbmc <- CreateSeuratObject(counts = pbmc.data, project = "10XPBMC")
## 讀入monocle2
sce <- newimport(pbmc)
本文采用第1種方式，讀入文件
library(Seurat)
library(monocle)
expression_matrix <- readRDS("packer_embryo_expression.rds")
cell_metadata <- readRDS("packer_embryo_colData.rds")
gene_annotation <- readRDS("packer_embryo_rowData.rds")
## 數據框需要先保存為AnnotatedDataFrame 格式，才可以創建newCellDataSet 對象
# Error: CellDataSet 'phenoData' is class 'data.frame' but should be or extend 'AnnotatedDataFrame'
pd <- new("AnnotatedDataFrame", data = cell_metadata)
fd <- new("AnnotatedDataFrame", data = gene_annotation)
sce <- newCellDataSet(expression_matrix,
phenoData = pd,
featureData = fd,
lowerDetectionLimit = 0.1,
expressionFamily = VGAM::negbinomial.size()) # 默認參數
查看sce 類型：
> sce
CellDataSet (storageMode: environment)
assayData: 20222 features, 6188 samples
element names: exprs
protocolData: none
phenoData
sampleNames: AAACCTGCAAGACGTG-300.1.1 AAACCTGGTGTGAATA-300.1.1 ...
TTTGTCAAGTACACCT-b02 (6188 total)
varLabels: cell n.umi ... State (21 total)
varMetadata: labelDescription
featureData
featureNames: WBGene00010957 WBGene00010958 ... WBGene00007064 (20222 total)
fvarLabels: id gene_short_name num_cells_expressed use_for_ordering
fvarMetadata: labelDescription
experimentData: use 'experimentData(object)'
Annotation:
查看一下數據讀入到monocle2里面，它的表達分布類型：
sce@expressionFamily
## Family: negbinomial.size
##
## Negative-binomial distribution with size known
##
## Links: loge(mu)
## Mean: mu
## Variance: mu * (1 + mu / size) for NB-2
? 注意到構建CDS對象過程中有一個參數是：expressionFamily ，它是選擇了一個數據分布，例如FPKM/TPM 值是log-正態分布的；UMIs和原始count值用負二項分布模擬的效果更好。負二項分布有兩種方法，這里選用了negbinomial.size，另外一種negbinomial稍微更準確一點，但速度大打折扣，它主要針對非常小的數據集，如下表：
由于輸入10x genomic 數count 類似，所以表達分布為 negbinomial.size()
| Family function | 數據類型 | 備注 |
|---|---|---|
| negbinomial.size() | 原始計數值, 比如UMIs counts | Negative binomial distribution with fixed variance |
| negbinomial() | 原始計數值, 比如UMIs counts | 比negbinomial.size()精確一點, 但是非常慢. |
| tobit() | FPKM, TPM | Tobits are truncated normal distributions. 注意這點不是log-transformed FPKM/TPM |
| gaussianff() | log-transformed FPKM/TPMs, Ct values from single-cell qPCR | 符合高期分布的數值 |
2.預處理
和處理RNA-seq數據一樣，monocle會有一些預處理的步驟，這包括估計size factors和dispersions，以及去除一些質量比較差的細胞。
第一行代碼用于評估每個細胞的sizefactor, 用于后續歸一化；
第二行代碼計算基因的方差,這一步可能會提醒我們有多少的outlier的細胞。所以下一步就是要去除掉這些細胞。
cds <- estimateSizeFactors(cds)
cds <- estimateDispersions(cds)
# Removing 143 outliers
通過pData和fData兩個函數，可以查看基因和細胞的相關信息，示意如下
- 查看細胞注釋信息：pData.
- 查看基因注釋信息：fData
過濾細胞
在準備樣品細胞的過程中，不可避免地會引入一下死的細胞，或者說是doublets(兩個細胞被標記成一個細胞)。 這些細胞對下游分析的影響會比較大，它們很有可能會占去很大分析權重。所以我們需要把它們去除掉。 去除它們的辦法就是設置一個比較合理的表達總值的上下限，然后把處于上下限外圍的細胞都去除掉。
- 首先我們來查看一下低表達的基因。
### detectGenes計算每一個細胞表達的基因個數.
sce <- detectGenes(sce, min_expr = 0.1)
### 保留在10個細胞中表達的基因，當做表達基因.
expressed_genes <- row.names(subset(fData(sce),
num_cells_expressed >= 10))
我們將表達值在10以上的基因保存為expressed_genes。下面的步驟會用到保存好的表達的基因。
-
接下來我們要去除掉死細胞或者doublets了。
head(pData(sce))
一般的，我們是沒有數據告訴我們哪些細胞是死的或者空的，哪些細胞是doublets的。但是通常而方言，我們都會拿到RPC(reads per cell)的計數，我們可以人為的設定一下表達總值的上下限。
pData(sce)$Total_mRNAs <- Matrix::colSums(exprs(sce))
sce <- sce[, pData(sce)$Total_mRNAs < 1e6 ]
##設置上下限：
upper_bound <- 10^(mean(log10(pData(sce)$Total_mRNAs)) +
2*sd(log10(pData(sce)$Total_mRNAs)))
lower_bound <- 10^(mean(log10(pData(sce)$Total_mRNAs)) -
2*sd(log10(pData(sce)$Total_mRNAs)))
## 可視化
qplot(Total_mRNAs, data = pData(sce), geom = "density") +
geom_vline(xintercept = lower_bound) +
geom_vline(xintercept = upper_bound) + xlim(0, 6000)+
theme_classic()
可視化RPC(reads per cell) 分布
過濾不合格細胞
## 保留下通過標準的細胞
sce <- sce[,pData(sce)$Total_mRNAs > lower_bound &
pData(sce)$Total_mRNAs < upper_bound]
## 新的sce 數據,評估細胞表達基因數.
sce <- detectGenes(sce, min_expr = 0.1)
> sce
CellDataSet (storageMode: environment)
assayData: 20222 features, 5943 samples
element names: exprs
protocolData: none
phenoData
sampleNames: AAACCTGCAAGACGTG-300.1.1 AAACCTGGTGTGAATA-300.1.1
... TTTGTCAAGTACACCT-b02 (5943 total)
varLabels: cell n.umi ... Total_mRNAs (20 total)
varMetadata: labelDescription
featureData
featureNames: WBGene00010957 WBGene00010958 ... WBGene00007064
(20222 total)
fvarLabels: id gene_short_name num_cells_expressed
fvarMetadata: labelDescription
experimentData: use 'experimentData(object)'
Annotation:
細胞數目有6188 變成現在的5943個.
檢查過濾細胞的效果，過濾后的值基本上是符合lognormal分布的。
# Log-transform each value in the expression matrix.
L <- log(exprs(sce[expressed_genes,]))
# Standardize each gene, so that they are all on the same scale,
# Then melt the data with plyr so we can plot it easily
melted_dens_df <- melt(Matrix::t(scale(Matrix::t(L))))
# Plot the distribution of the standardized gene expression values.
qplot(value, geom = "density", data = melted_dens_df) +
stat_function(fun = dnorm, size = 0.5, color = 'red') +
xlab("Standardized log(counts)") +
ylab("Density")
理想的圖：
得到過濾后的矩陣，可以分別進行聚類和擬時序分析.
3. 細胞分群/聚類
不使用marker 基因的細胞分類方法
使用函數clusterCells()，根據整體的表達量對細胞進行分組。例如，細胞表達了大量的與成肌細胞相關的基因，但就是沒有成肌細胞的marker--MYF5 ，我們依然可以判斷這個細胞屬于成肌細胞。
step1：dispersionTable()
首先就是判斷使用哪些基因進行細胞分群。當然，可以使用全部基因，但這會摻雜很多表達量不高而檢測不出來的基因，反而會增加噪音。挑有差異的，挑表達量不太低的
disp_table <- dispersionTable(sce)
unsup_clustering_genes <- subset(disp_table,
mean_expression >= 0.1) ## 數值因實驗而不同
sce <- setOrderingFilter(sce, unsup_clustering_genes$gene_id)
plot_ordering_genes(sce)
其中, setOrderingFilter函數設置了將來會用于分群的細胞。這一步對于分群非常關鍵，所以可以試著使用不同的方法來過濾基因，以期達到滿意的效果。
plot_ordering_genes根據這些基因的平均表達水平展示了基因的表達差異程度，紅線表示Monocle基于這種關系對分散的期望。 上圖中實黑的為會使用的基因，灰色的是過濾掉的基因。
step2：plot_pc_variance_explained() 耗時
然后選一下主成分
plot_pc_variance_explained(cds, return_all = F,max_components = 100) # norm_method='log'
上圖與Seurat中使用到的PCElbowPlot類似，我們可以看到大約多少的PC將會被我們使用。 可以看到大約在15的時候就已經到的平原區了。下面試著分群。
step3: 進行降維和聚類
根據上面??的圖，選擇合適的主成分數量（這個很主觀，可以多試幾次），這里選前15個成分（需要注意的 使用主成分會影響后面結果）
關于處理批次效應：例如在芯片數據中經常會利用SVA的combat函數。
磨平批次效應實際上就是去掉各個組的前幾個主成分
# 進行降維 ，設置降維維度15.
cds <- reduceDimension(sce, max_components = 2, norm_method = 'log',
num_dim = 15, reduction_method = "tSNE", verbose = TRUE)
# Remove noise by PCA ...
# Reduce dimension by tSNE ...
### 如果需要去除批次效應(batch 和 幾群細胞基因表達量數目)
# cds <- reduceDimension(cds, max_components = 2, num_dim = 6,
# reduction_method = 'tSNE',
# residualModelFormulaStr = "~batch + #num_genes_expressed",
# verbose = T)
# 進行聚類 （指定cluster為4的時候，只能畫出來3個,為什么？）
cds <- clusterCells(cds, num_clusters = 4)
# Distance cutoff calculated to 4.826512
## 查看聚類效果
head(cds@phenoData@data)
# 查看tSNE圖
plot_cell_clusters(cds,x=1,y=2, color_by = "Cluster")
# 畫具體基因的表達分布圖
#plot_cell_clusters(HSMM, 1, 2, color = "Cluster",
# + markers = c("CDC20", "GABPB2"))
4.篩選基因(用于擬分析時序)
4.1 一般過濾標準
篩選基因沒有一個固定標準，可以根據自己的需要靈活選擇，這里只展示其中1種 .
disp_table <- dispersionTable(sce)
unsup_clustering_genes <- subset(disp_table, mean_expression >= 0.1)
## 得到用于擬時序分析基因
ordering_genes <- row.names(unsup_clustering_genes)
4.2 使用差異表達基因
對于差異表達分析，可以像RNA-seq一樣，直接到不同屬性的樣品進行分析
fullModelFormulaStr ： 分組進行差異分析的變量.
我們可以看到，只要有不同的pData屬性，我們都可以做差異表達分析。比如State：
## 差異分析非常耗時，運行時間在幾分鐘至十幾分鐘不等
diff_test_res <- differentialGeneTest(sce[expressed_genes, ],
fullModelFormulaStr = "Cluster")
sig_genes <- subset(diff_test_res, qval < 0.1)
sig_genes[1:6,c("gene_short_name", "pval", "qval")]
## 得到用于擬時序分析基因
ordering_genes <- row.names(sig_genes)
下面是可選部分??
再比如 Pseudotime
diff_test_res <- differentialGeneTest(sce[expressed_genes, ],
fullModelFormulaStr = "~sm.ns(Pseudotime)")
sig_genes <- subset(diff_test_res, qval < 0.1)
sig_genes[1:6,c("gene_short_name", "pval", "qval")]
作圖（注意要將基因名變成character）
cg=as.character(head(sig_genes$gene_short_name))
# 普通圖
plot_genes_jitter(sce[cg,],
grouping = "State", ncol= 2)
# 還能上色
plot_genes_jitter(sce[cg,],
grouping = "State",
color_by = "State",
nrow= 3,
ncol = NULL )
還可以繪制熱圖
sig_genes <- sig_genes[order(sig_genes$qval), ]
plot_pseudotime_heatmap(sce[row.names(sig_genes)[1:20],],
num_clusters = 3,
cores = 1,
show_rownames = T)
得到類似圖
BEAM分析
BEAM分析的目的是比較分枝點與分枝末端的差異。
BEAM_res <- BEAM(sce[expressed_genes, ], branch_point = 1, cores = 4)
BEAM_res <- BEAM_res[order(BEAM_res$qval),]
BEAM_res <- BEAM_res[,c("gene_short_name", "pval", "qval")]
plot_genes_branched_heatmap(sce[row.names(subset(BEAM_res,
qval < 1e-4)),],
branch_point = 1,
num_clusters = 4,
cores = 1,
use_gene_short_name = T,
show_rownames = T)
可以針對基因做圖
plot_genes_branched_pseudotime(sce[rownames(subset(BEAM_res, qval < 1e-8)), ],
branch_point = 1, color_by = "orig.ident",
ncol = 3)
上面是可選部分 ??.
5.推斷發育軌跡
用上面過濾的基因進行降維， 以方便下一步將細胞分布到不同的狀態之間，可視化擬時序得分.
5.1: choosing genes that define progress
5.2: reducing the dimensionality of the data
5.3: ordering the cells in pseudotime
5.1. 選合適基因
得到上面兩種過濾的基因集：unsup_clustering_genes 或者 diff_test_res，選取合適基因進行排序.
## 以差異基因為例：
## ordering_genes <- row.names (subset(diff_test_res, qval < 0.01))
cds <- setOrderingFilter(cds, ordering_genes)
plot_ordering_genes(cds)
5.2 降維
默認使用DDRTree的方法進行降維分析，代碼如下
cds <- reduceDimension(
cds,
max_components = 2,
method = 'DDRTree')
5.3 細胞排序
然后就是細胞排序 ，代碼如下：
cds <- orderCells(cds)
運行之后，對于每個細胞，會給出一個pseudotime值，示意如下
可視化代碼：
- 默認用"state" 填充。應該是cluster 含義.
plot_cell_trajectory(sce)
- 降維之后，在二維空間展示細胞pseudotime的分布，可以看到是一個樹狀結構，除了上述方法外，還可以根據pseudotime的值給細胞賦顏色，代碼如下
plot_cell_trajectory(sce, color_by = "Pseudotime")
其實就是將fData中對應的列設置為顏色，如果想要觀察不同細胞亞型的分布，可以在fData中新增一列細胞對應的cluster ID, 然后用這一類來設置顏色。
對于pseudotime分析，我們需要明白它的基本輸入就是一張基因在細胞中表達量的表格，與細胞的聚類結果無關，只不過在可視化的時候根據聚類的結果填充了顏色而已。
另外，plot_genes_in_pseudotime 可以對基因在不同細胞中的表達量變化進行繪圖
plot_genes_in_pseudotime(cds[cg,],
color_by = "State")
小結：
【Workflow以及與Seurat的異同】
-
①創建CellDataSet對象（下簡稱CDS對象）
若要創建新的CDS對象，則需要整理出3個輸入文件（基因-細胞表達矩陣、細胞-細胞特征注釋矩陣、基因-基因特征注釋矩陣），但方便的是，Monocle支持從Seurat中直接導入對象，通過importCDS命令實現。
在創建之后，也會進行數據過濾和標準化，不同的是Seurat是基于作圖的方法去篩選掉異常的細胞，而Monocle的過濾方法則是根據表達數據的數學關系來實現。
上限：image.png
其中X為基因表達總數, n 為細胞數，sd為表達水平方差
大概就是以一個大致的細胞表達水平為基準，表達量太高的跟太低的去除掉。
②通過已知的Marker基因分類細胞
方法一：通過一些現有的生物/醫學知識手動賦予它們細胞名，將這些細胞分為幾大類，然后再聚類細胞。
方法二：與Seurat包的分類細胞方法類似，篩選出差異表達基因用于聚類，然后再根據每一個cluster的marker賦予細胞名。③聚類細胞
采用的也是t-SNE算法。-
④將細胞按照偽時間的順序排列在軌跡上
Step1：選擇輸入基因用于機器學習
這個過程稱為feature selection（特征選擇），這些基因對軌跡的形狀有著最重要的影響。我們應該要選擇的是最能反映細胞狀態的基因。
如果直接通過Seurat輸出的一些重要的基因（比如每個cluster中的高FC值基因）作為輸入對象的話就能夠實現一個“無監督”分析。或者也可以利用生物學知識手動選擇一些重要的基因進行“半監督”分析。Step2：數據降維
利用Reversed graph embedding算法將數據降維。
相對于PCA來說這個算法更能夠反應數據的內部結構（據monocle網站說是這樣）Step3：將細胞按照偽時間排序
這個過程稱為manifold learning（流形學習）。Monocle利用軌跡來描述細胞如何從一個狀態轉換到另一個狀態。得到的是一個樹狀圖，樹的根部或樹干表示的是細胞最初的狀態（如果有的話），隨著細胞的變化就沿著分叉樹枝發展。一個細胞的偽時間值（pseudotime value）為它的位置沿著樹枝到根部的距離。
分析scRNA-seq的數據的關鍵在于如何對細胞進行cluster。這其中有很多的算法，而之后的降維分析比如tSNE其實主要還是為了數據圖形化顯示方便。在細胞分群之后，差異表達分析其實與第三章的RNA-seq并無二致，我們只需要對需要比較的因素做到心中有數即可。
