如何使用purrr::map批量执行回归时生成并保存残差图？

我正在使用purrr和broom运行一系列回归模型，希望为每个模型生成残差图并保存至指定文件夹。我的回归简化代码如下：

library(tidyverse)

set.seed(1)
df <- data.frame(x1 = rnorm(100, 0, 1), 
                 x2 = rnorm(100, 0, 1),
                 y1 = rnorm(100, 0, 1), 
                 y2 = rnorm(100, 0, 1), 
                 t2 = sample(0:1, 100, replace = TRUE), 
                 t1 = sample(0:1, 100, replace = TRUE))

models <- data.frame(outcome = c("y1", "y2", "y2"),
                     treatment = c("t1", "t1", "t2"),
                     covariates = c("x1", "x1", "x1 + x2"))

regression_output <- models %>% 
  mutate(formula = paste(outcome, "~", treatment, "+", covariates), 
         fit = map(formula, ~ tidy(lm(.x, df)))) %>% 
  unnest(fit) %>% 
  filter(term == treatment)

我已编写一个保存QQ图的简单函数：

save_residual_plot <- function(formula, fit) {
  jpeg(paste0("QQ plot - ", formula, ".jpg"))
  plot(fit, which = 2)
  dev.off()
}

但我尚未找到在嵌套数据框/map框架中运行该函数的方法，请问是否可行？或是有更优的回归模型残差检验方法？

1. 修正模型拟合流程，保留原生模型对象 #

你当前代码里的fit列存储的是tidy()处理后的系数结果，并非完整的lm模型对象——而绘制残差图必须用到模型本身。先调整代码，优先保存完整模型，再生成整理后的系数数据：

regression_output <- models %>% 
  mutate(formula = paste(outcome, "~", treatment, "+", covariates),
         # 先存储完整的lm模型对象
         model = map(formula, ~ lm(.x, data = df)),
         # 基于模型生成tidy后的系数结果
         fit = map(model, tidy)) %>% 
  unnest(fit) %>% 
  filter(term == treatment)

2. 在嵌套框架中运行保存函数 #

现在model列是完整的模型对象，你可以用pwalk()同时传递formula和model参数到保存函数中。先微调函数，适配模型对象参数：

save_residual_plot <- function(formula_str, model_obj) {
  # 清理公式中的特殊字符，避免文件名报错
  clean_filename <- str_replace_all(formula_str, "~|\\+| ", "-")
  jpeg(paste0("QQ plot - ", clean_filename, ".jpg"))
  plot(model_obj, which = 2)
  dev.off()
}

接着在数据集中调用函数：

# 单独生成包含公式和模型对象的数据集（避免unnest后的数据干扰）
models_with_model <- models %>% 
  mutate(formula = paste(outcome, "~", treatment, "+", covariates),
         model = map(formula, ~ lm(.x, data = df)))

# 用pwalk传递多参数执行保存逻辑
models_with_model %>% 
  pwalk(~ save_residual_plot(formula_str = ..1, model_obj = ..2))

3. 更优的残差检验方法 #

使用ggfortify生成ggplot风格残差图 #

ggfortify可以直接为lm模型生成ggplot格式的诊断图，美观且支持自定义调整：

library(ggfortify)

save_gg_residual_plot <- function(formula_str, model_obj) {
  clean_filename <- str_replace_all(formula_str, "~|\\+| ", "-")
  # 生成QQ图并添加标题
  p <- autoplot(model_obj, which = 2) + ggtitle(paste("QQ Plot:", formula_str))
  ggsave(paste0("QQ plot - ", clean_filename, ".png"), p, dpi = 300)
}

# 调用方式同样用pwalk
models_with_model %>% 
  pwalk(~ save_gg_residual_plot(formula_str = ..1, model_obj = ..2))

使用DHARMa做全面残差诊断 #

如果涉及广义线性模型（GLM）或需要更严谨的拟合检验，DHARMa的模拟残差能更准确检测模型问题：

library(DHARMa)

save_dharma_residual_plot <- function(formula_str, model_obj) {
  clean_filename <- str_replace_all(formula_str, "~|\\+| ", "-")
  # 生成模拟残差
  sim_res <- simulateResiduals(model_obj)
  jpeg(paste0("DHARMA Residuals - ", clean_filename, ".jpg"))
  # 输出包含QQ图、残差-拟合值等的组合诊断图
  plot(sim_res)
  dev.off()
}

# 调用执行
models_with_model %>% 
  pwalk(~ save_dharma_residual_plot(formula_str = ..1, model_obj = ..2))

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