欢迎关注R语言数据分析指南
❝本节来分享解读一下nature communications上一篇文章的数据可视化案例图，论文中图表的数据+代码作者均有提供可从文章中直接下载，数据及代码整理的非常整洁明了，实际测试均可成功运行，对此感兴趣的读者可以去原文中详细查看。本次来介绍论文中的Figure_2图，个人观点仅供参考，更多详细内容请参考论文介绍。
论文
The biogeography of soil microbiome potential growth rates
https://www.nature.com/articles/s41467-024-53753-w
论文原图展示
图形解读
❝图2中最主要的当然是a图，此图相信读者们在很多论文中都看到过。热图色块表示组内相关性分析的结果，链接线则表示其它指标与理化因子等之间的关系，即组间相关性分析结果。通常此图的绘制主要是通过linkET包来实现，但是若是对图形有更高的个性化要求修改起来较为麻烦，在该论文图中作者则是通过自定义函数来进行相关性分析及数据格式整合，最终通过geom_segment()函数来添加左侧的链接线，这种思路非常值得推荐。下面来展示具体的代码，数据+代码论文中均可下载。
代码展示
library(readxl)
library(ggplot2)
library(ggpubr)
library(tidyr)
library(Hmisc)
growth <- data.frame(read_excel("41467_2024_53753_MOESM4_ESM.xlsx"))
cordata<- growth[,c("AI","MAT","pH","CS","SOC","TN","TP","DOC","AvaiN",
"Ascomycota","Gemmatimonadota","Actinobacteriota",
"Basidiomycota","Acidobacteriota","Proteobacteria",
"RelGrowth")]
tri.cordata <- function(cordata,vari,method) {
cordata1<-cordata[,names(cordata)[!names(cordata) %in% vari]]
cordata2<-cordata
df<-rcorr( as.matrix(cordata1),type=method)
df_r <- data.frame(df$r)
df_r[lower.tri(df_r, diag = TRUE)]=NA
df_r$fact1 <- row.names(df_r)
df_r <- gather(df_r, key="fact2", value='r',-fact1)
df_P <- data.frame(df$P)
df_P[lower.tri(df_P, diag = TRUE)]=NA
df_P$fact1 <- row.names(df_P)
df_P <- gather(df_P, key="fact2", value='P',-fact1)
df<-cbind(df_r,df_P$P)
names(df)[4]="P"
df$Pmark<-NA
df$Pmark[which(df$P>=0.05)] <- NA
df$Pmark[which(df$P>=0.01 & df$P<0.05)] <- "*"
df$Pmark[which(df$P>=0.001 & df$P<0.01)] <- "**"
df$Pmark[which(df$P>=0 & df$P<0.001)] <- "***"
df$fact1 <- factor(df$fact1,levels = rev(names(cordata1)))
df$fact2 <- factor(df$fact2,levels = rev(names(cordata1)))
df2<-rcorr( as.matrix(cordata2),type="spearman")
n1<-ncol(cordata1)
n2<-ncol(cordata2)
df2<-data.frame(fact=rep(row.names(df2$r)[1:n1],n2-n1),
vari=rep(names(cordata2)[(n1+1):n2],each=n1),
r=c(df2$r[1:n1,(n1+1):n2]),
P=c(df2$P[1:n1,(n1+1):n2]))
df2$x=NA
df2$y=NA
df2$xend=NA
df2$yend=NA
if (n2-n1 == 1) {
df2$x=2
df2$y=n1-1
df2$xend=n1:1
df2$yend=n1:1
} else if (n2-n1 == 2) {
df2$x=rep(c(2,4),each=n1)
df2$y=rep(c(n1-3,n1-1),each=n1)
df2$xend=rep(n1:1,n2-n1)
df2$yend=rep(n1:1,n2-n1)
} else if (n2-n1 == 3) {
df2$x=rep(c(2,3.5,5),each=n1)
df2$y=rep(c(n1-4,n1-2.5,n1-1),each=n1)
df2$xend=rep(n1:1,n2-n1)
df2$yend=rep(n1:1,n2-n1)
}
df2$Pmark<-NA
df2$Pmark[which(df2$P>=0.05)] <- NA
df2$Pmark[which(df2$P>=0.01 & df2$P<0.05)] <- "*"
df2$Pmark[which(df2$P>=0.001 & df2$P<0.01)] <- "**"
df2$Pmark[which(df2$P>=0 & df2$P<0.001)] <- "***"
df2<-na.omit(df2)
list(df,df2)
}
corplot<- tri.cordata(cordata=cordata,vari="RelGrowth",method="spearman")
p1 <- ggplot()+
geom_raster(data=corplot[[1]],aes(x=fact1,y=fact2,fill=r),na.rm = T)+
scale_fill_gradient2(limits = c(-1,1), high = 'dodgerblue', mid = 'white',low = 'red',midpoint = 0,
na.value =NA, name = "Spearman's r" )+
geom_text(data=corplot[[1]],aes(x=fact1,y=fact2,label=Pmark),size=2)+
theme_test() +
scale_y_discrete(position = "right",
labels=c("AI"="Aridity index",
"MAT"="Mean annual temperature",
"SOC"="Soil organic C",
"DOC"="Dissolved organic C",
"TN"="Soil total N",
"TP"="Soil total P",
"AvaiN"="Available N",
"CS"="Clay+silt"))+
scale_x_discrete(labels=c("AI"="Aridity index",
"MAT"="Mean annual temperature",
"SOC"="Soil organic C",
"DOC"="Dissolved organic C",
"TN"="Soil total N",
"TP"="Soil total P",
"AvaiN"="Available N",
"CS"="Clay+silt")) +
geom_segment(data=corplot[[2]],aes(x=x,y=y,xend=xend,yend=yend,color=r,size=abs(r))) +
scale_size_continuous(range = c(0.1, 0.7), name = "Spearman's r")+
scale_color_gradient2(limits = c(-1,1), high = 'dodgerblue', mid = 'white',low = 'red',midpoint = 0,
na.value =NA, name = "Spearman's r" )+
annotate("text",x=2.5,y=14.5,label=expression("Potential "*G[mass]),size=3)+
theme_test()+
theme(legend.title = element_text(size=7),
legend.text = element_text(size=6),
legend.key.size = unit(0.3,"cm"),
legend.key = element_blank(),
plot.margin = unit(c(3,30,3,30), "pt"),
axis.title = element_blank(),
axis.text = element_text(colour = "black",size=7),
axis.text.x = element_text(angle = 60,hjust=1))
关注下方公众号下回更新不迷路
购买介绍
❝本节介绍到此结束，有需要学习R数据可视化的朋友欢迎到淘宝店铺：R语言数据分析指南，购买小编的R语言可视化文档(2024版)，购买将赠送2023年的绘图文档内容。目前此文档(2023+2024)已经更新上传200案例文档，每个案例都附有相应的数据和代码，并配有对应的注释文档，方便大家学习和参考。
2024更新的绘图内容将同时包含数据+代码+注释文档+文档清单，2023无目录仅有数据文件夹，小编只分享案例文档，不额外回答问题，无答疑服务，零基础不推荐买。
案例特点
所选案例图均属于个性化分析图表完全适用于论文发表，内容异常丰富两年累计发布案例图200+，2024年6月起提供html版注释文档更加直观易学。文档累计上千人次购买拥有良好的社群交流体验。R代码结构清晰易懂，为防止中文乱码2024起提供单独的注释文档
R代码结构清晰易懂，为防止中文乱码2024年6月起提供单独html注释文档
