分组运行多个变量的单一线性回归

Question

我正在尝试对大量变量运行简单的单一线性回归，并根据另一个变量进行分组。以 mtcars 数据集为例，我想在 mpg 和每个其他变量（mpg ~ disp、mpg ~ hp 等）之间运行单独的线性回归，并按另一个变量（例如 cyl）分组。

使用 purrr::map 可以轻松地在每个变量上独立运行 lm （根据这个很棒的教程修改 - https://sebastiansauer.github.io/EDIT-multiple_lm_purrr_EDIT/）：

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

mtcars %>%
  select(-mpg) %>% #exclude outcome, leave predictors
  map(~ lm(mtcars$mpg ~ .x, data = mtcars)) %>%
  map_df(glance, .id='variable') %>%
  select(variable, r.squared, p.value)

# A tibble: 10 x 3
   variable r.squared  p.value
   <chr>        <dbl>    <dbl>
 1 cyl          0.726 6.11e-10
 2 disp         0.718 9.38e-10
 3 hp           0.602 1.79e- 7
 4 drat         0.464 1.78e- 5
 5 wt           0.753 1.29e-10
 6 qsec         0.175 1.71e- 2
 7 vs           0.441 3.42e- 5
 8 am           0.360 2.85e- 4
 9 gear         0.231 5.40e- 3
10 carb         0.304 1.08e- 3

使用 map 对分组变量运行线性模型也很容易：

mtcars %>%
  split(.$cyl) %>% #split by grouping variable
  map(~ lm(mpg ~ wt, data = .)) %>%
  map_df(broom::glance, .id='cyl') %>%
  select(cyl, variable, r.squared, p.value)

# A tibble: 3 x 3
  cyl   r.squared p.value
  <chr>     <dbl>   <dbl>
1 4         0.509  0.0137
2 6         0.465  0.0918
3 8         0.423  0.0118

所以我可以按变量或按组运行。但是，我不知道如何将这两者结合起来（按 cyl 对所有内容进行分组，然后分别运行 lm(mpg ~ every other 变量）。我希望做这样的事情：

mtcars %>%
  select(-mpg) %>% #exclude outcome, leave predictors
  split(.$cyl) %>% # group by grouping variable
  map(~ lm(mtcars$mpg ~ .x, data = mtcars)) %>% #run lm across all variables
  map_df(glance, .id='cyl') %>%
  select(cyl, variable, r.squared, p.value)

并得到一个结果，给出 cyl(group)、variable、r.squared 和 p.value（3 个组 * 10 个变量的组合 = 30 个模型输出）。

但是split()将数据帧转换为列表，第 1 部分 [ map(~ lm(mtcars$mpg ~ .x, data = mtcars) ) ]的构造无法处理该列表。我尝试修改它，使其不明确引用原始数据结构，但无法找出可行的解决方案。任何帮助是极大的赞赏！

Answer 1

IIUC，您可以使用group_by和group_modify，其map内部迭代预测变量。

\n

如果您可以提前隔离预测变量，那么事情就会变得更容易，就像ivs本解决方案一样。

\n

library(tidyverse)\n\nivs <- colnames(mtcars)[3:ncol(mtcars)]\nnames(ivs) <- ivs\n\nmtcars %>% \n  group_by(cyl) %>% \n  group_modify(function(data, key) {\n    map_df(ivs, function(iv) {\n      frml <- as.formula(paste("mpg", "~", iv))\n      lm(frml, data = data) %>% broom::glance()\n      }, .id = "iv") \n  }) %>% \n  select(cyl, iv, r.squared, p.value)\n\n# A tibble: 27 \xc3\x97 4\n# Groups:   cyl [3]\n     cyl iv    r.squared  p.value\n   <dbl> <chr>     <dbl>    <dbl>\n 1     4 disp  0.648      0.00278\n 2     4 hp    0.274      0.0984 \n 3     4 drat  0.180      0.193  \n 4     4 wt    0.509      0.0137 \n 5     4 qsec  0.0557     0.485  \n 6     4 vs    0.00238    0.887  \n 7     4 am    0.287      0.0892 \n 8     4 gear  0.115      0.308  \n 9     4 carb  0.0378     0.567  \n10     6 disp  0.0106     0.826  \n11     6 hp    0.0161     0.786  \n# ...\n

\n