【单细胞轨迹分析】monocle2

其实在前面也提到过Pseudotime分析，拟时间序列分析（Pseudotime分析）是通过构建细胞间的变化轨迹来重塑细胞随着时间的变化过程。从具体的分类分析和复杂程度来说，可以分为细胞轨迹分析和细胞谱系分析。

其中，Monocle2是做单细胞拟时分析最有名的R包。对比还在持续开发中的Monocle3来说，Monocle2更稳定且更倾向于半监督的分析模式，更适合针对感兴趣的细胞亚群做个性化分析。

====Monocle2的使用=====

官方教程：http://cole-trapnell-lab.github.io/monocle-release/docs/

安装

BiocManager::install("monocle")

2. 创建CellDataSet

创建所需要的CellDataSet一般有以下几种方法。

2.1 将Seurat object中数据提取来创建

数据准备：暂时用pbmc3k数据（轨迹分析的前提是待分析的细胞有紧密的发育关系，PBMC细胞不是很好的的示例数据，在此仅作为演示。）

由于该数据集没有对细胞类型进行注释，因此我们参考seurat标准流程对这个数据集进行注释。

library(dplyr)

library(Seurat)

library(patchwork) 

pbmc.data <- Read10X(data.dir = "filtered_gene_bc_matrices/hg19/")

pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)

pbmc

pbmc[["percent.mt"]] <- PercentageFeatureSet(pbmc, pattern = "^MT-")

pbmc <- subset(pbmc, subset = nFeature_RNA > 200 & nFeature_RNA < 2500 & percent.mt < 5)

pbmc <- NormalizeData(pbmc)

pbmc <- FindVariableFeatures(pbmc, selection.method = "vst", nfeatures = 2000)

all.genes <- rownames(pbmc)

pbmc <- ScaleData(pbmc, features = all.genes)

pbmc <- RunPCA(pbmc, features = VariableFeatures(object = pbmc))

pbmc <- FindNeighbors(pbmc, dims = 1:10)

pbmc <- FindClusters(pbmc, resolution = 0.5)

pbmc <- RunUMAP(pbmc, dims = 1:10)

new.cluster.ids <- c("Naive CD4 T", "Memory CD4 T", "CD14+ Mono", "B", "CD8 T", "FCGR3A+ Mono", "NK", "DC", "Platelet")

names(new.cluster.ids) <- levels(pbmc)

pbmc <- RenameIdents(pbmc, new.cluster.ids)

pbmc[['cell_type']] <- [email protected]

levels(pbmc)

saveRDS(pbmc, file = "pbmc.rds")

运行完上述代码，得到注释好的数据集。

从Seurat对象中提取构建CDS对象所需要的3个输入文件：表达矩阵信息、基因信息和表型信息。

monocle输入的是count矩阵（不建议使用data矩阵）

library(monocle)

pbmc <- readRDS("pbmc.rds") 

expr_matrix <- as(as.matrix(pbmc@assays$RNA@counts), 'sparseMatrix')

p_data <- [email protected] 

p_data$celltype <- [email protected]  

f_data <- data.frame(gene_short_name = row.names(pbmc),row.names = row.names(pbmc))

pd <- new('AnnotatedDataFrame', data = p_data) 

fd <- new('AnnotatedDataFrame', data = f_data)

cds <- newCellDataSet(expr_matrix,  phenoData = pd,featureData = fd,lowerDetectionLimit = 0.5,expressionFamily = negbinomial.size())

注：一般来说，FPKM/TPM值通常是对数正态分布的，而UMIs或读计数使用负二项分布能更好地建模。要处理计数数据，需要将负二项分布指定为newCellDataSet的expressionFamily参数：

从参数的释义来看，negbinomial.size()和negbinomial()：输入的表达矩阵为UMI,一般适用于10x的数据；negbinomial()的结果更准确，但是计算更耗时；一般建议采用negbinomial.size()。稀疏矩阵用negbinomial.size()

tobit():适用于输入的表达矩阵为FPKM或者TPM, 构建monocle2的class时会自动进行log化计算。

gaussianff():输入为log化后的FPKM或者TPM。(目前在单细胞数据中，FPKM已不多用，smart-seq2平台数据一般采用TPM)

2.2 直接读取表达矩阵来创建

library(data.table)

##读取数据

data <-fread("fpkm.txt",data.table = F,header = T)

pd <- fread("metadata.txt",data.table = F,header = T)

fd <-fread("gene_annotations.txt",data.table = F,header = T)

##创建

pd <-new("AnnotatedDataFrame", data = pd)

fd <-new("AnnotatedDataFrame", data = fd)

HSMM <- newCellDataSet(as.matrix(data), phenoData = pd,featureData = fd, expressionFamily =tobit())

###如果数据量大，建议转化为稀疏矩阵

HSMM <-newCellDataSet(as(as.matrix(data), "sparseMatrix"), phenoData = pd, featureData = fd, expressionFamily =tobit())

2.3 将Seurat对象直接转化为CellDataSet对象

importCDS(pbmc)

3. 估计size factor和离散度

size facotr帮助我们标准化细胞之间的mRNA的差异。离散度值可以帮助我们进行后续的差异分析。（类似于seurat的数据归一化处理）

cds <- estimateSizeFactors(cds)

cds <- estimateDispersions(cds)

注：与seurat把标准化后的表达矩阵保存在对象中不同，monocle只保存一些中间结果在对象中，需要用时再用这些中间结果转化。经过上面三个函数的计算，mycds对象中多了SizeFactors、Dipersions、num_cells_expressed和num_genes_expressed等信息。

4. 过滤低质量的细胞

大多数单细胞工作流程至少会包含一些由死细胞或空孔组成的库。同样重要的是要删除doublets:由两个或多个细胞意外生成的库。这些细胞可以破坏下游步骤，如伪时间排序或聚类。要知道一个特定的基因有多少个表达，或者一个给定的细胞有多少个基因表达，通常是很方便的。Monocle提供了一个简单的函数来计算这些统计数据。

因为Seurat已经完成细胞过滤，此步可省略。

但由于Seurat是通过基因表达量来对细胞进行过滤。因此，我们可以通过下面的代码用表达某基因的细胞的数目对基因进行过滤，从而得到后续操作需要的基因。

cds <- detectGenes(cds, min_expr = 0.1)  //将会在fData(cds)中添加一列num_cells_expressed

print(head(fData(cds)))

expressed_genes <- row.names(subset(fData(cds),num_cells_expressed >= 10))  //过滤掉在小于10个细胞中表达的基因

5. 细胞分类

Monocle官网教程提供了4个分类方法：

Classifying cells by type

Clustering cells without marker genes

Clustering cells using marker genes

Imputing cell type

但是：很多博主建议先将细胞注释好再进行Monocle分析，不建议使用monocle做细胞分类。

6. 轨迹定义基因选择及可视化和构建轨迹

一般来说，主要流程如下：

   Step 1: choosing genes that define progress

   Step 2: reducing the dimensionality of the data

   Step 3: ordering the cells in pseudotime

Step 1: 选择定义过程的基因

推断单细胞轨迹是一个机器学习问题。在单细胞RNA-Seq中，低水平表达的基因通常非常嘈杂，但有些基因包含有关细胞状态的重要信息。因此，轨迹推断的第一步就是选择Monocle将用作机器学习方法输入的基因。这叫做特征选择，它对轨迹的形状有很大的影响。

Monocle主要基于关键基因的表达模式，通过学习每个细胞必须经历的基因表达变化的序列，根据拟时间值中对单个细胞进行排序，模拟出时间发育过程的动态变化。而这个排序技术表现是一种在低维空间排布高维数据的降维技术。

Monocle提供了多种工具来选择基因，这些基因将产生一个健壮、准确和具有生物学意义的轨迹。你可以使用这些工具来执行一个完全“无监督”的分析，在这个分析中，Monocle不知道你认为哪个基因是重要的。或者，你可以利用marker gene知识来定义生物学进展，从而形成Monocle的轨迹。我们认为这种模式是“半监督”的分析。

Monocle官网教程提供了4个选择方法：

    选择发育差异表达基因

    选择clusters差异表达基因

    选择离散程度高的基因

    自定义发育marker基因

前三种都是无监督分析方法，细胞发育轨迹生成完全不受人工干预；最后一种是半监督分析方法，可以使用先验知识辅助分析。

//使用seurat选择的高变基因

express_genes <- VariableFeatures(pbmc)

cds<- setOrderingFilter(cds, express_genes)

plot_ordering_genes(cds)

//使用clusters差异表达基因

deg.cluster <- FindAllMarkers(pbmc)

express_genes <- subset(deg.cluster,p_val_adj<0.05)$gene

cds <- setOrderingFilter(cds,express_genes)

plot_ordering_genes(cds)

//使用monocle选择的高变基因

disp_table <- dispersionTable(cds)

disp.genes <- subset(disp_table,mean_expression >= 0.1 & dispersion_empirical >= 1 *dispersion_fit)$gene_id

cds <- setOrderingFilter(cds,disp.genes)

plot_ordering_genes(cds)

但是，理想情况下，我们希望尽可能少地使用生物学的先验知识。我们希望从数据中发现重要的排序基因，而不是依赖于文献，因为这可能会在排序中引入偏见。我们将从一种更简单的方法开始，但是我们通常推荐一种更复杂的方法，称为“dpFeature”。

//这一步输入的expressed_genes来自于步骤4。

//后续分析使用的是该方法

//也可输入seurat筛选出的高变基因：expressed_genes<- VariableFeatures(pbmc)

diff <-differentialGeneTest(cds[expressed_genes,],fullModelFormulaStr="~cell_type",cores=1)

//注：~后面是表示对谁做差异分析的变量，理论上可以为p_data的任意列名

head(diff)

//差异表达基因作为轨迹构建的基因,差异基因的选择标准是qval<0.01,decreasing=F表示按数值增加排序

deg <- subset(diff, qval < 0.01)            #选出2829个基因

deg <-deg[order(deg$qval,decreasing=F),]

head(deg)

//差异基因的结果文件保存

write.table(deg,file="train.monocle.DEG.xls",col.names=T,row.names=F,sep="\t",quote=F)

//轨迹构建基因可视化

ordergene <- rownames(deg)

cds <- setOrderingFilter(cds,ordergene) 

注：这一步是很重要的，在我们得到想要的基因列表后，我们需要使用setOrderingFilter将它嵌入cds对象，后续的一系列操作都要依赖于这个list。

#setOrderingFilter之后，这些基因被储存在cds@featureData@data[["use_for_ordering"]]，可以通过table(cds@featureData@data[["use_for_ordering"]])查看

plot_ordering_genes(cds)

注：图中黑色的点表示用来构建轨迹的差异基因，灰色表示背景基因。红色的线是根据第2步计算的基因表达大小和离散度分布的趋势(可以看到，找到的基因属于离散度比较高的基因)

注：选择的用于排序的基因数目一般在2000左右比较合适

//gene数太多的话也可以选择top基因

ordergene <-row.names(deg)[order(deg$qval)][1:400]

Step 2: 降维

一旦细胞有序排列，我们就可以在降维空间中可视化轨迹。所以首先选择用于细胞排序的基因，然后使用反向图嵌入(DDRTree)算法对数据进行降维。

cds <- reduceDimension(cds,max_components = 2,method = 'DDRTree')

Step 3: 拟时间轴轨迹构建和在拟时间内排列细胞

将表达数据投射到更低的维度空间，通过机器学习描述细胞如何从一种状态过渡到另一种状态的轨迹。假设轨迹具有树状结构，一端是“根”，另一端是“叶”。尽可能地将最佳树与数据匹配起来。这项任务被称为“歧管学习”，在生物过程的开始阶段，细胞从根部开始，沿着主干前进，直到到达第一个分支（如果有的话）。然后，细胞必须选择一条路径，沿着树走得越来越远，直到到达一片叶子。一个细胞的伪时间值是它回到根的距离。

根据order gene的表达趋势，将细胞排序并完成轨迹构建。

cds <- orderCells(cds)

//使用root_state参数可以设置拟时间轴的根，如下面的拟时间着色图中可以看出，左边是根。根据state图可以看出，根是State1，若要想把另一端设为根，可以按如下操作。

#cds <- orderCells(cds, root_state = 5)#把State5设成拟时间轴的起始点

可视化：根据cds@phenoData@data中的表型信息(metadata)对细胞上色

1. 以pseudotime值上色 (Pseudotime是monocle2基于细胞基因表达信息计算的概率，表示时间的先后。)

plot_cell_trajectory(cds,color_by="Pseudotime",size=1,show_backbone=TRUE)

2. 以细胞类型上色

plot_cell_trajectory(cds,color_by="cell_type",size=1,show_backbone=TRUE)

3. 以细胞状态上色

plot_cell_trajectory(cds, color_by = "State", size=1,show_backbone=TRUE)

4. 按照seurat分群排序细胞

5. 以细胞状态上色（拆分）“分面”轨迹图，以便更容易地查看每个状态的位置。

plot_cell_trajectory(cds, color_by = "State") + facet_wrap("~State", nrow = 1)

同样滴，我们也可以使用scale_color_manual()自己设置颜色。

library(ggsci)

p1=plot_cell_trajectory(cds, color_by = "cell_type")  + scale_color_npg() 

p2=plot_cell_trajectory(cds, color_by = "State")  + scale_color_nejm()

colour=c("#DC143C","#0000FF","#20B2AA","#FFA500","#9370DB","#98FB98","#F08080")

p3=plot_cell_trajectory(cds, color_by = "State")  + scale_color_manual(values = colour)

p1|p2|p3

我们同样也可以用树形图来展示：

plot_complex_cell_trajectory(cds, x = 1, y = 2,color_by = "celltype")

还可以画沿时间轴的细胞密度图

library(ggpubr)

df <- pData(cds) 

ggplot(df, aes(Pseudotime, colour = cell_type, fill=cell_type)) +

  geom_density(bw=0.5,size=1,alpha = 0.5)+theme_classic2()

手动进行颜色设置：

ClusterName_color_panel <- c(

 "Naive CD4 T" = "#DC143C", "Memory CD4 T"= "#0000FF", "CD14+ Mono" = "#20B2AA",

 "B" = "#FFA500", "CD8 T" ="#9370DB", "FCGR3A+ Mono" = "#98FB98",

 "NK" = "#F08080", "DC" ="#0000FF", "Platelet" = "#20B2AA"

)

ggplot(df, aes(Pseudotime, colour =cell_type, fill=cell_type)) +

 geom_density(bw=0.5,size=1,alpha = 0.5)+theme_classic2()+scale_fill_manual(name = "", values = ClusterName_color_panel)+scale_color_manual(name= "", values = ClusterName_color_panel)

提取感兴趣的细胞（进行后续分析）

比如对State7的细胞感兴趣：

pdata <- Biobase::pData(cds)

s.cells <- subset(pdata,State=="7") %>% rownames()

save(s.cells, file ="Monocle_state7.rda")

保存结果：

write.csv(pData(cds),"pseudotime.csv")

save(cds, file = "cds.rda")

7. 指定基因的可视化

直接查看一些基因随细胞状态等的表达变化。

//选择前4个top基因并将其对象取出

keygenes <- head(ordergene,4)

cds_subset <- cds[keygenes,]

//可视化：以state/celltype/pseudotime进行

p1 <-plot_genes_in_pseudotime(cds_subset, color_by = "State")

p2 <-plot_genes_in_pseudotime(cds_subset, color_by = "cell_type")

p3 <-plot_genes_in_pseudotime(cds_subset, color_by = "Pseudotime")

p1|p2|p3

//也可以自己指定基因

s.genes <-c("SELL","CCR7","IL7R","CD84","CCL5","S100A4")

p1 <- plot_genes_jitter(cds[s.genes,],grouping = "State", color_by = "State")

p2 <- plot_genes_violin(cds[s.genes,],grouping = "State", color_by = "State")

p3 <-plot_genes_in_pseudotime(cds[s.genes,], color_by = "State")

p1|p2|p3

//拟时序展示单个基因表达量

colnames(pData(cds))

pData(cds)$CCL5 = log2(exprs(cds)['CCL5',]+1)

p1=plot_cell_trajectory(cds, color_by ="CCL5")  + scale_color_gsea()

pData(cds)$S100A4 =log2(exprs(cds)['S100A4',]+1)

p2=plot_cell_trajectory(cds, color_by ="S100A4")    +scale_color_gsea()

library(patchwork)

p1+p2

8. 寻找拟时相关的基因（拟时差异基因）

使用回归算法 （注意：不要使用多核运算，经常会出现警告）

Monocle的主要工作是通过生物过程（如细胞分化）将细胞按顺序排列，而不知道要提前查看哪些基因。一旦这样做了，你就可以分析细胞，找到随着细胞进展而变化的基因。

官方给出的差异分析有三大方法：

1、Basic DifferentialAnalysis

2、Finding Genes thatDistinguish Cell Type or State

3、Finding Genes thatChange as a Function of Pseudotime

我们重点关注第三个：根据伪时间功能寻找差异基因

sm.ns函数指出Monocle应该通过表达式值拟合自然样条曲线，以帮助它将表达式的变化描述为进程的函数。

寻找拟时差异基因（qvalue体现基因与拟时的密切程度）绘制热图。

//这里是把排序基因（ordergene）提取出来做回归分析，来找它们是否跟拟时间有显著的关系,如果不设置，就会用所有基因来做它们与拟时间的相关性

Time_diff <-differentialGeneTest(cds[ordergene,], cores = 1,

                                 fullModelFormulaStr = "~sm.ns(Pseudotime)")

Time_diff <-Time_diff[,c(5,2,3,4,1,6,7)]     #把gene放前面，也可以不改

write.csv(Time_diff,"Time_diff_all.csv", row.names = F)

Time_genes <- Time_diff %>%pull(gene_short_name) %>% as.character()

plot_pseudotime_heatmap(cds[Time_genes,],num_clusters=4, show_rownames=T, return_heatmap=T)

注：图中横轴是拟时间，cluster1的基因是在拟时排序起点高表达的基因，cluster2的基因则是在拟时排序的重点高表达的。cluster数的多少是由plot_pseudotime_heatmap函数中的num_clusters参数定义的。

plot_pseudotime_heatmap函数可以来可视化所有monocle的假时间依赖性基因。plot_pseudotime_heatmap采用CellDataSet对象（通常只包含重要基因的子集），并生成平滑的表达曲线，非常类似于plot_genes_in_pseudotime。然后它对这些基因进行聚类，并使用pheatmap软件包进行绘图。绘出的热图可以让我们观测到假时间依赖性基因中的不同基因模块在不同的时间内共同变化，能比较好的回答时间序列基因表达中“哪些基因遵循相似的动力学趋势”这一常见问题。

显著差异基因按热图结果排序并保存

hp.genes <- p$tree_row$labels[p$tree_row$order]

Time_diff_sig <- Time_diff[hp.genes, c("gene_short_name", "pval", "qval")]

write.csv(Time_diff_sig, "Time_diff_sig.csv", row.names = F)

marker_genes <- row.names(subset(fData(cds), gene_short_name %in% c("MEF2C", "MEF2D", "MYF5","ANPEP", "PDGFRA","MYOG","TPM1",  "TPM2",  "MYH2","MYH3",  "NCAM1", "TNNT1","TNNT2", "TNNC1", "CDK1","CDK2",  "CCNB1", "CCNB2","CCND1", "CCNA1", "ID1")))

diff_test_res <- differentialGeneTest(cds[marker_genes,], fullModelFormulaStr = "~sm.ns(Pseudotime)")

sig_gene_names <- row.names(subset(diff_test_res, qval < 0.1))

plot_pseudotime_heatmap(cds[sig_gene_names,],num_clusters = 6,cores = 1,show_rownames = T)

9. 单细胞轨迹的“分支”分析

上一步寻找拟时相关的基因是全局的，找拟时起点和终点相关的基因，这一步则是寻找和分叉点相关的基因。

单细胞轨迹常常包括分支。这些分支的产生是因为细胞执行不同的基因表达程序。在发育过程中，当细胞做出命运选择时，分支出现在轨迹中：一个发育谱系沿着一条路径前进，而另一个谱系产生第二条路径。Monocle包含分析这些分支事件的广泛功能。Monocle提供了一个特殊的统计测试：分支表达式分析建模，或BEAM。BEAM(Branched expression analysis modeling)是一种统计方法，用于寻找以依赖于分支的方式调控的基因。

plot_cell_trajectory(cds, color_by = "State")

BEAM进行统计分析

BEAM_res <- BEAM(cds[ordergene,],branch_point = 1, cores = 2)

#这里用的是ordergene，也就是第六步dpFeature找出来的基因。如果前面用的是seurat的marker基因，记得改成express_genes

#BEAM_res <- BEAM(cds, branch_point = 1,cores = 2) #对所有基因进行排序，运行慢

BEAM_res <-BEAM_res[order(BEAM_res$qval),]

BEAM_res <-BEAM_res[,c("gene_short_name", "pval", "qval")]

head(BEAM_res)

write.csv(BEAM_res,"BEAM_res.csv", row.names = F)

plot_genes_branched_heatmap(cds[row.names(subset(BEAM_res,qval < 1e-4)),],branch_point = 1, num_clusters = 4, cores = 1,use_gene_short_name= T,show_rownames = T)

该热图显示的是同一时间点两个谱系的变化，热图的列是伪时间的点，行是基因。这张图最上面的条条，灰色的代表分叉前，左边红色代表左边这个cell fate，右边蓝色代表右边这个cell fate，从热图中间往右读，是伪时间的一个谱系，往左是另一个谱系。基因是被按照等级聚类的，需要结合生物学知识来进行解读。但是因为我们在参数设置的时候，选择branch_point = 1是1这个分叉点的两个cell的状态。

#也可以选前100个基因可视化

BEAM_genes <- top_n(BEAM_res, n = 100,desc(qval)) %>% pull(gene_short_name) %>% as.character()

p <-plot_genes_branched_heatmap(cds[BEAM_genes,], branch_point = 1,num_clusters =3, show_rownames = T, return_heatmap = T)

ggsave("BEAM_heatmap.pdf",p$ph_res, width = 6.5, height = 10)

//显著差异基因(top100)按热图结果排序并保存

//如果要所有的差异基因，就把前面所有基因的热图存为p

hp.genes <- p$ph_res$tree_row$labels[p$ph_res$tree_row$order]

BEAM_sig <- BEAM_res[hp.genes, c("gene_short_name", "pval", "qval")]

write.csv(BEAM_sig, "BEAM_sig.csv", row.names = F)

//选择上面热图中或显著差异基因中感兴趣的基因进行可视化

head(BEAM_sig)

genes <- row.names(subset(fData(cds),gene_short_name %in% c( "SITX11", "CEBPD", "TYROBP")))

plot_genes_branched_pseudotime(cds[genes,],branch_point = 1,color_by = "State",ncol = 1)

从图中可以看出，这2个基因都是在左边的cell fate中高表达的。

10. 文献里的monocle

有时候细胞群不会完美的按照分叉排列。如下，只要一类细胞占某一个分叉细胞的大部分也可以。

本文使用 文章同步助手 同步