带对角线和显著性的相关性热图

1.目的

用对角线热图来展示相关性。上三角形是相关性p值(颜色和显著性)，下三角形是相关系数，同时展示两种信息，也没有显得很杂乱。

2.搜索

记得我早先见过，但当时没感觉这图有啥用，放过去咯。最早出现这个三角形的热图应该是Y叔和果子分享的帖子：

[用ggplot2来画带有对角线的热图]（放不了链接，简书不让）

然后找到了这篇：[写个geom_rectriangle图层画对角线热图]（放不了链接，简书不让），本文部分代码参考了这一篇👆

向文章原作者致歉，我在别的平台发布的这一篇都加上了链接，但这里确实加不了。如果读者们想看，可以复制题目自己搜索，可以找到原文的。

直接写成了函数，可以方便的画图咯。

在前人的肩膀上，已经可以完成对角线热图的绘制，只需要加上一个p值就可以了。

3.沿对角线对称的相关性热图

需要一个数值型的数据框或者矩阵，表达矩阵就可以，示例数据mtcars也行。这个不太适合画横纵坐标都相同的热图，可以只取相关性矩阵的一部分，比如就计算mtcars的1_6列和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()