本节来解答群中小伙伴的一个问题，绘制一个更富有美感的相关性热图，在原有的画图基础上加了一下小小的改动
https://mp.weixin.qq.com/s/FrPaME-OwIh9Eqdu2SlaJw
pacman::p_load(tidyverse,reshape,psych)
table1 <- read.delim("env.xls",header =T,sep="\t",
row.names = 1,check.names = F)
table2 <- read.delim("genus.xls",header =T,sep="\t",
row.names = 1,check.names = F) %>%
t() %>% as.data.frame()
pp <- corr.test(table1,table2,method="pearson",adjust = "fdr")
cor <- pp$r
pvalue <- pp$p
myfun <- function(pval) {
stars = ""
if(pval <= 0.001)
stars = "***"
if(pval > 0.001 & pval <= 0.01)
stars = "**"
if(pval > 0.01 & pval <= 0.05)
stars = "*"
if(pval > 0.05 & pval <= 0.1)
stars = ""
stars
}
heatmap <- melt(cor) %>% rename(replace=c("X1"="sample","X2"="gene",
"value"="cor")) %>%
mutate(pvalue=melt(pvalue)[,3]) %>%
mutate(signif = sapply(pvalue, function(x) myfun(x)))
前面的步骤与之前绘制相关性热图的代码一致，主要在数据可视化处做了些许修改
ggplot(heatmap,aes(sample,gene,col=cor))+
geom_tile(color="grey70",fill="white",size=1)+
geom_point(aes(size = abs(cor)),shape=15) +
geom_text(aes(label=signif),size=6,color="white",
hjust=0.5,vjust=0.7)+
labs(x = NULL,y = NULL,color=NULL) +
scale_color_viridis_c()+
scale_x_discrete(expand=c(0,0)) +
scale_y_discrete(expand=c(0,0)) +
theme(text=element_text(family="Roboto"),
axis.ticks.x = element_blank(),
axis.ticks.y=element_blank(),
panel.border = element_rect(fill=NA,color="grey70",
size=2, linetype="solid")) +
scale_size(range=c(1,10),guide=NULL)+
guides(color = guide_colorbar(direction = "vertical",
reverse = F,barwidth = unit(.5, "cm"),
barheight = unit(15, "cm")))
