评估包含另一个呼叫的呼叫（呼叫内呼叫）

Question

我遇到了一个 sn-p 代码，其中 call 包含另一个调用。例如：

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

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

Answer 1

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

1. 定位通话中的任何通话
2. 对于每个调用，评估调用（不可见），或将调用替换为原始调用
3. 返回初始呼叫。

为了得到完整的答案，我们需要在调用中定位任何随后嵌套的调用。此外，我们需要避免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 这样的调用并将其保存在特定环境中。

---

编辑：当前提供的答案和性能概述的摘要

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

#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 返回一个未计算的表达式，该表达式在运行函数调用后进行了计算。 在下表中，我可视化了多功能性测试的结果。每一行都是问题答案中的一个单独函数，而每一列都是一个示例。对于每个测试，成功分别标记为 success、ERROR 和 failed，分别表示成功、早期中断和失败的评估。 （代码可在答案末尾获得，以便重现性。）

            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

有趣的是，更简单的调用bar、foo 和zz 大多由除一个答案之外的所有答案处理。只有oshka::expand 成功地评估了每种方法。只有两种方法成功了 massive_call 和 quz 示例，而只有 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 是最快的，大约是 fun 的两倍 (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 会话崩溃的不同风险。与我之前的总结不同，读者可以自行决定哪种实现最适合他们的特定问题。

重现摘要的代码

注意这段代码没有清洗，简单的放在一起做总结。此外，它不包含示例或功能，仅包含它们的评估。

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

Answer 2

我想你可能想要：

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

---

还有一件小事，你说：

这是预期的，因为 R 尝试运行 "foo" ^ 2

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

---

关于递归的附录

借用 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

Answer 3

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

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

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

所以调用oshka::expand(bar) 给出(a + a)^b 和eval(oshka::expand(bar)) 返回4。 它也适用于@Oliver 建议的更复杂的调用：

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

Answer 4

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

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

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() 做到这一点，但我想不通。我希望出现更权威的解决方案，但与此同时这可能会奏效。

Answer 5

以下是（至少部分）有效的方法：

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)