这是我最终使用的答案。它基本上依赖于一个函数，该函数将任何默认函数值明确注入到惰性点对象的表达式中。
完整的函数（带有注释）在此答案的末尾。
限制：
- 您需要至少一些额外的技巧才能使其正常工作（请参见下文）。
- 它忽略了原始函数，但我认为这些函数没有默认函数参数。
- 对于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))
Use mutate_ with dots directly:
dots <- lazyeval::all_dots(cyl_change = ~cyl != lag2(cyl), all_named = TRUE)
dots <- add_defaults_to_dots(dots)
mtcars %>% mutate_(.dots = dots)
Redefine mutate to include the addition of defaults.
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))
Use S3 dispatch to do this as the default for any custom class:
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)
}
gear是另一个向量，对吧？你没有将它传递给lag2的本地环境。尝试使用lag2 <- function(x, gear) {...}（注意，不需要写参数n）。 - alexwhitworthdata.table中达到你想要的目标，但是这些方法都不能与dplyr一起使用。 - eddimulti)dplyr。 - Axeman