如何在R的ggtree中为分类树末端标签添加彩色背景？

问题描述 #

我正在绘制一棵分类树，希望实现为末端标签添加彩色背景的效果。以下是我目前的最小可复现代码及当前效果，请问需要做哪些修改才能达到目标效果？

#install.packages("ape")
library(ape)
#install.packages("data.tree")
library(data.tree)
#BiocManager::install("ggtree")
library(ggtree)
#BiocManager::install("phyloseq")
library(phyloseq)
library(tidyverse)

data(GlobalPatterns)
data <- tax_table(GlobalPatterns) [1:50, ] |>
  as.data.frame() |>
  mutate(across(everything(), ~ replace_na(., "Incertae sedis"))) |>
  mutate(
    TaxLineage = paste0(
      "K: ",
      Kingdom,
      "; P: ",
      Phylum,
      "; C: ",
      Class,
      "; O: ",
      Order,
      "; F: ",
      Family,
      "; G: ",
      Genus,
      "; S: ",
      Species
    )
  ) |>
  select(TaxLineage) |>
  mutate(
    TaxLineage = str_replace_all(
      TaxLineage,
      "K:\\s*|P:\\s*|C:\\s*|O:\\s*|F:\\s*|G:\\s*|S:\\s*",
      ""
    ),
    TaxLineage = str_replace_all(TaxLineage, ";\\s*", "/")
  )

node <- as.Node(data.frame(
  pathString = data$TaxLineage,
  stringsAsFactors = FALSE
))
tree <- as.phylo(node)

plot <- ggtree(tree, layout = "circular", size = 0.5) +
  geom_nodelab(angle = 0, size = 2) +
  geom_tiplab() +
  geom_highlight(node = 12, fill = "firebrick", alpha = 0.75) +
  theme(plot.margin = margin(t = 80, r = 0, b = 80, l = 0))
plot

修改方案 #

要实现末端标签的彩色背景，需通过「先绘制背景矩形，再叠加标签文本」的方式完成，核心步骤如下：

• 保留分类分组信息：预处理数据时保留用于颜色分组的分类层级（如示例中的Phylum），用于后续颜色映射。
• 提取末端节点坐标：从ggtree的绘图数据中筛选出所有末端节点（isTip == TRUE）的位置信息。
• 绘制背景矩形：用geom_rect根据末端节点坐标绘制矩形背景，颜色通过分类分组映射，调整矩形参数适配标签大小。
• 对齐标签位置：修改geom_tiplab的offset参数，让文本精准叠加在背景矩形上。

修改后的完整代码 #

#install.packages("ape")
library(ape)
#install.packages("data.tree")
library(data.tree)
#BiocManager::install("ggtree")
library(ggtree)
#BiocManager::install("phyloseq")
library(phyloseq)
library(tidyverse)

data(GlobalPatterns)
data <- tax_table(GlobalPatterns) [1:50, ] |>
  as.data.frame() |>
  mutate(across(everything(), ~ replace_na(., "Incertae sedis"))) |>
  mutate(
    TaxLineage = paste0(
      "K: ",
      Kingdom,
      "; P: ",
      Phylum,
      "; C: ",
      Class,
      "; O: ",
      Order,
      "; F: ",
      Family,
      "; G: ",
      Genus,
      "; S: ",
      Species
    )
  ) |>
  select(TaxLineage, Phylum) |>  # 保留Phylum用于颜色分组
  mutate(
    TaxLineage = str_replace_all(
      TaxLineage,
      "K:\\s*|P:\\s*|C:\\s*|O:\\s*|F:\\s*|G:\\s*|S:\\s*",
      ""
    ),
    TaxLineage = str_replace_all(TaxLineage, ";\\s*", "/")
  )

# 构建树结构
node <- as.Node(data.frame(
  pathString = data$TaxLineage,
  stringsAsFactors = FALSE
))
tree <- as.phylo(node)

# 绘制基础树并提取绘图数据
p <- ggtree(tree, layout = "circular", size = 0.5)

# 合并末端节点的分类信息与绘图坐标
tip_data <- p$data %>%
  filter(isTip) %>%
  left_join(
    data %>% mutate(label = str_remove(TaxLineage, ".*/")) %>% select(label, Phylum),
    by = "label"
  )

# 计算矩形背景的参数（适配圆形布局）
tip_data <- tip_data %>%
  mutate(
    xmin = x + 0.1,
    xmax = x + 0.6,
    ymin = y - 0.1,
    ymax = y + 0.1
  )

# 最终绘图：先画背景矩形，再叠加标签和其他元素
final_plot <- p +
  # 绘制末端标签背景矩形
  geom_rect(
    data = tip_data,
    aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = Phylum),
    alpha = 0.7
  ) +
  # 绘制末端标签，调整offset让文本在背景上
  geom_tiplab(offset = 0.3, size = 2) +
  geom_nodelab(angle = 0, size = 2) +
  geom_highlight(node = 12, fill = "firebrick", alpha = 0.75) +
  theme(plot.margin = margin(t = 80, r = 0, b = 80, l = 0))

final_plot

关键说明 #

• 颜色分组自定义：示例中用Phylum门水平作为颜色映射依据，可直接替换为Class、Family等其他分类层级。
• 矩形参数调整：xmin、xmax、ymin、ymax的值可根据标签大小、树的整体布局灵活调整，确保背景完全覆盖标签文本。
• 布局适配：若使用线性布局（layout = "rectangular"），只需调整矩形坐标的计算逻辑即可，实现原理一致。

内容的提问来源于stack exchange，提问作者ginn