Создайте операторы dplyr для последующей оценки в R

Question

Я хочу создать одну функцию с именем eval_data, где пользователь может ввести

1. список фреймов данных
2. список dplyr функций для применения к фреймы данных
3. список столбцов для выбора из каждого фрейма данных:

Это будет выглядеть примерно так:

eval_data <- function(data, dplyr_logic, select_vector) {
  data %>%
    # this doesn't work
    eval(dplyr_logic) %>%
    select(
      { select_vector }
    )
}

dplyr_logic - это список либо:

1. Ничего
2. Оператор mutate
3. 2 оператора mutate
4. a filter

Вход 1: Список фреймов данных:

dd <- list()
dd$data <- list(
  mutate0 = iris,
  mutate1 = iris,
  mutate2= iris,
  filter1 = iris
)

Вход 3 Выберите вектор:

select_vec <- list(
  c("Species", "Sepal.Length"),
  c("Species", "New_Column1"),
  c("Species", "New_Column2", "New_Column3"),
  c("Species", "Sepal.Width")
)

Вход 2: список логик c для применения к каждому фрейму данных в списке

logic <- list(
  # do nothing -- this one works
  I(),
  #mutate1
  rlang::expr(mutate(New_Column1 = case_when(
    Sepal.Length > 7 ~'Big',
    Sepal.Length > 6 ~ 'Medium',
    TRUE ~ 'Small'
    )
  )),
  #mutate2
  rlang::expr(mutate(New_Column2 = case_when(
    Sepal.Width > 3.5 ~'Big2',
    Sepal.Width > 3 ~ 'Medium2',
    TRUE ~ 'Small2'
  )) %>%
    mutate(
      New_Column3 = case_when(
        Petal.Width > 2 ~'Big3',
        Petal.Width > 1 ~ 'Medium3',
        TRUE ~ 'Small3'
      )
    )
  ),
  #filter1
  rlang::expr(filter(Sepal.Width > 3))
)

# eval_data(dd$data[[1]], logic[[1]], select_vec[[1]]) works
# eval_data(dd$data[[2]], logic[[2]], select_vec[[2]]) does not

Желаемая цель:

pmap(dd$data, logic, select_vec, ~eval_data)

Желаемая продукция

pmap_output <- list(
  iris1 = iris %>% I() %>% select("Species", "Sepal.Length"),

  iris2 = iris %>% 
    mutate(New_Column1 = 
             case_when(
               Sepal.Length > 7 ~'Big',
               Sepal.Length > 6 ~ 'Medium',
               TRUE ~ 'Small')) %>% 
    select("Species", "New_Column1"),

  iris4 = iris %>% 
    mutate(New_Column2 = case_when(
      Sepal.Width > 3.5 ~'Big2',
      Sepal.Width > 3 ~ 'Medium2',
      TRUE ~ 'Small2'
    )) %>%
    mutate(
      New_Column3 = case_when(
        Petal.Width > 2 ~'Big3',
        Petal.Width > 1 ~ 'Medium3',
        TRUE ~ 'Small3'
      )
    ) %>%
    select("Species", "New_Column2", "New_Column3"),

  iris3 = iris %>% filter(Sepal.Width > 3) %>% select("Species", "Sepal.Width")
)

Что мне нужно изменить в eval_data и списке logic, чтобы сделать эту работу ? Любая помощь приветствуется!

Answer 1

Два изменения. Во-первых, вам нужно включить data %>% в вашу оценку dplyr logi c:

eval_data <- function(data, dplyr_logic, select_vector) {
    rlang::expr( data %>% !!dplyr_logic ) %>%
        eval() %>%
        select( one_of(select_vector) )
}

Во-вторых, цепочка мутаций на самом деле немного сложнее. Напомним, что x %>% f(y) можно переписать как f(x,y). Следовательно, ваше выражение с двойным изменением может быть переписано как mutate( mutate(expr1), expr2 ). Когда вы передаете данные в него, оно становится

mutate(data, mutate(expr1), expr2)

вместо желаемого

mutate(mutate(data, expr1), expr2)

Итак, нам нужно использовать местоимение ., чтобы указать, куда должен вводиться канал go в нашем сложном выражении:

logic <- rlang::exprs(                # We can use exprs instead of list(expr())
  I(),
  mutate(New_Column1 = case_when(
    Sepal.Length > 7 ~'Big',
    Sepal.Length > 6 ~ 'Medium',
    TRUE ~ 'Small'
    )),
  {mutate(., New_Column2 = case_when(       # <--- NOTE the { and the .
    Sepal.Width > 3.5 ~'Big2',
    Sepal.Width > 3 ~ 'Medium2',
    TRUE ~ 'Small2')) %>%
    mutate(
      New_Column3 = case_when(
        Petal.Width > 2 ~'Big3',
        Petal.Width > 1 ~ 'Medium3',
        TRUE ~ 'Small3'
      ))},                                  # <--- NOTE the matching }
  filter(Sepal.Width > 3)
)

Теперь все работает:

res <- pmap(list(dd$data, logic, select_vec), eval_data)

## Compare to desired output
map2_lgl( res, pmap_output, identical )
#  mutate0 mutate1 mutate2 filter1
#     TRUE    TRUE    TRUE    TRUE