CODEWITHSUNDEEP
rnserlangtidyeval
kevinykuo
kevinykuo

Reputation: 4762

Forwarding expressions in dots after manipulation while capturing environment

I have a function fun_1 that utilizes substitute() on its ... argument, and another function fun_2 with signature fun_2(...) that implements the pattern do.call(fun_1, dots). I want fun_1() inside fun_2() to see the ... passed to fun_2(). Here's an illustration of what I'm trying to do.

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"

I think there's enough magic in rlang to make this work but I'm having trouble figuring out how. I'm OK with modifying fun_1 as long as

  1. fun_1() has access to the values of foo and bar
  2. The do.call pattern is implemented in fun_2()

EDIT: I also need fun_2(list(foo, bar, NULL)) to work

Upvotes: 0

Views: 188

Answers (3)

Lionel Henry
Lionel Henry

Reputation: 6803

Here is a cleaner way of doing it:

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)
}

However it is often a bad idea to parse expressions this way. The list-splicing implemented here will only work if the calls specifically mention list(), they won't work if they use rlang::ll() or if the user unquotes lists, or in many other situations. Since this is not a tidyeval implementation, maybe you should remove the tag?

Upvotes: 0

kevinykuo
kevinykuo

Reputation: 4762

I ended up doing it this way:

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"

First I had to manipulate the expressions passed to ..., then create quosures out of them using the correct environment, then construct a call to forward to fun_1.

Upvotes: 0

Adam Spannbauer
Adam Spannbauer

Reputation: 2757

Possible solution using pryr & throwing out any 0 length elements passed.

using 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"

using standalone 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"

Upvotes: 1

Related Questions