评估包含另一个调用的调用(调用中的调用)

Evaluate call that contains another call (call within call)

我遇到了一段代码,其中调用包含另一个调用。例如:

a <- 1
b <- 2
# First call
foo <- quote(a + a)
# Second call (call contains another call)
bar <- quote(foo ^ b)

我们可以使用 evaleval(foo))评估调用,但是 eval(bar) 不起作用。这是预期的,因为 R 尝试 运行 "foo" ^ 2(将 foo 视为非数字对象)。
如何评价这样的callception?

我想出了一个简单的解决方案,但似乎有点不合适,我希望有一个更规范的方法来应对这种情况。尽管如此,这应该有望完成工作。

基本思想是遍历您的表达式,并将未计算的第一次调用替换为其计算值。代码如下:

a <- 1
b <- 2
# First call
foo <- quote(a + a)
# Second call (call contains another call)
bar <- quote(foo ^ b)

bar[[grep("foo", bar)]] <- eval(foo)
eval(bar)
#> [1] 4

到目前为止这很容易。当然,如果你的表达式更复杂,这会很快变得更复杂。例如,如果您的表达式具有 foo^2 + a,那么我们需要确保将术语 foo^2 替换为 eval(foo)^2 而不是 eval(foo) 等等。我们可以编写一些辅助函数,但需要大量工作才能稳健地泛化到复杂的嵌套情况:

# but if your expressions are more complex this can
# fail and you need to descend another level
bar1 <- quote(foo ^ b + 2*a)

# little two-level wrapper funciton
replace_with_eval <- function(call2, call1) {
  to.fix <- grep(deparse(substitute(call1)), call2)
  for (ind in to.fix) {
    if (length(call2[[ind]]) > 1) {
      to.fix.sub <- grep(deparse(substitute(call1)), call2[[ind]])
      call2[[ind]][[to.fix.sub]] <- eval(call1)
    } else {
      call2[[ind]] <- eval(call1)
    }
  }
  call2
}

replace_with_eval(bar1, foo)
#> 2^b + 2 * a
eval(replace_with_eval(bar1, foo))
#> [1] 6

bar3 <- quote(foo^b + foo)

eval(replace_with_eval(bar3, foo))
#> [1] 6

我想我应该可以用 substitute() 做到这一点,但我想不通。我希望出现一个更权威的解决方案,但与此同时这可能会奏效。

以下是(至少部分)有效的方法:

evalception <- function (expr) {
    if (is.call(expr)) {
        for (i in seq_along(expr))
            expr[[i]] <- eval(evalception(expr[[i]]))
        eval(expr)
    }
    else if (is.symbol(expr)) {
        evalception(eval(expr))
    }
    else {
        expr
    }
}

它支持任意嵌套,但对于 expression 模式的对象可能会失败。

> a <- 1
> b <- 2
> # First call
> foo <- quote(a + a)
> # Second call (call contains another call)
> bar <- quote(foo ^ b)
> baz <- quote(bar * (bar + foo))
> sample <- quote(rnorm(baz, 0, sd=10))
> evalception(quote(boxplot.stats(sample)))
$stats
[1] -23.717520  -8.710366   1.530292   7.354067  19.801701

$n
[1] 24

$conf
[1] -3.650747  6.711331

$out
numeric(0)

要回答这个问题,将其分成 3 个子问题可能会有所帮助

  1. 找到通话中的任何通话
  2. 对于每个调用,评估调用(不可见),用原始调用替换调用
  3. Return初始调用。

为了得到完整的答案,我们需要在调用中找到任何后续嵌套的调用。此外,我们需要避免 bar <- quote(bar + 3).

的无限循环

因为任何调用都可能嵌套调用,例如:

a <- 3
zz <- quote(a + 3)
foo <- quote(zz^a)
bar <- quote(foo^zz)

我们必须确保在评估最终调用之前评估每个堆栈。

按照这种思路,下面的函数甚至可以评估复杂的调用。

eval_throughout <- function(x, envir = NULL){
  if(!is.call(x))
    stop("X must be a call!")

  if(isNullEnvir <- is.null(envir))
    envir <- environment()
  #At the first call decide the environment to evaluate each expression in (standard, global environment)
  #Evaluate each part of the initial call, replace the call with its evaluated value
  # If we encounter a call within the call, evaluate this throughout.
  for(i in seq_along(x)){
    new_xi <- tryCatch(eval(x[[i]], envir = envir),
                       error = function(e)
                         tryCatch(get(x[[i]],envir = envir), 
                                  error = function(e)
                                    eval_throughout(x[[i]], envir)))
    #Test for endless call stacks. (Avoiding primitives, and none call errors)
    if(!is.primitive(new_xi) && is.call(new_xi) && any(grepl(deparse(x[[i]]), new_xi)))
      stop("The call or subpart of the call is nesting itself (eg: x = x + 3). ")
    #Overwrite the old value, either with the evaluated call, 
    if(!is.null(new_xi))
      x[[i]] <- 
        if(is.call(new_xi)){
          eval_throughout(new_xi, envir)
        }else
          new_xi
  }
  #Evaluate the final call
  eval(x)
}

展示

所以让我们尝试几个例子。最初,我将使用问题中的示例,再进行一个稍微复杂一点的调用。

a <- 1
b <- 2
c <- 3
foo <- quote(a + a)
bar <- quote(foo ^ b)
zz <- quote(bar + c) 

评估其中的每一个都会得到预期的结果:

>eval_throughout(foo)
2
>eval_throughout(bar)
4
>eval_throughout(zz)
7

但这并不局限于简单的调用。让我们将其扩展为更有趣的调用。

massive_call <- quote({
  set.seed(1)
  a <- 2
  dat <- data.frame(MASS::mvrnorm(n = 200, mu = c(3,7), Sigma = matrix(c(2,4,4,8), ncol = 2), empirical = TRUE))
  names(dat) <- c("A","B")
  fit <- lm(A~B, data = dat)
  diff(coef(fit)) + 3 + foo^bar / (zz^bar)
})

令人惊讶的是,这也很好。

>eval_throughout(massive_call)
B
4

当我们尝试仅评估实际需要的段时,我们得到相同的结果:

>set.seed(1)
>a <- 2
>dat <- data.frame(MASS::mvrnorm(n = 200, mu = c(3,7), Sigma = matrix(c(2,4,4,8), ncol = 2), empirical = TRUE))
>names(dat) <- c("A","B")
>fit <- lm(A~B, data = dat)
>diff(coef(fit)) + 3 + eval_throughout(quote(foo^bar / (zz^bar)))
B
4

请注意,这可能不是最有效的评估方案。最初 envir 变量应该是 NULL,除非像 dat <- x 这样的调用应该被评估并保存在特定的环境中。


编辑:当前提供的答案摘要和性能概览

这个问题自打了额外奖励后就受到了相当多的关注,提出了很多不同的答案。在本节中,我将简要概述答案、它们的局限性以及它们的一些好处。请注意,当前提供的所有答案都是不错的选择,但解决问题的程度不同,有不同的优点和缺点。因此,本节并不意味着对任何答案的负面评论,而是对不同方法进行概述的尝试。 我的回答中上面给出的示例已被其他一些答案采用,而在该回答的评论中提出了一些建议,它们代表了问题的不同方面。我将使用我的回答中的示例以及下面的一些示例,来尝试说明在整个 post 中建议的不同方法的有用性。为了完成,下面的代码中显示了不同的示例。感谢@Moody_Mudskipper 在下面的评论中提供了额外的例子!

#Example 1-4:
a <- 1
b <- 2
c <- 3
foo <- quote(a + a)
bar <- quote(foo ^ b)
zz <- quote(bar + c) 
massive_call <- quote({
  set.seed(1)
  a <- 2
  dat <- data.frame(MASS::mvrnorm(n = 200, mu = c(3,7), Sigma = matrix(c(2,4,4,8), ncol = 2), empirical = TRUE))
  names(dat) <- c("A","B")
  fit <- lm(A~B, data = dat)
  diff(coef(fit)) + 3 + foo^bar / (zz^bar)
})
#Example 5
baz <- 1
quz <- quote(if(TRUE) baz else stop())
#Example 6 (Endless recursion)
ball <- quote(ball + 3)
#Example 7 (x undefined)
zaz <- quote(x > 3)

解决方案的多功能性

问题答案中提供的解决方案,将问题解决到各个方面。一个问题可能是这些扩展解决了评估引用表达式的各种任务。 为了测试解决方案的多功能性,使用每个答案中提供的 raw 函数对示例 1 至 5 进行了评估。示例 6 和 7 存在不同类型的问题,将在下面的部分(实施安全)中单独处理。请注意 oshka::expand returns 一个未计算的表达式,它是在 运行 函数调用之后计算的。 在下面的 table 中,我可视化了多功能性测试的结果。每行都是问题答案中的一个单独函数,而每列标记一个示例。对于每个测试,成功标记为 sucessERRORfailed,表示成功、提前中断和分别评估失败。 (代码在可重复性的答案末尾可用。)

            function     bar     foo  massive_call     quz      zz
1:   eval_throughout  succes  succes        succes   ERROR  succes
2:       evalception  succes  succes         ERROR   ERROR  succes
3:               fun  succes  succes         ERROR  succes  succes
4:     oshka::expand  sucess  sucess        sucess  sucess  sucess
5: replace_with_eval  sucess  sucess         ERROR   ERROR   ERROR

有趣的是,较简单的调用 barfoozz 大多由除一个答案外的所有答案处理。只有 oshka::expand 成功评估了每个方法。只有两个方法在 massive_callquz 示例之后,而只有 oshka::expand 为特别讨厌的条件语句创建了一个成功的评估表达式。 然而,人们可能会注意到,根据设计,任何中间结果都使用 oshka::expand 方法保存,在使用时应牢记这一点。然而,这可以通过将函数或子环境中的表达式评估为全局环境来简单地解决。 另一个重要的注意事项是第 5 个示例代表了大多数答案的一个特殊问题。由于每个表达式在 5 个答案中有 3 个单独求值,因此调用 stop 函数只会中断调用。因此,任何包含对 stop 的调用的引用表达式都显示了一个简单且特别曲折的示例。


效率比较:

另一种经常受到关注的性能指标是纯粹的效率或速度。即使某些方法失败了,意识到方法的局限性,由于速度性能,也会产生更简单的方法更好的情况。 为了比较这些方法,我们需要假设我们知道该方法足以解决我们的问题。出于这个原因,为了比较不同的方法,使用 zz 作为标准进行了基准测试。这减少了一种方法,没有对其进行基准测试。结果如下所示。

Unit: microseconds
            expr      min        lq       mean    median        uq      max neval
 eval_throughout  128.378  141.5935  170.06306  152.9205  190.3010  403.635   100
     evalception   44.177   46.8200   55.83349   49.4635   57.5815  125.735   100
             fun   75.894   88.5430  110.96032   98.7385  127.0565  260.909   100
    oshka_expand 1638.325 1671.5515 2033.30476 1835.8000 1964.5545 5982.017   100

出于比较的目的,中位数是一个更好的估计值,因为垃圾清理器可能会污染某些结果,从而污染平均值。 从输出中可以看到清晰的图案。更高级的功能需要更长的时间来评估。 在这四个函数中,oshka::expand 是最慢的竞争者,比最接近的竞争者慢 12 倍 (1835.8 / 152.9 = 12),而 evalception 是最快的,大约是 [=39= 的两倍] (98.7 / 49.5 = 2) 比 eval_throughout 快三倍(该死!) 因此,如果需要速度,那么评估成功的最简单方法似乎就是要走的路。


实施安全 良好实施的一个重要方面是它们识别和处理不正当输入的能力。对于这个方面,示例 6 和 7 代表不同的问题,可能会破坏实现。示例 6 表示无限递归,这可能会中断 R 会话。例7表示缺失值问题

示例 6 是 运行 在相同条件下。结果如下所示。

eval_throughout(ball) #Stops successfully
eval(oshka::expand(ball)) #Stops succesfully
fun(ball) #Stops succesfully
#Do not run below code! Endless recursion
evalception(ball)

四个答案中,只有evalception(bar)未能检测到无限递归,并导致R会话崩溃,而其余成功停止。

注:我不建议运行后一个例子。

示例 7 是 运行 在相同条件下。结果如下所示。

eval_throughout(zaz) #fails
oshka::expand(zaz) #succesfully evaluates
fun(zaz) #fails
evalception(zaz) #fails

重要的一点是,对示例 7 的任何评估都将失败。只有 oshka::expand 成功,因为它旨在使用基础环境将任何现有值归因于表达式。这个特别有用的功能让人们可以创建复杂的调用并输入任何引用的表达式来扩展表达式,而其余的答案(包括我自己的)在评估表达式时会因设计而失败。


最终评论

好了。我希望答案的总结是有用的,显示每个实施的正面和可能的负面影响。每个都有其可能的场景,在这些场景中,它们会胜过其余的,而只有一个可以在所有代表的情况下成功使用。 对于多功能性,oshka::expand 是明显的赢家,而如果首选速度,则必须评估答案是否可用于手头的情况。通过使用更简单的答案可以大大提高速度,同时它们代表不同的风险,可能会导致 R 会话崩溃。与我之前的总结不同,reader 由他们自己决定哪种实施最适合他们的特定问题。

重现摘要的代码

注意这段代码没有清理,只是简单地放在一起作为总结。此外它不包含示例或功能,仅包含它们的评估。

require(data.table)
require(oshka)
evals <- function(fun, quotedstuff, output_val, epsilon = sqrt(.Machine$double.eps)){
  fun <- if(fun != "oshka::expand"){
    get(fun, env = globalenv())
  }else
    oshka::expand
  quotedstuff <- get(quotedstuff, env = globalenv())
  output <- tryCatch(ifelse(fun(quotedstuff) - output_val < epsilon, "succes", "failed"), 
                     error = function(e){
                       return("ERROR")
                     })
  output
}
call_table <- data.table(CJ(example = c("foo", 
                                        "bar", 
                                        "zz", 
                                        "massive_call",
                                        "quz"),
                            `function` = c("eval_throughout",
                                           "fun",
                                           "evalception",
                                           "replace_with_eval",
                                           "oshka::expand")))
call_table[, incalls := paste0(`function`,"(",example,")")]
call_table[, output_val := switch(example, "foo" = 2, "bar" = 4, "zz" = 7, "quz" = 1, "massive_call" = 4), 
           by = .(example, `function`)]
call_table[, versatility := evals(`function`, example, output_val), 
           by = .(example, `function`)]
#some calls failed that, try once more
fun(foo)
fun(bar) #suces
fun(zz) #succes
fun(massive_call) #error
fun(quz)
fun(zaz)
eval(expand(foo)) #success
eval(expand(bar)) #sucess
eval(expand(zz)) #sucess
eval(expand(massive_call)) #succes (but overwrites environment)
eval(expand(quz))
replace_with_eval(foo, a) #sucess
replace_with_eval(bar, foo) #sucess
replace_with_eval(zz, bar) #error
evalception(zaz)
#Overwrite incorrect values.
call_table[`function` == "fun" & example %in% c("bar", "zz"), versatility := "succes"]
call_table[`function` == "oshka::expand", versatility := "sucess"]
call_table[`function` == "replace_with_eval" & example %in% c("bar","foo"), versatility := "sucess"]
dcast(call_table, `function` ~ example, value.var = "versatility")
require(microbenchmark)
microbenchmark(eval_throughout = eval_throughout(zz),
               evalception = evalception(zz),
               fun = fun(zz),
               oshka_expand = eval(oshka::expand(zz)))
microbenchmark(eval_throughout = eval_throughout(massive_call),
               oshka_expand = eval(oshka::expand(massive_call)))
ball <- quote(ball + 3)
eval_throughout(ball) #Stops successfully
eval(oshka::expand(ball)) #Stops succesfully
fun(ball) #Stops succesfully
#Do not run below code! Endless recursion
evalception(ball)
baz <- 1
quz <- quote(if(TRUE) baz else stop())
zaz <- quote(x > 3)
eval_throughout(zaz) #fails
oshka::expand(zaz) #succesfully evaluates
fun(zaz) #fails
evalception(zaz) #fails

我想你可能想要:

eval(do.call(substitute, list(bar, list(foo = foo))))
# [1] 4

评估前调用:

do.call(substitute, list(bar, list(foo = foo)))
#(a + a)^b

这也有效,而且可能更容易理解:

eval(eval(substitute(
  substitute(bar, list(foo=foo)),
  list(bar = bar))))
# [1] 4

并倒退:

eval(substitute(
  substitute(bar, list(foo=foo)), 
  list(bar = bar)))
# (a + a)^b

还有一些

substitute(
  substitute(bar, list(foo=foo)),
  list(bar = bar))
# substitute(foo^b, list(foo = foo))

不完全相同,但如果您有能力以不同方式定义 bar,您也可以在此处使用 bquote

bar2 <- bquote(.(foo)^b)
bar2
# (a + a)^b
eval(bar2)
# [1] 4

在这种情况下,使用 rlang 的接近等效项将是:

library(rlang)
foo <- expr(a + a) # same as quote(a + a)
bar2 <- expr((!!foo) ^ b)
bar2
# (a + a)^b
eval(bar2)
# [1] 4

还有一件小事,你说:

This is expected as R tries to run "foo" ^ 2

它不会,它会尝试 运行 quote(foo)^b ,如果您直接在控制台中 运行 它会 return 同样的错误。


递归附录

借用 Oliver 的例子,你可以通过循环我的解决方案来处理递归,直到你评估了所有你能做的,我们只需要稍微修改我们的 substitute 调用以提供所有环境而不是显式替换:

a <- 1
b <- 2
c <- 3
foo <- quote(a + a)
bar <- quote(foo ^ b)
zz <- quote(bar + c) 

fun <- function(x){
while(x != (
  x <- do.call(substitute, list(x, as.list(parent.frame())))
)){}
  eval.parent(x)
}
fun(bar)
# [1] 4
fun(zz)
# [1] 7
fun(foo)
# [1] 2

我找到了一个可以做到这一点的 CRAN 包 - oshka: Recursive Quoted Language Expansion

它以递归方式替换环境中对象引用的语言调用。

a <- 1
b <- 2
foo <- quote(a + a)
bar <- quote(foo ^ b)

所以调用 oshka::expand(bar) 得到 (a + a)^beval(oshka::expand(bar)) returns 4。 它还适用于 建议的更复杂的调用:

d <- 3
zz <- quote(bar + d)
oshka::expand(zz)
# (a + a)^b + d