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

为了回答这个问题,把它分成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

dat <- x 应在特定环境中进行评估和保存。

这一问题自从获得额外奖励以来就受到了相当多的关注,并提出了许多不同的答案。在本节中,我将简要概述这些答案、它们的局限性以及它们的一些好处。请注意,目前提供的所有答案都是不错的选择,但解决问题的程度不同,利弊也不同。因此,本节不是对任何答案的否定性评论,而是对不同方法的概述的尝试。

#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)

解决方案通用性

解答中提供的问题,解决了问题的各个方面。其中一个问题可能是,这些函数在多大程度上解决了计算引用表达式的各种任务。 为了测试溶液的通用性,使用 每个答案中提供的函数。例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::扩展 成功评估每个方法。只有两种方法成功 massive_call 和 quz 示例,而仅 为特别讨厌的条件语句创建一个成功的求值表达式。 oshka::扩展 另一个重要的注意事项是第5个例子代表了一个特殊的问题和大多数答案。由于每个表达式在5个答案中的3个答案中分别求值,因此 stop 这是一个简单而又特别离经叛道的例子。

效率比较:

为了比较这些方法,我们需要假设在这种情况下,我们知道这种方法对我们的问题是足够的。为此,为了比较不同的方法,使用

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::扩展 是最慢的竞争者,比最接近的竞争者慢12倍(1835.8/152.9=12),而 evalception 最快的速度是 fun (98.7/49.5=2),比 eval_throughout 因此,如果需要速度,看来最简单的方法,将成功地评估是要走的路。

实施安全

在同样的条件下运行。结果如下所示。

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::扩展

最后评论

好了,就这样。我希望答案的摘要证明是有用的,显示了每种实现的积极和可能的消极。每一种都有其可能的场景,在这些场景中,它们的性能都会优于其余的场景,而在所有表示的环境中,只有一种场景可以成功地使用。 多才多艺 oshka::扩展 是明显的赢家,而如果速度是首选之一,将不得不评估的答案是否可以用于手头的情况。通过使用简单的答案可以实现巨大的速度提升,但它们代表了不同的风险,可能会使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))

bquote 如果你有能力定义 bar

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

我找到了一个可以这样做的起重机包- 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

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

基本思想是遍历表达式,并用其求值值替换未求值的第一个调用。代码如下:

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)