Получить выражение, которое оценивается как точка в функции, вызываемой конвейером `magrittr`

У меня есть функция x_expression(), которая печатает выражение, переданное аргументу x.

pacman::p_load(magrittr, rlang)

x_expression <- function(x) {
  print(enquo(x))
}

y <- 1

x_expression(y)
#> <quosure>
#>   expr: ^y
#>   env:  global

y %>% x_expression()
#> <quosure>
#>   expr: ^.
#>   env:  0x7ff27c36a610

Итак, вы можете видеть, что он знает, что y было передано ему, но когда y передается с помощью %>%, функция возвращает отпечатки .. Есть ли способ восстановить y в случае, если он подключен, или он исчез навсегда? Вкратце, мне нужна функция типа x_expression(), но та, которая будет печатать y в обоих вышеупомянутых случаях.

Этот вопрос действительно похож на вопрос Получить имя фрейма данных, переданного через канал в R, однако он немного более общий. Этому человеку просто нужно имя фрейма данных, мне нужно выражение, каким бы оно ни было. Однако один и тот же ответ, скорее всего, применим к обоим. Мне не нравится ответ на этот почти повторяющийся вопрос, как и автору этого ответа.


person Rory Nolan    schedule 28.08.2018    source источник
comment
Связано: stackoverflow.com/questions/49074569/   -  person acylam    schedule 29.08.2018
comment
Я видел это, но я недостаточно понимаю вопрос, чтобы применить его к своему.   -  person Rory Nolan    schedule 29.08.2018
comment
Возможный дубликат: stackoverflow.com/questions/42560389/   -  person MrFlick    schedule 29.08.2018
comment
Не видел, но интересный и более-менее дублирующий. Он появился раньше, чем rlang, так что я надеюсь, что у кого-то получится здесь лучше.   -  person Rory Nolan    schedule 29.08.2018
comment
Это невозможно.   -  person Lionel Henry    schedule 29.08.2018
comment
Лайонел является авторитетом в этом вопросе, так что тогда все.   -  person Rory Nolan    schedule 29.08.2018


Ответы (1)


y не "ушел навсегда", потому что канал вызывает вашу функцию, и он также знает о y. Есть способ восстановить y, но он требует некоторого обхода стека вызовов. Чтобы понять, что происходит, мы будем использовать ?sys.frames и ?sys.calls:

«Sys.calls» и «sys.frames» дают список всех активных вызовов и кадров, соответственно, а «sys.parents» возвращает целочисленный вектор индексов родительских кадров каждого из этих кадров.

Если мы рассыпаем их по всему вашему x_expression(), мы увидим, что происходит, когда мы вызываем y %>% x_expression() из глобальной среды:

x_expression <- function(x) {
  print( enquo(x) )
  # <quosure>
  #   expr: ^.
  #   env:  0x55c03f142828                <---

  str(sys.frames())
  # Dotted pair list of 9
  #  $ :<environment: 0x55c03f151fa0> 
  #  $ :<environment: 0x55c03f142010> 
  #  ...
  #  $ :<environment: 0x55c03f142828>     <---
  #  $ :<environment: 0x55c03f142940>

  str(sys.calls())
  # Dotted pair list of 9
  #  $ : language y %>% x_expression()    <---
  #  $ : language withVisible(eval(...
  #  ...
  #  $ : language function_list[[k]...
  #  $ : language x_expression(.)
}

Я выделил важные части с помощью <---. Обратите внимание, что запрос, захваченный enquo, находится в родительской среде функции (второй снизу стека), в то время как вызов канала, который знает о y, находится на самом верху стека.

Есть несколько способов пройти по стеку. ответ @ MrFlick на аналогичный вопрос, а также эта проблема GitHub пересекает фреймы / среды из sys.frames(). Здесь я покажу альтернативу, которая просматривает sys.calls() и анализирует выражения, чтобы найти %>%.

Первая часть головоломки - определить функцию, которая преобразует выражение в его Абстрактное дерево Sytax (AST) < / а>:

# Recursively constructs Abstract Syntax Tree for a given expression
getAST <- function(ee) purrr::map_if(as.list(ee), is.call, getAST)
# Example: getAST( quote(a %>% b) )
# List of 3
#  $ : symbol %>%
#  $ : symbol a
#  $ : symbol b

Теперь мы можем систематически применять эту функцию ко всему стеку sys.calls(). Цель состоит в том, чтобы идентифицировать AST, где первым элементом является %>%; второй элемент будет соответствовать левой стороне трубы (symbol a в a %>% b примере). Если таких AST несколько, то мы находимся во вложенном %>% конвейере. В этом случае последний AST в списке будет самым низким в стеке вызовов и ближайшим к нашей функции.

x_expression2 <- function(x) {
  sc <- sys.calls()
  ASTs <- purrr::map( as.list(sc), getAST ) %>%
    purrr::keep( ~identical(.[[1]], quote(`%>%`)) )  # Match first element to %>%

  if( length(ASTs) == 0 ) return( enexpr(x) )        # Not in a pipe
  dplyr::last( ASTs )[[2]]    # Second element is the left-hand side
}

(Незначительное примечание: я использовал enexpr() вместо enquo(), чтобы обеспечить согласованное поведение функции в канале и вне его. Поскольку обход sys.calls() возвращает выражение, а не запрос, мы хотим сделать то же самое и в случае по умолчанию.)

Новая функция довольно надежна и работает внутри других функций, включая вложенные %>% конвейеры:

x_expression2(y)
# y

y %>% x_expression2()
# y

f <- function() {x_expression2(v)}
f()
# v

g <- function() {u <- 1; u %>% x_expression2()}
g()
# u

y %>% (function(z) {w <- 1; w %>% x_expression2()})  # Note the nested pipes
# w
person Artem Sokolov    schedule 29.08.2018