如何实现patchwork拼接的ggplot图表颜色条高度匹配面板？

我用ggplot绘制了一组图表，通过patchwork包拼接并共用一个图例，但右侧的颜色条高度无法与拼接后的整个图表面板高度对齐。单张图表时可以用自定义函数实现高度匹配，但拼接后该方法失效，请问有可行的解决办法？

演示代码 #

首先是用于复现问题的示例代码：

library(reshape2)
library(ggplot2)
library(patchwork)
library(grid)

set.seed(123)
t <- seq(0, 1, by = 0.001)
p <- length(t) - 1
n <- 5
I <- matrix(rnorm(n * p, 0, 1 / sqrt(p)), n, p)
df <- data.frame(apply(I, 1, cumsum))
df <- data.frame(x = seq_along(df[, 1]), df)
df <- melt(df, id.vars = "x")
df$variable <- as.numeric(df$variable)

gg <- ggplot(df, aes(x = x, y = value, color = variable, group = variable)) +
  geom_line() +
  viridis::scale_color_viridis() +
  theme(panel.border = element_rect(color = "black", fill = NA, linewidth = 0.5))

# 拼接图表并收集图例
p <- gg + gg + gg + gg + plot_layout(guides = "collect")

运行上述代码后，颜色条高度无法匹配拼接后的整体面板高度，单图时的自定义函数也无法直接复用。

解决方法 #

核心思路是先将patchwork拼接好的图表转换为grob对象，计算整体面板区域的总高度，再修改图例中颜色条的高度：

adjust_legend_height <- function(p) {
  # 将拼接后的patchwork对象转为grob
  g <- ggplotGrob(p)
  
  # 计算所有面板区域的总高度（null单位对应面板的伸缩高度）
  panel_height_units <- g$heights[which(grid::unitType(g$heights) == "null")]
  total_panel_height <- sum(panel_height_units)
  
  # 定位到图例组件并修改颜色条高度
  legend_pos <- which(g$layout$name == "guide-box")
  if (length(legend_pos) > 0) {
    legend_grob <- g$grobs[[legend_pos]]
    # 找到颜色条对象
    colorbar_idx <- sapply(legend_grob$grobs, function(x) "guide-colorbar" %in% class(x))
    colorbar <- legend_grob$grobs[[which(colorbar_idx)]]
    # 设置颜色条高度为面板总高度
    colorbar$bar$height <- total_panel_height
    legend_grob$grobs[[which(colorbar_idx)]] <- colorbar
    g$grobs[[legend_pos]] <- legend_grob
  }
  
  # 绘制调整后的图表并返回grob对象
  grid.draw(g)
  return(g)
}

# 调用函数调整图例高度
adjust_legend_height(p)

说明 #

• 该方法会自动计算拼接后所有面板的总高度，无论你的布局是几行几列，都能精准匹配面板高度；
• 代码中通过定位guide-box找到图例组件，再修改颜色条的bar$height属性，确保颜色条高度与整体面板完全对齐。

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