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的函数。

这个问题的确与Get name of dataframe passed through pipe in R类似，但是更笼统。这个人只想要数据框的名称，我想要表达式，无论它是什么。但是，相同的答案很可能适用于两者。我不喜欢这个几乎重复的问题的答案，也不喜欢这个答案的作者。

Answer 1

y不是“永远消失”，因为管道调用了您的函数，并且它也知道y。有一种恢复y的方法，但是它需要遍历调用堆栈。要了解发生了什么，我们将使用?sys.frames和?sys.calls：

'sys.calls'和'sys.frames'分别给出所有活动调用和帧的配对列表，'sys.parents'返回每个帧的父帧索引的整数向量。 / p>

如果将它们撒在您的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捕获的quores位于函数的父环境中（位于堆栈底部的第二个位置），而知道y的管道调用始终位于函数的顶部。堆栈。

有两种方法可以遍历堆栈。 @MrFlick's answer到类似问题以及this GitHub issue遍历sys.frames()的框架/环境。在这里，我将展示一个遍历sys.calls()并解析表达式以找到%>%的替代方法。

难题的第一步是定义一个将表达式转换为其Abstract Sytax Tree(AST)的函数：

# Recursively constructs Abstract Syntax Tree for a given expression
getAST <- function( ee ) { as.list(ee) %>% purrr::map_if(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

获取经计算得出的表达式，该表达式在`magrittr`调用的函数中为点

1 个答案: