r - 将多个模型公式应用于数据组

Question

我想对我的数据应用 3 个线性模型，并为每个模型提取残差。我想知道是否有一种方法可以使用 dplyr 和 purrr 的组合对每个模型应用相同的步骤:

我想保留:

1. 每个模型的lm对象
2. 每个模型的增强输出
3. 每个模型的残差

这是一个分析 mpg 数据集的工作示例:

library(dplyr)
library(tidyr)
library(purrr)
library(broom)
library(ggplot2)

这是我想在我的 lm 中使用的三个不同的公式

f1 = hwy ~ cyl
f2 = hwy ~ displ
f3 = hwy ~ cyl + displ

lin_mod = function(formula) {
  function(data) {
    lm(formula, data = data)
  }
}

这是我为单个公式提取残差的方式:

mpg %>% 
group_by(manufacturer) %>% 
nest() %>% 
mutate(model = map(data, lin_mod(f1)), 
       aug = map(model, augment), 
       res = map(aug, ".resid"))

但是，对于所有公式来说，这种技术似乎是一种糟糕的方法，因为我重写了很多代码:

mpg %>% 
group_by(manufacturer) %>% 
nest() %>% 
mutate(model1 = map(data, lin_mod(f1)), 
       aug1 = map(model1, augment), 
       res1 = map(aug1, ".resid"),
       model2 = map(data, lin_mod(f2)), 
       aug2 = map(model2, augment), 
       res2 = map(aug2, ".resid"),
       model3 = map(data, lin_mod(f3)), 
       aug3 = map(model3, augment), 
       res3 = map(aug3, ".resid"))

如何优雅地将此函数应用于每个公式？我在想 mutate_all，或者将公式放入列表中可能会在某种程度上有所帮助，但可惜我被困住了。

Answer 1

您可以使用 mutate_at(或 mutate_if)就地改变列表列。这节省了几次迭代，并使代码可通过管道传输且更紧凑。

library(dplyr)
library(tidyr)
library(purrr)
library(broom)

lin_mod = function(formula) {
  function(data,...){
  map(data,~lm(formula, data = .x))
  }
}

list_model <- list(cyl_model= hwy ~ cyl,
                   displ_model= hwy ~ displ,
                   full_model= hwy ~ cyl + displ) %>% 
              lapply(lin_mod)

ggplot2::mpg %>% 
  group_by(manufacturer) %>% nest() %>% 
    mutate_at(.vars=("data"),.funs=list_model) %>% 
    mutate_at(.vars=vars(ends_with("model")), .funs=~map(.x, augment)) %>% 
    mutate_at(.vars=vars(ends_with("model")), .funs=~map(.x, ".resid")) %>% unnest()