如何用R语言purrr::map及其变体简化回归循环代码

我正在处理涉及不同因变量和自变量的多元回归问题，已编写了一段通过for循环调用回归函数的脚本，希望使用purrr::map或其变体替代当前的for loop。以下是模拟数据及现有代码：

# 创建模拟数据
df <- data.frame(y1=sample(rnorm(n=50, mean=3.25, sd=.25), replace=TRUE),
                 y2=sample(rnorm(n=50, mean=3.75, sd=.48), replace=TRUE),
                 x1=sample(rnorm(n=50, mean=4.28, sd=.32), replace=TRUE),
                 x2=sample(rnorm(n=50, mean=3.75, sd=.64), replace=TRUE),
                 x3=sample(rnorm(n=50, mean=3.99, sd=.55), replace=TRUE),
                 x4=sample(runif(n=50, min=1L, max=2L), replace=TRUE),
                 wgt=sample(runif(n=50, min=.20, max=.75), replace=TRUE))


# 回归函数
reg_func <- function(y, ...){
  x = sapply(substitute(...()), deparse)
  f = reformulate(termlabels=x, response=y)
  model = eval(lm(f, data=df, weights=wgt, na.action=na.omit))
  an0va = anova(model)
  jt = jtools::summ(model, confint=TRUE, ci.width=0.95, robust=FALSE, vifs=TRUE)
  list(outcome=y, model_summary=summary(model), a0nova=an0va, jtools_summumary=jt)
}

# 选择因变量并命名
dvs <- names(df)[1:2]
dvs <- purrr::set_names(dvs)

需要简化以下循环部分：

# 遍历因变量并存储结果
reg_out = list()
reg_out2 = list()
for (i in seq_along(dvs)){
  reg_out[[i]] = reg_func(y=dvs[i], x1, x2)
  reg_out2[[i]] = reg_func(y=dvs[i], x3, x4)
}
reg_out
reg_out2

解决方案 #

1. 直接用purrr::map替换单组自变量的循环 #

由于dvs已经通过set_names设置了名称，map会自动将结果列表的名称与因变量对应，无需手动处理索引：

# 对应原reg_out：用x1、x2作为自变量
reg_out <- purrr::map(dvs, ~reg_func(y = .x, x1, x2))

# 对应原reg_out2：用x3、x4作为自变量
reg_out2 <- purrr::map(dvs, ~reg_func(y = .x, x3, x4))

2. 批量处理多组自变量组合（进阶） #

如果后续需要处理更多自变量组合，可先定义自变量组列表，再通过嵌套map批量生成结果，提升扩展性：

# 定义多组自变量组合
x_groups <- list(
  c("x1", "x2"),
  c("x3", "x4")
)

# 批量生成所有回归结果
all_reg_out <- purrr::map(x_groups, function(x_vars) {
  # 用rlang::syms将字符串转成符号，适配原函数的...参数
  purrr::map(dvs, ~reg_func(y = .x, !!!rlang::syms(x_vars)))
})

# 给结果命名，方便区分不同自变量组
names(all_reg_out) <- c("x1_x2", "x3_x4")

3. 优化回归函数（可选） #

原函数通过substitute(...())解析自变量，可修改为直接接收自变量名向量，让函数更适配purrr的函数式风格，调用更简洁：

# 优化后的回归函数
reg_func_optim <- function(y, x_vars){
  f <- reformulate(termlabels = x_vars, response = y)
  model <- lm(f, data = df, weights = wgt, na.action = na.omit)
  an0va <- anova(model)
  jt <- jtools::summ(model, confint = TRUE, ci.width = 0.95, robust = FALSE, vifs = TRUE)
  list(outcome = y, model_summary = summary(model), a0nova = an0va, jtools_summumary = jt)
}

# 调用优化后的函数
reg_out_optim <- purrr::map(dvs, reg_func_optim, x_vars = c("x1", "x2"))
reg_out2_optim <- purrr::map(dvs, reg_func_optim, x_vars = c("x3", "x4"))

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