使用 purrr::map 函数对 mutate(across(...)) 进行操作

Question

我在使用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。

在我的实际数据中，我还会按另一个变量进行分组，以便为每个预测变量的每个组计算斜率。我已经可以使用标准的 mutate 函数来针对每个变量单独完成此操作，如下所示：

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)
               ))

因此：

1. 我认为我的问题是如何将要预测的列名传递给lm。
2. 我不知道解决方案是否需要嵌套，所以如果在考虑的mtcars示例中，可以给予一些提示就好了。

- jzadra

---

在第二种情况下，您是否有一个可重现的示例。第一个示例没起作用是因为1）across(-mpg)已关闭，2）data = .x应该是原始数据，因为.x是一个向量。 - akrun

@akrun 不幸的是，我还没有，因为我卡在了如何让它工作上。 - jzadra

Answer 1

如果我们想要对 'mpg' 作为自变量在 'mtcars' 的所有其他列上进行 lm，一种选项是循环遍历除了 'mpg' 以外的 'mtcars' 的列名，使用 reformulate 创建公式，应用 lm，将其转换为 tidy 格式，filter 掉“Intercept”，并 select “estimate” 列。

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

或者可以更轻松地使用一个矩阵作为依赖项。

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 

---

另一种选择是使用 across 的 summarise。

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

- akrun

---

@jzadra 你可以将数据子集化为矩阵，并使用与更新相同的自变量。 - akrun

@jzadra，我更新了两个选项。希望对你有用。 - akrun

我也很困惑为什么会返回两个值（即为什么它是嵌套的）- 应该只返回一个值。 - jzadra

@jzadra 如果你给新的名称 .names = "{.col}_slope"。 - akrun

@jzadra，这很容易解释：filter(term != "(Intercept)")而不是filter(term != "(Intercept")。 - akrun

Answer 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

- tmfmnk