如何在dplyr :: across（）中使用返回多个值的函数？

Question

我想对多列执行多个操作，可以使用 dplyr::across() 来实现：

library(tidyverse)

df = tibble(x=1:5, p1=x*2, p2=x*4, p3=x*5)
r1 = df %>% 
    mutate(across(starts_with("p"), c(inf=~.x-1, sup=~.x+1)))
r1
#> # A tibble: 5 x 10
#>       x    p1    p2    p3 p1_inf p1_sup p2_inf p2_sup p3_inf p3_sup
#>   <int> <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
#> 1     1     2     4     5      1      3      3      5      4      6
#> 2     2     4     8    10      3      5      7      9      9     11
#> 3     3     6    12    15      5      7     11     13     14     16
#> 4     4     8    16    20      7      9     15     17     19     21
#> 5     5    10    20    25      9     11     19     21     24     26
names(r1)
#>  [1] "x"      "p1"     "p2"     "p3"     "p1_inf" "p1_sup" "p2_inf" "p2_sup"
#>  [9] "p3_inf" "p3_sup"

然而，如果函数计算很多东西，这种方法并不是非常可扩展的，因为它会被评估两次。

相反，如果我能够使用一个计算需要计算的事物的函数，并返回2个（或更多）结果的列表，那就太好了。

例如，考虑以下示例：

#perform heavy calculation on x2 and return 2 flavours of it
f = function(x) {
    x2=x #wow, such heavy, very calculate
    Sys.sleep(1)
    data.frame(inf=x2-10, sup=x2+10)
}

r2 = df %>% 
    mutate(across(starts_with("p"), f, .names="{.col}_{.fn}"))
r2
#> # A tibble: 5 x 7
#>       x    p1    p2    p3 p1_1$inf  $sup p2_1$inf  $sup p3_1$inf  $sup
#>   <int> <dbl> <dbl> <dbl>    <dbl> <dbl>    <dbl> <dbl>    <dbl> <dbl>
#> 1     1     2     4     5       -8    12       -6    14       -5    15
#> 2     2     4     8    10       -6    14       -2    18        0    20
#> 3     3     6    12    15       -4    16        2    22        5    25
#> 4     4     8    16    20       -2    18        6    26       10    30
#> 5     5    10    20    25        0    20       10    30       15    35
names(r2)
#> [1] "x"    "p1"   "p2"   "p3"   "p1_1" "p2_1" "p3_1"
map_chr(r2, class)
#>            x           p1           p2           p3         p1_1         p2_1 
#>    "integer"    "numeric"    "numeric"    "numeric" "data.frame" "data.frame" 
#>         p3_1 
#> "data.frame"

^{此文档由reprex包（v2.0.1）于2021-10-25创建。}

使用rbind()代替data.frame()将得到相同的结果，只是变量名略有不同（p1_1$inf变成了p1_1[,"inf"]），并且返回的对象类型也不同（data.frame变成了c("matrix", "array")）。

此外，在使用单个函数时，{.fn}是函数的位置，因此可能存在命名问题。

我也尝试过使用unnest()，但没有成功。

是否有一种方法可以使用across()中的函数得到第一个输出的确切结果？

- Dan Chaltiel

---

你可不可以把繁重的计算结果x2存储到一个新的列/数据框中，然后使用mutate将下一步(inf/sup)应用在其中？如果你正在使用一个新的数据框，请将其与原始数据框联接起来。 - Martin Gal

@MartinGal确实，如果没有更简单的解决方案，那可能是我会采取的方式。但我相信一定有更好的方法。 - Dan Chaltiel

Answer 1

也许这会对你有所帮助？

library(tidyverse)

f = function(x, y) {
  x2=x
  tibble(!!paste0(y, '_inf') := x2-10, 
         !!paste0(y, '_sup') := x2+10)
}

imap_dfc(select(df, starts_with('p')), f)

#  p1_inf p1_sup p2_inf p2_sup p3_inf p3_sup
#   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
#1     -8     12     -6     14     -5     15
#2     -6     14     -2     18      0     20
#3     -4     16      2     22      5     25
#4     -2     18      6     26     10     30
#5      0     20     10     30     15     35

将原始数据框 df 绑定到当前环境中。

bind_cols(df %>% select(-starts_with('p')), 
          imap_dfc(select(df, starts_with('p')), f))

- Ronak Shah

---

很棒的答案！如果我们假设列x是一个ID列，那么有没有一种简单的方法来保留这个列并将您的f应用于其余的以“p”开头的列？我问这个问题，因为我通常会尝试避免使用bind_cols而选择使用*_join函数。但是我在这里看不到明显的解决方案来保留x。 - Martin Gal

是的，我也一样。我认为bind_cols解决方案应该很简单并且有效。 - Ronak Shah

非常好的答案，谢谢。 - Dan Chaltiel

Answer 2

实际上，由于你已经完成了繁重的计算，得到了一个嵌套的数据框，所以你只需要将其转换为平面形式，也许一些 mutate() 和 rename 可以帮助吗？

r2 <- df %>% 
mutate(across(2:4, f, .names="{.col}_{.fn}")) %>% 
mutate(across(5:7, .names = ("{.col}_inf"), .fn = ~ .x[,1] )  ) %>%
mutate(across(5:7, .names = ("{.col}_sup"), .fn = ~ .x[,2] )  ) %>% 
rename_with(.fn = ~ gsub("_1_", "_", .x)) %>% 
select(-contains("_1"))

> r2
# A tibble: 5 x 10
      x    p1    p2    p3 p1_inf p2_inf p3_inf p1_sup p2_sup p3_sup
  <int> <dbl> <dbl> <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1     1     2     4     5     -8     -6     -5     12     14     15
2     2     4     8    10     -6     -2      0     14     18     20
3     3     6    12    15     -4      2      5     16     22     25
4     4     8    16    20     -2      6     10     18     26     30
5     5    10    20    25      0     10     15     20     30     35

- Werner Stauffacher

---

稍微通俗一点：df %>% mutate(across(starts_with("p"), f, .names = "{.col}_{.fn}")) %>% mutate(across(-colnames(df), .fn = list(inf = ~ .x[,1], sup = ~.x[,2])), .keep = "unused") %>% rename_with(.fn = ~ gsub("_1_", "_", .x)). ；-) - Martin Gal

非常好的答案，谢谢。我认为这就是unpack()在内部执行的操作。 - Dan Chaltiel

Answer 3

实际上，这个问题已经在 dplyr 的 Github 上被考虑过了：https://github.com/tidyverse/dplyr/issues/5563#issuecomment-721769342。

在那里，@romainfrancois 提供了一个非常有用的解决方案，即使用 unpackross() 函数：

library(tidyverse)
f = function(x) tibble(inf=x-10, sup=x+10)
unpackross = function(...) {
    out = across(...)
    tidyr::unpack(out, names(out), names_sep = "_")
}

df = tibble(x=1:5, p1=x*2, p2=x*4, p3=x*5)
r2 = df %>% 
    mutate(unpackross(starts_with("p"), f, .names="{.col}_{.fn}"))
r2
#> # A tibble: 5 x 10
#>       x    p1    p2    p3 p1_1_inf p1_1_sup p2_1_inf p2_1_sup p3_1_inf p3_1_sup
#>   <int> <dbl> <dbl> <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
#> 1     1     2     4     5       -8       12       -6       14       -5       15
#> 2     2     4     8    10       -6       14       -2       18        0       20
#> 3     3     6    12    15       -4       16        2       22        5       25
#> 4     4     8    16    20       -2       18        6       26       10       30
#> 5     5    10    20    25        0       20       10       30       15       35
names(r2)
#>  [1] "x"        "p1"       "p2"       "p3"       "p1_1_inf" "p1_1_sup"
#>  [7] "p2_1_inf" "p2_1_sup" "p3_1_inf" "p3_1_sup"
map_chr(r2, class)
#>         x        p1        p2        p3  p1_1_inf  p1_1_sup  p2_1_inf  p2_1_sup 
#> "integer" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" 
#>  p3_1_inf  p3_1_sup 
#> "numeric" "numeric"

^{2021-10-26由reprex包（v2.0.1）创建}

希望有一天across()中会有一个unpack参数！（如果您同意，请在这里给我的建议加上+1）

- Dan Chaltiel