在捕获环境时在操作后转发点中的表达式

Question

我有一个函数fun_1，它在其... 参数上使用substitute()，另一个函数fun_2 带有签名fun_2(...)，它实现了模式do.call(fun_1, dots)。我希望fun_1() 在fun_2() 中看到... 传递给fun_2()。这是我正在尝试做的一个说明。

fun_1 <- function(...) {
  substitute(list(...))[-1] %>%
    sapply(deparse)
}
foo <- "X"
bar <- "Y"
fun_1(foo, bar)
# [1] "foo" "bar"

fun_2 <- function(...) {
  # dots <- Filter(length, ???)
  # rlang::invoke(my_fun, dots)
}
fun_2(foo, bar, NULL)
# desired output:
# [1] "foo" "bar"

我认为 rlang 有足够的魔力来完成这项工作，但我无法弄清楚如何做。我可以修改fun_1，只要

1. fun_1() 可以访问 foo 和 bar 的值
2. do.call 模式在fun_2() 中实现

编辑：我还需要fun_2(list(foo, bar, NULL)) 工作

Answer 1

使用pryr 并丢弃任何长度为 0 的元素的可能解决方案。

使用do.call & fun_1

fun_2 <- function(...) {
  #get dot values
  dot_vals   <- list(...)
  #get dot names as passed
  dot_names  <- pryr::dots(...)
  #which dots' lengths == 0
  len_0_dots <- 0 == vapply(dot_vals, length, numeric(1))
  #drop length 0s and call fun_1
  do.call('fun_1', dot_names[!len_0_dots])
}

foo  <- "x"
bar  <- "y"
null <- NULL

fun_2(foo, bar, null, NULL)

[1] "foo" "bar"

使用独立的fun3

fun_3 <- function(...) {
  #get dot values
  dot_vals   <- list(...)
  #get dot names as passed
  dot_names  <- pryr::dots(...)
  #which dots' lengths == 0
  len_0_dots <- 0 == vapply(dot_vals, length, numeric(1))
  #drop length 0s and convert to vec
  as.character(dot_names[!len_0_dots])
}

foo  <- "x"
bar  <- "y"
null <- NULL

fun_3(foo, bar, null, NULL)

[1] "foo" "bar"

Answer 2

我最终这样做了：

fun_1 <- function(...) {
  substitute(list(...))[-1] %>%
    sapply(deparse) %>%
    gsub("~", "", .)
}
foo <- "X"
bar <- "Y"
fun_1(foo, bar)
# [1] "foo" "bar"

fun_2 <- function(...) {
  nonempty <- rlang::dots_splice(...) %>%
    sapply(Negate(rlang::is_empty)) %>%
    which()
  envir <- rlang::caller_env()
  quosures <- rlang::dots_exprs(...) %>%
    lapply(function(x) if (rlang::is_lang(x))
      rlang::lang_tail(x) else x) %>%
    unlist() %>%
    lapply(rlang::new_quosure, env = envir) %>%
    `[`(nonempty)

  rlang::lang("fun_1", !!! quosures)  %>%
    rlang::eval_tidy()
}
fun_2(foo, bar, NULL)
# [1] "foo" "bar"
fun_2(list(foo, bar))
# [1] "foo" "bar"
fun_2(foo, list(bar))
# [1] "foo" "bar"

首先我必须操作传递给... 的表达式，然后使用正确的环境从它们中创建quosures，然后构造一个调用以转发到fun_1。

Answer 3

这是一种更简洁的方法：

library("purrr")
library("rlang")

quo_list <- function(quo) {
  expr <- get_expr(quo)
  if (is_lang(expr, "list")) {
    args <- lang_args(expr)
    map(args, new_quosure, env = get_env(quo))
  } else {
    list(quo)
  }
}

fun2 <- function(...) {
  quos <- quos(..., .ignore_empty = "all")
  quos <- flatten(map(quos, quo_list))
  fun1(!!! quos)
}
fun1 <- function(...) {
  map(quos(...), quo_name)
}

但是，以这种方式解析表达式通常不是一个好主意。此处实现的列表拼接仅在调用特别提到 list() 时才有效，如果他们使用 rlang::ll() 或用户取消引用列表或在许多其他情况下，它们将不起作用。由于这不是一个 tidyeval 实现，也许您应该删除标签？