对多个任意过滤条件使用 tidy eval

Question

我想使用整洁的评估来编写多个、完全灵活的过滤条件。一个相关但不太复杂的问题已在 Stackoverflow Question 中得到解决。以下代码（改编自上述其他问题）正在运行。它将两个过滤条件应用于gapminder数据集，并返回过滤后的数据。

library(tidyverse)
library(gapminder)

my_filter <- function(df, cols, vals){    
  paste_filter <- function(x, y) quo(!!sym(x) %in% {{y}})
  fp <- pmap(list(cols, vals), paste_filter)
  filter(df, !!!fp)
}

cols <- list("country", "year")
vals = list(c("Albania", "France"), c(2002, 2007))
gapminder %>% my_filter(cols, vals) 

问题：到目前为止，该解决方案仅限于一种类型的过滤运算符 ( %in%)。我想扩展这种方法以接受任意类型的运算符（==, %in%, >, ...）。预期的函数my_filter应该处理以下内容：

cols <- list("country", "year")
ops <- list("%in%", ">=")
vals = list(c("Albania", "France"), 2007))
gapminder %>% my_filter(cols, ops, vals)

我脑海中浮现的用例是闪亮的应用程序。使用这样的功能，我们可以更轻松地让用户对数据集的变量设置任意过滤条件。

Answer 1

创建一个调用列表并将它们拼接到：

\n

library(dplyr)\nlibrary(gapminder)\n\ncols <- list("country", "year")\nops <- list("%in%", ">=")\nvals <- list(c("Albania", "France"), 2007)\n\n# Assumes LHS is the name of a variable and OP is\n# the name of a function\nop_call <- function(op, lhs, rhs) {\n  call(op, sym(lhs), rhs)\n}\n\nmy_filter <- function(data, cols, ops, vals) {\n  exprs <- purrr::pmap(list(ops, cols, vals), op_call)\n  data %>% dplyr::filter(!!!exprs)\n}\n\ngapminder %>% my_filter(cols, ops, vals)\n#> # A tibble: 2 \xc3\x97 6\n#>   country continent  year lifeExp      pop gdpPercap\n#>   <fct>   <fct>     <int>   <dbl>    <int>     <dbl>\n#> 1 Albania Europe     2007    76.4  3600523     5937.\n#> 2 France  Europe     2007    80.7 61083916    30470.\n

\n

在这里，我们不必担心范围问题，因为 (a) 假定列名在数据掩码中定义，(b) 值按值传递并内联到创建的调用中，(c) 函数假定为二元运算符，并且很少重新定义它们。

\n

为了允许自定义用户功能，我们可以采用两种方法。首先，我们可以使用以下命令手动创建环境并创建配额new_quosure()：

\n

op_call <- function(op, lhs, rhs, env = caller_env()) {\n  new_quosure(call(op, sym(lhs), rhs), env)\n}\n\nmy_filter <- function(data, cols, ops, vals, env = caller_env()) {\n  exprs <- purrr::pmap(list(ops, cols, vals), op_call, env)\n  data %>% dplyr::filter(!!!exprs)\n}\n\ngapminder %>% my_filter(cols, ops, vals)\n\nlocal({\n  my_op <- `%in%`\n  gapminder %>% my_filter(cols, list("my_op", ">="), vals)\n})\n#> # A tibble: 2 \xc3\x97 6\n#>   country continent  year lifeExp      pop gdpPercap\n#>   <fct>   <fct>     <int>   <dbl>    <int>     <dbl>\n#> 1 Albania Europe     2007    76.4  3600523     5937.\n#> 2 France  Europe     2007    80.7 61083916    30470.\n

\n

另一种可能更简单的方法是允许调用包含内联函数。为此，请使用rlang::call2()而不是base::call()：

\n

op_call <- function(op, lhs, rhs) {\n  call2(op, sym(lhs), rhs)\n}\n\nmy_filter <- function(data, cols, ops, vals) {\n  exprs <- purrr::pmap(list(ops, cols, vals), op_call)\n  data %>% dplyr::filter(!!!exprs)\n}\n\nlocal({\n  my_op <- `%in%`\n  gapminder %>% my_filter(cols, list(my_op, ">="), vals)\n})\n#> # A tibble: 2 \xc3\x97 6\n#>   country continent  year lifeExp      pop gdpPercap\n#>   <fct>   <fct>     <int>   <dbl>    <int>     <dbl>\n#> 1 Albania Europe     2007    76.4  3600523     5937.\n#> 2 France  Europe     2007    80.7 61083916    30470.\n

\n

内联函数的缺点是，这将阻止优化和到其他 dplyr 后端的可移植性。

\n