Question

match.call()和sys.call()很容易获得对当前执行的函数的调用，但是我似乎无法可靠地将对函数的调用向上一级。

我想建立以下功能工厂

factory <- function(){

  CALL <- function(){
    # does operations on what would be the output of match.call() and sys.call() 
    # if they were executed in the manufactured function
  }

  CALL2 <- function() {
    # calls CALL() and does other operations
  }

  function(x, y){
    # calls CALL() and CALL2(), not necessarily at the top level
  }
}

这是一个简化的示例，具有预期的输出，在这里我只是尝试打印正确的match.call()和sys.call()：

代码

我希望您的答案可以通过添加找到# INSERT SOME CODE条注释的代码来编辑以下内容。

最后，我的代码以不同的方式调用CALL和CALL2函数，以测试解决方案的健壮性。

预计这些方式中的每一种都将打印相同的输出，即{print(match.call()); print(sys.call())}将打印的输出。

factory <- function(){
  CALL <- function(){
    # INSERT SOME CODE HERE
  }
  CALL2 <- function() {
    # INSERT SOME CODE HERE IF NECESSARY
    CALL()
  }

  function(x, y){
    # INSERT SOME CODE HERE IF NECESSARY

    # Don't edit following code
    message("call from top level")
    CALL()
    message("call from lst")
    dplyr::lst(CALL())
    message("call from lapply")
    lapply(CALL(), identity)
    message("call from sub function")
    f <- function() CALL()
    f()
    message("call from another function from enclosing env")
    CALL2()
    message("call from lst")
    dplyr::lst(CALL2())
    message("call from lapply")
    lapply(CALL2(), identity)
    message("call from sub function")
    g <- function() CALL2()
    g()
    invisible(NULL)
  }
}

输入

要测试该功能，应执行以下代码：

fun <- factory()
fun("foo", y = "bar")

OR

fun2 <- function(){
  fun("foo", y = "bar")
}
fun2()

通过这种方式，该解决方案将通过2个不同的调用堆栈进行测试，以确保其健壮性。

所需的输出

在上面的示例中，每次调用CALL时，都应打印以下内容，但是它被称为：

fun(x = "foo", y = "bar")
fun("foo", y = "bar")

这意味着运行fun("foo", y = "bar")或fun2()时的完整输出应为：

call from top level
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lst
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lapply
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from sub function
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from another function from enclosing env
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lst
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from lapply
fun(x = "foo", y = "bar")
fun("foo", y = "bar")
call from sub function
fun(x = "foo", y = "bar")
fun("foo", y = "bar")

也许rlang / tidyeval可以救援吗？

我尝试的内容

我相信我找到了match.call()成功的方法。

为确保match.call()在正确的环境中执行，我使用ENV创建了到我的制造函数环境的绑定ENV <- environment()。然后，我可以通过在ENV <- eval.parent(quote(ENV))和CALL()中调用CALL2()来检索此环境，然后可以通过调用eval(quote(match.call()), ENV)获得正确的输出。

此相同策略不适用于sys.call()。

factory <- function(){

  CALL <- function(){
    ENV <- eval.parent(quote(ENV))
    print(eval(quote(match.call()), ENV))
    print(eval(quote(sys.call()), ENV))
  }

  CALL2 <- function() {
    ENV <- eval.parent(quote(ENV))
    CALL()
  }

  function(x, y){
    ENV <- environment()
    message("call from top level")
    CALL()
    message("call from lst")
    dplyr::lst(CALL())
    message("call from lapply")
    lapply(CALL(), identity)
    message("call from sub function")
    f <- function() CALL()
    f()
    message("call from another function from enclosing env")
    CALL2()
    message("call from lst")
    dplyr::lst(CALL2())
    message("call from lapply")
    lapply(CALL2(), identity)
    message("call from sub function")
    g <- function() CALL2()
    g()
    invisible(NULL)
  }
}

输出：

fun <- factory()
fun("foo", y = "bar")
#> call from top level
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from another function from enclosing env
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)

fun2 <- function(){
  fun("foo", y = "bar")
}
fun2()
#> call from top level
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from another function from enclosing env
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lst
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from lapply
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)
#> call from sub function
#> fun(x = "foo", y = "bar")
#> eval(quote(sys.call()), ENV)

^{由reprex package（v0.2.1）于2019-06-05创建}

您可以看到输出显示eval(quote(sys.call()), ENV)，我想在哪里看到fun("foo", y = "bar")。

我还尝试了print(eval(quote(sys.call()), ENV))和print(sys.call(1))而不是print(sys.call(sys.parent()))，但有时都可以打印出正确的内容，但并不可靠。

Answer 1

只是给您关于问题本身的不同观点，您可以将呼叫保存在封闭环境中，始终在“主要”功能中与之匹配：

factory <- function(){
  matched_call <- NULL

  CALL <- function(){
    print(matched_call)
  }
  CALL2 <- function() {
    CALL()
  }

  function(x, y){
    matched_call <<- match.call()
    on.exit(matched_call <<- NULL)

    ...
  }
}

Answer 2

我不知道它是否健壮或惯用，但我可以通过在root.root上使用ExecStartPost=/sbin/lsing来解决。

问题是sys.call()在不经过适当替换的情况下已被软弃用，因此我定义了一个函数rlang::frame_position()，在我的用例中，该函数似乎是相同的：

frame_position()

frame_pos()

frame_pos <- function(frame) {
  pos <- which(sapply(sys.frames(), identical, frame))
  if(!length(pos)) pos <- 0
  pos
}

factory <- function(){
  CALL <- function(){
    ENV <- eval.parent(quote(ENV))
    print(eval(quote(match.call()), ENV))
    print(sys.call(rlang::frame_position(ENV)))
    print(sys.call(frame_pos(ENV)))
  }
  CALL2 <- function() {
    ENV <- eval.parent(quote(ENV))
    CALL()
  }
  function(x, y){
    ENV <- environment()
    message("call from top level")
    CALL()
    message("call from lst")
    dplyr::lst(CALL())
    message("call from lapply")
    lapply(CALL(), identity)
    message("call from sub function")
    f <- function() CALL()
    f()
    message("call from another function from enclosing env")
    CALL2()
    message("call from lst")
    dplyr::lst(CALL2())
    message("call from lapply")
    lapply(CALL2(), identity)
    message("call from sub function")
    g <- function() CALL2()
    g()
    invisible(NULL)
  }
}

从封闭环境的函数调用的match.call（）和sys.call（）

2 个答案: