使用dplyr::case_when进行整洁评估编程

Question

我尝试编写一个简单的函数，用于包装dplyr::case_when()函数。我阅读了 dplyr编程 文档在 https://cran.r-project.org/web/packages/dplyr/vignettes/programming.html 上但是无法弄清楚如何在case_when()函数中使用此功能。

我有以下数据：

data <- tibble(
   item_name = c("apple", "bmw", "bmw")
)

并列如下列表：

cat <- list(
   item_name == "apple" ~ "fruit",
   item_name == "bmw" ~ "car"
)

那么我想编写一个类似的函数：

category_fn <- function(df, ...){
   cat1 <- quos(...)
   df %>%
     mutate(category = case_when((!!!cat1)))
}

不幸的是，在这种情况下，category_fn(data,cat)会产生评估错误。 我希望获得与以下输出相同的输出：

很抱歉，在这种情况下，category_fn(data,cat)会引发评估错误。我希望获得与以下代码输出相同的结果：

data %>% 
   mutate(category = case_when(item_name == "apple" ~ "fruit",
                               item_name == "bmw" ~ "car"))

怎样做才能实现这个？

- mharinga

---

这应该可以直接使用，有一个GitHub问题与之对应：https://github.com/tidyverse/dplyr/issues/3133。目前，使用答案中建议的替代方案之一。 - krlmlr

Answer 1

1) pass list 使用wrapr包中的let，以及从问题中使用的data和cat函数，可以在不修改任何输入的情况下完成此操作。

library(dplyr)
library(wrapr)

category_fn <- function(data, List) {
  let(c(CATEGORY = toString(sapply(List, format))),
      data %>% mutate(category = case_when(CATEGORY)),
      subsMethod = "stringsubs",
      strict = FALSE)
}
category_fn(data, cat) # test

提供：

# A tibble: 3 x 2
  item_name category
      <chr>    <chr>
1     apple    fruit
2       bmw      car
3       bmw      car

1a) 使用tidyeval/rlang以及来自问题的data和cat:

category_fn <- function(data, List) {
  cat_ <- lapply(List, function(x) do.call("substitute", list(x)))
  data %>% mutate(category = case_when(!!!cat_))
}
category_fn(data, cat)

给出与上述相同的结果。

2) 分别传递列表组件：如果您的意图是分别传递cat的每个组件而不是cat本身，则可以这样做：

category_fn <- function(data, ...) eval.parent(substitute({
   data %>% mutate(category = case_when(...))
}))

category_fn(data, item_name == "apple" ~ "fruit",
                   item_name == "bmw" ~ "car") # test

提供：

# A tibble: 3 x 2
  item_name category
      <chr>    <chr>
1     apple    fruit
2       bmw      car
3       bmw      car

2a) 如果您更喜欢使用tidyeval/rlang，则这种情况很简单：

library(dplyr)
library(rlang)

category_fn <- function(data, ...) {
   cat_ <- quos(...)
   data %>% mutate(category = case_when(!!!cat_))
}

category_fn(data, item_name == "apple" ~ "fruit",
                   item_name == "bmw" ~ "car") # test

- G. Grothendieck

Answer 2

首先引用列表中的每个元素：

cat <- list(
  quo(item_name == "apple" ~ "fruit"),
  quo(item_name == "bmw" ~ "car")
)

您的函数此时不必引用cat对象本身。我还将“everything else（其他所有东西）”参数的使用更改为在调用中明确引用category参数：

category_fn <- function(df, categories){
  df %>%
    mutate(category = case_when(!!!categories))
}

函数的输出结果如预期所示：

category_fn(data, cat)
# A tibble: 3 x 2
  item_name category
      <chr>    <chr>
1     apple    fruit
2       bmw      car
3       bmw      car

为了完整起见，我需要指出当使用基本的R quote()函数定义时，类别列表也可以与您的函数一起使用：

cat <- list(
  quote(item_name == "apple" ~ "fruit"),
  quote(item_name == "bmw" ~ "car")
)
> cat
[[1]]
item_name == "apple" ~ "fruit"

[[2]]
item_name == "bmw" ~ "car"

> category_fn(data, cat)
# A tibble: 3 x 2
  item_name category
      <chr>    <chr>
1     apple    fruit
2       bmw      car
3       bmw      car

- Stewart Ross

---

这个解决方案对我很有效。但是有没有办法避免在列表中的每个项目中编写单词 quo？我的天真做法是尝试定义 quolist <- function(...) { lapply(X = list(...), FUN = quo) }，但似乎不起作用。 - rcorty

是的，原问题中使用的代码不再产生错误信息。 - mharinga

Answer 3

这里有另一种以tidyverse为中心的方法

cat <- tribble(
    ~name, ~category,
    "apple", "fruit",
    "bmw", "car"
) %>% 
    str_glue_data("item_name == '{name}' ~ '{category}'")

data %>% 
    mutate(category = case_when(!!! map(cat, rlang::parse_expr)))

- Ploulack