0

我有一个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))工作

4

3 回答 3

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"
于 2017-05-05T14:32:41.430 回答
0

我最终这样做了：

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，然后构造一个调用 forward to fun_1。

于 2017-05-09T14:08:17.567 回答
0

这是一种更清洁的方法：

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 实现，也许您应该删除标签？

于 2017-05-10T16:05:15.527 回答