r - 在 `dplyr::case_when()` 的上下文中使用 `dplyr::mutate()` 中的复杂 RHS 表达式

Question

问题

我正在尝试使用 dplyr::mutate()和 dplyr::case_when()在数据框中创建新的数据列，该列使用存储在另一个对象(“查找列表”)中的数据填充，并基于数据框中列中的信息。

我知道答案可能与 (im) 正确使用准引用和 NSE 有关，但我无法推断 Programming with dplyr vignette 中的信息对我的情况。

我希望在这里发布这个 reprex 可以指导我找到正确的答案，我认为解决这个问题对帮助我理解 NSE 大有帮助。

样本数据

key_list <- list(
  "a" = list(
    foo = 1,
    bar = 2),
  "b" = list(
    foo = 3,
    bar = 4),
  "c" = list(
    foo = 5,
    bar = 6)
  )

x <- tibble(fruit = c("apple", "orange", "grape", "apple", "apple", "orange"),
            `Old Letter` = c("a", "a", "b", "c", "c", "c"),
            `Old Number` = c(9, 8, 7, 6, 5, 4)
            )

x

# # A tibble: 6 x 3
#   fruit  `Old Letter` `Old Number`
#   <chr>  <chr>               <dbl>
# 1 apple  a                       9
# 2 orange a                       8
# 3 grape  b                       7
# 4 apple  c                       6
# 5 apple  c                       5
# 6 orange c                       4

目标

具体来说，我想在 x 中创建一个新列(我将其称为 `New Number` )基于 x$fruit 中的值填充和 x$`Old Letter` .

这是模仿我在实际用例中挂断电话的代码:

x %>% mutate(`New Number` = case_when(
  fruit == "apple" ~ pluck(key_list, `Old Letter`, "foo") * 10,
  fruit == "orange" ~ pluck(key_list, `Old Letter`, "foo") * 100,
  fruit == "grape" ~ pluck(key_list, `Old Letter`, "foo") * 1000
  ))

# Error: Index 1 must have length 1, not 6

预期输出

在我看来，我看到了这样的(期望的)操作顺序，例如第一排 x :

fruit == "apple"为 TRUE，因此计算此表达式:pluck(key_list, `Old Letter`, "foo") * 10

由于值在 `Old Letter`此行的列是 "a" ，表达式变为 pluck(key_list, "a", "foo") * 10 (应该对全局环境中的 key_list 对象进行操作)

这简化为 2 * 10等于 20

将此表达式的计算结果放入 `New Number`柱子。

将此外推到整个命令，我希望这是输出:

# # A tibble: 6 x 4
#   fruit  `Old Letter` `Old Number` `New Number`
#   <chr>  <chr>               <dbl>        <dbl>
# 1 apple  a                       9           20
# 2 orange a                       8          200
# 3 grape  b                       7         4000
# 4 apple  c                       6           60
# 5 apple  c                       5           60
# 6 orange c                       4          600

我的看法:

从我收到的错误消息来看，它看起来不是来自 `Old Letter` 的单个值。用作 pluck() 索引的列使用，整个 `Old Letter`列作为向量传递。我猜这是因为根据 documentation for case_when() :

case_when() is not a tidy eval function.

我试图追踪这是如何发生的，但跟踪堆栈似乎没有给我任何有用的地方，并将整个命令包装在 rlang::qq_show() 中。或 quo()没有向我展示 R 如何解释与 NSE 相关的命令，因为它们都抛出了同样的错误。

我已经尝试了以下组合:

quo() ,

enquo() ,

!! ,

!!enquo() (缩写为 {{}} )和

sym()

在 Reprex上面的代码，以及把它包装成一个函数，但它抛出了同样的错误:

get_num <- function(x, y) purrr::pluck(key_list, x, y)

x %>% mutate(`New Number` = case_when(
  fruit == "apple" ~ get_num(`Old Letter`, "foo") * 10,
  fruit == "orange" ~ get_num(`Old Letter`, "foo") * 100,
  fruit == "grape" ~ get_num(`Old Letter`, "foo") * 1000
  ))

# Error: Index 1 must have length 1, not 6

This answer另一个关于 SO 的问题告诉我

I guess what you are missing about case_when() is that the arguments are evaluated at once, not per row.

但我不确定这是否/如何适用于我的情况，所以我不知所措。

无论如何，感谢您提供的任何帮助!
sessionInfo() :

R version 3.6.0 (2019-04-26)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS  10.15

Matrix products: default
BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/3.6/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] rlang_0.4.1     readxl_1.3.1    forcats_0.4.0   stringr_1.4.0   dplyr_0.8.3     purrr_0.3.3     readr_1.3.1     tidyr_1.0.0     tibble_2.1.3   
[10] ggplot2_3.2.1   tidyverse_1.2.1

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.2       cellranger_1.1.0 pillar_1.4.2     compiler_3.6.0   base64enc_0.1-3  tools_3.6.0      digest_0.6.22    zeallot_0.1.0    evaluate_0.14   
[10] lubridate_1.7.4  jsonlite_1.6     lifecycle_0.1.0  nlme_3.1-141     gtable_0.3.0     lattice_0.20-38  pkgconfig_2.0.3  cli_1.1.0        rstudioapi_0.10 
[19] yaml_2.2.0       haven_2.1.1      xfun_0.10        withr_2.1.2      xml2_1.2.2       httr_1.4.1       knitr_1.25       generics_0.0.2   vctrs_0.2.0     
[28] hms_0.5.1        grid_3.6.0       tidyselect_0.2.5 glue_1.3.1       R6_2.4.0         fansi_0.4.0      rmarkdown_1.16   modelr_0.1.5     magrittr_1.5    
[37] htmltools_0.4.0  backports_1.1.5  scales_1.0.0     rvest_0.3.4      assertthat_0.2.1 colorspace_1.4-1 utf8_1.1.4       stringi_1.4.3    lazyeval_0.2.2  
[46] munsell_0.5.0    broom_0.5.2      crayon_1.3.4 

Answer 1

我认为这个问题可能与 NSE 的关系不大，而是 pluck未矢量化 - 如当前所写 pluck不是每行评估一次，而是尝试运行所有行 pluck立刻。然而，正如你所发现的，pluck需要单个数字输入，而不是向量。

解决此问题的一种方法是 map跨行的函数，使用您的代码作为一个小 lambda 风格的函数。请注意，您需要使用 map_dbl强制一个数值，否则 map将返回一个列表，一切都会爆炸:-)

x %>% 
  mutate(`New Number` = case_when(
    fruit == "apple" ~ map_dbl(`Old Letter`, ~ pluck(key_list, ., "foo")) * 10,
    fruit == "orange" ~ map_dbl(`Old Letter`, ~ pluck(key_list, ., "foo")) * 100,
    fruit == "grape" ~ map_dbl(`Old Letter`, ~ pluck(key_list, ., "foo")) * 1000
  ))

# # A tibble: 6 x 4
#   fruit  `Old Letter` `Old Number` `New Number`
#   <chr>  <chr>               <dbl>        <dbl>
# 1 apple  a                       9           10
# 2 orange a                       8          100
# 3 grape  b                       7         3000
# 4 apple  c                       6           50
# 5 apple  c                       5           50
# 6 orange c                       4          500