R 查找由 mutate() 中另一列值定义的列的值

Question

我正在尝试从我的数据框/tibble 中的其他列中查找依赖于列 var 中的值的值。我可以通过在 case_when() 中对它们进行硬编码来实现这一点。 :

library(tidyverse)
set.seed(1)
ds <- tibble(var = paste0("x", sample(1:3, 10, replace = T)),
             x1 = 0:9,
             x2 = 100:109,
             x3 = 1000:1009)
ds %>% 
   mutate(result = case_when(var == "x1" ~ x1,
                             var == "x2" ~ x2,
                             var == "x3" ~ x3))
#> # A tibble: 10 x 5
#>    var      x1    x2    x3 result
#>    <chr> <int> <int> <int>  <int>
#>  1 x1        0   100  1000      0
#>  2 x3        1   101  1001   1001
#>  3 x1        2   102  1002      2
#>  4 x2        3   103  1003    103
#>  5 x1        4   104  1004      4
#>  6 x3        5   105  1005   1005
#>  7 x3        6   106  1006   1006
#>  8 x2        7   107  1007    107
#>  9 x2        8   108  1008    108
#> 10 x3        9   109  1009   1009

但是，如果我没有只有 3 列而是许多 xn 呢？
我发现以下适用于外部变量/对象:

y <- "x2"
ds %>% 
  mutate(result = !!sym(y))
#> # A tibble: 10 x 5
#>    var      x1    x2    x3 result
#>    <chr> <int> <int> <int>  <int>
#>  1 x1        0   100  1000    100
#>  2 x3        1   101  1001    101
#>  3 x1        2   102  1002    102
#>  4 x2        3   103  1003    103
#>  5 x1        4   104  1004    104
#>  6 x3        5   105  1005    105
#>  7 x3        6   106  1006    106
#>  8 x2        7   107  1007    107
#>  9 x2        8   108  1008    108
#> 10 x3        9   109  1009    109

但它不适用于 tibble 中的内部变量/列:

ds %>% 
  mutate(result = !!sym(var))
#> Error: Only strings can be converted to symbols

创建于 2021-05-24 由 reprex package (v2.0.0)
非常感谢有关如何在数据框/tibble 列中使用它的任何想法。

Answer 1

使用 {dplyr}
我能想到的有两种解决方案。第一个在语法上更简洁，使用 rowwise()连同 get() :

ds %>% 
  rowwise() %>% 
  mutate(result = get(var)) %>% 
  ungroup()
#> # A tibble: 10 x 5
#>    var      x1    x2    x3 result
#>    <chr> <int> <int> <int>  <int>
#>  1 x1        0   100  1000      0
#>  2 x3        1   101  1001   1001
#>  3 x1        2   102  1002      2
#>  4 x2        3   103  1003    103
#>  5 x1        4   104  1004      4
#>  6 x3        5   105  1005   1005
#>  7 x3        6   106  1006   1006
#>  8 x2        7   107  1007    107
#>  9 x2        8   108  1008    108
#> 10 x3        9   109  1009   1009

使用 {purrr}
第二个用途 purrr::pmap()所以可以被认为更先进一点。然而，它具有更快和更简洁的优点:

ds %>% 
  mutate(result = pmap_int(., function(var, ...) c(...)[var]))
#> # A tibble: 10 x 5
#>    var      x1    x2    x3 result
#>    <chr> <int> <int> <int>  <int>
#>  1 x1        0   100  1000      0
#>  2 x3        1   101  1001   1001
#>  3 x1        2   102  1002      2
#>  4 x2        3   103  1003    103
#>  5 x1        4   104  1004      4
#>  6 x3        5   105  1005   1005
#>  7 x3        6   106  1006   1006
#>  8 x2        7   107  1007    107
#>  9 x2        8   108  1008    108
#> 10 x3        9   109  1009   1009

编辑:功能方法
我刚刚想到的另一种选择是以编程方式构造对 case_when() 的调用。 .这可能类似于以下内容:

# Define a function to construct a `case_when()` call:
x <- switch_cols <- function(var) {
  
  vals <- unique(var)
  
  name <- deparse(substitute(var))
  
  formulae <- lapply(
    sprintf("%s == '%s' ~ %s", name, vals, vals), 
    as.formula, 
    env = parent.frame()
  )
  
  case_when(!!!formulae)
  
}

ds %>% 
    mutate(result = switch_cols(var))
#> # A tibble: 10 x 5
#>    var      x1    x2    x3 result
#>    <chr> <int> <int> <int>  <int>
#>  1 x1        0   100  1000      0
#>  2 x3        1   101  1001   1001
#>  3 x1        2   102  1002      2
#>  4 x2        3   103  1003    103
#>  5 x1        4   104  1004      4
#>  6 x3        5   105  1005   1005
#>  7 x3        6   106  1006   1006
#>  8 x2        7   107  1007    107
#>  9 x2        8   108  1008    108
#> 10 x3        9   109  1009   1009

表现
我们可以使用 microbenchmark() 测试性能.为了完整性，我还包含了@akrun 的基本 R 解决方案:

microbenchmark::microbenchmark(
  
  rowwise = ds %>% 
    rowwise() %>% 
    mutate(result = get(var)) %>% 
    ungroup(),
  
  purrr = ds %>% 
    mutate(result = purrr::pmap_int(., function(var, ...) c(...)[var])),
  
  functional = ds %>% 
    mutate(result = switch_cols(var)),
  
  base1 = ds %>%
    mutate(result = as.data.frame(.[-1])[cbind(dplyr::row_number(), 
                                               match(var, names(.)[-1]))]),
  
  base2 = ds$result <- as.data.frame(ds[-1])[cbind(seq_len(nrow(ds)), 
                                                   match(ds$var, names(ds)[-1]))]
)
#> Unit: microseconds
#>       expr    min     lq    mean median      uq   max neval
#>    rowwise 5385.9 6347.3 10692.3 8127.9 12756.3 32893   100
#>      purrr 2957.2 3698.2  5837.4 4533.2  7566.6 12317   100
#> functional 3098.4 3956.6  5625.8 4536.0  7124.5 12665   100
#>      base1 3028.9 3867.3  5839.6 4525.5  7610.0 16408   100
#>      base2  275.9  386.6   584.5  488.6   676.9  3996   100

不出所料，“纯” base R方法无疑是最快的选择。除了 rowwise() 之外，其他都相当可比。这要慢得多。