如何统一GAM模型绘图Y轴范围以完整显示置信区间？

现有如下R代码用于生成并保存多个gam()模型的绘图：

library(mgcv)
library(gratia)
library(tidyverse)

iterate = function(z){

    model1 <- gam(mpg ~ cyl + s(disp, k = 25) + wt, 
        data = mtcars %>% dplyr::filter(carb == z), method = "REML")

    gam_plot <- draw(model1, ci_col = "red", smooth_col = "red")
    assign(paste0("gam_plot", z), gam_plot, envir = .GlobalEnv)
}

z_list = unique(mtcars$gear)

sapply(X = z_list,FUN = iterate)

使用ggarrange()组合这些绘图时，需设置最窄的Y轴范围——既要保证置信区间完整显示，又不会因范围过宽导致图难以解读。请问最高效的设置scale_y_continuous的方法是什么？是否需要提前计算，还是可在单次函数运行中完成？

最省心高效的实现方式是一次流程搞定Y轴范围计算和绘图调整，不用拆分步骤单独提前计算，具体操作如下：

1. 修改迭代函数，同时返回绘图与Y轴极值 #

调整原iterate函数，让它在生成绘图的同时，提取每个绘图中置信区间的上下限，把绘图和极值信息打包返回：

iterate = function(z){
    # 拟合模型
    model1 <- gam(mpg ~ cyl + s(disp, k = 25) + wt, 
        data = mtcars %>% dplyr::filter(carb == z), method = "REML")
    # 生成gam绘图
    gam_plot <- draw(model1, ci_col = "red", smooth_col = "red")
    # 从绘图数据中提取置信区间的上下限
    plot_data <- gam_plot$data
    y_min <- min(plot_data$lower)
    y_max <- max(plot_data$upper)
    # 返回包含绘图和极值的列表
    list(plot = gam_plot, y_min = y_min, y_max = y_max)
}

# 运行迭代，得到所有结果的集合
results_list <- lapply(unique(mtcars$gear), iterate)

2. 计算全局统一的Y轴范围 #

从结果列表中汇总所有极值，算出能覆盖所有置信区间的最小范围（可以加一点缓冲值，避免置信区间贴在图边缘）：

# 提取所有绘图的Y轴极值
all_y_mins <- sapply(results_list, function(x) x$y_min)
all_y_maxs <- sapply(results_list, function(x) x$y_max)
# 计算全局Y轴范围
global_y_range <- c(min(all_y_mins) - 0.5, max(all_y_maxs) + 0.5)

3. 统一调整绘图Y轴并组合 #

用lapply批量给每个绘图设置统一的Y轴范围，再用ggarrange组合：

library(ggpubr) # 加载ggarrange所在的包

# 批量调整所有绘图的Y轴
adjusted_plots <- lapply(results_list, function(x){
    x$plot + scale_y_continuous(limits = global_y_range)
})

# 组合绘图，可根据数量调整行列数
ggarrange(plotlist = adjusted_plots, nrow = 2, ncol = 2)

为什么这是高效的？ #

• 全程只需要一次迭代，同时完成模型拟合、绘图生成和极值提取，避免重复处理数据
• 直接从gratia::draw()生成的绘图数据中提取置信区间上下限，比手动从模型预测结果计算更准确，代码也更简洁

内容的提问来源于stack exchange，提问作者flâneur