`match.call ()` и `sys.call ()` вызываются из функции окружающей среды - PullRequest
Новая
       41

`match.call ()` и `sys.call ()` вызываются из функции окружающей среды

1 голос
/ 05 июня 2019

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)

Создано в 2019-06-05 пакетом Представить (v0.2.1)

Как видите, вывод показывает eval(quote(sys.call()), ENV), где я хочу видеть fun("foo", y = "bar").

Вместо print(eval(quote(sys.call()), ENV)) Я также попытался print(sys.call(1)) и print(sys.call(sys.parent())), и оба иногда печатают правильную вещь, но не являются надежными.

Ответы [ 2 ]

1 голос
/ 06 июня 2019

Просто чтобы дать вам другую точку зрения на саму проблему, Вы можете просто сохранить вызов в окружающей среде, всегда сопоставляя его в «основной» функции: 

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)

    ...
  }
}
0 голосов
/ 06 июня 2019

Я не знаю, является ли он надежным или идиоматическим, но я мог бы решить его, используя 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)
  }
}

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

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