相关性热图,顾名思义就是根据数据之间的相关性系数来绘制热图,可分为2类:组内相关性热图
与组间相关性热图
组内相关性热图,即由一组数据内部的相关性系数绘制而成,废话不多说直接看代码
相关性矩阵可视化
library(tidyverse)
library(corrplot)
cor(mtcars) %>% corrplot(method = "circle",order = "hclust",
type = "lower",tl.srt = 45,tl.col = "black")
正相关以蓝色显示,负相关以红色显示。颜色强度和圆圈的大小与相关系数成正比
full
:显示完整的相关矩阵
upper
:显示相关矩阵的上三角
lower
:显示相关矩阵的下三角
将相关图与显着性检验相结合
cor.mtest( )函数计算P值
res1 <- cor.mtest(mtcars)
sig.level = -1
显示所有p值
cor(mtcars)%>% corrplot(type="lower", order="hclust",tl.srt = 45,
tl.col = "black",
p.mat = res1$p,insig = "p-value",sig.level = -1)
显示不显著点的p值
cor(mtcars)%>% corrplot(type="lower", order="hclust",
p.mat = res1$p,insig = "p-value")
将不显著的点用空表示
cor(mtcars)%>% corrplot(type="lower",order="hclust",
p.mat = res1$p,insig = "blank")
在p值> 0.05的点上打X
cor(mtcars)%>% corrplot(type="lower",order="hclust",
p.mat = res1$p, sig.level = .05)
在p值> 0.01的点上打X
cor(mtcars)%>% corrplot(type="lower",order="hclust",
p.mat = res1$p, sig.level = .01)
将p值转化为*
添加于图上
cor(mtcars) %>% corrplot(type="lower", order="hclust",
p.mat = res1$p,insig = "label_sig",
sig.level = c(.001, .01, .05),
pch.cex = .9, pch.col = "white",
tl.srt = 45,tl.col = "black")
ggplot2绘制组内相关性热图
corr.test( )
会同时计算p值与相关性系数,通过for循环将p值转化为*
library("reshape")
library("psych")
p <- corr.test(mtcars,method="pearson",adjust = "fdr")
cor <- p$r
pvalue <- p$p
display <- pvalue
l1 <- nrow(display)
l2 <- ncol(display)
for(i in 1:l1){
for(k in 1:l2){
a <- as.numeric(display[i,k])
if(a <= 0.001){
a <- "***"
}
if( 0.001 < a && a <= 0.01){
a <- "**"
}
if(0.01 < a && a < 0.05){
a <- "*"
}
if(a >= 0.05){
a <- ""
}
display[i,k] <- a
}
}
构建ggplot2绘图文件并导出
heatmap <- melt(cor) %>% rename(replace=c("X1"="sample1","X2"="sample2",
"value"="cor")) %>%
mutate(pvalue=melt(pvalue)[,3]) %>%
mutate(display=melt(display)[,3])
write.table(heatmap,file ="heatmap.xls",sep ="\t",row.names = F)
ggplot2可视化
ggplot(heatmap,aes(sample1,sample2,fill=cor))+
geom_tile()+
theme_minimal()+
scale_fill_distiller(palette = "Spectral")+
geom_text(aes(label=display),size=5,color="white")+
scale_y_discrete(position="left")+xlab(NULL) + ylab(NULL)+
labs(fill ="expr")