リスト・カラム・データ・フレームの各行に異なるモデルをフィット

Question

リスト・カラム・データ構造を持つデータ・フレームの行ごとに異なるモデル式をぴったり合わせるには、どのような方法が最適ですか？

Data ScienceのRでは、Hadleyはlist-columnsデータ構造を使い、多くのモデルに簡単にフィットする方法の素晴らしい例を紹介します（http://r4ds.had.co.nz/many-models.html#gapminder）。私は若干異なる数式で多くのモデルを適合させる方法を見つけようとしています。以下の例では、元の例を適用して、各大陸に異なるモデルを適合させる最良の方法は何ですか？

formulae <- list(
    Asia=~lm(lifeExp ~ year, data = .), 
    Europe=~lm(lifeExp ~ year + pop, data = .), 
    Africa=~lm(lifeExp ~ year + gdpPercap, data = .), 
    Americas=~lm(lifeExp ~ year - 1, data = .), 
    Oceania=~lm(lifeExp ~ year + pop + gdpPercap, data = .) 
) 

for (i in 1:nrow(by_continent)) { 
    by_continent$model[[i]] <- map(by_continent$data, formulae[[i]])[[i]] 
} 

by_continent %>% 
    mutate(glance=map(model, glance)) %>% 
    unnest(glance, .drop=T) 

## A tibble: 5 × 12 
# continent r.squared adj.r.squared  sigma statistic  p.value df 
#  <fctr>  <dbl>   <dbl>  <dbl>  <dbl>   <dbl> <int> 
#1  Asia 0.4356350  0.4342026 8.9244419 304.1298 6.922751e-51  2 
#2 Europe 0.4984677  0.4956580 3.8584819 177.4093 3.186760e-54  3 
#3 Africa 0.4160797  0.4141991 7.0033542 221.2506 2.836552e-73  3 
#4 Americas 0.9812082  0.9811453 8.9703814 15612.1901 4.227928e-260  1 
#5 Oceania 0.9733268  0.9693258 0.6647653 243.2719 6.662577e-16  4 
## ... with 5 more variables: logLik <dbl>, AIC <dbl>, BIC <dbl>, 
## deviance <dbl>, df.residual <int> 

しかし、それはベースにループに戻って、次ずにこれを行うことが可能です：

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

by_continent <- gapminder %>% 
    group_by(continent) %>% 
    nest() 

by_continent <- by_continent %>% 
    mutate(model = map(data, ~lm(lifeExp ~ year, data = .))) 

by_continent %>% 
    mutate(glance=map(model, glance)) %>% 
    unnest(glance, .drop=T) 

## A tibble: 5 × 12 
# continent r.squared adj.r.squared  sigma statistic  p.value df 
#  <fctr>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl> <int> 
#1  Asia 0.4356350  0.4342026 8.9244419 304.1298 6.922751e-51  2 
#2 Europe 0.4984659  0.4970649 3.8530964 355.8099 1.344184e-55  2 
#3 Africa 0.2987543  0.2976269 7.6685811 264.9929 6.780085e-50  2 
#4 Americas 0.4626467  0.4608435 6.8618439 256.5699 4.354220e-42  2 
#5 Oceania 0.9540678  0.9519800 0.8317499 456.9671 3.299327e-16  2 
## ... with 5 more variables: logLik <dbl>, AIC <dbl>, BIC <dbl>, 
## deviance <dbl>, df.residual <int> 

は、私はそれがすべての大陸のための各モデルを推定して、私はby_continent（効率的ではありませんを反復処理することによってそれを行うことができます知っていますR（と私は必要のないフィッティングモデルを回避する）

私が試したことは、このようなものです：？

by_continent <- by_continent %>% 
left_join(tibble::enframe(formulae, name="continent", value="formula")) 

by_continent %>% 
    mutate(model=map2(data, formula, est_model)) 

しかし私は動作するest_model関数を思いつくことができないようです。動作しません：私は、この関数（https://gist.github.com/multidis/8138757 H/t）を：試してみました。

est_model <- function(data, formula, ...) { 
    mc <- match.call() 
    m <- match(c("formula","data"), names(mc), 0L) 
    mf <- mc[c(1L, m)] 
    mf[[1L]] <- as.name("model.frame") 
    mf <- eval(mf, parent.frame()) 
    data.st <- data.frame(mf) 

    return(data.st) 
} 

（確かに、これは不自然な例である私の実際の場合は、私は私のデータでは、キー独立変数が欠けてかなりの観測を持っているということです、私は完全に観測し、残りの観測上の変数のサブセットのみで、他の上のすべての変数と一つのモデルに合うようにしたい。）

UPDATE

私も働くest_model機能（思い付きましたおそらく効率的ではないでしょう）：

est_model <- function(data, formula, ...) { 
    map(list(data), formula, ...)[[1]] 
} 

by_continent <- by_continent %>% 
    mutate(model=map2(data, formula, est_model)) 

by_continent %>% 
    mutate(glance=map(model, glance)) %>% 
    unnest(glance, .drop=T) 

## A tibble: 5 × 12 
# continent r.squared adj.r.squared  sigma statistic  p.value df 
#  <chr>  <dbl>   <dbl>  <dbl>  <dbl>   <dbl> <int> 
#1  Asia 0.4356350  0.4342026 8.9244419 304.1298 6.922751e-51  2 
#2 Europe 0.4984677  0.4956580 3.8584819 177.4093 3.186760e-54  3 
#3 Africa 0.4160797  0.4141991 7.0033542 221.2506 2.836552e-73  3 
#4 Americas 0.9812082  0.9811453 8.9703814 15612.1901 4.227928e-260  1 
#5 Oceania 0.9733268  0.9693258 0.6647653 243.2719 6.662577e-16  4 
## ... with 5 more variables: logLik <dbl>, AIC <dbl>, BIC <dbl>, deviance <dbl>, 
## df.residual <int> 

Answer 1

モデル式のリストを作成する方が簡単です。各モデルは対応するcontinentのために一度しか適合しませんでした。入れ子になったデータに新しい列formulaを追加して、formulaとcontinentが同じ順序でないかどうかを確認します。

formulae <- c(
    Asia= lifeExp ~ year, 
    Europe= lifeExp ~ year + pop, 
    Africa= lifeExp ~ year + gdpPercap, 
    Americas= lifeExp ~ year - 1, 
    Oceania= lifeExp ~ year + pop + gdpPercap 
) 

df <- gapminder %>% 
    group_by(continent) %>% 
    nest() %>% 
    mutate(formula = formulae[as.character(continent)]) %>% 
    mutate(model = map2(formula, data, ~ lm(.x, .y))) %>% 
    mutate(glance=map(model, glance)) %>% 
    unnest(glance, .drop=T) 

# # A tibble: 5 × 12 
# continent r.squared adj.r.squared  sigma statistic  p.value df  logLik  AIC  BIC 
#  <fctr>  <dbl>   <dbl>  <dbl>  <dbl>   <dbl> <int>  <dbl>  <dbl>  <dbl> 
# 1  Asia 0.4356350  0.4342026 8.9244419 304.1298 6.922751e-51  2 -1427.65947 2861.31893 2873.26317 
# 2 Europe 0.4984677  0.4956580 3.8584819 177.4093 3.186760e-54  3 -995.41016 1998.82033 2014.36475 
# 3 Africa 0.4160797  0.4141991 7.0033542 221.2506 2.836552e-73  3 -2098.46089 4204.92179 4222.66639 
# 4 Americas 0.9812082  0.9811453 8.9703814 15612.1901 4.227928e-260  1 -1083.35918 2170.71836 2178.12593 
# 5 Oceania 0.9733268  0.9693258 0.6647653 243.2719 6.662577e-16  4 -22.06696 54.13392 60.02419 
# # ... with 2 more variables: deviance <dbl>, df.residual <int> 

Answer 2

私は元の質問にest_model()でやりたいんpurrr::at_depth()を見つけました。 。これは私が今、幸せですソリューションです。私は私の研究を行っていると思います:(ここ

library(gapminder) 
library(tidyverse) 
library(purrr) 
library(broom) 

fmlas <- tibble::tribble(
    ~continent, ~formula, 
    "Asia", ~lm(lifeExp ~ year, data = .), 
    "Europe", ~lm(lifeExp ~ year + pop, data = .), 
    "Africa", ~lm(lifeExp ~ year + gdpPercap, data = .), 
    "Americas", ~lm(lifeExp ~ year - 1, data = .), 
    "Oceania", ~lm(lifeExp ~ year + pop + gdpPercap, data = .) 
) 

by_continent <- gapminder %>% 
    nest(-continent) %>% 
    left_join(fmlas) %>% 
    mutate(model=map2(data, formula, ~at_depth(.x, 0, .y))) 

by_continent %>% 
    mutate(glance=map(model, glance)) %>% 
    unnest(glance, .drop=T)