将 mutate(across(...)) 与 purrr::map 一起使用答案

【问题标题】：Using mutate(across(...)) with purrr::map将 mutate(across(...)) 与 purrr::map 一起使用
【发布时间】：2021-05-25 19:28:23
【问题描述】：

我无法弄清楚如何将purrr::map() 与mutate(across(...)) 一起使用。

我想做一个线性模型，并提取单列预测的多列斜率的估计值。

这是我正在尝试的示例数据集：

mtcars %>%
  mutate(across(-mpg), 
    map(.x, lst(slope = ~lm(.x ~ mpg, data = .x) %>% 
          tidy() %>% 
          filter(term != "(Intercept") %>% 
            pull(estimate)
  )))

我正在寻找的输出将是每个非 mpg 列的新列，名称后附加 _slope，即cyl_slope

在我的实际数据中，我也会按另一个变量进行分组，以防万一，因为我需要每个预测变量的每个组的斜率。我有这个在标准变异中工作，一次做一个变量，如下所示：

df %>% 
  group_by(unitid) %>% 
  nest() %>% 

  mutate(tuition_and_fees_as_pct_total_rev_slope = map_dbl(data, ~lm(tuition_and_fees_as_pct_total_rev ~ year, data = .x) %>%
               tidy() %>%
                 filter(term == "year") %>%
                 pull(estimate)
               ))

所以：

我认为我的问题是如何将预测的列名传递到lm
我不知道解决方案是否需要嵌套，因此如果在考虑的mtcars 示例中将不胜感激。

【问题讨论】：

第二种情况，有没有可重现的例子。第一个不起作用，因为 1) across(-mpg) 关闭，2) data = .x 应该是原始数据，因为 .x 是向量
@akrun 不，不幸的是，我不知道如何让它工作。

标签： r dplyr purrr

【解决方案1】：

如果我们想在自变量为“mpg”的所有其他列上执行lm，一种选择是循环遍历除“mpg”之外的“mtcars”的列名，使用reformulate创建公式，应用lm，转换为tidy 格式，filter 出'拦截'和select'估计'列

library(dplyr)
library(tidyr)
library(broom)
map_dfc(setdiff(names(mtcars), 'mpg'), ~ 
   lm(reformulate('mpg', response = .x), data = mtcars) %>%
     tidy %>% 
     filter(term != "(Intercept)") %>%
     select(estimate))

-输出

# A tibble: 1 x 10
#   estimate...1 estimate...2 estimate...3 estimate...4 estimate...5 estimate...6 estimate...7 estimate...8 estimate...9 estimate...10
#      <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>        <dbl>         <dbl>
#1       -0.253        -17.4        -8.83       0.0604       -0.141        0.124       0.0555       0.0497       0.0588        -0.148

或者这可以通过 matrix 作为依赖更轻松地完成

library(stringr)
lm(as.matrix(mtcars[setdiff(names(mtcars), "mpg")]) ~ mpg, 
       data = mtcars) %>% 
    tidy %>% 
    filter(term != "(Intercept)") %>%
    select(response, estimate) %>%
    mutate(response = str_c(response, '_slope'))

-输出

# A tibble: 10 x 2
#   response   estimate
#   <chr>         <dbl>
# 1 cyl_slope   -0.253 
# 2 disp_slope -17.4   
# 3 hp_slope    -8.83  
# 4 drat_slope   0.0604
# 5 wt_slope    -0.141 
# 6 qsec_slope   0.124 
# 7 vs_slope     0.0555
# 8 am_slope     0.0497
# 9 gear_slope   0.0588
#10 carb_slope  -0.148

或者另一个选项是summarise 和across

mtcars %>%
     summarise(across(-mpg, ~ list(lm(reformulate('mpg', 
              response = cur_column())) %>%
                   tidy %>%
                   filter(term != "(Intercept)") %>%
                   pull(estimate)), .names = "{.col}_slope")) %>%
     unnest(everything())
# A tibble: 1 x 10
#  cyl_slope disp_slope hp_slope drat_slope wt_slope qsec_slope vs_slope am_slope gear_slope carb_slope
#      <dbl>      <dbl>    <dbl>      <dbl>    <dbl>      <dbl>    <dbl>    <dbl>      <dbl>      <dbl>
#1    -0.253      -17.4    -8.83     0.0604   -0.141      0.124   0.0555   0.0497     0.0588     -0.148

【讨论】：

谢谢。在实际数据中，并非所有其他列都是我使用 mutate(across(...)) 的原因
@jzadra 您可以将子集设置为矩阵并使用与更新中相同的自变量
@jzadra 我更新了两个选项。希望它对你有用
@jzadra 如果你有新名字.names = "{.col}_slope"))
@jzadra 很容易解释 filter(term != "(Intercept)") 而不是 filter(term != "(Intercept")

【解决方案2】：

一个选项可能是：

map_dfr(.x = names(select(mtcars, -c(mpg, vs))),
        ~ mtcars %>%
         group_by(vs) %>%
         nest() %>%
         mutate(variable = .x,
                estimate = map_dbl(data, function(y) lm(!!sym(.x) ~ mpg, data = y) %>% 
                                    tidy() %>%
                                    filter(term != "(Intercept)") %>%
                                    pull(estimate))) %>%
         select(-data))

     vs variable estimate
   <dbl> <chr>       <dbl>
 1     0 cyl       -0.242 
 2     1 cyl       -0.116 
 3     0 disp     -22.5   
 4     1 disp      -8.01  
 5     0 hp       -10.1   
 6     1 hp        -3.26  
 7     0 drat       0.0748
 8     1 drat       0.0529
 9     0 wt        -0.192 
10     1 wt        -0.113 
11     0 qsec      -0.0357
12     1 qsec      -0.0432
13     0 am         0.0742
14     1 am         0.0710
15     0 gear       0.114 
16     1 gear       0.0492
17     0 carb      -0.0883
18     1 carb      -0.0790

【讨论】：