这是我最终使用的最终答案。它从根本上依赖于一个函数,该函数将任何默认函数值显式注入到惰性点对象的表达式中。
完整的功能(带注释)在这个答案的末尾。
限制:
- 您至少需要一些额外的技巧才能很好地完成这项工作(见下文)。
- 它忽略了原始函数,但我认为这些函数没有默认函数参数。
- 对于 S3 泛型,应该使用实际的方法。比如
seq.default
代替seq
。如果目标是在您自己的函数中注入默认值,那么这通常不会有太大问题。
例如,可以像这样使用这个函数:
dots <- lazyeval::all_dots(a = ~x, b = ~lm(y ~ x, data = d))
add_defaults_to_dots(dots)
$a
<lazy>
expr: x
env: <environment: R_GlobalEnv>
$b
<lazy>
expr: lm(formula = y ~ x, data = d, subset = , weights = , na.action = , ...
env: <environment: R_GlobalEnv>
我们可以通过几种方式从问题中解决玩具问题。记住新功能和理想用例:
lag2 <- function(x, n = 1L, order_by = gear) lag(x, n = n, order_by = order_by)
mtcars %>%
mutate(cyl_change = cyl != lag2(cyl))
mutate_
直接使用dots
:
dots <- lazyeval::all_dots(cyl_change = ~cyl != lag2(cyl), all_named = TRUE)
dots <- add_defaults_to_dots(dots)
mtcars %>% mutate_(.dots = dots)
重新定义mutate
以包括添加默认值。
mutate2 <- function(.data, ...) {
dots <- lazyeval::lazy_dots(...)
dots <- add_defaults_to_dots(dots)
dplyr::mutate_(.data, .dots = dots)
}
mtcars %>% mutate2(cyl_change = cyl != lag2(cyl))
使用 S3 dispatch 作为任何自定义类的默认设置:
mtcars2 <- mtcars
class(mtcars2) <- c('test', 'data.frame')
mutate_.test <- function(.data, ..., .dots) {
dots <- lazyeval::all_dots(.dots, ..., all_named = TRUE)
dots <- add_defaults_to_dots(dots)
dplyr::mutate_(tibble::as_tibble(.data), .dots = dots)
}
mtcars2 %>% mutate(cyl_change = cyl != lag2(cyl))
根据用例,我认为选项 2 和 3 是实现此目的的最佳方法。选项 3 实际上具有完整的建议用例,但确实依赖于额外的 S3 类。
功能:
add_defaults_to_dots <- function(dots) {
# A recursive function that continues to add defaults to lower and lower levels.
add_defaults_to_expr <- function(expr) {
# First, if a call is a symbol or vector, there is nothing left to do but
# return the value (since it is not a function call).
if (is.symbol(expr) | is.vector(expr) | class(expr) == "formula") {
return(expr)
}
# If it is a function however, we need to extract it.
fun <- expr[[1]]
# If it is a primitive function (like `+`) there are no defaults, and we
# should not manipulate that call, but we do need to use recursion for cases
# like a + f(b).
if (is.primitive(match.fun(fun))) {
new_expr <- expr
} else {
# If we have an actual non-primitive function call, we formally match the
# call, so abbreviated arguments and order reliance work.
matched_expr <- match.call(match.fun(fun), expr, expand.dots = TRUE)
expr_list <- as.list(matched_expr)
# Then we find the default arguments:
arguments <- formals(eval(fun))
# And overwrite the defaults for which other values were supplied:
given <- expr_list[-1]
arguments[names(given)] <- given
# And finally build the new call:
new_expr <- as.call(c(fun, arguments))
}
# Then, for all function arguments we run the function recursively.
new_arguments <- as.list(new_expr)[-1]
null <- sapply(new_arguments, is.null)
new_arguments[!null] <- lapply(new_arguments[!null], add_defaults_to_expr)
new_expr <- as.call(c(fun, new_arguments))
return(new_expr)
}
# For lazy dots supplied, separate the expression and environments.
exprs <- lapply(dots, `[[`, 'expr')
envrs <- lapply(dots, `[[`, 'env')
# Add the defaults to the expressions.
new_exprs <- lapply(exprs, add_defaults_to_expr)
# Add back the correct environments.
new_calls <- Map(function(x, y) {
lazyeval::as.lazy(x, y)
}, new_exprs, envrs)
return(new_calls)
}