Переадресация выражений точками после манипуляций при захвате окружения

У меня есть функция 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)) для работы


r tidyeval rlang nse
person kevinykuo    schedule 05.05.2017    source источник
comment
Вы хотите отфильтровывать NULL только тогда, когда он явно передан? или вы хотите отфильтровать foo, если is.null(foo)?   -  person Adam Spannbauer    schedule 05.05.2017
comment
@AdamSpannbauer последний   -  person kevinykuo    schedule 05.05.2017
comment
Я не уверен, что смогу вам помочь, потому что не понимаю, чего вы пытаетесь достичь. Если вы хотите переслать точки после некоторых манипуляций, просто возьмите точки в обеих функциях с помощью exprs(), quos(), dots_list() или dots_splice() в зависимости от того, что вам нужно, а затем перенаправьте их с помощью !!!.   -  person Lionel Henry    schedule 09.05.2017
comment
@lionel да, это именно то, что мне нужно! Все стало более понятным после того, как я RTFM... по какой-то причине я не мог найти виньетку о приливах пару дней назад.   -  person kevinykuo    schedule 09.05.2017

Ответы (3)


arrow_upward
1
arrow_downward

Возможное решение с использованием 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"
person Adam Spannbauer    schedule 05.05.2017
comment
Спасибо! Это определенно полезно, и я думаю, что приближает меня. У меня было упущение, которое заключалось в том, что функция также должна была принимать списки в качестве входных данных... Я отредактировал OP - person kevinykuo; 05.05.2017

arrow_upward
0
arrow_downward

В итоге я сделал это так:

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"

Сначала мне пришлось манипулировать выражениями, переданными в ..., затем создать из них квазуры, используя правильную среду, а затем сконструировать вызов для пересылки в fun_1.

person kevinykuo    schedule 09.05.2017
comment
Я бы настоятельно рекомендовал против такого рода реализации. Вместо того, чтобы анализировать вызовы и объединять выражения, я оценивал их, а затем сглаживал фактические списки. Тогда он будет надежно работать, в том числе с другими конструкторами списков, такими как rlang::ll(), и со списками без кавычек. - person Lionel Henry; 10.05.2017

arrow_upward
0
arrow_downward

Вот более чистый способ сделать это:

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 реализация, возможно, вам следует удалить тег?

person Lionel Henry    schedule 10.05.2017