如何修改ggplot2的gtable后保留元数据并返回ggplot对象？

问题背景 #

我正在开发ggplot2的anno_margin扩展函数，目标是让用户不用手动调整theme(plot.margin)，直接在绘图边距添加文本注释——核心思路是修改绘图的gtable来自动分配边距空间。理想的链式调用方式如下：

mpg |>
  ggplot(aes(cty, hwy)) +
  geom_point() +
  anno_margin("Hello, world!", side = "t") +
  # 后续还能继续加图层/标度
  geom_line(aes(group = class))

但遇到了瓶颈：能成功提取并修改gtable，但用patchwork::wrap_ggplot_grob或ggplotify::as.ggplot把修改后的gtable转回ggplot对象时，原始的美学映射、数据源等元数据会丢失，导致后续无法添加新图层。

示例代码（问题复现） #

library(ggplot2)

# 基础绘图
p <- mpg |>
  ggplot(aes(cty, hwy)) +
  geom_point()

# 提取gtable并修改
p_gt <- ggplotGrob(p)
p_gt2 <- gtable::gtable_add_rows(p_gt, heights = grid::unit(1, "lines"), pos = 0)
p_gt3 <- gtable::gtable_add_grob(p_gt2, grobs = grid::textGrob("Hello, world!"), t = 1, l = 7, b = 1, r = 7)

# 查看修改后的效果
plot(p_gt3)

# 尝试转回ggplot后添加图层（失败，无原始元数据）
p_new1 <- patchwork::wrap_ggplot_grob(p_gt3)
p_new1 + geom_line()  # 报错：找不到映射对应的变量

p_new2 <- ggplotify::as.ggplot(p_gt3)
p_new2 + geom_line()  # 同样报错

解决方案：不转gtable，直接扩展ggplot对象 #

核心思路是不把gtable转回ggplot，而是将修改gtable的逻辑作为元数据附加到原始ggplot对象上，通过自定义打印方法在绘图时动态应用修改，这样就能完整保留原始的数据源、映射和图层信息，后续仍可继续添加新元素。

实现代码 #

library(ggplot2)
library(gtable)
library(grid)

# 定义存储注释信息的ggproto类
AnnoMargin <- ggproto(
  "AnnoMargin",
  NULL,
  text = NULL,
  side = NULL
)

# 定义anno_margin函数，作为ggplot对象的修改器
anno_margin <- function(text, side = c("t", "b", "l", "r")) {
  side <- match.arg(side)
  
  # 返回一个函数，接收ggplot对象并返回修改后的对象
  function(plot) {
    # 初始化注释存储区
    if (is.null(plot$annotations$margin)) {
      plot$annotations$margin <- list()
    }
    # 添加当前注释到存储区
    plot$annotations$margin[[length(plot$annotations$margin) + 1]] <- AnnoMargin(
      text = text,
      side = side
    )
    # 给plot添加自定义类，用于触发自定义打印逻辑
    class(plot) <- c("ggplot_with_margin_anno", class(plot))
    plot
  }
}

# 自定义打印方法：绘制时动态修改gtable
print.ggplot_with_margin_anno <- function(x, ...) {
  # 先构建原始绘图的gtable（包含所有图层）
  gt <- ggplot_gtable(ggplot_build(x))
  
  # 遍历所有边距注释，逐个应用修改
  for (anno in x$annotations$margin) {
    panel_idx <- which(gt$layout$name == "panel")[[1]]
    panel_layout <- gt$layout[panel_idx, ]
    
    switch(anno$side,
           "t" = {
             # 顶部添加行
             gt <- gtable_add_rows(gt, heights = unit(1, "lines"), pos = 0)
             # 在新行添加文本，对齐面板宽度
             gt <- gtable_add_grob(gt, textGrob(anno$text), 
                                   t = 1, l = panel_layout$l, r = panel_layout$r)
           },
           "b" = {
             # 底部添加行
             gt <- gtable_add_rows(gt, heights = unit(1, "lines"), pos = nrow(gt))
             gt <- gtable_add_grob(gt, textGrob(anno$text), 
                                   t = nrow(gt), l = panel_layout$l, r = panel_layout$r)
           },
           "l" = {
             # 左侧添加列
             gt <- gtable_add_cols(gt, widths = unit(2, "lines"), pos = 0)
             # 旋转文本，对齐面板高度
             gt <- gtable_add_grob(gt, textGrob(anno$text, rot = 90), 
                                   t = panel_layout$t, b = panel_layout$b, l = 1)
           },
           "r" = {
             # 右侧添加列
             gt <- gtable_add_cols(gt, widths = unit(2, "lines"), pos = ncol(gt))
             gt <- gtable_add_grob(gt, textGrob(anno$text, rot = 270), 
                                   t = panel_layout$t, b = panel_layout$b, l = ncol(gt))
           }
    )
  }
  
  # 绘制最终的gtable
  grid.draw(gt)
  invisible(x)
}

使用示例 #

# 创建基础绘图并添加边距注释
p <- mpg |>
  ggplot(aes(cty, hwy)) +
  geom_point() +
  anno_margin("顶部注释", side = "t") +
  anno_margin("左侧注释", side = "l")

# 打印绘图，显示带注释的效果
print(p)

# 继续添加新图层，完全兼容
p <- p + geom_line(aes(group = class), color = "red", alpha = 0.5)
print(p)

原理说明 #

• 我们没有把gtable转回ggplot，而是将注释信息作为元数据附加到原始ggplot对象上，保留了所有原始的数据源、美学映射和图层。
• 自定义的print.ggplot_with_margin_anno方法会在每次打印绘图时，重新构建包含所有当前图层的gtable，然后应用边距注释的修改，确保后续添加的图层也能被正确包含。
• 之前用wrap_ggplot_grob或as.ggplot的方法之所以失败，是因为它们创建的是一个“静态”的ggplot对象，底层是已经渲染好的grob，没有原始的元数据可供后续图层调用。

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