複数のモデル式をデータのグループに適用する

Question

データに3つの線形モデルを適用し、それぞれの残差を抽出したいと思います。私は維持したい

を：：dplyrとpurrrの組み合わせを使用して、各モデルについて、同じ手順を適用する方法がある場合、私は疑問に思って

1. 各モデル
2. augmentためlmオブジェクト各モデルの出力
3. 各モデルの残差

はここを分析する作業例です10セット：

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() 

Answer 2

これは私が例にhere

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

# Here are the three different formulas I want to use for my lm 

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

formulas = c(f1,f2,f3) 

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

list_model = lapply(formulas, lin_mod) 
names(list_model) = c('cyl_model', 'displ_model', 'full_model') 


fn_model <- function(.model, df){ 
    df$model <- map(df$data, possibly(.model, NULL)) 
    df 
} 

mpg_nested = mpg %>% 
group_by(manufacturer) %>% 
nest() 

mpg_nested_new = list_model %>% 
       map_df(fn_model, mpg_nested, .id = 'id_model') %>% 
       arrange(manufacturer) %>% 
       mutate(aug = map(model, augment), 
       res = map(aug, ".resid")) 


output = mpg_nested_new %>% 
gather(Var, val, c('model', 'aug', 'res')) %>% 
unite(desc, id_model, Var)%>% 
spread(desc, val)