【问题标题】：R Lookup values of a column defined by another column's values in mutate()R查找由mutate（）中另一列的值定义的列的值
【发布时间】：2021-05-24 20:11:32
【问题描述】：

我正在尝试从我的数据框/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

^{由reprex package (v2.0.0) 于 2021 年 5 月 24 日创建}
非常感谢任何有关如何使其在数据框/小标题列中工作的想法。

【问题讨论】：

标签： r

【解决方案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() 慢很多。

【讨论】：

非常感谢！没想到rowwise()和get()的组合
没问题！如果有解决方案使用mget() 来避免使用rowwise()，那就太好了，但不幸的是我认为这是不可能的。

【解决方案2】：

在base R 中使用行/列索引方法会更快

ds$result <- as.data.frame(ds[-1])[cbind(seq_len(nrow(ds)), 
       match(ds$var, names(ds)[-1]))]
ds$result
#[1]    0 1001    2  103    4 1005 1006  107  108 1009

或dplyr构造中的相同`

ds %>%
    mutate(result = as.data.frame(.[-1])[cbind(row_number(), 
         match(var, names(.)[-1]))])
# 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

【讨论】：

不错！是的，我的任何一个解决方案所花费的时间大约为 5%。如果速度是一个优先事项，我会说使用这个解决方案。

【解决方案3】：

这里已经发布了另一种非常相似的解决方案。也可以将get函数与包胶的函数glue结合使用：

library(dplyr)
library(glue)

ds %>%
  rowwise() %>%
  mutate(result = get(glue({var})))

# A tibble: 10 x 5
# Rowwise: 
   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

在函数 glue 的调用中，无论您放在双括号之间的任何内容都将被评估为 R 代码。

【讨论】：

glue 的不错选择
非常感谢。起初，这听起来像是多了一步，因为我们可以使用get 和var 获得相同的结果。但我已经广泛使用它了。

【解决方案4】：

您还可以考虑使用 pivot_longer() 的替代 tidyverse 解决方案。

library(dplyr)
library(tidyr)

ds %>%
  pivot_longer(-var) %>%
  filter(var == name) %>%
  bind_cols(ds) %>%
  select(-name, -var...4, 'var' = 'var...1', 'result' = 'value')

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

【讨论】：