不久前有小伙伴留言，需要绘制相关性热图的示例数据，的确是我个人的疏忽，以后尽量附带示例数据，关注个人公众号R语言数据分析指南，在此先行拜谢了！！
在此就不对代码进行说明了，请参考以前的文档

rm(list=ls())
library(pacman)
pacman::p_load(tidyverse,psych,reshape,ggtree,aplot)
table1 <- read.delim("genus.xls",header =T,sep="\t",
           row.names = 1,check.names = F) %>% 
  t() %>% as.data.frame()

table2 <- read.delim("env.xls",header =T,sep="\t",
                     row.names = 1,check.names = F)

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)))

write.table (heatmap,file ="heatmap.xls", sep ="\t", row.names = F)

phr <- hclust(dist(cor)) %>% 
  ggtree(layout="rectangular", branch.length="none")

phc <- hclust(dist(t(cor))) %>% ggtree() + layout_dendrogram()

pp <- ggplot(heatmap,aes(gene,sample,fill=cor)) + 
  geom_tile()+theme_minimal()+
  scale_fill_viridis_c()+
  geom_text(aes(label=signif),size=6,color="white",hjust=0.5,vjust=0.5)+
  scale_y_discrete(position="right")+xlab(NULL) + ylab(NULL)+
  theme(axis.text.x=element_text(angle =90,hjust=1,vjust=0.5,
                                 family = "Times",face = "italic",
colour = "black",size=12),
        axis.text.y=element_text(family= "Times",
                                 face = "plain",colour = "black",size=12),
        legend.text=element_text(face="plain",family = "Times",
                                 colour = "black",size = 12))+
  guides(fill = guide_colorbar(direction = "vertical",reverse = F, 
                               barwidth = unit(.5, "cm"),
                               barheight = unit(15, "cm")))+labs(fill= "")

pp %>% insert_left(phr, width=.2) %>%
  insert_top(phc, height=.1)