R元编程：使用函数调用粘贴逻辑表达式

Posted 2023-03-25

【中文标题】R元编程：使用函数调用粘贴逻辑表达式

【英文标题】：R meta programming: Paste logic expressions with function call

【发布时间】：2021-12-11 16:52:08

【问题描述】：

我想要一个粘贴逻辑表达式的函数

paste_logic(a == b, c > q, f < g, sep = and) 
# should return
# expr(a == b & c > q & f < g)

我还想在 ruturning 期间（不是在函数调用中）懒惰地取消引用，理想情况下控制哪一侧

paste_expr(paste_expr(a == b, c > q, f < g, sep = and, side = right)
# should return
# expr(a == !!b & c > !!q & f < !!g)

我实现第一个目标的解决方案是：

paste_logic <- function(sep, ...) 
  dots <- enquos(...)
  sep <- enexpr(sep)
  dispatch <- function(symbol) if (symbol == expr(and)) `&` else `|`
  if (length(dots) == 1) 
    dots[[1]]
   else 
    expr(`!!`(dispatch(sep))(!!(dots[[1]]), !!paste_logic(sep, !!!dots[-1])))
  

paste_logic(and, a > b, c == d, k == f) 
# returns
# .Primitive("&")(~a > b, .Primitive("&")(~c == d, ~k == f))

和

a <- 1
b <- 2
c <- 3
d <- 3
k <- 9
f <- 10

eval_tidy(paste_logic(and, a > b, c == d, k == f))
# returns FALSE
eval_tidy(paste_logic(or, a > b, c == d, k == f))
# returns TRUE

两者都符合预期。

关于如何改进这段代码并实现第二个目标（在返回的表达式中取消引用），我有几个问题。

第一季度。在这部分最后else ...闭包：

expr(`!!`(dispatch(sep))(!!(dots[[1]]), !!paste_logic(sep, !!!dots[-1])))

我必须使用素数符号来包装!! 运算符或使用UQ 函数。如果我简单地将它作为!!(dispatch(sep)) 或完整的函数定义作为这个

paste_logic <- function(sep, ...) 
  dots <- enquos(...)
  sep <- enexpr(sep)
  dispatch <- function(symbol) if (symbol == expr(and)) `&` else `|`
  if (length(dots) == 1) 
    dots[[1]]
   else 
    expr(!!(dispatch(sep))(!!(dots[[1]]), !!paste_logic(!!sep, !!!dots[-1])))
  

paste_logic(or, a > b, c == d, k == f)

返回错误

Error: Quosures can only be unquoted within a quasiquotation context.

  # Bad:
  list(!!myquosure)

  # Good:
  dplyr::mutate(data, !!myquosure)

在全球环境中测试

a <- 1
b <- 2
c <- `&`
expr(!!(c)(!!a, !!n))

工作正常且没有错误并返回TRUE。那么，为什么在我的代码中这不起作用而我必须使用<prime>!!<prime>？

第二季度。我必须使用逻辑运算符的前缀函数版本，因此最终表达式是对.Primitive("&") 的递归函数调用。

有没有办法将& 和| 作为函数外部的符号传递，所以我得到最终表达式为expr(a == b & c > q & f < g)？

简单地将& 和| 与ensym 或enexpr 包装在函数体内会产生如下错误：Error: unexpected '&' in "expr(&"

第三季度。此解决方案不支持在返回的表达式中进一步取消引用，例如

expr(a == !!b & c > !!q & f < !!g)

因为每个dots[[i]] 都是像a == b 这样的单个表达式，我无法进一步分解和操作。定义不被引用的一面甚至更难完成。有什么简单的方法可以实现吗？

【问题讨论】：

您能否发布您实际尝试解决的问题的摘要？我不相信你会以正确的方式去做。

@wurli，我要解决的问题是我要编写的函数不言自明：我想使用函数的方式将几个单个逻辑表达式粘贴到一个完整的逻辑表达式中。我没有使用任何数据对象。我正在直接使用代码。

对不起，我不清楚。你会用这样的功能做什么？或者您只是想了解更多关于 R 元编程的信息？

此模式的一个实际示例是dplyr::filter()，它在内部将... 中的输入与布尔运算符连接起来。

@wurli 感谢您的关注。我正在使用它来学习 R 中元编程和 rlang 的详细信息。我确实有一个用于构建简单语言解释器的用例。有一段与逻辑有关。为此，我需要首先了解 R 对操作和评估表达式的支持，并尽可能多地关注范围和环境安全。您可以认为这是一个玩具示例。我还有其他玩具示例。

【参考方案1】：

我认为您正在寻找减少操作：

exprs_reduce <- function(xs, op) 
  n <- length(xs)

  if (n == 0) 
    return(NULL)
  

  if (n == 1) 
    return(xs[[1]])
  

  # Replace `call()` by `call2()` to support inlined functions
  purrr::reduce(xs, function(out, new) call(op, out, new))


exprs_reduce(alist(), "&")
#> NULL

exprs_reduce(alist(foo), "&")
#> foo

exprs_reduce(alist(foo, bar), "&")
#> foo & bar

exprs_reduce(alist(foo, bar, baz), "|")
#> foo | bar | baz

【讨论】：

该列表可能包含 quosures，但必须使用 eval_tidy() 评估简化的表达式（在 op 在范围内的环境中，当前环境通常应该有效，但如果 op 则不一定由用户提供）。

【参考方案2】：

我会听从 Lionel Henry 在解决您问题的一般方法方面的专业知识，但要让您的函数完全按照您的要求执行，您可以尝试以下方法：

library(rlang)

paste_logic <- function(sep, ..., side = "none")

  elements <- as.list(match.call())[-1]
  sep <- elements$sep
  elements <- elements[!nzchar(names(elements))]

  sep <- if(sep == expr(and)) " & " else " | "
  if(side == "right") 
    elements <- lapply(elements, function(x) 
      x <- as.character(x); 
      x[3] <- paste0("!!", x[3]); 
      str2lang(paste(x[c(2, 1, 3)], collapse = " ")))
  
  if(side == "left") 
    elements <- lapply(elements, function(x) 
      x <- as.character(x); 
      x[2] <- paste0("!!", x[2]); 
      str2lang(paste(x[c(2, 1, 3)], collapse = " ")))
  
  result <- do.call(function(...) paste(..., sep = sep), 
                    lapply(elements, capture.output))
  return(str2lang(result))

这将返回实际的语言对象，以及可选的 bang-bang 运算符：

paste_logic(and, a == b, c > q, f < g)
#> a == b & c > q & f < g

paste_logic(or, a == b, c > q, f < g)
#> a == b | c > q | f < g

paste_logic(and,  a == b, c > q, f < g, side = "left")
#> !!a == b & !!c > q & !!f < g

paste_logic(and,  a == b, c > q, f < g, side = "right")
#> a == !!b & c > !!q & f < !!g

当然，这些可以按预期进行评估：

a <- 1
b <- 2
c <- 3
d <- 3
k <- 9
f <- 10

eval_tidy(paste_logic(and, a > b, c == d, k == f))
#> [1] FALSE

eval_tidy(paste_logic(or, a > b, c == d, k == f))
#> [1] TRUE

^{由reprex package (v2.0.0) 于 2021 年 10 月 26 日创建}

【讨论】：

感谢您的回答。我看到你使用 str2lang 。我几乎找不到详细的文档，它是一个基本功能。是否有任何 tidyeval 等价物？