复现Nature正刊上配图，换数据即可用！

本次使用R语言复现Nature正刊上的1张图！

R绘制-d图

✅d图构建一个圆形系统发育树（phylogenetic tree）+ 两层heatmap的组合图表，该图展示了与次级胆汁酸（BBAAs）代谢相关的特定细菌基因（bsh）在不同细菌中的存在情况和丰度比例。

图层结构解读（从内到外）：

• 1️⃣ 内层，系统发育树。展示细菌之间的系统发育关系，分支颜色代表门水平（Phylum），帮助识别高阶分类群。
• 2️⃣ 中间层，BBAAs产生能力。使用红色渐变heatmap表示每类细菌产出BBAAs的能力，从白色（未检测到）到深红（高比例）。
• 3️⃣ 外层，bsh基因存在情况。使用蓝色分类heatmap标示是否检测到_Choloylglycine hydrolase（bsh）基因，蓝色-基因存在（Present），浅蓝/白-基因缺失（Absent）。
• 4️⃣ 内层高亮区域，感兴趣的特定菌属。例如，Bifidobacterium、Enterococcus、Clostridium等。高亮显示这些菌属的系统发育位置，方便观察它们的功能基因特征与BBAA代谢能力。

✅读入测试数据

✅内层，系统发育树关键代码，

# 创建基础树图
tree_rooted$node.label <- gsub("'", "", tree_rooted$node.label) # 不展示标签
p <- ggtree(tree_rooted,
  layout = "circular", # 圆形树
  size = 0.5, open.angle = 5,
  branch.length = "none", aes(color = phylum) # 按照phylum层级着色
) %<+%
  tree_df_taxid +
  geom_tippoint(size = 0, alpha = 0) + # 添加图例中的圆点但不显示在实际节点上
  scale_color_npg(
    name = "Phylum", palette = c("nrc"), # 调用ggsci调色板
    alpha = 1,
    breaks = na.omit(unique(tree_df_taxid$phylum)), # 仅显示非NA的分类
    na.value = "grey40"
  ) +
  theme(
    legend.title = element_text(size = 11, family = "Helvetica") # 图例标题属性
  ) +
  guides(color = guide_legend(override.aes = list(size = 3, alpha = 1))) # 图例中不展示NA标签

p

这里注意几个细节，

• 图例的NA处理

breaks = na.omit(unique(tree_df_taxid$phylum)), # 仅显示非NA的分类

guides(color = guide_legend(override.aes = list(size = 3, alpha = 1))) # 图例中不展示NA标签

• 分支节点末尾点处理

geom_tippoint(size = 0, alpha = 0) # 添加图例中的圆点但不显示在实际节点上

• ggsci调色板调用

palette = c("nrc"), # 调用ggsci调色板

✅ 中层，红色渐变heatmap关键代码，

# 系统发育树添加中层环状渐变heatmap
p2 <- gheatmap(p1,
  proportions_df,
  offset = 1, width = 0.1, color = "black",
  colnames = FALSE
) +
  scale_fill_gradient2(
    low = "white",
    mid = "#ED7F7F",
    high = "#DC0000FF",
    midpoint = 0.3
  ) +
  labs(fill = "Fraction of total<br />BBAAs detected") +
  theme(
    legend.title = element_markdown(size = 11, family = "Helvetica")
  )
p2

这里注意一个小细节，

• 利用element_markdown使用markdown文本格式

labs(fill = "Fraction of total<br />BBAAs detected") + #<br />分行
  theme(
    legend.title = element_markdown(size = 11, family = "Helvetica")
  )

• scale_fill_gradient2构建渐变颜色卡，

scale_fill_gradient2(
    low = "white",
    mid = "#ED7F7F",
    high = "#DC0000FF",
    midpoint = 0.3
  )

✅ 外层，蓝色渐变heatmap关键代码，

# 系统发育树添加外层环状渐变heatmap

p4 <- gheatmap(p3,
  bsh_df,
  offset = 1.75, width = 0.1, color = "black",
  colnames = FALSE
) +
  scale_fill_manual(
    values = c("#EBF7FA", "#4DBBD5FF"),
    name = " Presence of *bsh* gene",
    na.translate = FALSE# 关闭NA标签显示在图例中
  ) +
  theme(legend.title = element_markdown())
p4

✅ 内层高亮区域，感兴趣的特定菌属关键代码，

# 高亮内层特定菌属
p5 <- p4 + geom_hilight(
  data = nodedf, mapping = aes(node = id),
  fill = highlight_colors,
  extendto = 8,
  size = 0.03
)

# 内层高亮特定菌属添加标签
for (i in seq_len(nrow(nodedf))) {
# Bacteroides标签特殊处理
if (nodedf$label[i] == "Bacteroides") {
    p5 <- p5 +
      geom_cladelabel(
        node = nodedf$id[i],
        label = "Bacteroides",
        align = FALSE,
        offset = 0.1,
        offset.text = -1.2,
        fontsize = 3.5,
        barsize = NA,
        angle = 0, # 保持水平
        hjust = 0.5,
        color = "black"
      )
  } else {
# 其他标签处理
    p5 <- p5 +
      geom_cladelabel(
        node = nodedf$id[i],
        label = nodedf$label[i],
        align = FALSE,
        offset = 0.2,
        offset.text = 0.1,
        fontsize = 3.5,
        barsize = NA,
        angle = "auto",
        hjust = 1.0,
        color = "black"
      )
  }
}

p5

这里注意几个小细节，

• geom_hilight高亮特定菌属，

# 高亮内层特定菌属
p5 <- p4 + geom_hilight(
  data = nodedf, mapping = aes(node = id),
  fill = highlight_colors,
  extendto = 8,
  size = 0.03
)

• geom_cladelabel为以上高亮区添加标签，

# 内层高亮特定菌属添加标签
p5 <- p5 +
      geom_cladelabel(
        node = nodedf$id[i],
        label = "Bacteroides",
        align = FALSE,
        offset = 0.1,
        offset.text = -1.2,
        fontsize = 3.5,
        barsize = NA,
        angle = 0, # 保持水平
        hjust = 0.5,
        color = "black"
      )

唯一不足的是，这里的标签不太容易调整为沿着弧线展示（可以考虑自定义函数完成），如原图，

本期结束！

测试数据+详细代码👇

（备注：299）