Упорядоченное оценочное программирование с помощью dplyr :: case_when

Я пытаюсь написать простую функцию, оборачивающуюся вокруг функции 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) в этом случае выдает ошибку оценки. Я хотел бы получить тот же результат, что и результат, полученный с помощью:

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

Как это сделать?


r dplyr lazy-evaluation nse
person mharinga    schedule 29.12.2017    source источник
comment
Это должно работать из коробки, для этого есть проблема с GitHub: github.com/tidyverse/dplyr / issues / 3133. А пока воспользуйтесь одной из альтернатив, предложенных в ответе.   -  person krlmlr    schedule 29.12.2017

Ответы (3)


arrow_upward
7
arrow_downward

Процитируйте сначала каждый элемент вашего списка:

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

Тогда ваша функция не должна цитировать сам объект cat. Я также изменил использование аргумента «все остальное» ..., чтобы явно ссылаться на аргумент категории в вызове:

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
person Stewart Ross    schedule 29.12.2017
comment
Это решение сработало для меня. Но есть ли способ обойтись написанием слова quo для каждого элемента в списке? Мой наивный подход состоял в том, чтобы попытаться определить quolist <- function(...) { lapply(X = list(...), FUN = quo) }, но, похоже, это не сработало. - person rcorty; 30.03.2019
comment
Да, код, использованный в исходном вопросе, больше не выдает сообщения об ошибке. - person mharinga; 05.04.2019

arrow_upward
8
arrow_downward

1) список проходов. Используя let из пакета wrapr и 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
person G. Grothendieck    schedule 29.12.2017

arrow_upward
1
arrow_downward

Вот еще один подход, ориентированный на 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)))
person Ploulack    schedule 04.10.2020