1.目的
用對角線熱圖來展示相關(guān)性。上三角形是相關(guān)性p值(顏色和顯著性)，下三角形是相關(guān)系數(shù)，同時展示兩種信息，也沒有顯得很雜亂。
2.搜索
記得我早先見過，但當(dāng)時沒感覺這圖有啥用，放過去咯。最早出現(xiàn)這個三角形的熱圖應(yīng)該是Y叔和果子分享的帖子：
[用ggplot2來畫帶有對角線的熱圖]（放不了鏈接，簡書不讓）
然后找到了這篇：[寫個geom_rectriangle圖層畫對角線熱圖]（放不了鏈接，簡書不讓），本文部分代碼參考了這一篇??
向文章原作者致歉，我在別的平臺發(fā)布的這一篇都加上了鏈接，但這里確實加不了。如果讀者們想看，可以復(fù)制題目自己搜索，可以找到原文的。
直接寫成了函數(shù)，可以方便的畫圖咯。
在前人的肩膀上，已經(jīng)可以完成對角線熱圖的繪制，只需要加上一個p值就可以了。
3.沿對角線對稱的相關(guān)性熱圖
需要一個數(shù)值型的數(shù)據(jù)框或者矩陣，表達(dá)矩陣就可以，示例數(shù)據(jù)mtcars也行。這個不太適合畫橫縱坐標(biāo)都相同的熱圖，可以只取相關(guān)性矩陣的一部分，比如就計算mtcars的16列和711列之間的相關(guān)性。
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()
這里的最后一句就是加顯著性標(biāo)簽用的。
4.免疫細(xì)胞與基因的相關(guān)性熱圖
這個數(shù)據(jù)來自免疫細(xì)胞與基因的相關(guān)性熱圖，m和p分別是免疫細(xì)胞和基因的相關(guān)性系數(shù)和p值，關(guān)于為什么橫縱坐標(biāo)不同，以及怎么得到這個數(shù)據(jù)，都在里面啦。
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
也是同樣的輸入數(shù)據(jù)和代碼咯。
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()
