获取由`magrittr`调用的函数中得到的表达式

Question

我有一个函数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中通过管道传递的数据帧的获取名称,但它稍微更一般.这个人只想要数据框的名称,我想要表达式,无论它是什么.但是,相同的答案可能适用于两者.我不喜欢这个近似重复的问题的答案,答案的作者也不喜欢.

Answer 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(.)
}

我用 突出显示了重要的部分<---。请注意，被捕获的 quosureenquo位于函数的父环境中（从堆栈底部算起第二个），而知道的管道调用y一直在堆栈顶部。

有几种方法可以遍历堆栈。@MrFlick对类似问题的回答以及这个 GitHub 问题从sys.frames(). 在这里，我将展示一个替代方案，它遍历sys.calls()并解析表达式以找到 find %>%。

难题的第一部分是定义一个将表达式转换为其抽象语法树（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()遍历返回一个表达式，而不是一个 quosure，我们也希望在默认情况下做同样的事情。）

新函数非常健壮，可以在其他函数中使用，包括嵌套%>%管道：

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