如何在ggplot分面图的分面间/分面内绘制对比线条？

针对嵌套分面（ggh4x::facet_nested）的箱线图，我们可以通过提取绘图底层数据、解析分面布局，结合gtable手动添加对比线条和显著性标记，实现类似ggsignif的自动化效果，支持分面内、子分面内、跨分面三种对比场景。

步骤1：准备模拟数据与基础绘图 #

首先生成符合结构的模拟数据，并绘制基础嵌套分面箱线图：

library(ggplot2)
library(ggh4x)
library(gtable)
library(dplyr)
library(stringr)
library(grid)

# 生成模拟数据
set.seed(123)
sim_data <- expand.grid(
  MAT = c("A", "B"),
  OPERATOR = c("Op1", "Op2"),
  TREAT = c("Ctrl", "Trt1", "Trt2"),
  rep = 1:10
) %>%
  mutate(value = rnorm(n(), mean = case_when(
    MAT == "A" & TREAT == "Ctrl" ~ 5,
    MAT == "A" & TREAT == "Trt1" ~ 7,
    MAT == "A" & TREAT == "Trt2" ~ 6,
    MAT == "B" & TREAT == "Ctrl" ~ 4,
    MAT == "B" & TREAT == "Trt1" ~ 6,
    MAT == "B" & TREAT == "Trt2" ~ 5.5
  ), sd = 1))

# 绘制基础嵌套分面箱线图
p <- ggplot(sim_data, aes(x = TREAT, y = value)) +
  geom_boxplot(fill = "lightblue") +
  facet_nested(MAT ~ OPERATOR, nest_line = TRUE) +
  theme_bw()

步骤2：提取绘图底层信息 #

获取ggplot_build对象和分面布局，为后续坐标计算做准备：

pb <- ggplot_build(p)
gt <- ggplot_gtable(pb)

# 整理分面布局索引（包含每个分面对应的行、列和分组信息）
facet_layout <- pb$layout$layout %>%
  mutate(
    row = as.integer(row),
    col = as.integer(col),
    MAT = as.character(MAT),
    OPERATOR = as.character(OPERATOR)
  )

步骤3：定义对比规则与处理函数 #

先定义需要标注的对比关系，再写辅助函数解析分组条件、获取对应坐标：

# 定义对比关系：包含对比类型、分组条件、显著性标记、线条偏移高度
comparisons <- tibble(
  type = c("within_facet", "within_nest", "cross_nest"),
  group1 = c("MAT:A,OPERATOR:Op1,TREAT:Ctrl", "MAT:A,TREAT:Trt2", "OPERATOR:Op1,TREAT:Ctrl"),
  group2 = c("MAT:A,OPERATOR:Op1,TREAT:Trt1", "MAT:A,TREAT:Trt2", "OPERATOR:Op1,TREAT:Ctrl"),
  group2_extra = c("", "OPERATOR:Op2", "MAT:B"),
  label = c("***", "*", "ns"),
  y_offset = c(0.3, 0.5, 0.4)
)

# 解析分组字符串为筛选条件
parse_group <- function(group_str) {
  str_split(group_str, ",") %>%
    unlist() %>%
    str_split_fixed(":", 2) %>%
    as.data.frame() %>%
    tibble::column_to_rownames("V1") %>%
    t() %>%
    as.data.frame()
}

# 获取指定分组的x坐标与分面位置
get_group_coords <- function(group_df, facet_layout, plot_data) {
  # 筛选对应分面
  facet_rows <- facet_layout
  for (col in names(group_df)) {
    facet_rows <- facet_rows %>% filter(.data[[col]] == group_df[[col]])
  }
  # 获取x轴离散型坐标（对应整数位置）
  x_val <- plot_data %>%
    filter(!!!map(names(group_df), ~ sym(.x) == group_df[[.x]])) %>%
    pull(x) %>%
    unique()
  list(facet = facet_rows, x = x_val)
}

步骤4：自动添加对比线条与标记 #

循环处理每个对比，根据对比类型计算线条位置，添加到gtable中：

# 遍历所有对比，添加线条和标记
for (i in 1:nrow(comparisons)) {
  comp <- comparisons[i, ]
  
  # 获取分组1的坐标和分面信息
  g1 <- parse_group(comp$group1)
  coords1 <- get_group_coords(g1, facet_layout, pb$data[[1]])
  
  # 获取分组2的坐标和分面信息（合并额外条件）
  g2 <- parse_group(comp$group2)
  if (comp$group2_extra != "") {
    g2_extra <- parse_group(comp$group2_extra)
    g2 <- cbind(g2, g2_extra)
  }
  coords2 <- get_group_coords(g2, facet_layout, pb$data[[1]])
  
  # 计算线条y位置（基于对应区域的箱线图最大值+偏移）
  y_max <- pb$data[[1]] %>%
    filter(
      MAT %in% c(coords1$facet$MAT, coords2$facet$MAT),
      OPERATOR %in% c(coords1$facet$OPERATOR, coords2$facet$OPERATOR)
    ) %>%
    pull(ymax) %>%
    max()
  y_line <- y_max + comp$y_offset
  
  # 处理不同对比类型
  if (comp$type == "within_facet") {
    # 子分面内对比：单个分面单元格内绘制线条
    facet_row <- coords1$facet$row
    facet_col <- coords1$facet$col
    x_start <- coords1$x
    x_end <- coords2$x
    
    line_grob <- linesGrob(
      x = unit(c(x_start, x_end), "native"),
      y = unit(y_line, "native"),
      gp = gpar(lwd = 1.2)
    )
    label_grob <- textGrob(
      comp$label,
      x = unit(mean(c(x_start, x_end)), "native"),
      y = unit(y_line + 0.1, "native"),
      gp = gpar(fontsize = 12, fontface = "bold")
    )
    
    gt <- gtable_add_grob(gt, line_grob, t = facet_row, l = facet_col)
    gt <- gtable_add_grob(gt, label_grob, t = facet_row, l = facet_col)
    
  } else if (comp$type == "within_nest") {
    # 同大分面跨子分面：线条横跨多个分面列
    facet_row <- coords1$facet$row
    facet_cols <- c(coords1$facet$col, coords2$facet$col)
    panel_info <- gt$layout %>% filter(name == "panel", row == facet_row, col %in% facet_cols)
    
    x_start <- unit(panel_info$l[1], "null") + unit(0.1, "npc")
    x_end <- unit(panel_info$r[2], "null") - unit(0.1, "npc")
    
    line_grob <- linesGrob(
      x = c(x_start, x_end),
      y = unit(y_line, "native"),
      gp = gpar(lwd = 1.2)
    )
    label_grob <- textGrob(
      comp$label,
      x = unit(mean(c(panel_info$l[1], panel_info$r[2])), "null"),
      y = unit(y_line + 0.1, "native"),
      gp = gpar(fontsize = 12, fontface = "bold")
    )
    
    gt <- gtable_add_grob(gt, line_grob, t = facet_row, l = panel_info$l[1], r = panel_info$r[2], clip = "off")
    gt <- gtable_add_grob(gt, label_grob, t = facet_row, l = panel_info$l[1], r = panel_info$r[2], clip = "off")
    
  } else if (comp$type == "cross_nest") {
    # 跨大分面对比：在两个大分面的对应位置绘制对齐线条
    facet_rows <- c(coords1$facet$row, coords2$facet$row)
    facet_col <- coords1$facet$col
    panel_info <- gt$layout %>% filter(name == "panel", row %in% facet_rows, col == facet_col)
    
    x_start <- unit(panel_info$l[1], "null") + unit(0.1, "npc")
    x_end <- unit(panel_info$r[1], "null") - unit(0.1, "npc")
    
    line_grob <- linesGrob(
      x = c(x_start, x_end),
      y = unit(y_line, "native"),
      gp = gpar(lwd = 1.2)
    )
    label_grob <- textGrob(
      comp$label,
      x = unit(mean(c(panel_info$l[1], panel_info$r[1])), "null"),
      y = unit(y_line + 0.1, "native"),
      gp = gpar(fontsize = 12, fontface = "bold")
    )
    
    # 分别添加到两个大分面的对应单元格
    gt <- gtable_add_grob(gt, line_grob, t = facet_rows[1], l = facet_col, clip = "off")
    gt <- gtable_add_grob(gt, line_grob, t = facet_rows[2], l = facet_col, clip = "off")
    gt <- gtable_add_grob(gt, label_grob, t = facet_rows[1], l = facet_col, clip = "off")
    gt <- gtable_add_grob(gt, label_grob, t = facet_rows[2], l = facet_col, clip = "off")
  }
}

# 绘制最终带对比标记的图形
grid.draw(gt)

关键说明 #

• 对比类型分为三种：within_facet（子分面内的组间对比）、within_nest（同一大分面下跨子分面的组对比）、cross_nest（跨大分面的组对比）
• 对比规则可通过修改comparisons数据框灵活扩展，添加更多对比关系
• 线条高度通过y_offset参数调整，避免与箱线图重叠
• 使用clip = "off"确保跨分面的线条和标记不会被裁剪

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