欢迎关注R语言数据分析指南
❝本节来介绍Nature一篇新论文中的一组相关性热图的绘制方法，作者提供了数据但是未提供所对应的代码，小编根据论文所提供的source data数据结合原图进行了些许微调，力争还原图表。 更多详细内容请查看论文内介绍。本次介绍两种绘图方法
论文信息
Multi-omic profiling reveals age-related immune dynamics in healthy adults
Gong, Q., Sharma, M., Glass, M.C. et al. Multi-omic profiling reveals age-related immune dynamics in healthy adults. Nature (2025). https://doi.org/10.1038/s41586-025-09686-5
论文原图
代码展示
library(tidyverse)
library(legendry)
library(readxl)
library(magrittr)
library(corrplot)
library(RColorBrewer)
library(grid)
数据处理
原始数据中有很多NA根据个人经验应该是将其转化为0在进行相关性分析
df1 <- read_excel("41586_2025_9686_MOESM8_ESM.xlsx",sheet="Fig4l") %>%
set_colnames(c("subjectGuid","CD4 T cell","CD8 T cel",
"Total_IgG_D7","Total_IgG_D0","IgG2/IgG3_Ratio_D0",
"IgG2_IgG3_Ratio_D7","Response_Score",
"IgG2_Total_IgG")) %>% select(-1) %>%
mutate(across(everything(), ~replace_na(.x, 0)))
corrplot绘制相关性热图
col_custom <- colorRampPalette(rev(brewer.pal(11, "RdBu")))(200)
cor(df1,method = "spearman",use = "pairwise.complete.obs") %>%
corrplot(type="lower",
col=col_custom,
tl.srt = 90,
tl.col = c(rep("tomato",2),rep("#7294D4",6)),
tl.cex = 0.8,
pch.col="white",
cl.ratio=0.2,
cl.length = 5, # 刻度数量
cl.pos = "r")
可以看到代码过程非常的简洁，但是与论文原图还是有些许不同。由于小编不太熟悉R基础绘图语法，下面介绍如何使用ggplot2代码风格来绘制出原图
数据整合
cor_mat <- cor(df1, method = "spearman",use = "pairwise.complete.obs")
cor_long <- as.data.frame(as.table(cor_mat))
names(cor_long) <- c("fact1","fact2","r")
lev <- colnames(cor_mat)
cor_data <- cor_long %>%
mutate(
i = match(fact1, colnames(cor_mat)), #把 fact1 转换成对应的列索引
j = match(fact2, colnames(cor_mat)) # 把 fact2 转换成对应的行索引
) %>%
filter(j >= i) # 只保留下三角的数据
# 构建对角线文本
diag_labels <- tibble(
fact1 = factor(lev, levels = lev),
fact2 = factor(lev, levels = rev(lev)),label = lev)
ggplot2版相关性热图
plot <- ggplot(cor_data, aes(x = fact1,y = fact2)) +
geom_tile(color = "grey50",linewidth = 0.6,fill="white") +
geom_point(aes(color=r,size=r),pch=19) +
scale_y_discrete(limits = rev(levels(factor(cor_data$fact2)))) +
geom_text(data = diag_labels,
aes(fact1, fact2, label = label),inherit.aes = F,
hjust = 0, vjust = 1,nudge_x=-0.2,nudge_y = 0.6,
size = 10,angle=90,size.unit = "pt",
color=c(rep("tomato",2),rep("#7294D4",6))) +
scale_color_gradientn(limits = c(-1,1),na.value = NA,
colours = rev(RColorBrewer::brewer.pal(11,"RdBu")),
name = "Spearman's r") +
scale_size_continuous(range = c(8,11)) +
coord_cartesian(clip="off") +
guides(size="none",color=guide_colorbar(
barwidth=unit(0.5,"cm"),barheight=unit(5,"cm"))) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_blank(),
plot.margin = margin(2,1,0.5,2,unit="cm"),
axis.text.y=element_text(color=c(rep("#7294D4",6),rep("tomato",2)),
vjust=0.5,hjust=1),
panel.grid = element_blank(),
axis.title = element_blank(),
legend.frame = element_rect(color="black"),
legend.background = element_blank(),
legend.title = element_text(color="black",size=10,vjust=0.5,hjust=1),
legend.text=element_text(color="black",size=10)) +
annotation_custom( # 添加线条注释
grob=grid.segments(gp=gpar(col="#7294D4",lwd=10)),
xmin=-3.8,xmax=-3.8,ymin=1,ymax=6) +
annotation_custom( # 添加线条注释
grob=grid.segments(gp=gpar(col="tomato",lwd=10)),
xmin=-2,xmax=-2,ymin=6.7,ymax=8.3) +
annotation_custom(
grob = grid.text(label="RNA age\nmetric (up)",hjust=0,vjust=0,rot=0,
gp=gpar(col="tomato",fontsize=10)),
xmin=-3.9,xmax=-3.9,ymin=7.2,ymax=7.2) +
annotation_custom(
grob = grid.text(label="BYam\n2020-2021",hjust=0,vjust=0,rot=90,
gp=gpar(col="#7294D4",fontsize=10)),
xmin=-4.1,xmax=-4.1,ymin=3,ymax=3)
plot
ggsave(plot,file="heatmap.pdf",width=6.57,height=4.17,unit="in")
关注下方公众号下回更新不迷路
❝本节介绍到此结束，有需要深入学习R数据可视化的读者欢迎购买下方所示付费文档，购买后会邀请加入对应交流群并分享数据。
详情介绍：
1. 内容更新截止2025年/12月/31日结束，后期无任何更新。
2. 只分享案例内容，无答疑，交流群只供读者互相交流，不会有人回答问题。
3. 内容只包含R语言绘图内容，无任何生信分析全套代码，有过高期望者不要买。
4. 有充足时间者可以考虑继续等待，2026年会正式出版R语言绘图相关的书籍
❝若上述几点都可以接受，欢迎付费购买此文档。购买后会联系小编会及时邀请进交流群，群内分享资料。通过在线腾讯文档分析案例清单，内附案例下载链接，案例代码文件夹支持下载到本地查看。
在线目录大纲
❝通过腾讯文档在线编辑，小编可实时进行bug注解，只要保证R软件及R包版本号与案例所示一致，无须担心代码运行报错问题。在线文档内附有案例代码下载链接
html注释文档
从2025年起的除极个别案例外，其余案例图提供下方所示html注释文档非常方便查看