R元編程：使用函式呼叫粘貼邏輯運算式

我想要一個粘貼邏輯運算式的函式

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

兩者都符合預期。

關于如何改進這段代碼并實作第二個目標（在回傳的運算式中并排取消參考），我有幾個問題。

Q1。在最后一個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>？

Q2. I have to use the prefix functional version of the logical operators, thus the final expression is recursive function calls to .Primitive("&").

Is there a way to pass & and | as symbols from outside of the function so I get final expression as expr(a == b & c > q & f < g)?

Simply wrapping & and | with ensym or enexpr inside function body generates errors like: Error: unexpected '&' in "expr(&"

Q3. This solution does not support further unquoting within the returned expression such as

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

since each dots[[i]] is a single expression like a == b which I couldn't further decompose and manipulate with. Defining side to be unquoted is even harder to accomplish. Is there any simple way to achieve this?

uj5u.com熱心網友回復：

我認為您正在尋找減少操作：

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

uj5u.com熱心網友回復：

在解決您的問題的一般方法方面，我會尊重 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 包( v2.0.0 )于 2021 年 10 月 26 日創建}

標籤：r metaprogramming quote tidyeval quasiquotes

上一篇：R回圈將相同的功能應用于多個資料幀

下一篇：為什么ShinyFeedback會覆寫自定義CSS？