创建 dplyr 语句,稍后在 R 中进行评估

Create dplyr statements to later be evaluated in R

我想创建一个名为 eval_data 的函数,用户可以在其中输入

  1. 数据帧列表
  2. 要应用于数据框的 dplyr 函数列表
  3. 每个数据帧 select 的列列表:

这看起来像:

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

dplyr_logic 是以下任一列表:

  1. 没有
  2. 一个变异语句
  3. 2 个变异语句
  4. 一个过滤器

输入 1:数据帧列表:

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

输入 3 Select 向量:

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

输入 2:应用于列表中每个数据框的逻辑列表

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_datalogic 列表中更改什么才能使这项工作正常进行?任何帮助表示赞赏!

两个变化。首先,您需要将 data %>% 包含在您的 dplyr 逻辑评估中:

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)

因此,我们需要使用代词 . 来指定管道输入在复杂表达式中的位置:

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