Чтобы ответить на этот вопрос, было бы полезно разделить его на 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 оценивали с использованием функции raw , предоставленной в каждом ответе.Примеры 6 и 7 представляют проблемы различного рода и будут рассмотрены отдельно в следующем разделе (Безопасность реализации).Обратите внимание, что oshka::expand возвращает неоцененное выражение, которое оценивалось после выполнения вызова функции.В таблице ниже я визуализировал результаты теста универсальности.Каждая строка представляет собой отдельную функцию в ответе на вопрос, в то время как каждый столбец обозначает пример.Для каждого теста успех отмечается как sucess , ERROR и fail для успешно, досрочно прерванной и неудачной оценки соответственно.(Коды доступны в конце ответа для воспроизводимости.)
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-й пример представляет собой особую проблему с большинством ответов.Поскольку каждое выражение оценивается индивидуально в 3 из 5 ответов, вызов функции 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