运行 `map::purrr()` 函数后用列名替换 `.x`

Question

我使用purrr:map() 函数为数据集的每一列运行lm()，其中一列作为因变量。

除此之外，结果几乎是完美的——我想用我运行lm() 的变量替换结果中的.x。

R purrr map show column names in output 的帖子是相关的，但我想避免创建函数。

下面是使用 mtcars 数据集的代码。我知道，例如，第一个输出的.x 指的是$mpg。我不确定setNames() 是否有效。

library(tidyverse)
library(broom)
mod3 <- map(mtcars, ~ lm(mpg ~ .x, data = mtcars)) %>%
  map(~tidy(.x))
#> Warning in summary.lm(x): essentially perfect fit: summary may be
#> unreliable
mod3
#> $mpg
#> # A tibble: 2 x 5
#>   term         estimate std.error statistic   p.value
#>   <chr>           <dbl>     <dbl>     <dbl>     <dbl>
#> 1 (Intercept) -5.02e-15  9.94e-16  -5.06e 0 0.0000198
#> 2 .x           1.00e+ 0  4.74e-17   2.11e16 0        
#> 
#> $cyl
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic  p.value
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
#> 1 (Intercept)    37.9      2.07      18.3  8.37e-18
#> 2 .x             -2.88     0.322     -8.92 6.11e-10
#> 
#> $disp
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic  p.value
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
#> 1 (Intercept)  29.6      1.23        24.1  3.58e-21
#> 2 .x           -0.0412   0.00471     -8.75 9.38e-10
#> 
#> $hp
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic  p.value
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
#> 1 (Intercept)  30.1       1.63       18.4  6.64e-18
#> 2 .x           -0.0682    0.0101     -6.74 1.79e- 7
#> 
#> $drat
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic   p.value
#>   <chr>          <dbl>     <dbl>     <dbl>     <dbl>
#> 1 (Intercept)    -7.52      5.48     -1.37 0.180    
#> 2 .x              7.68      1.51      5.10 0.0000178
#> 
#> $wt
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic  p.value
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
#> 1 (Intercept)    37.3      1.88      19.9  8.24e-19
#> 2 .x             -5.34     0.559     -9.56 1.29e-10
#> 
#> $qsec
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic p.value
#>   <chr>          <dbl>     <dbl>     <dbl>   <dbl>
#> 1 (Intercept)    -5.11    10.0      -0.510  0.614 
#> 2 .x              1.41     0.559     2.53   0.0171
#> 
#> $vs
#> # A tibble: 2 x 5
#>   term        estimate std.error statistic  p.value
#>   <chr>          <dbl>     <dbl>     <dbl>    <dbl>
#> 1 (Intercept)    16.6       1.08     15.4  8.85e-16
#> 2 .x              7.94      1.63      4.86 3.42e- 5

Answer 1

这是一种方法

library(tidyverse)
library(broom)

names(mtcars)[-1] %>% 
  set_names() %>% 
  map(~ lm(as.formula(paste0('mpg ~ ', .x)), data = mtcars)) %>% 
  map_dfr(., broom::tidy, .id = "variable")

#> # A tibble: 20 x 6
#>    variable term        estimate std.error statistic  p.value
#>    <chr>    <chr>          <dbl>     <dbl>     <dbl>    <dbl>
#>  1 cyl      (Intercept)  37.9      2.07       18.3   8.37e-18
#>  2 cyl      cyl          -2.88     0.322      -8.92  6.11e-10
#>  3 disp     (Intercept)  29.6      1.23       24.1   3.58e-21
#>  4 disp     disp         -0.0412   0.00471    -8.75  9.38e-10
#>  5 hp       (Intercept)  30.1      1.63       18.4   6.64e-18
#>  6 hp       hp           -0.0682   0.0101     -6.74  1.79e- 7
#>  7 drat     (Intercept)  -7.52     5.48       -1.37  1.80e- 1
#>  8 drat     drat          7.68     1.51        5.10  1.78e- 5
#>  9 wt       (Intercept)  37.3      1.88       19.9   8.24e-19
#> 10 wt       wt           -5.34     0.559      -9.56  1.29e-10
#> 11 qsec     (Intercept)  -5.11    10.0        -0.510 6.14e- 1
#> 12 qsec     qsec          1.41     0.559       2.53  1.71e- 2
#> 13 vs       (Intercept)  16.6      1.08       15.4   8.85e-16
#> 14 vs       vs            7.94     1.63        4.86  3.42e- 5
#> 15 am       (Intercept)  17.1      1.12       15.2   1.13e-15
#> 16 am       am            7.24     1.76        4.11  2.85e- 4
#> 17 gear     (Intercept)   5.62     4.92        1.14  2.62e- 1
#> 18 gear     gear          3.92     1.31        3.00  5.40e- 3
#> 19 carb     (Intercept)  25.9      1.84       14.1   9.22e-15
#> 20 carb     carb         -2.06     0.569      -3.62  1.08e- 3

^{由reprex package (v0.2.1.9000) 于 2019-02-10 创建}

Answer 2

您好，您可以像这样使用 purrr::imap()：

mod3 <- map(mtcars, ~ lm(mpg ~ .x, data = mtcars)) %>%
  map(tidy) %>% 
  imap( ~   {.x[2, 1] <-  .y ; return(.x)}   )

imap 向函数/公式发送两件事：.x 项和 .y 项的名称（在本例中为名称）或索引。在这种情况下，我必须将所有内容都包装在 {} 中才能让任务生效