这里有一个例子。在其中,calc_1是一个函数,它包含大量的数值参数,希望对它们进行加法和乘法运算。它将这项工作委托给calc_2,calc_2是一个辅助函数,它接受大部分这些参数。但calc_2还需要一些额外的参数(q到t),calc_1无法从其自身的实际参数提供这些参数。相反,它把它们当作额外的东西。
如果将对calc_2的调用编写为显示calc_1传递给它的所有内容,那么它将非常可怕。因此,我们假设如果calc_1和calc_2共享一个形式参数,那么它们会给它取相同的名称。这使得可以编写一个调用者来计算calc_1可以传递给calc_2的参数,构造一个调用,并输入额外的值来完成它。下面代码中的注释应该清楚说明这一点。
顺便说一句,只有%>%才需要库“tidyverse”和str_c(我用它定义了calc_2),以及一个断言的库“assertthat”。(虽然在一个现实的程序中,我会提出断言来检查论点。)
以下是输出:
> calc_1( a=1, b=11, c=2, d=22, e=3, f=33, g=4, h=44, i=5, j=55, k=6
+ , l=66, m=7, n=77, o=8, p=88
+ )
[1] "87654321QRST"
下面是代码:
library( tidyverse )
library( rlang )
library( assertthat )
`%(%` <- call_with_extras
#
# This is the operator for calling
# a function with arguments passed
# from its parent, supplemented
# with extras. See call_with_extras()
# below.
# A function with a very long
# argument list. It wants to call
# a related function which takes
# most of these arguments and
# so has a long argument list too.
# The second function takes some
# extra arguments.
#
calc_1 <- function( a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p )
{
calc_2 %(% list( t = "T", q = "Q", s = "S", r = "R" )
#
# Call it with those extras, passing
# all the others that calc_2() needs
# as well. %(% is my function for
# doing so: see below.
}
# The function that we call above. It
# uses its own arguments q to t , as
# well as those from calc_1() .
#
calc_2 <- function( a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t )
{
( a + c * 10 + e * 100 + g * 1000 + i * 10000 + k * 100000 +
m * 1000000 + o * 10000000 ) %>%
str_c( q, r, s, t )
}
# Calls function f2 . Passes f2 whichever
# arguments it needs from its caller.
# Corresponding formals should have the
# same name in both. Also passes f2 extra
# arguments from the named list extra.
# The names should have the same names as
# corresponding formals of f2 .
#
call_with_extras <- function( f2, extras )
{
f1_call <- match.call( sys.function(1), sys.call(1) )
# A call object.
f1_actuals <- as.list( f1_call %>% tail(-1) )
# Named list of f1's actuals.
f1_formals <- names( f1_actuals )
# Names of f1's formals.
f2_formals <- names( formals( f2 ) )
# Names of f2's formals.
f2_formals_from_f1 <- intersect( f2_formals, f1_formals )
# Names of f2's formals which f1 can supply.
f2_formals_not_from_f1 <- setdiff( f2_formals, f1_formals )
# Names of f2's formals which f1 can't supply.
extra_formals <- names( extras )
# Names of f2's formals supplied as extras.
assert_that( setequal( extra_formals, f2_formals_not_from_f1 ) )
# The last two should be equal.
f2_actuals_from_f1 <- f1_actuals[ f2_formals_from_f1 ]
# List of actuals which f1 can supply to f2.
f2_actuals <- append( f2_actuals_from_f1, extras )
# All f2's actuals.
f2_call <- call2( f2, !!! f2_actuals )
# Call to f2.
eval( f2_call )
# Run it.
}
# Test it.
#
calc_1( a=1, b=11, c=2, d=22, e=3, f=33, g=4, h=44, i=5, j=55, k=6
, l=66, m=7, n=77, o=8, p=88
)
