我遇到了一段代码,其中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？
要回答这个问题,将它分成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返回未评估的表达式,该表达式在运行函数调用后进行了评估.在下表中,我已经可视化了多功能性测试的结果.在每个列标记一个示例时,每一行都是一个单独的函数,用于回答问题.对于每个测试的更迭被标记为sucess,ERROR和失败用于succesfuly,早期中断,并且分别失败的评价.(代码在答案的最后可用于再现性.)
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
我想你可能想要:
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
我找到了一个可以做到这一点的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