1.目的
用对角线热图来展示相关性。上三角形是相关性p值(颜色和显著性)，下三角形是相关系数，同时展示两种信息，也没有显得很杂乱。
2.搜索
记得我早先见过，但当时没感觉这图有啥用，放过去咯。最早出现这个三角形的热图应该是Y叔和果子分享的帖子：
[用ggplot2来画带有对角线的热图]（放不了链接，简书不让）
然后找到了这篇：[写个geom_rectriangle图层画对角线热图]（放不了链接，简书不让），本文部分代码参考了这一篇👆
向文章原作者致歉，我在别的平台发布的这一篇都加上了链接，但这里确实加不了。如果读者们想看，可以复制题目自己搜索，可以找到原文的。
直接写成了函数，可以方便的画图咯。
在前人的肩膀上，已经可以完成对角线热图的绘制，只需要加上一个p值就可以了。
3.沿对角线对称的相关性热图
需要一个数值型的数据框或者矩阵，表达矩阵就可以，示例数据mtcars也行。这个不太适合画横纵坐标都相同的热图，可以只取相关性矩阵的一部分，比如就计算mtcars的16列和711列之间的相关性。
library(tidyverse)
library(corrplot)
if(!require(ggcor))devtools::install_github("xukaili/ggcor",upgrade = F)
datp <- cor.mtest(mtcars)$p[7:11,1:6] %>%
as.data.frame()%>%
rownames_to_column("A") %>%
gather("B","p",-A)
data <- cor(mtcars)[7:11,1:6] %>%
as.data.frame()%>%
rownames_to_column("A") %>%
gather("B","r",-A) %>%
mutate(p = datp$p)
data$ps = case_when(data$p<0.01~"**",
data$p<0.05~"*",
T~"")
source("function.R")
# function.R是个脚本，里面的代码是https://mp.weixin.qq.com/s/YtHh_1GbwdmjLwF4scJrsA里面[造图层]那一大段
#install.packages("ggnewscale")
ggplot()+
geom_rectriangle(data = data, aes(A, B, fill = -log10(p)),type = "upper", r = 1)+
scale_fill_gradient(low = "white", high = "#66a3b1",na.value = "white")+
ggnewscale::new_scale_fill()+
geom_rectriangle(data = data, aes(A, B, fill = r),type = "lower", r = 1)+
scale_fill_gradient2(high = "red", mid = "white",low = "blue")+
labs(x = "", y = "")+
geom_text(data = data,aes(A,B,label = ps),
nudge_y = 0.05)+
theme_bw()
这里的最后一句就是加显著性标签用的。
4.免疫细胞与基因的相关性热图
这个数据来自免疫细胞与基因的相关性热图，m和p分别是免疫细胞和基因的相关性系数和p值，关于为什么横纵坐标不同，以及怎么得到这个数据，都在里面啦。
load("PM.Rdata")
dim(p)
## [1] 28 7
dim(m)
## [1] 28 7
p[1:4,1:4]
## CENPF CENPU CEP55 KIF4A
## Activated B cell 1.968812e-07 1.470000e-14 7.705000e-13 6.075000e-11
## Activated CD4 T cell 8.740000e-10 6.990000e-14 7.885000e-13 7.915000e-13
## Activated CD8 T cell 1.399524e-02 6.022069e-01 9.375117e-01 1.431641e-01
## Activated dendritic cell 6.339883e-04 8.438520e-01 1.907942e-01 6.550569e-01
m[1:4,1:4]
## CENPF CENPU CEP55 KIF4A
## Activated B cell 0.15386941 0.304567460 0.326199847 0.27690014
## Activated CD4 T cell 0.37535403 0.617726731 0.686491006 0.65282992
## Activated CD8 T cell -0.07302135 -0.015508140 -0.002332703 -0.04354359
## Activated dendritic cell -0.10139930 -0.005860714 0.038911461 -0.01329231
也是同样的输入数据和代码咯。
datp <- p %>%
as.data.frame()%>%
rownames_to_column("A") %>%
gather("B","p",-A)
data <- m %>%
as.data.frame()%>%
rownames_to_column("A") %>%
gather("B","r",-A) %>%
mutate(p = datp$p)
data$ps = case_when(data$p<0.01~"**",
data$p<0.05~"*",
T~"")
ggplot()+
geom_rectriangle(data = data, aes(A, B, fill = -log10(p)),type = "upper", r = 1)+
scale_fill_gradient(low = "white", high = "#66a3b1")+
ggnewscale::new_scale_fill()+
geom_rectriangle(data = data, aes(A, B, fill = r),type = "lower", r = 1)+
scale_fill_gradient2(high = "red", mid = "white",low = "blue")+
labs(x = "", y = "")+
geom_text(data = data,aes(A,B,label = ps),
nudge_y = 0.05)+
theme(axis.text.x = element_text(angle = 50,
vjust = 0.5))+
coord_fixed()
