map()を使用して、複数の `lm`モデルを推定し、1つのテーブルに出力を返します

2
Jeremy K. 2019-07-12 16:58.

同じデータセットで多数の線形モデルを推定し、回帰結果をすべて1つのテーブルにまとめる必要があります。再現可能な例として、以下を使用した簡略化を示しmtcarsます。

formula_1 = "mpg ~ disp"
formula_2 = "mpg ~ log(disp)"
formula_3 = "mpg ~ disp + hp" 

現在、私のアプローチは次のとおりです。

  1. すべての数式を含むリストを作成します。
  2. purrr:map()すべてのlmモデルを推定するために使用します。
  3. stargazer::出力テーブルを作成するために使用します。
library(tidyverse)
library(stargazer)

formula_1 = "mpg ~ disp"
formula_2 = "mpg ~ log(disp)"
formula_3 = "mpg ~ disp + hp"

lst <- list(formula_1, formula_2, formula_3)

models<- lst %>% map(~lm(., mtcars))
stargazer(models, type = "text")

これは私が探している出力を私に与えます:

#> 
#> =========================================================================================
#>                                              Dependent variable:                         
#>                     ---------------------------------------------------------------------
#>                                                      mpg                                 
#>                              (1)                     (2)                    (3)          
#> -----------------------------------------------------------------------------------------
#> disp                      -0.041***                                      -0.030***       
#>                            (0.005)                                        (0.007)        
#>                                                                                          
#> log(disp)                                         -9.293***                              
#>                                                    (0.787)                               
#>                                                                                          
#> hp                                                                        -0.025*        
#>                                                                           (0.013)        
#>                                                                                          
#> Constant                  29.600***               69.205***              30.736***       
#>                            (1.230)                 (4.185)                (1.332)        
#>                                                                                          
#> -----------------------------------------------------------------------------------------
#> Observations                  32                     32                      32          
#> R2                          0.718                   0.823                  0.748         
#> Adjusted R2                 0.709                   0.817                  0.731         
#> Residual Std. Error    3.251 (df = 30)         2.579 (df = 30)        3.127 (df = 29)    
#> F Statistic         76.513*** (df = 1; 30) 139.350*** (df = 1; 30) 43.095*** (df = 2; 29)
#> =========================================================================================
#> Note:                                                         *p<0.1; **p<0.05; ***p<0.01

簡単な質問:

数式が多い場合、どうすればすべての数式をリストに入れることができますか?以下の行は、数式が3つしかない場合は機能しますが、推定するモデルが多い場合は不器用に見えます。

lst <- list(formula_1, formula_2, formula_3)

2番目の質問:

saybroomまたは別の方法を使用して、タスク全体を実行するためのより良い方法はありますか?それともpurrr:map()合理的な解決策ですか?

2 answers

2
avid_useR 2019-07-13 02:11.

これが私が提案するワークフローです。ネストされたtibblesを使用broomしてデータを構造化し、使用して適切な推定値と近似値を取得できます。

library(tidyverse)
library(broom)

# Created nested tibble
nested_df <- tibble(formula = c("mpg ~ disp", "mpg ~ log(disp)", "mpg ~ disp + hp")) %>%
  group_by(ID = formula) %>%
  group_modify(~ as_tibble(mtcars)) %>%
  nest() 

# Get model estimates
nested_df %>%
  mutate(estimates = data %>% map2(ID, ~ tidy(lm(.y, data = .x)))) %>%
  select(-data) %>%
  unnest()

# Get fitted values and residuals
nested_df %>%
  mutate(model = ID %>% map2(data, lm),
         stats = model %>% map(augment)) %>%
  select(-data, -model) %>%
  unnest() 

出力:

> nested_df
# A tibble: 3 x 2
  ID              data              
  <chr>           <list>            
1 mpg ~ disp      <tibble [32 x 11]>
2 mpg ~ disp + hp <tibble [32 x 11]>
3 mpg ~ log(disp) <tibble [32 x 11]>

# A tibble: 7 x 6
  ID              term        estimate std.error statistic  p.value
  <chr>           <chr>          <dbl>     <dbl>     <dbl>    <dbl>
1 mpg ~ disp      (Intercept)  29.6      1.23        24.1  3.58e-21
2 mpg ~ disp      disp         -0.0412   0.00471     -8.75 9.38e-10
3 mpg ~ disp + hp (Intercept)  30.7      1.33        23.1  3.26e-20
4 mpg ~ disp + hp disp         -0.0303   0.00740     -4.10 3.06e- 4
5 mpg ~ disp + hp hp           -0.0248   0.0134      -1.86 7.37e- 2
6 mpg ~ log(disp) (Intercept)  69.2      4.19        16.5  1.28e-16
7 mpg ~ log(disp) log(disp)    -9.29     0.787      -11.8  8.40e-13

# A tibble: 96 x 12
   ID           mpg  disp .fitted .se.fit .resid   .hat .sigma  .cooksd .std.resid    hp log.disp.
   <chr>      <dbl> <dbl>   <dbl>   <dbl>  <dbl>  <dbl>  <dbl>    <dbl>      <dbl> <dbl>     <dbl>
 1 mpg ~ disp  21    160     23.0   0.664 -2.01  0.0418   3.29 0.00865      -0.630    NA        NA
 2 mpg ~ disp  21    160     23.0   0.664 -2.01  0.0418   3.29 0.00865      -0.630    NA        NA
 3 mpg ~ disp  22.8  108     25.1   0.815 -2.35  0.0629   3.28 0.0187       -0.746    NA        NA
 4 mpg ~ disp  21.4  258     19.0   0.589  2.43  0.0328   3.27 0.00983       0.761    NA        NA
 5 mpg ~ disp  18.7  360     14.8   0.838  3.94  0.0663   3.22 0.0558        1.25     NA        NA
 6 mpg ~ disp  18.1  225     20.3   0.575 -2.23  0.0313   3.28 0.00782      -0.696    NA        NA
 7 mpg ~ disp  14.3  360     14.8   0.838 -0.462 0.0663   3.31 0.000770     -0.147    NA        NA
 8 mpg ~ disp  24.4  147.    23.6   0.698  0.846 0.0461   3.30 0.00172       0.267    NA        NA
 9 mpg ~ disp  22.8  141.    23.8   0.714 -0.997 0.0482   3.30 0.00250      -0.314    NA        NA
10 mpg ~ disp  19.2  168.    22.7   0.647 -3.49  0.0396   3.24 0.0248       -1.10     NA        NA
# ... with 86 more rows

stargazerテーブルが必要な場合はpullmodelリスト列を出力することもできます。

library(stargazer)

nested_df %>%
  mutate(model = ID %>% map2(data, ~ lm(.x, .y))) %>%
  pull(model) %>%
  stargazer(type = "text")

出力:

=========================================================================================
                                             Dependent variable:                         
                    ---------------------------------------------------------------------
                                                     mpg                                 
                             (1)                    (2)                     (3)          
-----------------------------------------------------------------------------------------
disp                      -0.041***              -0.030***                               
                           (0.005)                (0.007)                                

hp                                                -0.025*                                
                                                  (0.013)                                

log(disp)                                                                -9.293***       
                                                                          (0.787)        

Constant                  29.600***              30.736***               69.205***       
                           (1.230)                (1.332)                 (4.185)        

-----------------------------------------------------------------------------------------
Observations                  32                     32                     32           
R2                          0.718                  0.748                   0.823         
Adjusted R2                 0.709                  0.731                   0.817         
Residual Std. Error    3.251 (df = 30)        3.127 (df = 29)         2.579 (df = 30)    
F Statistic         76.513*** (df = 1; 30) 43.095*** (df = 2; 29) 139.350*** (df = 1; 30)
=========================================================================================
Note:                                                         *p<0.1; **p<0.05; ***p<0.01

これgroup_modifyは現在実験段階であることに注意してください。そのプロパティと意図は将来変更される可能性があるため、注意して使用してください。

関連する問題については、他の回答も参照してください。predict()の結果をリスト内のforループに配置します

1
M-- 2019-07-13 00:16.

数式がすでにグローバル環境に保存されている場合は、次のようなリストを作成できます。

formula_list<-do.call("list",mget(grep("formula",names(.GlobalEnv),value=TRUE)))

それはあなたに与えます:

#> $formula_1 #> [1] "mpg ~ disp" #> #> $formula_2
#> [1] "mpg ~ log(disp)"
#> 
#> $formula_3
#> [1] "mpg ~ disp + hp"

使うのpurrr::mapは良いアプローチだと思います。しかし、他の人はより良いアイデアを持っているかもしれません。

Related questions

MORE COOL STUFF

Reba McEntire は、彼女が息子の Shelby Blackstock と共有する「楽しい」クリスマスの伝統を明らかにしました:「私たちはたくさん笑います」

Reba McEntire は、彼女が息子の Shelby Blackstock と共有する「楽しい」クリスマスの伝統を明らかにしました:「私たちはたくさん笑います」

Reba McEntire が息子の Shelby Blackstock と共有しているクリスマスの伝統について学びましょう。

メーガン・マークルは、自然な髪のスタイリングをめぐってマライア・キャリーと結ばれました

メーガン・マークルは、自然な髪のスタイリングをめぐってマライア・キャリーと結ばれました

メーガン・マークルとマライア・キャリーが自然な髪の上でどのように結合したかについて、メーガンの「アーキタイプ」ポッドキャストのエピソードで学びましょう.

ハリー王子は家族との関係を修復できるという「希望を持っている」:「彼は父親と兄弟を愛している」

ハリー王子は家族との関係を修復できるという「希望を持っている」:「彼は父親と兄弟を愛している」

ハリー王子が家族、特にチャールズ王とウィリアム王子との関係について望んでいると主張したある情報源を発見してください。

ワイノナ・ジャッドは、パニックに陥った休暇の瞬間に、彼女がジャッド家の家長であることを認識しました

ワイノナ・ジャッドは、パニックに陥った休暇の瞬間に、彼女がジャッド家の家長であることを認識しました

ワイノナ・ジャッドが、母親のナオミ・ジャッドが亡くなってから初めての感謝祭のお祝いを主催しているときに、彼女が今では家長であることをどのように認識したかを学びましょう.

セントヘレナのジェイコブのはしごを登るのは、気弱な人向けではありません

セントヘレナのジェイコブのはしごを登るのは、気弱な人向けではありません

セント ヘレナ島のジェイコブズ ラダーは 699 段の真っ直ぐ上る階段で、頂上に到達すると証明書が発行されるほどの難易度です。

The Secrets of Airline Travel Quiz

The Secrets of Airline Travel Quiz

Air travel is far more than getting from point A to point B safely. How much do you know about the million little details that go into flying on airplanes?

Where in the World Are You? Take our GeoGuesser Quiz

Where in the World Are You? Take our GeoGuesser Quiz

The world is a huge place, yet some GeoGuessr players know locations in mere seconds. Are you one of GeoGuessr's gifted elite? Take our quiz to find out!

バイオニック読書はあなたをより速く読むことができますか?

バイオニック読書はあなたをより速く読むことができますか?

BionicReadingアプリの人気が爆発的に高まっています。しかし、それは本当にあなたを速読術にすることができますか?

Redditで何かを見つけるのに最適な場所は、ミソジニーのゴミを宣伝することです

Redditで何かを見つけるのに最適な場所は、ミソジニーのゴミを宣伝することです

画像:Gizmodo Subreddit of the Dayは、Redditのクールで奇妙で楽しい部分を祝うことです。SROTDのモデレーターは毎日、候補者の大規模なプールからsubredditを引き出し、宣伝します。

バットマンとオタク文化の台頭

バットマンとオタク文化の台頭

イラスト:アダム・クラーク・エステスバットマンが執着するようになると同時に、新しい種類の愛好家が目立つようになり始めました。何年もの間、彼らは大衆文化の陰の隅に潜んでいて、彼らの間のニッチな興味を静かに追求し、より広い世界の好奇心旺盛で判断力のある視線を避けるために頭を下げていました。

UberはGoogleとの法廷闘争を世間の目から遠ざけようとしている

UberはGoogleとの法廷闘争を世間の目から遠ざけようとしている

写真:AP先月、GoogleはUberに対して訴訟を起こし、ライドシェアリング会社が元Googleエンジニアと衝突して、Waymo自動運転車ユニットから企業秘密と独自のデザインを盗んだと主張しました。本日、Uberの弁護士は、訴訟を仲裁の暗い穴に移すよう申し立てました。

あなたが真剣に石で打たれたときに見るのに最適なSF映画

あなたが真剣に石で打たれたときに見るのに最適なSF映画

ドゥウウウデ。マリファナは悪い映画を良くし、良い映画を素晴らしいものにすることができます。

バレンタインデーにユーカリのシャワースチーマーで「最高の睡眠」を贈りましょう。

バレンタインデーにユーカリのシャワースチーマーで「最高の睡眠」を贈りましょう。

BodyRestore ユーカリ シャワー スチーマーは、Amazon で 11,000 を超える 5 つ星の評価を得ています。セルフケアが必要な人へのバレンタインデーのギフトとして、ホームスパ製品を贈りましょう。

この「邪悪な吸引力」を備えたこの250ドルのハンドヘルド掃除機は、Amazonで75%オフになりました

この「邪悪な吸引力」を備えたこの250ドルのハンドヘルド掃除機は、Amazonで75%オフになりました

多くのAmazonの買い物客がUmlo H6ハンドヘルド掃除機を推奨しており、現在スーパーセール中です. ハンドヘルド デバイスには HEPA フィルターが装備されており、複数のアタッチメントが付属しています。Amazonで75%オフのときにハンドヘルド掃除機を購入する

オクタヴィア・スペンサー、「ザ・ヘルプ」共演者のシシー・スペイセクが17歳で映画のインターンをした後、彼女のことを「実際に」思い出したと語る

オクタヴィア・スペンサー、「ザ・ヘルプ」共演者のシシー・スペイセクが17歳で映画のインターンをした後、彼女のことを「実際に」思い出したと語る

オクタヴィア・スペンサーは、ヘルプで一緒に共演するずっと前に、シシー・スペイセク主演の 1990 年の映画「ロング・ウォーク・ホーム」でインターンとして働いていました。

ジュリア・フォックス、「マスカラ」がTikTokユーザーの性的暴行コードだったことを知らなかったことを謝罪

ジュリア・フォックス、「マスカラ」がTikTokユーザーの性的暴行コードだったことを知らなかったことを謝罪

ジュリア・フォックスは、彼女のTikTokで共有された応答ビデオで、「本当に申し訳ありません。今、本当に年齢を示しています」と述べました。

メリック・ガーランドはアメリカに失敗しましたか?

バイデン大統領の任期の半分以上です。メリック・ガーランドは何を待っていますか?

メリック・ガーランドはアメリカに失敗しましたか?

人々にチャンスを与えることは、人生で少し遅すぎると私は信じています。寛大に。

良いものと醜いもの: 2022

良いものと醜いもの: 2022

もうわからない。何が「ヒット」かを正確に判断することは、もはやほとんど不可能に思えます。

楽しみのために — 2022 年のトップの新しい音楽再生

楽しみのために — 2022 年のトップの新しい音楽再生

ついに!私の 2022 年のトップ ニューミュージック プレイへようこそ。私は毎年これを共有して、友達とつながります。

ヒーズ・オール・アイヴ・ガット

ヒーズ・オール・アイヴ・ガット

あなたの心をチェックしてください。私たちの心はしばしば迷います。

Language