如何获取在指定环境中评估调用对象时使用的所有参数的值
How can I get the values of all arguments used when evaluating a call object in a specified environment
说我有一个函数 f
as
f = function(x = 1, y, z, t) { x + y + z}
还有一个列表l
这样
l = list(Y = 2, t = "test")
我可以像
那样在l
中评估f
eval(quote(f(y = Y, z = 3)), envir = l)
6
我的问题是我想获取最终被函数 f
使用的参数的所有值,即。一个函数 magic
,它将接受一个调用对象和一个环境,并将 return 将用于计算表达式的所有参数的值。
例如:
call_obj = quote(f(y = Y, z = 3))
magic(call_obj, envir = l)
# I get a named list which value is list(1,2,3,"test")
# For that matter I do not even need the default arguments values (x)
编辑:为 base-r 答案添加赏金(虽然@Artem Sokolov 提供了一个 purrr-rlang 答案,但提取几个相关函数仍然没问题)
tidyverse 解决方案
# Identify the variables in l that can be used to specify arguments of f
args1 <- l[ intersect( names(formals(f)), names(l) ) ]
# Augment the call with these variables
call_obj2 <- rlang::call_modify( call_obj, !!!args1 )
# f(y = Y, z = 3, t = "test")
# Evaluate the arguments of the call in the context of l and combine with defaults
purrr::list_modify( formals(f),
!!!purrr::map(rlang::call_args(call_obj2), eval, l) )
base R 解决方案
# As above
args1 <- l[ intersect( names(formals(f)), names(l) ) ]
# Augment the call with variables in args1
l1 <- modifyList( as.list(call_obj), args1 )[-1]
# Evaluate the arguments in the context of l and combine with defaults
modifyList(formals(f), lapply(l1, eval, l))
两个解决方案的输出
# $x
# [1] 1
#
# $y
# [1] 2
#
# $z
# [1] 3
#
# $t
# [1] "test"
这个怎么样:
magic <- function(call_obj, envir) {
call_fun <- as.list(as.call(call_obj))[[1]]
call_obj <- match.call(match.fun(call_fun), as.call(call_obj))
## arguments supplied in call
call_args <- as.list(call_obj)[-1]
## arguments from function definition
fun_args <- formals(match.fun(call_fun))
## match arguments from call with list
new_vals_call <- lapply(call_args, function(x) eval(x, envir = envir))
## match arguments from function definition with list
## because everything (including NULL) can be a valid function argument we cannot directly use mget()
in_list <- sapply(names(fun_args), function(x, env) exists(x, envir = env), as.environment(envir))
new_vals_formals <- mget(names(fun_args), envir = as.environment(envir), ifnotfound = "")[in_list]
## values in the call take precedence over values from the list (can easily be reversed if needed)
new_vals_complete <- modifyList(fun_args, new_vals_formals, keep.null = TRUE)
new_vals_complete <- modifyList(new_vals_complete, new_vals_call, keep.null = TRUE)
## Construct a call object (if you want only the list of arguments return new_vals_complete)
as.call(c(call_fun, new_vals_complete))
}
# -------------------------------------------------------------------------
f <- function(x = 1, y, z, t) { x + y + z}
## Tests
## basic test
magic(quote(f(y = Y, z = 3)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = 3, t = "test")
## precedence (t defined twice)
magic(quote(f(y = Y, z = 3, t=99)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = 3, t = 99)
## missing values (z is missing)
magic(quote(f(y = Y)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = , t = "test")
## NULL values in call
magic(quote(f(y = Y, z = NULL)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = NULL, t = "test")
## NULL values in list
magic(quote(f(y = Y, z = 3)), list(Y = 2, t = NULL))
#> f(x = 1, y = 2, z = 3, t = NULL)
## NULL values and precendece
magic(quote(f(y = Y, z = 3, t= NULL)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = 3, t = NULL)
magic(quote(f(y = Y, z = 3, t=99)), list(Y = 2, t = NULL))
#> f(x = 1, y = 2, z = 3, t = 99)
## call with subcalls
magic(quote(f(y = sin(pi), z = 3)), list(Y = 2, t = "test"))
#> f(x = 1, y = 1.22460635382238e-16, z = 3, t = "test")
magic(quote(f(y = Y, z = 3)), list(Y = sin(pi), t = "test"))
#> f(x = 1, y = 1.22460635382238e-16, z = 3, t = "test")
## call with additional vars (g is not an argument of f) -> error: unused arguments
magic(quote(f(g = Y, z = 3)), list(Y = 2, t = "test"))
## list with with additional vars (g is not an argument of f) -> vars are ignored
magic(quote(f(y = Y, z = 3)), list(Y = 2, t = "test", g=99))
#> f(x = 1, y = 2, z = 3, t = "test")
## unnamed arguments
magic(quote(f(99, y = Y, z = 3)), list(Y = 2, t = "test"))
#> f(x = 99, y = 2, z = 3, t = "test")
magic(quote(f(99, y = Y, 77)), list(Y = 2, t = "test"))
#> f(x = 99, y = 2, z = 77, t = "test")
Strictly Base R...还支持 call_obj
中的未命名参数。
函数定义
magic <- function(call_obj, envir) {
#browser()
# Get all formal args
Formals <- formals(as.character(call_obj))
# fix names of call_obj to allow unnamed args
unnamed <- which(names(call_obj)[-1] == "")
# ignore extra arguments names if too many args (issue a warning?)
unnamed <- unnamed[unnamed <= length(Formals)]
# check for names conflicts
named <- which(names(call_obj)[-1] != "")
if (any(unnamed > named))
stop("Unnamed arguments cannot follow named arguments in call_obj")
if (any(names(Formals)[unnamed] %in% names(call_obj)))
stop("argument names conflicting in call_obj; ",
"avoid unnamed arguments if possible")
names(call_obj)[unnamed + 1] <- names(Formals)[unnamed]
# Replace defaults by call_obj values
for (nn in intersect(names(call_obj), names(Formals))) {
Formals[nn] <- call_obj[nn]
}
# Check for other values in envir
for (mm in names(which(sapply(Formals, class) == "name"))) {
if (mm %in% names(envir))
Formals[mm] <- envir[mm]
else if (Formals[mm] %in% names(envir))
Formals[mm] <- envir[which(names(envir) == Formals[[mm]])]
}
print(as.call(c(as.list(as.call(call_obj))[[1]], Formals)))
return(invisible(Formals))
}
示例
f = function(x = 1, y, z, t) { x + y + z}
l = list(Y = 2, t = "test")
call_obj = quote(f(y = Y, z = 3))
magic(call_obj, envir = l)
结果(印刷)
f(x = 1, y = 2, z = 3, t = "test")
返回对象(不可见,用于赋值)
$x
[1] 1
$y
[1] 2
$z
[1] 3
$t
[1] "test"
虽然我们通过不同的方式到达那里,但 AEF 测试的所有结果都与我一致。
说我有一个函数 f
as
f = function(x = 1, y, z, t) { x + y + z}
还有一个列表l
这样
l = list(Y = 2, t = "test")
我可以像
那样在l
中评估f
eval(quote(f(y = Y, z = 3)), envir = l)
6
我的问题是我想获取最终被函数 f
使用的参数的所有值,即。一个函数 magic
,它将接受一个调用对象和一个环境,并将 return 将用于计算表达式的所有参数的值。
例如:
call_obj = quote(f(y = Y, z = 3))
magic(call_obj, envir = l)
# I get a named list which value is list(1,2,3,"test")
# For that matter I do not even need the default arguments values (x)
编辑:为 base-r 答案添加赏金(虽然@Artem Sokolov 提供了一个 purrr-rlang 答案,但提取几个相关函数仍然没问题)
tidyverse 解决方案
# Identify the variables in l that can be used to specify arguments of f
args1 <- l[ intersect( names(formals(f)), names(l) ) ]
# Augment the call with these variables
call_obj2 <- rlang::call_modify( call_obj, !!!args1 )
# f(y = Y, z = 3, t = "test")
# Evaluate the arguments of the call in the context of l and combine with defaults
purrr::list_modify( formals(f),
!!!purrr::map(rlang::call_args(call_obj2), eval, l) )
base R 解决方案
# As above
args1 <- l[ intersect( names(formals(f)), names(l) ) ]
# Augment the call with variables in args1
l1 <- modifyList( as.list(call_obj), args1 )[-1]
# Evaluate the arguments in the context of l and combine with defaults
modifyList(formals(f), lapply(l1, eval, l))
两个解决方案的输出
# $x
# [1] 1
#
# $y
# [1] 2
#
# $z
# [1] 3
#
# $t
# [1] "test"
这个怎么样:
magic <- function(call_obj, envir) {
call_fun <- as.list(as.call(call_obj))[[1]]
call_obj <- match.call(match.fun(call_fun), as.call(call_obj))
## arguments supplied in call
call_args <- as.list(call_obj)[-1]
## arguments from function definition
fun_args <- formals(match.fun(call_fun))
## match arguments from call with list
new_vals_call <- lapply(call_args, function(x) eval(x, envir = envir))
## match arguments from function definition with list
## because everything (including NULL) can be a valid function argument we cannot directly use mget()
in_list <- sapply(names(fun_args), function(x, env) exists(x, envir = env), as.environment(envir))
new_vals_formals <- mget(names(fun_args), envir = as.environment(envir), ifnotfound = "")[in_list]
## values in the call take precedence over values from the list (can easily be reversed if needed)
new_vals_complete <- modifyList(fun_args, new_vals_formals, keep.null = TRUE)
new_vals_complete <- modifyList(new_vals_complete, new_vals_call, keep.null = TRUE)
## Construct a call object (if you want only the list of arguments return new_vals_complete)
as.call(c(call_fun, new_vals_complete))
}
# -------------------------------------------------------------------------
f <- function(x = 1, y, z, t) { x + y + z}
## Tests
## basic test
magic(quote(f(y = Y, z = 3)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = 3, t = "test")
## precedence (t defined twice)
magic(quote(f(y = Y, z = 3, t=99)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = 3, t = 99)
## missing values (z is missing)
magic(quote(f(y = Y)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = , t = "test")
## NULL values in call
magic(quote(f(y = Y, z = NULL)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = NULL, t = "test")
## NULL values in list
magic(quote(f(y = Y, z = 3)), list(Y = 2, t = NULL))
#> f(x = 1, y = 2, z = 3, t = NULL)
## NULL values and precendece
magic(quote(f(y = Y, z = 3, t= NULL)), list(Y = 2, t = "test"))
#> f(x = 1, y = 2, z = 3, t = NULL)
magic(quote(f(y = Y, z = 3, t=99)), list(Y = 2, t = NULL))
#> f(x = 1, y = 2, z = 3, t = 99)
## call with subcalls
magic(quote(f(y = sin(pi), z = 3)), list(Y = 2, t = "test"))
#> f(x = 1, y = 1.22460635382238e-16, z = 3, t = "test")
magic(quote(f(y = Y, z = 3)), list(Y = sin(pi), t = "test"))
#> f(x = 1, y = 1.22460635382238e-16, z = 3, t = "test")
## call with additional vars (g is not an argument of f) -> error: unused arguments
magic(quote(f(g = Y, z = 3)), list(Y = 2, t = "test"))
## list with with additional vars (g is not an argument of f) -> vars are ignored
magic(quote(f(y = Y, z = 3)), list(Y = 2, t = "test", g=99))
#> f(x = 1, y = 2, z = 3, t = "test")
## unnamed arguments
magic(quote(f(99, y = Y, z = 3)), list(Y = 2, t = "test"))
#> f(x = 99, y = 2, z = 3, t = "test")
magic(quote(f(99, y = Y, 77)), list(Y = 2, t = "test"))
#> f(x = 99, y = 2, z = 77, t = "test")
Strictly Base R...还支持 call_obj
中的未命名参数。
函数定义
magic <- function(call_obj, envir) {
#browser()
# Get all formal args
Formals <- formals(as.character(call_obj))
# fix names of call_obj to allow unnamed args
unnamed <- which(names(call_obj)[-1] == "")
# ignore extra arguments names if too many args (issue a warning?)
unnamed <- unnamed[unnamed <= length(Formals)]
# check for names conflicts
named <- which(names(call_obj)[-1] != "")
if (any(unnamed > named))
stop("Unnamed arguments cannot follow named arguments in call_obj")
if (any(names(Formals)[unnamed] %in% names(call_obj)))
stop("argument names conflicting in call_obj; ",
"avoid unnamed arguments if possible")
names(call_obj)[unnamed + 1] <- names(Formals)[unnamed]
# Replace defaults by call_obj values
for (nn in intersect(names(call_obj), names(Formals))) {
Formals[nn] <- call_obj[nn]
}
# Check for other values in envir
for (mm in names(which(sapply(Formals, class) == "name"))) {
if (mm %in% names(envir))
Formals[mm] <- envir[mm]
else if (Formals[mm] %in% names(envir))
Formals[mm] <- envir[which(names(envir) == Formals[[mm]])]
}
print(as.call(c(as.list(as.call(call_obj))[[1]], Formals)))
return(invisible(Formals))
}
示例
f = function(x = 1, y, z, t) { x + y + z}
l = list(Y = 2, t = "test")
call_obj = quote(f(y = Y, z = 3))
magic(call_obj, envir = l)
结果(印刷)
f(x = 1, y = 2, z = 3, t = "test")
返回对象(不可见,用于赋值)
$x
[1] 1
$y
[1] 2
$z
[1] 3
$t
[1] "test"
虽然我们通过不同的方式到达那里,但 AEF 测试的所有结果都与我一致。