(Smartseq2) single cell RNA-seq分析练习

这次跟着课程(Smartseq2 scRNA小鼠发育学习笔记-1-前言及上游介绍)要练习的文章是:Dissecting Cell Lineage Specification and Sex Fate Determination in Gonadal Somatic Cells Using Single-Cell Transcriptomics。
课程里是从下载sra文件开始的,但是由于这篇文章的数据实在是太大了。。。

(Smartseq2) single cell RNA-seq分析练习_第1张图片

都下载下来的话,按照我这网速,可能要一年以后才能下载完了。所以我直接从课程的第二讲开始练习(Smartseq2 scRNA小鼠发育学习笔记-2-根据表达矩阵进行分群)。关于单细胞测序的数据如何批量下载,如何比对,还有featureCount定量,我在上一个练习里有写到(单细胞测序实战(第一部分))。这次主要练习下游的分析部分,这部分是最重要的,也是核心部分。还有个原因就像课程说的(Smartseq2 scRNA小鼠发育学习笔记-1-前言及上游介绍):

smartseq2得到的两个R1、R2都是测序信息,于是它的操作和我们常规bulk转录组是类似的。可以用hisat2+featureCounts进行操作

需要明确的是:文章表明了6个发育时期、4群细胞、2个发育轨迹这三种细胞属性

首先先下载原始count矩阵https://raw.githubusercontent.com/IStevant/XX-XY-mouse-gonad-scRNA-seq/master/data/female_count.Robj
作者rpkm标准化后的矩阵https://github.com/IStevant/XX-XY-mouse-gonad-scRNA-seq/raw/master/data/female_rpkm.Robj

(一)过滤重复的细胞,构建表达矩阵(使用原始count矩阵)

#导入作者上传的原始矩阵
> load(file="female_count.Robj")
> load(file="female_rpkm.Rdata")
# 去掉重复细胞(作者用“rep”进行了标记),先看一下哪些列是重复的
> grep("rep",colnames(female_count))
[1] 257 #第257列是重复的
# 直接对细胞和基因过滤
female_count <- female_count[rownames(female_count) %in% rownames(females),!colnames(female_count) %in% grep("rep",colnames(female_count), value=TRUE)]
# %in%相当于match()函数的一个缩写。用来判断一个数组或矩阵(前面的)是否包含在另一个数组或矩阵(后面的)里。
#看一下过滤之后的
> female_count[1:3,1:3]
      E10.5_XX_20140505_C01_150331_1 E10.5_XX_20140505_C02_150331_1 E10.5_XX_20140505_C03_150331_1
eGFP                           19582                            526                           4786
Gnai3                           2218                            122                              4
Pbsn                               0                              0                              0
#保存一下
> save(female_count,file = 'female_count.Rdata')

(二)tSNE分析(Seurat方法)
在分析之前,先简单的了解一下什么是Seurat,这是这个包的官方网站(SATIJA LAB),据说这个包今年刚升过级,这个包还可以很友好的直接读取10x Genomics的输出结果(单细胞转录组测序分析--初探Seurat)。有几个比较好的文章对于这个包进行介绍:
1.Seurat使用教程(v3.0)
2.单细胞Seurat包升级,换汤不换药
3.单细胞转录组测序分析--初探Seurat

下面进行分析,首先要对细胞分群,按照不同的发育时期来获取细胞群:

> load(file="female_count.Rdata")
> dim(females) #看一下多少行,多少列
[1] 21083   563
> head(colnames(females)) #看一下列名
[1] "E10.5_XX_20140505_C01_150331_1" "E10.5_XX_20140505_C02_150331_1" "E10.5_XX_20140505_C03_150331_1"
[4] "E10.5_XX_20140505_C04_150331_2" "E10.5_XX_20140505_C06_150331_2" "E10.5_XX_20140505_C07_150331_3"
#按照胚胎的天数来分细胞群,所以要按照E10.5这部分来划分
> female_stages <- stringr::str_split(colnames(females),'_', simplify = T)[,1] 
#str_split意思是按照模式分割字符串,这里是按照行名里的下划线分割,后面的1是第一个下划线的意思
> head(female_stages)
[1] "E10.5" "E10.5" "E10.5" "E10.5" "E10.5" "E10.5"
#表达矩阵里有多少列(多少细胞),female_stages里就有多少元素,把列名赋值给它
> names(female_stages) <- colnames(females) 
> table(female_stages)
female_stages
E10.5 E11.5 E12.5 E13.5 E16.5    P6 
   68   100   103    99    85   108 
(Smartseq2) single cell RNA-seq分析练习_第2张图片
这是分群的结果,这一看到所有的细胞都被标记了是哪一个胚胎时间的

现在就得到了6个不同的群,每个群的细胞数不同
下面使用seurat进行tSNE分析,分几步进行:
(1)构建对象

#安装seurat包
> install.packages('Seurat')
> library(Seurat)
#构建对象
> sce_female <- CreateSeuratObject(counts = female_count, 
                                 project = "sce_female", 
                                 min.cells = 1, min.features = 0)
# 这一步还有过滤功能,基因至少在min.cells个细胞中表达,每个细胞中至少表达min.genes个基因/features。这句的代码是这个基因至少要在1个细胞里有表达,不然就被过滤掉。
> sce_female
An object of class Seurat 
16765 features across 563 samples within 1 assay 
Active assay: RNA (16765 features)

view一下这个sce_female:

(Smartseq2) single cell RNA-seq分析练习_第3张图片

点开里面的meta.data,可以看到UMI的情况:

(Smartseq2) single cell RNA-seq分析练习_第4张图片

我搜了一下网上,想知道这些都是些啥,在这篇文章里得知(单细胞转录组测序分析--初探Seurat):创建完Seurat对象后,Seurat将数据保存在不同的slot中,如[email protected], sce_female@data, [email protected], sce_female@ident,其中meta.data存放的是每个细胞的统计数据如UMI数目,gene数目等,ident此时存放的是project信息。

(2)添加样品注释

#使用AddMetaData添加meta信息
> sce_female <- AddMetaData(object = sce_female, 
                          metadata = apply(female_count, 2, sum), 
                          col.name = 'nUMI_raw')
> sce_female <- AddMetaData(object = sce_female, 
                          metadata = female_stages, 
                          col.name = 'female_stages') #把上面我们分的细胞的不同时期加到这个对象里

(3)标准化
Seurat官网上对于标准化的这部分是这样写的:

After removing unwanted cells from the dataset, the next step is to normalize the data. By default, we employ a global-scaling normalization method “LogNormalize” that normalizes the feature expression measurements for each cell by the total expression, multiplies this by a scale factor (10,000 by default), and log-transforms the result. Normalized values are stored in @data.
去除掉不想要的细胞以后,下一步就是标准化。默认值下,我们使用global-scaling标准化方法,称为“LogNormalize”。对每个基因进行标准化:该基因的UMI除以该细胞内转录物的总UMI并乘以10000(默认值),再取log值作为结果。

> sce_female <- NormalizeData(sce_female) #这是简化版的代码,也是官方推荐使用的
#这句代码的完整格式应该是这样:
#sce_female <- NormalizeData(object =sce_female,normalization.method = "LogNormalize", scale.factor = 10000)

Performing log-normalization
0%   10   20   30   40   50   60   70   80   90   100%
[----|----|----|----|----|----|----|----|----|----|
**************************************************|

> sce_female[["RNA"]]@data[1:3,1:3] #看一眼标准化之后的
3 x 3 sparse Matrix of class "dgCMatrix"
      E10.5_XX_20140505_C01_150331_1 E10.5_XX_20140505_C02_150331_1 E10.5_XX_20140505_C03_150331_1
eGFP                        3.753731                      0.7024916                      2.8485868
Gnai3                       1.744141                      0.2121183                      0.0135009
Cdc45                       2.001816                      1.6581178                      0.6510173

(4)找差异基因Identification of highly variable features (feature selection)

> sce_female <- FindVariableFeatures(sce_female, 
                                    selection.method = "vst", 
                                    nfeatures = 2000)
# nfeatures = 2000是默认值
Calculating gene variances
0%   10   20   30   40   50   60   70   80   90   100%
[----|----|----|----|----|----|----|----|----|----|
**************************************************|
Calculating feature variances of standardized and clipped values
0%   10   20   30   40   50   60   70   80   90   100%
[----|----|----|----|----|----|----|----|----|----|
**************************************************|
# HVGs可视化
> VariableFeaturePlot(sce_female)
(Smartseq2) single cell RNA-seq分析练习_第5张图片

如果想看上面这个图里偏上的红点都是什么基因,还可以再用两句代码:

> top10 <- head(VariableFeatures(sce_female), 10)
> plot1<- VariableFeaturePlot(sce_female)
> plot2 <- LabelPoints(plot = plot1, points = top10, repel = TRUE)
> plot2
(Smartseq2) single cell RNA-seq分析练习_第6张图片

(5)数据比例化(调整数据范围)
在降维之前还可以有一步就是数据的比例化,官方是这样解释为什么要进行这一步的:

(1)Shifts the expression of each gene, so that the mean expression across cells is 0
(2)Scales the expression of each gene, so that the variance across cells is 1
(3)This step gives equal weight in downstream analyses, so that highly-expressed genes do not dominate
The results of this are stored in pbmc[["RNA"]]@scale.data
说的简单一点就是,有些基因的表达量非常高,会掩盖掉低表达基因的变化,这一步就是降低高表达基因的影响。

#默认只对FindVariableFeatures得到的HVGs进行操作
> sce_female <- ScaleData(object = sce_female, 
                         vars.to.regress = c('nUMI_raw'), 
                         model.use = 'linear', 
                         use.umi = FALSE)
#vars.to.regress的意思就是需要去除的变异来源。该函数会先进行先行回归分析,然后再进行数据的比例化

Regressing out nUMI_raw
  |=============================================================================================================| 100%
Centering and scaling data matrix
  |=============================================================================================================| 100%

(6)PCA降维
对于降维:PCA和tSNE都是数据降维分析方法,PCA属于线性降维,tSNE属于非线性降维(单细胞转录组测序分析--初探Seurat)。
为什么要降维?单细胞测序数据是一个高维的复杂数据。降维,就是把高维数据通过优化保留原始数据中的关键特征后投射到低维空间,从而可以通过二维或三维的形式把数据展示出来。先执行PCA分析,使高维数据的信息最大程度保留在低维数据中。

> sce_female <- RunPCA(sce_female, 
                      features = VariableFeatures(object = sce_female))
#然后会弹出下面一堆:
PC_ 1 
Positive:  Kctd14, Cgn, Itga6, Kitl, Gstm2, Bhlhe41, Lzts1, eGFP, Serpinb6a, Ttyh2 
       Soat1, Ifitm1, Rnf213, Gstm1, Idh1, Pank1, Anxa2, Gpr56, Klhl23, Sdc4 
       Hmgcs2, Laptm4b, Tmprss13, Tmem206, Clu, Rgs11, Serpinb6b, Gadd45g, Cpa2, Gatm 
Negative:  Col1a2, Col1a1, Sfrp1, Sept11, Ncam1, Ptn, Mmp2, Fn1, Col3a1, Hmga2 
       Nrep, Sparcl1, Tcf21, Mfap4, Sox11, Meis1, Cxcl12, Nfib, Bgn, Cnn2 
       Pdgfra, Efna5, Dcn, Cdh11, Fstl1, Fblim1, Vcan, Top2a, Tuba1a, Lpar1 
PC_ 2 
Positive:  Itih5, Cfh, Dcn, Col6a2, Igf1, Akr1cl, Ogn, Col1a1, Lama2, Sparcl1 
       Lum, Zbtb20, Cd34, Col6a1, Ptrf, Rarres2, Col1a2, Bgn, Gas6, Lrrc17 
       Cped1, Col4a4, Srpx2, Col6a3, Prss35, Plxnc1, Serpine2, Slc26a7, Tcf21, Pdlim3 
Negative:  Hmga2, Peg3, Mest, Sox11, Cdkn1c, Rrm2, Rgs5, Ccnb1, Aldh1a2, Ccnd1 
       Oraov1, Asb4, Tpx2, Cenpf, Flrt3, Hapln1, Kif20a, Ect2, Top2a, Meis1 
       Cenpe, F11r, Kif22, Bub1, Sfrp2, Kif2c, Krt18, Ube2c, Ncaph, Sulf1 
PC_ 3 
Positive:  Cdkn1c, Ifitm1, Peg3, Fstl1, Acaa2, Nfib, Lzts1, Cgn, Anxa6, Tnfrsf19 
       Lhx9, Laptm4b, Col3a1, Sema6d, Col1a1, Sulf1, Zfp57, Serpinb6b, Bgn, Timp3 
       eGFP, Anxa2, Lgr4, Col1a2, Colec12, Itm2a, Hmcn1, Mest, Serpini1, Bhlhe41 
Negative:  Serpine2, Socs2, Inha, Kazald1, Lect1, Ephx2, Ptges, Hsd3b1, Hsd17b1, Apoa1 
       Myo1e, Ubash3b, Esr2, Fam13a, Arhgap31, Gls, Gja1, Slc18a2, Ablim1, Tanc2 
       Slc26a7, Map1b, Sytl4, Myo5c, Tenm4, Ivns1abp, Thbs1, Epn2, Top2a, Akr1c14 
PC_ 4 
Positive:  Top2a, Prc1, Ube2c, Ccnb1, Cenpf, Tpx2, Plk1, Kif22, Ckap2l, Bub1 
       Kif23, Mki67, Aspm, Cdk1, eGFP, Bub1b, Ccna2, Kif2c, Ncaph, Ect2 
       Cenpe, Cdc25c, Ccnb2, Kif20a, Ifitm1, Nr6a1, Zwilch, Sgol1, Rrm2, Gm3550 
Negative:  Alcam, Ptgs1, Fras1, Gata2, Upk1b, Ccnd2, Dpp4, Runx1t1, Pkhd1l1, Frem2 
       Vstm2a, Cpa6, Efna5, Nfib, Itm2a, Flrt1, Mn1, Sdc4, Plscr2, Gpm6a 
       Sema3c, Egr1, Mybpc1, Btg2, Krt18, Atp2b1, Zfp36, Sorbs2, Timp2, Ece1 
PC_ 5 
Positive:  Nup62cl, Cyp11a1, Pnlip, Gadd45g, Sphkap, Asb4, Pnliprp2, Akr1cl, Inha, Plac1 
       Gfra3, Asns, Siglecg, Foxp2, Pls3, Nefm, St3gal5, Adam8, Mc2r, Vav3 
       Gk5, Cpa1, Sprr2d, Tenm4, Hmga2, Cxcl12, Gbp5, Trpc7, Ttc38, Inhbb 
Negative:  Sorbs2, Cav1, Btg2, Pdpn, Lgr5, Prc1, Egr1, Cst12, Mt1, Ccnb1 
       Ube2c, Fos, Zfp36, Aspm, Sdc4, Cenpf, Ckap2l, Top2a, Tpx2, Mki67 
       Egr2, Cdk1, Kif23, Plk1, Tnfrsf19, Kif20a, Pde8b, Bub1, Kif22, Enpp2

Seurat包提供了多种PCA可视化的方法,感兴趣的同学可以参考:https://satijalab.org/seurat/v3.1/pbmc3k_tutorial.html官网学习。这里只举例一种:

> DimPlot(sce_female, reduction = "pca")
(Smartseq2) single cell RNA-seq分析练习_第7张图片

还可以画个热图,举个例子,画PC_1和PC_2两个dim的热图:

> DimHeatmap(object = sce_female, dims = 1:2, cells = 500, balanced = TRUE)
(Smartseq2) single cell RNA-seq分析练习_第8张图片

(7)降维以后聚类
在进行聚类分析之前,需要选择使用对少个主成分进行计算。每个主成分实际上代表的是相关基因集的信息,因此确定多少个主成分是一个重要的步骤,我们可以根据PCElbowPlot函数来判断。

#Seurat采用的是基于图形的聚类方法,即利用PCA空间中的欧几里德距离构造一个KNN图。官网上写了一堆数学概念,我也看不懂。。。
> sce_female <- FindNeighbors(sce_female, dims = 1:20)
Computing nearest neighbor graph
Computing SNN
> sce_female <- FindClusters(sce_female, resolution = 0.3)
#官方解释:将resolution参数设置在0.4-1.2之间,对于3K左右的单细胞数据集通常会得到良好的结果。对于较大的数据集,最佳分辨率通常会增加。课程里这里用了0.3,为了尽量还原课程里的图,我也用了0.3。(resolution会影响聚类的个数)

(8)tSNE

#在进行tSNE之前要先确定有多少个主成分,可以用PCElbowPlot函数来看
> ElbowPlot(sce_female)
(Smartseq2) single cell RNA-seq分析练习_第9张图片

可以看到,拐点出现在9左右,所以我们可以选择9来进行聚类分析。

(9)tSNE可视化
Seurat提供了几种非线性的降维技术,如tSNE和UMAP。

> sce_female_tsne <- RunTSNE(sce_female, dims = 1:9)
# 6个发育时间
> DimPlot(object = sce_female_tsne, reduction = "tsne",
        group.by = 'female_stages')
(Smartseq2) single cell RNA-seq分析练习_第10张图片
# 4个cluster
> DimPlot(sce_female_tsne, reduction = "tsne")
(Smartseq2) single cell RNA-seq分析练习_第11张图片

如果用UMAP来降维:

> sce_female_umap <- RunUMAP(sce_female, dims = 1:9)
> DimPlot(sce_female_umap, reduction = "umap",group.by = 'female_stages')
(Smartseq2) single cell RNA-seq分析练习_第12张图片
6个发育时期的可视化
> DimPlot(sce_female_umap, reduction = "umap")
(Smartseq2) single cell RNA-seq分析练习_第13张图片
4个cluster的可视化

(三)tSNE分析(DBSCAN、kmeans方法)
上面用了Seurat包做了分群,课程里还用了DBSCAN方法跑了一遍,所以我也练习了一下。

# 这个运行会非常慢!
> if(T){
  library(Rtsne)
  N_tsne <- 10 
  # 其实这里应该多运行一些,例如N_tsne <- 50,但是会非常非常慢。。。
  tsne_out <- list(length = N_tsne)
  KL <- vector(length = N_tsne)
  set.seed(1234)
  for(k in 1:N_tsne)
  {
    tsne_out[[k]]<-Rtsne(t(log2(females+1)),initial_dims=30,verbose=FALSE,check_duplicates=FALSE,
                         perplexity=27, dims=2,max_iter=5000)
    KL[k]<-tail(tsne_out[[k]]$itercosts,1)
    print(paste0("FINISHED ",k," TSNE ITERATION"))
  }
  names(KL) <- c(1:N_tsne)
  opt_tsne <- tsne_out[[as.numeric(names(KL)[KL==min(KL)])]]$Y
#在Y里储存了画图坐标
}

这个代码运行的时候,会弹出来一堆一下的东西:

[1] "FINISHED 1 TSNE ITERATION"
[1] "FINISHED 2 TSNE ITERATION"
[1] "FINISHED 3 TSNE ITERATION"
[1] "FINISHED 4 TSNE ITERATION"
[1] "FINISHED 5 TSNE ITERATION"
[1] "FINISHED 6 TSNE ITERATION"
[1] "FINISHED 7 TSNE ITERATION"
[1] "FINISHED 8 TSNE ITERATION"
[1] "FINISHED 9 TSNE ITERATION"
[1] "FINISHED 10 TSNE ITERATION"
# DBSCAN结果
> library(dbscan)
> plot(opt_tsne,  col=dbscan(opt_tsne,eps=3.1)$cluster, 
     pch=19, xlab="tSNE dim 1", ylab="tSNE dim 2")
(Smartseq2) single cell RNA-seq分析练习_第14张图片
DBSCAN方法
# kmeans方法
plot(opt_tsne,  col=kmeans(opt_tsne,centers = 4)$clust, 
     pch=19, xlab="tSNE dim 1", ylab="tSNE dim 2")
(Smartseq2) single cell RNA-seq分析练习_第15张图片
kmeans方法

(四)标记基因可视化
这一部分将跟着课程(Smartseq2 scRNA小鼠发育学习笔记-3-标记基因可视化)进行练习。我们已经把细胞分了群,接下来就要分析一下这些群间的差异性。Seurat包也可以做这个事情,FindAllMarkers能够同时计算所有亚群的差异性(分别计算每个亚群与剩下的所有细胞的差异性)。但课程里写到原文作者根据胚胎细胞发育的不同时期,选取了一些能代表不同时期的特异性marker进行后续分析。所以这里我还是跟随教程走一遍。

目标:根据之前分析的6个发育时期和4个cluster的tSNE结果,画一些marker基因的热图、小提琴图。
首先要明确作者选了哪些基因(这些基因在原文中作者有提到是分别代表了哪些细胞群的marker基因):

# 作者选择的14个marker基因
> markerGenes <- c(
  "Nr2f1",
  "Nr2f2",
  "Maf",
  "Foxl2",
  "Rspo1",
  "Lgr5",
  "Bmp2",
  "Runx1",
  "Amhr2",
  "Kitl",
  "Fst",
  "Esr2",
  "Amh",
  "Ptges"
)

小提琴图,可以直接查看选取的这些marker基因在不同的cluster里的表达情况:

> VlnPlot(object = sce_female_tsne, features =  markerGenes , 
        pt.size = 0.2,ncol = 4)
(Smartseq2) single cell RNA-seq分析练习_第16张图片

热图:

> FeaturePlot(object = sce_female_tsne, features = markerGenes ,
            pt.size = 0.2,ncol = 3)
(Smartseq2) single cell RNA-seq分析练习_第17张图片
热图太大了,我就截取了一部分

如果是想单独画一个箱线图(比如只画Nrf2f这个基因):

# 分类信息
> group <- Seurat::Idents(sce_female)
## 表达矩阵
> nr2f2 <- as.numeric(log(female_count['Nr2f2',]+1))
#出图
> boxplot(nr2f2~group)
(Smartseq2) single cell RNA-seq分析练习_第18张图片

觉得丑?那就画个看起来高大上的小提琴图吧。用ggviolin画

#nrf2f的小提琴图
> df <- data.frame(expr=nr2f2,
                 group=group) #首先整一个data.frame,以为ggplot要用data.frame才行

看一下这个df长什么样

> view(df)
(Smartseq2) single cell RNA-seq分析练习_第19张图片
这是所有细胞的nr2f2的表达量,还有它们的分组情况0,1,2,3
> female_clusterPalette <- c(
  "#560047", 
  "#a53bad", 
  "#eb6bac", 
  "#ffa8a0"
) #这一步是给小提琴图上颜色
> my_comparisons <- list( c("0", "1"), c("1", "2"), c("2", "3") ) #还想给这四组两两比较
> ggviolin(df, "group", "expr", fill = "group",
         palette = female_clusterPalette,
         add = "boxplot", add.params = list(fill = "white"))+
  stat_compare_means(comparisons = my_comparisons)
#这里"group"和"expr"分别代表了x轴和y轴
(Smartseq2) single cell RNA-seq分析练习_第20张图片

(五)monocle V2进行差异分析
这一部分按照教程(Smartseq2 scRNA小鼠发育学习笔记-4-差异分析及功能注释)来练习。现在就要对之前分出来的4群细胞进行差异分析。这部分主要是利用原文文献作者上传的代码来进行分析。另外,ROTS包也可以用来进行单细胞测序的差异分析,我这里没有练习,之后有时间可以再练习一下。具体ROTS包流程代码可见:Smartseq2 scRNA小鼠发育学习笔记-4-差异分析及功能注释

(1)准备表达矩阵和分群信息

#获取6个发育时期
> head(colnames(female_count))
[1] "E10.5_XX_20140505_C01_150331_1" "E10.5_XX_20140505_C02_150331_1" "E10.5_XX_20140505_C03_150331_1" "E10.5_XX_20140505_C04_150331_2"
[5] "E10.5_XX_20140505_C06_150331_2" "E10.5_XX_20140505_C07_150331_3"
> female_stages <- sapply(strsplit(colnames(female_count), "_"), `[`, 1)
> names(female_stages) <- colnames(female_count)
> table(female_stages)
female_stages
E10.5 E11.5 E12.5 E13.5 E16.5    P6 
   68   100   103    99    85   108
#这部分跟前面是一样的

接下来我用的是下载下来的clustering文件(https://github.com/IStevant/XX-XY-mouse-gonad-scRNA-seq/blob/master/data/female_clustering.csv):

> cluster <- read.csv('female_clustering.csv')
> female_clustering=cluster[,2];names(female_clustering)=cluster[,1]
> table(female_clustering)
female_clustering
 C1  C2  C3  C4 
240  90 190  43 

(2)构建对象
需要:表达矩阵、细胞信息、基因信息

# 表达矩阵
> dim(female_count)
# 细胞分群信息(包括6个stage和4个cluster)
> table(female_stages)
female_stages
E10.5 E11.5 E12.5 E13.5 E16.5    P6 
   68   100   103    99    85   108 
> table(female_clustering)
female_clustering
 C1  C2  C3  C4 
240  90 190  43
# 基因信息
> gene_annotation <- as.data.frame(rownames(female_count))
#开始构建
> library(monocle)

这里教程使用了文献中的源代码prepare_for_DE,作者把下面这些代码包装成一个function:

> prepare_for_DE <- function(count_matrix=count_matrix, clustering=clustering, stages=stages){
  # Prepare tables for monocle object
  expr_matrix <- as.matrix(count_matrix)
  sample_sheet <- data.frame(cells=names(count_matrix), stages=stages, cellType=clustering)
  rownames(sample_sheet)<- names(count_matrix)
  gene_annotation <- as.data.frame(rownames(count_matrix))
  rownames(gene_annotation)<- rownames(count_matrix)
  colnames(gene_annotation)<- "genes"
  pd <- new("AnnotatedDataFrame", data = sample_sheet)
  fd <- new("AnnotatedDataFrame", data = gene_annotation)
  
  # Create a CellDataSet from the relative expression levels
  HSMM <- newCellDataSet(
    as(expr_matrix, "sparseMatrix"),
    phenoData = pd,
    featureData = fd,
    lowerDetectionLimit=0.5,
    expressionFamily=negbinomial.size()
  )
  
  HSMM <- detectGenes(HSMM, min_expr = 5)
  # HSMM <- HSMM[fData(HSMM)$num_cells_expressed > 5, ]
  HSMM <- HSMM[fData(HSMM)$num_cells_expressed > 10, ]
  
  HSMM <- estimateSizeFactors(HSMM)
  HSMM <- estimateDispersions(HSMM)
  
  return(HSMM)
}

然后直接使用这个function:

#包装好的函数只需要提供表达矩阵和细胞信息
> DE_female <- prepare_for_DE (
  female_count, 
  female_clustering, 
  female_stages
)

下面这一步是筛选那些差异较大的基因(FDR<0.05,也就是q值小于0.05),这里教程还是使用了文献里的源代码进行筛选。源代码包成了一个包:

#第一次运行的话,需要自己运行一遍这个,这样自己的R里就会储存这个function,之后就可以直接调用了
> findDEgenes <- function(HSMM=HSMM, qvalue=qvalue){
  diff_test_res <- differentialGeneTest(
    HSMM,
    fullModelFormulaStr="~cellType",
    cores = 3
  )
  
  sig_genes_0.05 <- subset(diff_test_res, qval < 0.05)
  sig_genes_0.01 <- subset(diff_test_res, qval < 0.01)
  
  print(paste(nrow(sig_genes_0.05), " significantly DE genes (FDR<0.05).", sep=""))
  print(paste(nrow(sig_genes_0.01), " significantly DE genes (FDR<0.01).", sep=""))
  
  diff_test_res <- subset(diff_test_res, qval< qvalue)
  
  return(diff_test_res)
}

然后直接运行这个function:

> start_time <- Sys.time()
> female_DE_genes <- findDEgenes(
   DE_female, 
   qvalue=0.05
 )
[1] "4435 significantly DE genes (FDR<0.05)." #也就是说最后我们筛选出来了4435个差异显著的基因
[1] "3268 significantly DE genes (FDR<0.01)."
> end_time <- Sys.time()
> end_time - start_time
Time difference of 1.661446 mins

得到了显著的差异基因,需要知道这些基因都是属于哪一个cluster的。这里文献的作者仍然包了一个函数get_up_reg_clusters(),这个函数的作用是:先得到了每个差异基因在不同cluster的平均表达量,然后找平均表达量最大的那个cluster,就认为这个基因属于这个cluster。get_up_reg_clusters源代码是:

> get_up_reg_clusters <- function(count, clustering, DE_genes){
cluster_nb <- unique(clustering)
mean_per_cluster <- vector()
DE_genes <- DE_genes[order(rownames(DE_genes)),]
count <- count[order(rownames(count)),]
count_de_genes <- count[rownames(count) %in% DE_genes$genes,]
print(dim(count_de_genes))
for (clusters in cluster_nb) {
  # print(head(count_de_genes[,
  #         colnames(count_de_genes) %in% names(clustering[clustering==clusters])
  #     ]))
  mean <- rowMeans(
    as.matrix(count_de_genes[,
                             colnames(count_de_genes) %in% names(clustering[clustering==clusters])
                             ])
  )
  names(mean) <- clusters
  mean_per_cluster <- cbind(
    mean_per_cluster,
    mean
  )
}
colnames(mean_per_cluster) <- cluster_nb
up_reg_cluster <- colnames(mean_per_cluster)[apply(mean_per_cluster,1,which.max)]
de_genes_table <- data.frame(
  DE_genes,
  mean_per_cluster,
  cluster=up_reg_cluster
)

return(de_genes_table)
}

然后用我们最开始下载的RPKM矩阵

> load(file="female_rpkm.Rdata")
> de_clusters <- get_up_reg_clusters(
  females, 
  female_clustering, 
  female_DE_genes
)

(六)差异基因功能注释
之前用了monocle分析得到了差异基因,接下来就是对这些差异基因进行注释了。首先我们要先找到这些差异基因的基因名:

> de_genes <- subset(de_clusters, qval<0.05)
> length(de_genes$genes)
[1] 4435

基因的ID进行转换:

基因ID转换
> entrez_genes <- bitr(de_genes$genes, fromType="SYMBOL", 
                      toType="ENTREZID", 
                      OrgDb="org.Mm.eg.db")

NOTE:接下来一步,根据课程(Smartseq2 scRNA小鼠发育学习笔记-4-差异分析及功能注释)里写的,作者剔除掉了一个基因名

> entrez_genes <- entrez_genes[!entrez_genes$ENTREZID %in% "101055843",]
> length(entrez_genes$SYMBOL)
[1] 4281 #有些基因SYMBOL没有对应的ENTREZID,所以少了100多个基因
#把那些存在ENTREZID的基因的基因名和cluster信息提取出来
> de_gene_clusters <- de_genes[de_genes$genes %in% entrez_genes$SYMBOL,
                             c("genes", "cluster")]
# 保持de_gene_clusters$genes的顺序不变,将symbol变成entrez ID
> de_gene_clusters <- data.frame(
  ENTREZID=entrez_genes$ENTREZID[entrez_genes$SYMBOL %in% de_gene_clusters$genes],
  cluster=de_gene_clusters$cluster
)

现在看一下de_gene_clusters,可以看出来这4000多个差异基因的ENTREZID名字都有一个对应的cluster了:

(Smartseq2) single cell RNA-seq分析练习_第21张图片

下面就是把这些混在一起的cluster们都拆分出来,

> list_de_gene_clusters <- split(de_gene_clusters$ENTREZID, 
                                de_gene_clusters$cluster)

然后再看看我们拆分的情况:

(Smartseq2) single cell RNA-seq分析练习_第22张图片
这里就可以看到每一个cluster都有多少差异基因了

下面就是注释的步骤了:

> formula_res <- compareCluster(
  ENTREZID~cluster, 
  data=de_gene_clusters, 
  fun="enrichGO", 
  OrgDb="org.Mm.eg.db",
  ont          = "BP",
  pAdjustMethod = "BH",
  pvalueCutoff  = 0.01,
  qvalueCutoff  = 0.05
)

最后就是可视化:
在教程里,大神用的是dotplot来画图,可奈何我的电脑不知道为何一直报错。。。明明就是很简单的一句代码:

> dotplot(formula_res, showCategory=5)

解决了两天也没弄好,后来寻思着那就换一个包画图吧。。。在网上搜了好久,发现了这篇文章:听说你也在画dotplot,但是我不服! 文章里说“clusterProfiler的输出你不用as.data.frame,就可以直接传给ggplot2”,那我就用ggplot2试试吧

>  ggplot(formula_res, aes(Cluster, Description), showCategory=5) 
+   geom_point(aes(color=qvalue, size=GeneRatio)) + theme_bw()+scale_colour_gradient(low="#132B43",high="#56B1F7")
(Smartseq2) single cell RNA-seq分析练习_第23张图片

到此为止,smartseq2的单细胞测序基本的分析就做完了。因为我不做胚胎这块,发育轨迹接触的机会也几乎没有,所以没有跟着教程做发育谱系可视化这一块练习(Smartseq2 scRNA小鼠发育学习笔记-5-发育谱系推断及可视化),有兴趣和有需要的同学可以继续练习这一块。总之,需要深入学习的还有很多,这次练习的收获就是初次接触了Seurat包,也是单细胞测序分析的主流包。对于这些经常能用得到的包,还是多研究一下比较好,最好是能去官网阅读一下说明书,加深理解。

你可能感兴趣的:((Smartseq2) single cell RNA-seq分析练习)