我遇到了一段代码，其中调用包含另一个调用。例如：
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视为非数字对象)时，这是预期的。
如何评价这种召唤？
要回答这个问题，将其分为 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这样的调用。
编辑：当前提供的答案摘要和性能概述
自从给予额外奖励以来，这个问题得到了相当多的关注，并提出了许多不同的答案。在本节中，我将简要概述答案，它们的局限性以及它们的一些好处。请注意，当前提供的所有答案都是不错的选择，但解决问题的程度不同，具有不同的优点和缺点。因此，本节并不意味着对任何答案的负面评论，而是对不同方法进行概述的试验。 我回答中上面提供的例子已被其他一些答案所采用，而本答案的评论中提出了一些代表问题不同方面的例子。我将使用我的答案以及下面的一些示例来尝试说明本文中建议的不同方法的有用性。为了完成，下面的代码显示了不同的示例。感谢@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)
解决方案的多功能性
问题的答案中提供的解决方案，可以最大程度地解决问题。一个问题可能是这些扩展解决了计算引用表达式的各种任务。 为了测试解决方案的多功能性，使用每个答案中提供的原始函数评估示例1至5。示例6和7提出了不同类型的问题，将在下面的部分(实施的安全性)中单独处理。请注意，oshka::expand返回一个未计算的表达式，该表达式是在运行函数调用后计算的。 在下表中，我可视化了多功能性测试的结果。每一行都是问题答案中的单独函数，而每列标记一个示例。对于每个测试，成功分别标记为成功、错误和失败，以进行成功、早期中断和失败的评估。 (代码在答案末尾可用，以实现可重复性。
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是最慢的竞争对手，比最接近的竞争对手 (1835.8/152.9 = 12) 慢 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
我想你可能想要：
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
我找到了一个可以做到这一点的CRAN包 - oshka：递归引用语言扩展。
它递归替换环境中对象的引用语言调用。
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
我想出了一个简单的解决方案，但这似乎有点不合适，我希望存在一种更规范的方法来应对这种情况。尽管如此，这应该有望完成工作。
基本思想是循环访问表达式，并将未计算的第一次调用替换为其计算值。代码如下：
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)