modelr：リサンプリングデータと<a href="https://github.com/hadley/modelr" rel="noreferrer"><code>modelr</code></a>に実装<a href="http://r4ds.had.co.nz/" rel="noreferrer">tidy model of data science (TM)</a>で

Question

を複数のモデルフィッティング、リサンプリングデータをlist-columnsを使用して編成されている：

library(modelr) 
library(tidyverse) 

# create the k-folds 
df_heights_resampled = heights %>% 
    crossv_kfold(k = 10, id = "Resample ID") 

これは、リストの列のトレーニングデータセットの各々にmapモデルに可能ですtrainを使用し、mapによってリストの列testにpingすることによってパフォーマンスメトリックを計算します。

複数のモデルでこれを行う必要がある場合は、モデルごとにこれを繰り返す必要があります。与え

# create a list of formulas 
formulas_heights = formulas(
    .response = ~ income, 
    model1 = ~ height + weight + marital + sex, 
    model2 = ~ height + weight + marital + sex + education 
) 

# fit each of the models in the list of formulas 
df_heights_resampled = df_heights_resampled %>% 
    mutate(
    model1 = map(train, function(train_data) { 
     lm(formulas_heights[[1]], data = train_data) 
    }), 
    model2 = map(train, function(train_data) { 
     lm(formulas_heights[[2]], data = train_data) 
    }) 
) 

# score the models on the test sets 
df_heights_resampled = df_heights_resampled %>% 
    mutate(
    rmse1 = map2_dbl(.x = model1, .y = test, .f = rmse), 
    rmse2 = map2_dbl(.x = model2, .y = test, .f = rmse) 
) 

：

> df_heights_resampled 
# A tibble: 10 × 7 
      train   test `Resample ID` model1 model2 rmse1 rmse2 
      <list>   <list>   <chr> <list> <list> <dbl> <dbl> 
1 <S3: resample> <S3: resample>   01 <S3: lm> <S3: lm> 58018.35 53903.99 
2 <S3: resample> <S3: resample>   02 <S3: lm> <S3: lm> 55117.37 50279.38 
3 <S3: resample> <S3: resample>   03 <S3: lm> <S3: lm> 49005.82 44613.93 
4 <S3: resample> <S3: resample>   04 <S3: lm> <S3: lm> 55437.07 51068.90 
5 <S3: resample> <S3: resample>   05 <S3: lm> <S3: lm> 48845.35 44673.88 
6 <S3: resample> <S3: resample>   06 <S3: lm> <S3: lm> 58226.69 54010.50 
7 <S3: resample> <S3: resample>   07 <S3: lm> <S3: lm> 56571.93 53322.41 
8 <S3: resample> <S3: resample>   08 <S3: lm> <S3: lm> 46084.82 42294.50 
9 <S3: resample> <S3: resample>   09 <S3: lm> <S3: lm> 59762.22 54814.55 
10 <S3: resample> <S3: resample>   10 <S3: lm> <S3: lm> 45328.48 41882.79 

質問：

これは本当に速い探求するモデルの数が多い場合に面倒な取得することができます。 modelrは、複数のモデル（複数の数式によって特徴付けられる）上で反復することを可能にするが、上記のモデルではtrainのようなリスト列を考慮しないようにする関数fit_withを提供する。私は*map*ファシリティファミリの1つがこれを可能にすると仮定していますが（invoke_map？）、どうやって調べることができませんでした。

Answer 1

mapとlazyeval::interpを使用して、プログラムで呼び出しを作成できます。純粋なpurrrソリューションがあれば私は興味がありますが、問題は複数の列を作成したいということです。そのためには複数の呼び出しが必要です。おそらくpurrrソリューションは、すべてのモデルを含む別のリスト列を作成します。 my own questionに触発

library(lazyeval) 
model_calls <- map(formulas_heights, 
        ~interp(~map(train, ~lm(form, data = .x)), form = .x)) 
score_calls <- map(names(model_calls), 
        ~interp(~map2_dbl(.x = m, .y = test, .f = rmse), m = as.name(.x))) 
names(score_calls) <- paste0("rmse", seq_along(score_calls)) 

df_heights_resampled %>% mutate_(.dots = c(model_calls, score_calls)) 

# A tibble: 10 × 7 
      train   test `Resample ID` model1 model2 rmse1 rmse2 
      <list>   <list>   <chr> <list> <list> <dbl> <dbl> 
1 <S3: resample> <S3: resample>   01 <S3: lm> <S3: lm> 44720.86 41452.07 
2 <S3: resample> <S3: resample>   02 <S3: lm> <S3: lm> 54174.38 48823.03 
3 <S3: resample> <S3: resample>   03 <S3: lm> <S3: lm> 56854.21 52725.62 
4 <S3: resample> <S3: resample>   04 <S3: lm> <S3: lm> 53312.38 48797.48 
5 <S3: resample> <S3: resample>   05 <S3: lm> <S3: lm> 61883.90 57469.17 
6 <S3: resample> <S3: resample>   06 <S3: lm> <S3: lm> 55709.83 50867.26 
7 <S3: resample> <S3: resample>   07 <S3: lm> <S3: lm> 53036.06 48698.07 
8 <S3: resample> <S3: resample>   08 <S3: lm> <S3: lm> 55986.83 52717.94 
9 <S3: resample> <S3: resample>   09 <S3: lm> <S3: lm> 51738.60 48006.74 
10 <S3: resample> <S3: resample>   10 <S3: lm> <S3: lm> 45061.22 41480.35 

Answer 2

、私はこの質問への同様のアプローチがあると思います。

まず、リスト・カラム構造のデータと式の引数を取り、入力を持つモデルを推定することができる機能を定義します。

​​3210

各CVで複数のモデルを推定することは、その後は簡単だろう折りたたみ式のペアを：おそらく

library(gapminder) 
library(tidyverse) 
library(modelr) 

cv_gm <- gapminder %>% 
    crossv_kfold(k = 10, id = "Resample ID") 

# Assume 4 different formulae 
formulae_tbl <- tibble::frame_data(
    ~model, ~fmla, 
    1, ~lm(lifeExp ~ year, data = .), 
    2, ~lm(lifeExp ~ year + pop, data = .), 
    3, ~lm(lifeExp ~ year + gdpPercap, data = .), 
    4, ~lm(lifeExp ~ year + pop + gdpPercap, data = .) 
) 

cv_gm_results <- cv_gm %>% 
    tidyr::crossing(formulae_tbl) 

cv_gm_results <- cv_gm_results %>% 
    mutate(fit=map2(train, fmla, est_model), 
     rmse=map2_dbl(fit, test, .f = rmse)) 

、きちんとデータ哲学によると、以降cv_gm_resultsで作業した方が良いですが、元の質問（H/T this question）での形状でそれをしたい場合：

cv_gm_results %>% 
    select(`Resample ID`, model, fit, rmse) %>% 
    gather(variable, value, fit, rmse) %>% 
    unite(temp, variable, model, sep="") %>% 
    spread(temp, value) %>% 
    mutate_at(.cols=vars(starts_with("rmse")), .funs=flatten_dbl) 

# A tibble: 10 × 9 
    `Resample ID`  fit1  fit2  fit3  fit4 rmse1 rmse2 
      <chr> <list> <list> <list> <list> <dbl> <dbl> 
1    01 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.32344 11.32201 
2    02 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.34626 11.33175 
3    03 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.62480 11.60221 
4    04 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 10.80946 10.81421 
5    05 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.52413 11.52384 
6    06 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 12.10914 12.08134 
7    07 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.97641 12.00809 
8    08 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 12.30191 12.31489 
9    09 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.96970 11.95617 
10   10 <S3: lm> <S3: lm> <S3: lm> <S3: lm> 11.30289 11.30294 
# ... with 2 more variables: rmse3 <dbl>, rmse4 <dbl> 

更新

それは（est_modelが判明）purrrは、我々の目的のために働くat_depth()を提供し、必要はありません。

cv_gm_results <- cv_gm_results %>% 
    mutate(fit=map2(train, fmla, ~at_depth(.x, 0, .y)), 
     rmse=map2_dbl(fit, test, .f = rmse))