上一篇文章里分析到CPM标准化（去除文库大小差异），接下来就是要做聚类分析了。
再说一句，CPM只对测序深度进行校正（也就是文库大小），如果你是想比较同一基因在不同样品间的表达差异，校正到测序深度就足够了，因为对于同一个基因来说，在样品A里是这么长，在样品B里还是这么长～但是！如果你要是比较同一样品里不同的基因表达量，就不能用CPM了！！！而要用RPKM/FPKM，这两个的标准化是在CPM的基础上，又对基因长度进行了校正处理，这样既可以横向比较某个基因在不同样本间的表达情况，又可以纵向比较同一个样本内不同基因的表达情况。
（一）聚类
聚类需要用到的是：
第一个：dist函数。它是计算距离用的，计算每一个细胞间的距离，在我们的矩阵里，也就是计算每一列之间的距离。关于dist计算距离的方法：主要有6种：”欧式euclidean”, “切比雪夫距离maximum”, “绝对值距离manhattan”, “Lance距离canberra”, “定型变量距离binary” or “明可夫斯基距离minkowski（使用时要指定p值）”。默认使用第一种欧氏距离，它计算的是：几何空间中两点之间的距离。思想类似于勾股定理求第三条斜边的长度=》平方和再开方（单细胞转录组学习笔记-5-熟悉文献作者提供的两个表达矩阵）。
第二个：hclust函数。进行层次聚类（系谱聚类）的方法。什么是层次聚类呢？这里有说明（R语言的三种聚类方法）：先计算样本之间的距离。每次将距离最近的点合并到同一个类。然后，再计算类与类之间的距离，将距离最近的类合并为一个大类。不停的合并，直到合成了一个类。关于hclust聚类的方法：”离差平方和法ward”, “最短距离法single”, “最长距离法complete”,”类平均法average”, “相似法mcquitty”, “中间距离法median” or “重心法centroid”。默认使用complete算法。
> hc=hclust(dist(t(finaldata2)))
#这里的t()是转置函数，因为dist()是以行计算距离的，而我们需要计算列之间的距离。
#可视化，labels=F是不显示各个样本名称，因为样本太多，会让图看起来很乱。
> plot(hc,labels = FALSE)
另外一个函数cutree，是对聚类树进行修剪。聚类结果是分群的，cutree就是指定输出都分了哪些群(结果是从大群到小群排列)。
> clus = cutree(hc, 4)
> group_list= as.factor(clus)
#得到的这个因子型变量group_list中样本顺序和输入的顺序一致，并且属于第几类都有记录
> table(group_list)
group_list
1 2 3 4
239 382 129 17
（二）提取批次信息
这篇文章的单细胞测序是分成两个板做的。“Libraries for scRNA-seq were prepared in two 384-well plates harboring CAFs from one tumor each,...”那么如何提取批次信息呢？
你可以去GEO网站看一下所有的样品名称，发现两个板唯一的区别就是0048还是0049
> head(colnames(finaldata2))
[1] " SS2_15_0048_A1" " SS2_15_0048_A2" " SS2_15_0048_A3" " SS2_15_0048_A4" " SS2_15_0048_A5" " SS2_15_0048_A6"
使用strsplit函数去分割matrix，strsplit(x, split, fixed = FALSE) ，需要注意两点：
1.字符串切分后，返回的是一个列表，如果要再还原成字符串，需要用unlist()
2.默认情况下它是使用正则表达式的，如果不想用，可以指定fixed = TRUE
> options(stringsAsFactors = F)
#分割字符串，此方法返回的数组包含被分割字符串的子字符串，每个子字符串都由另一个匹配给定表达式的子字符串终止，或者由此字符串末尾终止。
> plate=do.call(rbind.data.frame,strsplit(colnames(finaldata2),"_"))[,3]
#简单的讲，do.call（）的功能就是执行一个函数
（三）新建细胞的属性信息
# 还记得之前对基因进行过滤时，我们对行进行操作吗？
# apply(a,1, function(x) sum(x>1) > floor(ncol(a)/50))
# 现在这里要检测每个样本中有多少基因是表达的，是对列进行操作。count值以1为标准，rpkm值可以用0为标准
> n_g = apply(a,2,function(x) sum(x>1))
# 对于单细胞转录组，一般会有超过半数的基因不会表达
之后构建数据框：
> meta=data.frame(g=group_list,plate=plate,n_g=n_g)
#括号里分别是：聚类信息，批次信息，每个样品的基因表达信息
> meta$all='all'
> head(meta)#这里的all暂时没啥用，但是下面会用到。就是把矩阵加一列，这一列全都标注为"all"
g plate n_g all
SS2_15_0048_A1 1 0048 5076 all
SS2_15_0048_A2 2 0048 5593 all
SS2_15_0048_A3 1 0048 2798 all
SS2_15_0048_A4 2 0048 4696 all
SS2_15_0048_A5 1 0048 3572 all
SS2_15_0048_A6 1 0048 2875 all
（四）count表达矩阵热图
要注意，count的表达矩阵和rpkm表达矩阵的聚类分组不是一回事。
> grp=meta$g
> table(grp)
grp
1 2 3 4
239 382 129 17
之前我们得到的表达矩阵，过滤完以后大概还剩了16000个基因，对于画热图来讲太多了，所以我们可以只选取其中的一部分来画图。所以我们取表达量标准差最大的1000个基因(也即是说，这1000个基因在所有的样本中表达差异最大)。
> tail(sort(apply(finaldata2,1,sd)),1000)
#apply()函数是对我们的表达矩阵finaldata2取sd值，就是标准差。
#sort是把所有的基因排个序，默认是从小到大，取1000个。
#tail是取整个表里的最后1000个，那么也就是整个矩阵里表达量最大的1000了。
> top_g=names(tail(sort(apply(finaldata2,1,sd)),1000))#这里是取这1000个基因的名字了。
> head(top_g)#看看这些基因名
[1] "Tor1b" "Tceal8" "Rc3h2" "Gdi1" "Nras" "Wdr45b"
> library(pheatmap)
> pheatmap(finaldata2[top_g,],show_colnames =F,show_rownames = F)
这个热图是基因的绝对表达量，但是有一个问题是CPM标准化有一个缺陷，就是那些高表达并且在细胞群体表达差异很大的基因会严重影响那些低表达基因。也就是说，有些基因表达量低，但是人家也有差异的～所以要用scale()把这些基因的差异表示出来。
scale是对列进行操作，而我们是想对基因(也就是按行操作)，这个函数有两个主要的选项：center和scale ，其中center是将每列的元素减去这一列的均值(这个选项是默认TRUE的)；scale 是在center操作后，再将处理过的元素除以标准差(同样是默认TRUE的)。另外，处理完别忘了再转换回来。参考：单细胞转录组学习笔记-6-得到表达矩阵后看内部异质性
> n=t(scale(t(finaldata2[top_g,])))
#top_g是取的1000个基因的名字，是每一行的名字；
#t()是转置函数，行变成列；
#再用scale函数去操作
#最后再用t()转置函数再转回来，最后操作完了的新矩阵输入一个新变量n
上一个热图的范围是0-15，现在设置一个新范围-2到2。
> n[n>2]=2
> n[n< -2]= -2
# 先构建一个分组的数据框，想让画出来的热图是之前的分组信息（4个组）
> anno_col=data.frame(g=grp)
# 新热图的行名要样本名称，也就是归一化后的n矩阵的列名
> rownames(anno_col)=colnames(n)
> # 看一下结果，是不是样品名称
> head(anno_col)
g
SS2_15_0048_A1 1
SS2_15_0048_A2 2
SS2_15_0048_A3 1
SS2_15_0048_A4 2
SS2_15_0048_A5 1
SS2_15_0048_A6 1
> pheatmap(n,
+ show_colnames =F, #不显示列名
+ show_rownames = F, #不显示行名
+ annotation_col=anno_col) #在每一列上方加分组的信息
但是这张图的分组信息好乱，乱的像二维码。。。如果想让同一个组的呆一起怎么办？还记得之前的聚类用的函数吗？hclust，是的，就用它。现在不用最开始的finaldata2矩阵了，用scale后的n矩阵～
# 将原来finaldata2换为n
> hc=hclust(dist(t(n)))
> clus = cutree(hc, 4)
> top1000_grp=as.factor(clus)
> table(top1000_grp)
top1000_grp
1 2 3 4
399 194 47 127
> table(top1000_grp,grp)
grp
top1000_grp 1 2 3 4
1 160 233 6 0
2 28 149 0 17
3 36 0 11 0
4 15 0 112 0
*这里可以看出有399个基因属于新分组的1号组，但其中有233个属于原来分组的2号组(这个数量超过了原来分组的1号组)，可以看出新分组和原分组的重合度并不高，因此更加说明我们重新分组的重要性。
> new_anno_col=data.frame(g=top1000_grp)
> rownames(new_anno_col)=colnames(n)
> pheatmap(n,
+ show_colnames =F,
+ show_rownames = F,
+ annotation_col=new_anno_col)
（五）每个细胞检测到的基因数的差异
这篇文献对细胞进行过滤用了5个标准，这就是我之前写到的，每个人过滤的标准不是统一的。但是如果要过滤，我们必须要知道每一个细胞里有多少基因表达。
# 这里检测每个样本中有多少基因是表达的，count值以1为标准，rpkm值可以用0为标准
>n_g = apply(a,2,function(x) sum(x>1))
> head(meta)
g plate n_g all
SS2_15_0048_A1 1 0048 5076 all
SS2_15_0048_A2 2 0048 5593 all
SS2_15_0048_A3 1 0048 2798 all
SS2_15_0048_A4 2 0048 4696 all
SS2_15_0048_A5 1 0048 3572 all
SS2_15_0048_A6 1 0048 2875 all
#现在就用上了之前的meta信息里的all，是将全部的基因都画在一起
#检测细胞中可以表达的基因数量，这里要画的是所有样品中所有表达的基因数的平均值
>library(ggpubr)
>ggviolin(meta, x = "all", y = "n_g", fill = "all",
add = "boxplot", add.params = list(fill = "white"))
之后可以看一下，这个测序是分了两个板进行的，把两个板分开来画图：
#看下批次之间比较
>ggviolin(meta, x = "plate", y = "n_g", fill = "plate",
palette = c("#00AFBB", "#E7B800", "#FC4E07"),
add = "boxplot", add.params = list(fill = "white"))
还可以看看4个大组分别的基因表达数：
#hclust分组间比较
>ggviolin(meta, x = "g", y = "n_g", fill = "g",
add = "boxplot", add.params = list(fill = "white")) + stat_compare_means()
#stat_compare_means()是把图加上p-value
或者把4个组两两比较：
>my_comparisons <- list( c("1", "2"), c("2", "3"), c("3", "4") )
>ggviolin(meta, x = "g", y = "n_g", fill = "g",
add = "boxplot", add.params = list(fill = "white")) + stat_compare_means(comparisons = my_comparisons)+ # Add pairwise comparisons p-value
stat_compare_means(label.y = 50)
（六）画个PCA图
根据教程来，可以先把矩阵做一个备份：
> finaldata2_bk=finaldata2#备份
> dat=t(finaldata2)#把矩阵做个转置，现在行是样品，列是基因了
> dat=as.data.frame(dat)
> dat=cbind(dat,grp)#这里的grp是我们之前做的分类
用fviz_pca_ind函数进行可视化
> library("FactoMineR")
> library("factoextra")
> dat.pca <- PCA(dat[,-ncol(dat)], graph = FALSE)
> fviz_pca_ind(dat.pca,repel =T,
+ geom.ind = "point",
+ col.ind = dat$grp, # 按组分颜色
+ # palette = c("#00AFBB", "#E7B800"),
+ addEllipses = TRUE,
+ legend.title = "Groups"
+ )
