如何为ggalluvial桑基图添加Markdown格式的分层标签

我希望为以下ggalluvial桑基图中不同列的部分分层标签添加格式：

library(ggplot2)
library(ggalluvial)

dataset <- data.frame(Gene = c("A1", "B2", "C1", "DNA repair", "Q3"),
Type.of.mutation = c("somatic", "somatic", "somatic", "germline", "somatic"), 
Drug = c("A", "B", "C", "D", "E"), 
Response = c("Responsive", "Responsive", "Responsive", "Resistant", "Responsive"), 
weight = c(7L, 4L, 9L, 8L, 10L))

p <- (ggplot(dataset,aes(y=weight, axis2=Gene, axis1=Type.of.mutation, axis3=Drug)) + 
geom_alluvium(aes(fill=Response), width=1/2, knot.pos=0.2, reverse=TRUE) +
geom_stratum(width=1/2, fill="white", color="black", alpha=0.5) +
geom_label(stat="stratum", aes(label=after_stat(stratum)), size=3, label.size=NA,alpha=0) +
scale_x_discrete(limits=c("Mutation type", "Gene / Function", "Drug")) +
theme_bw() +
theme(
  axis.text.x=element_text(size=12, color="black"),
  axis.title.y=element_blank(), 
  axis.text.y=element_blank(),
  axis.ticks.y=element_blank(),
  axis.ticks.x=element_blank(),
  panel.grid.major=element_blank(), 
  panel.grid.minor=element_blank(),
  panel.border = element_blank(),
  panel.background = element_blank(),
  plot.title=element_text(hjust=0.5)
) +
theme(legend.position="bottom") +
ggtitle( paste0("Clinically-actionable targets" ) ))
print(p)

当前代码生成的桑基图如下：

我曾尝试用ggtext包的ggtext::geom_richtext替换geom_label（并为相关标签添加Markdown格式），但标签消失了。请问是否有方法为部分（而非全部）分层标签选择性添加文本格式？若实在不行我可以后期手动添加标签，但更倾向于自动化方案，以便后续修改数据时无需重复操作。

解决方案 #

直接替换geom_label时标签消失，是因为没有正确处理stat="stratum"的标签映射逻辑。以下提供两种自动化实现方式：

方式一：直接在geom_richtext中条件格式化标签 #

这种方式无需预计算数据，直接在aes中通过stage函数配合条件判断，给特定标签添加Markdown格式：

library(ggplot2)
library(ggalluvial)
library(ggtext)

dataset <- data.frame(
  Gene = c("A1", "B2", "C1", "DNA repair", "Q3"),
  Type.of.mutation = c("somatic", "somatic", "somatic", "germline", "somatic"), 
  Drug = c("A", "B", "C", "D", "E"), 
  Response = c("Responsive", "Responsive", "Responsive", "Resistant", "Responsive"), 
  weight = c(7L, 4L, 9L, 8L, 10L)
)

p <- ggplot(dataset,aes(y=weight, axis2=Gene, axis1=Type.of.mutation, axis3=Drug)) + 
  geom_alluvium(aes(fill=Response), width=1/2, knot.pos=0.2, reverse=TRUE) +
  geom_stratum(width=1/2, fill="white", color="black", alpha=0.5) +
  # 用geom_richtext配合stage实现条件格式化
  ggtext::geom_richtext(
    stat="stratum",
    aes(label=stage(
      stratum,
      after_stat=ifelse(stratum == "DNA repair", "**DNA repair**",
                       ifelse(stratum == "germline", "*germline*", stratum))
    )),
    size=3, label.size=NA, fill=NA, color="black"
  ) +
  scale_x_discrete(limits=c("Mutation type", "Gene / Function", "Drug")) +
  theme_bw() +
  theme(
    axis.text.x=element_text(size=12, color="black"),
    axis.title.y=element_blank(), 
    axis.text.y=element_blank(),
    axis.ticks.y=element_blank(),
    axis.ticks.x=element_blank(),
    panel.grid.major=element_blank(), 
    panel.grid.minor=element_blank(),
    panel.border = element_blank(),
    panel.background = element_blank(),
    plot.title=element_text(hjust=0.5)
  ) +
  theme(legend.position="bottom") +
  ggtitle("Clinically-actionable targets")

print(p)

方式二：预计算分层数据，批量处理标签格式 #

如果需要对大量标签做不同格式处理，预计算分层数据的方式更灵活：

library(ggplot2)
library(ggalluvial)
library(ggtext)
library(dplyr)

dataset <- data.frame(
  Gene = c("A1", "B2", "C1", "DNA repair", "Q3"),
  Type.of.mutation = c("somatic", "somatic", "somatic", "germline", "somatic"), 
  Drug = c("A", "B", "C", "D", "E"), 
  Response = c("Responsive", "Responsive", "Responsive", "Resistant", "Responsive"), 
  weight = c(7L, 4L, 9L, 8L, 10L)
)

# 预计算所有分层的位置与标签数据
p_temp <- ggplot(dataset,aes(y=weight, axis2=Gene, axis1=Type.of.mutation, axis3=Drug)) +
  stat_stratum(geom="blank")
stratum_data <- layer_data(p_temp)

# 为特定标签添加Markdown格式，支持粗体、斜体、颜色等
stratum_data$formatted_label <- case_when(
  stratum_data$stratum == "DNA repair" ~ "**DNA repair**",
  stratum_data$stratum == "germline" ~ "*germline*",
  stratum_data$stratum == "Responsive" ~ "<span style='color:#1f77b4'>Responsive</span>",
  TRUE ~ stratum_data$stratum
)

# 绘制图形
p <- ggplot(dataset,aes(y=weight, axis2=Gene, axis1=Type.of.mutation, axis3=Drug)) + 
  geom_alluvium(aes(fill=Response), width=1/2, knot.pos=0.2, reverse=TRUE) +
  geom_stratum(width=1/2, fill="white", color="black", alpha=0.5) +
  # 使用预计算的带格式标签数据
  ggtext::geom_richtext(
    data=stratum_data,
    aes(x=x, y=y, label=formatted_label),
    size=3, label.size=NA, fill=NA, color="black"
  ) +
  scale_x_discrete(limits=c("Mutation type", "Gene / Function", "Drug")) +
  theme_bw() +
  theme(
    axis.text.x=element_text(size=12, color="black"),
    axis.title.y=element_blank(), 
    axis.text.y=element_blank(),
    axis.ticks.y=element_blank(),
    axis.ticks.x=element_blank(),
    panel.grid.major=element_blank(), 
    panel.grid.minor=element_blank(),
    panel.border = element_blank(),
    panel.background = element_blank(),
    plot.title=element_text(hjust=0.5)
  ) +
  theme(legend.position="bottom") +
  ggtitle("Clinically-actionable targets")

print(p)

注意事项 #

• 设置fill=NA可让标签背景透明，匹配原geom_label的无背景效果；label.size=NA可去掉标签边框。
• Markdown格式支持粗体（**文本**）、斜体（*文本*）、内嵌HTML颜色样式等，可按需调整。

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