热图我们做过很多，参照公众号热图系列，这里介绍三角热图的绘制，演示corrplot的参数设置。为了让演示有意义，这里的热图数据使用单细胞亚群相关分析数据演示，之前我们简单介绍过（玩转单细胞(4)：单细胞相关性）。代码参考一篇NC的文章，Cortical arealization of interneurons defines shared and distinct molecular programs in developing human and macaque brains，这篇文章也提供给了其他的代码可供学习。

（reference：Cortical arealization of interneurons defines shared and distinct molecular programs in developing human and macaque brains）

#===========================================================================

#相关性热图-对角线热图

#===========================================================================


setwd('D:\\KS项目\\公众号文章\\单细胞相关性-三角热图')


library(Seurat)
library(dplyr)
library(ggplot2)
library(corrplot)
library(RColorBrewer)

#我没有亚群，所以这里用cluster代替，看看相关聚类效果
uterus$subtype <- paste0("Cells_",uterus$seurat_clusters)

Idents(uterus) <- "subtype"
Markers <- FindAllMarkers(uterus,only.pos= T, min.pct = 0.2, logfc.threshold = 0.25,verbose = T,max.cells.per.ident = 2000)
Markers <- subset(Markers[grep("^RP[L|S]",Markers$gene, ignore.case = FALSE,invert=TRUE),],subset=p_val_adj < 0.05)
Markers_av <- AverageExpression(uterus,group.by = "subtype",features = unique(Markers$gene),assays = "RNA") 
Markers_av <- Markers_av$RNA
gene_cell_exp <- t(scale(t(Markers_av),scale = T,center = T))

#计算相关性
cell_cor <- cor(as.matrix(gene_cell_exp), method = 'spearman')

#显著性检验
cell_cor_p <- cor.mtest(cell_cor, conf.level = 0.95)$p

使用corrplot绘图，我注释了常用的参数，其他的参数可自行探究，很多文献中的个性化图并没有做什么，只是将参数调整好了，你也会得到一张审稿人点赞的图。

corrplot(cell_cor, #相关性矩阵
         method = 'circle',#热图形状，默认是circle，可选c("circle", "square", "ellipse", "number", "shade", "color", "pie")
         order = "original", #矩阵排列顺序，默认original是顺序不变，按照矩阵列名顺序，如果你需要聚类展示，可以选择hclust，选择hclust，则需设置参数hclust.method
         type = "full", #热图类型，默认full绘制整个热图，设置"lower", "upper“，分别表示展示下半角或者上半角热图
         addrect = NULL,#默认是NULL，如果order设置为hclust，则可以根据层次聚类添加聚类框线，设置为整数
         tl.pos = "lt", #文字字符标记位置，一般不用设置，自动的。type是full，默认是lt，文字位于左侧、顶部，上三角则默认是td，位于对角和顶部。如果只想展示在左侧设置为'l',只想展示在对角，设置为'd'
         tl.cex=.8,#文字标签大小
         col = rev(brewer.pal(n=8, name="RdYlBu")),#热图颜色，和heatmap设置相同
         tl.col = "black",#文字标签颜色
         cl.cex = 0.7,#legend标签文字大小
         cl.pos = "r",#legend位置，r表示位于右侧，b表示位于底部
         cl.length = 3,#legend标签break，相关矩阵系数是-1到1，设置为3则展示-1，0，1
         cl.ratio=0.1,#legend宽度，建议0.1-0.2
         title="XXX",#热图标题
         p.mat = cell_cor_p,#检验p矩阵，默认NULL，如果需要展示，可设置sig.level, insig, pch, pch.col, pch.cex are invalid等参数
         sig.level = 0.05,#图中展示的p值显著性阈值，默认0.05
         insig='label_sig',#默认标注的是非显著的，要标注显著的，需要设置为label_sig，也可以选择‘blank',将不显著的直接变为空白
         pch = '*',#R基本形状，用于标记显著的方块
         pch.col='red',#显著标记形状颜色
         pch.cex=1,##显著标记形状大小
         mar=c(3, 0, 2, 0),) #四个数字分别对应下左上右，距离边框位置，便于图的展示

plot

corrplot(cell_cor, 
         method = 'circle',
         order = "hclust", 
         hclust.method='ward.D',
         type = "full", 
         addrect = 5,
         col = rev(brewer.pal(n=8, name="RdYlBu")),
         tl.cex=0.8,
         tl.col = "black",
         cl.cex = 0.5,
         cl.pos = "r",
         cl.length = 5,
         cl.ratio=0.1,
         mar=c(3, 0, 2, 0)) 

image.png

有时候，我们可能还想对热图有所注释，例如这些亚群是归属于哪些大群？可以将不同来源大群的亚群用不同的颜色标注。

df <- uterus@meta.data[,c("celltype","subtype")] %>%
  distinct(celltype, subtype)
rownames(df) <- df$subtype
#设置分组颜色
group_color <- c("Smooth muscle cells" = '#E58606',
                 "Lymphocytes"=    '#5D69B1' ,           
                 "Unciliated epithelial cells"= '#52BCA3',
                 "Stromal fibroblasts"=   '#99C945',     
                 "Ciliated epithelial cells"='#CC61B0',
                 "Endothelial cells"='#24796C',          
                 "Macrophages"='#2F8AC4')
df$color <- group_color[df$celltype]
lab_order <- colnames(p$corr)
df <- df[lab_order,]#对分组颜色数据框重新排序

#plot，修改tl.col
corrplot(cell_cor, 
         method = 'square',
         order = "hclust", 
         hclust.method='ward.D',
         type = "upper", 
         col = rev(brewer.pal(n=8, name="RdYlBu")),
         tl.cex=0.8,
         tl.col = df$color,
         cl.cex = 0.5,
         cl.pos = "b",
         cl.length = 5,
         cl.ratio=0.1,
         p.mat = cell_cor_p,
         sig.level = 0.05,
         insig='blank',
         mar=c(3, 0, 2, 0)) 

image.png

还可以plot注释信息，以及其他的信息，比如这里我使用条形图添加了cell number，然后AI中手动拼图：

#可以plot注释，保存图片，手动拼图
df$subtype <- factor(df$subtype, levels = df$subtype)#固定顺序
ggplot(df, aes(x=subtype,y=1,fill=celltype))+ #plot亚群，颜色填充为分组
  geom_tile() + 
  theme_classic()+
  theme(axis.text = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        axis.line = element_blank(),
        legend.position = "bottom")+
  scale_fill_manual(values = group_color)#对应分组颜色。


#还可以添加的信息有cell number，当然其他内容可自行再添加
cell_number <- table(uterus$subtype) %>% as.data.frame()
rownames(cell_number) <- cell_number$Var1
cell_number <- cell_number[lab_order,]
cell_number$celltype <- df$celltype
#做条形图
cell_number$Var1 <- factor(cell_number$Var1, levels = df$subtype)#固定顺序
ggplot(cell_number,aes(x=Freq,y=rev(Var1),fill=celltype))+
  geom_col()+
  scale_fill_manual(values=group_color,guide="none")+
  scale_x_continuous(expand=c(0,0))+
  theme_classic()+
  theme(axis.title = element_blank(),
        axis.text.y = element_blank(), axis.ticks.y = element_blank())


###

# corrplot(cell_cor, 
#          method = 'square',
#          order = "hclust", 
#          hclust.method='ward.D',
#          type = "full", 
#          addrect = 5,
#          col = rev(brewer.pal(n=8, name="RdYlBu")),
#          tl.cex=0.8,
#          tl.col = df$color,
#          cl.cex = 0.8,
#          cl.pos = "b",
#          cl.length = 5,
#          cl.ratio=0.1,
#          p.mat = cell_cor_p,
#          sig.level = 0.05,
#          insig='blank',
#          mar=c(2, 0, 2, 0)) 

image.png