Related
I will use the following example to explain my question. But the question is not only about this specific example, but more general about meta-programming in R.
I have two specific functions to make plots
Specific function 1
draw_hists <- function(dts, indexs, title_prefix = 'sd = ') {
mapply(
function(dt, index)
{
hist(dt, main = paste(title_prefix, as.character(index)))
},
dts, indexs
)
}
plots histograms
sds <- c(0.1, 0.5, 5, 100)
raw_normals <- purrr::map(sds, ~rnorm(500, mean = 1, sd = .x))
draw_hists(raw_normals, sds)
Specific function 2
plots scatter plots of percentage ranks against raw data
draw_percentage <- function(dts, indexs, title_prefix = 'sd = ') {
mapply(
function(dt, index)
{
plot(dt, dplyr::percent_rank(dt), main = paste(title_prefix, as.character(index)))
},
dts, indexs
)
}
sds <- c(0.1, 0.5, 5, 100)
raw_normals <- purrr::map(sds, ~rnorm(500, mean = 1, sd = .x))
draw_percentage(raw_normals, sds)
Now assume I want to abstract out the general patterns of these functions and define a generic higher-order function that takes inputs of any arbitrary plotting function and its argument as an expression to be flexible enough drawing nearly whatever I want to draw. I thought something like this would work.
draw_generic <- function(dts, indexs, plfun, plfun_arguments_as_expr) {
....
}
The formal parameter plfun_arguments_as_expr would bind to an expression such like expr(dplyr::percent_rank(dt)) to make the plotting truly generic and flexible. I come up with the following solution.
draws_generic <- function(dts, indexs, plfun, title_prefix = 'sd =', ...) {
dots <- enquos(...)
mapply(
function(dt, index)
{
eval_tidy(
expr(
plfun(dt, main = paste(title_prefix, as.character(index)), !!!dots)
)
)
}
,
dts, indexs
)
}
draws_generic(raw_normals, sds, hist)
draws_generic(raw_normals, sds, plot, dplyr::percent_rank(dt))
The histogram works. But the percent_rank one gives me error
Error in x[!nas] : object of type 'closure' is not subsettable
In addition: Warning message:
In is.na(x) : is.na() applied to non-(list or vector) of type 'closure'
Called from: rank(x, ties.method = "min", na.last = "keep")
I think this might be related to the fact that the environment scope captured by enquos is global, but the expression contains a name dt for which its binding existed in local scope created by the anonymous function function(dt, index). Is this truly the reason of this error? If so, is there a neat and clean way to fix it that follows principles of "tidy evaluation"?
Update
Inspired by the comments, I modify here my question. In stead of using a pure functional abstraction to generalize procedures, what I really want is to achieve generalization by treating code as object and manipulate it freely in a R function or kind of macro programming. More precisely what I want is a draw_expression function to plot data against a given expression instead of previous draw_generic. Below are some of my attempts so far:
The 1st version plots a plotting expression with x as data argument against given data without additional indexs parameter and title. The code has been tested working.
draw_expression_1 <- function(dts, plexpr) {
plexpr <- enexpr(plexpr)
lapply(dts, eval(expr(function(x) !!plexpr)))
}
draw_expression_1(raw_normals, hist(x))
draw_expression_1(raw_normals, plot(x, dplyr::percent_rank(x))
The 2nd version adds additional indexs parameter and titles by modifying the given expression. The code has been tested working.
draw_expression_2 <- function(dts, indexs, plexpr, title_prefix = 'sd =') {
plexpr <- enexpr(plexpr)
mapply(eval(expr(function(x, index) {
UQ(rlang::call_modify(plexpr, main = quote(paste(title_prefix, as.character(index)))))
})), dts, indexs)
}
draw_expression_2(raw_normals, sds, hist(x))
draw_expression_2(raw_normals, sds, plot(x, dplyr::percent_rank(x))
The 3rd version is aimed at allowing the call expression to have any arbitrary formal parameter name instead of x. Release the assumption to be that the 1st parameter corresponds to the data to be plotted, but it can be named whatever users wished.
draw_expression_3 <- function(dts, indexs, plexpr, title_prefix = 'sd =') {
plexpr <- enexpr(plexpr)
first_arg_name <- rlang::call_args(plexpr)
mapply(eval(expr(function(first_arg_name, index) {
UQ(rlang::call_modify(plexpr, main = quote(paste(title_prefix, as.character(index)))))
})), dts, indexs)
}
draw_expression_3(raw_normals, sds, hist(x))
draw_expression_3(raw_normals, sds, plot(x, dplyr::percent_rank(x))
This prints me error:
Error in plot(x, dplyr::percent_rank(x), main = paste(title_prefix, as.character(index))) :
object 'x' not found
Apparently first_arg_name has to been unquoted in the expression. Thus I did this:
draw_expression_3 <- function(dts, indexs, plexpr, title_prefix = 'sd =') {
plexpr <- enexpr(plexpr)
first_arg_name <- rlang::call_args(plexpr)
mapply(eval(expr(function(UQ(first_arg_name), index) {
UQ(rlang::call_modify(plexpr, main = quote(paste(title_prefix, as.character(index)))))
})), dts, indexs)
}
draw_expression_3(raw_normals, sds, hist(x))
draw_expression_3(raw_normals, sds, plot(x, dplyr::percent_rank(x))
But I got weird syntax error:
Error: unexpected '}' in " }"
Now I don't understand why this happens. Any help?
Also I could not use enquo + eval_tidy here, since enquo will capture the environment of the call expression which is global, but the expression inside the function that I would like to modify and manipulate contains x which belongs to the inner scope. Thus this is not a tidy evaluation. But I am not perusing that anymore. I simply want do macro programming as freely as I can with base R plus some of convenient tools provided by rlang.
NOTE: I am not trying to do any production work. I am just trying to see the limit of this language and understand things better.
I don't know the "tidy evaluation" way to do this, but the simpler base R method is to pass a function rather than an expression. For example,
sds <- c(0.1, 0.5, 5, 100)
raw_normals <- purrr::map(sds, ~rnorm(500, mean = 1, sd = .x))
draws_generic2 <- function(dts, indexs, plfun, title_prefix = 'sd =') {
mapply(
function(dt, index)
{
plfun(dt, main = paste(title_prefix, as.character(index)))
},
dts, indexs
)
invisible(NULL)
}
par(mfrow=c(2,2))
draws_generic2(raw_normals, sds, hist)
draws_generic2(raw_normals, sds, function(dt, ...) plot(dt, dplyr::percent_rank(dt), ...))
Created on 2022-04-15 by the reprex package (v2.0.1)
I used dt in my function definition in the second example, but I could have used any variable name, e.g. this would give the same output except for the axis labels:
draws_generic2(raw_normals, sds,
function(x, ...) plot(x, dplyr::percent_rank(x), ...))
I would like to have a function accept arguments in the usual R way, most of which will have defaults. But I would also like it to accept a list of named arguments corresponding to some or some or all of the formals. Finally, I would like arguments supplied to the function directly, and not through the list, to override the list arguments where they conflict.
I could do this with a bunch of nested if-statements. But I have a feeling there is some elegant, concise, R-ish programming-on-the-language solution -- probably multiple such solutions -- and I would like to learn to use them. To show the kind of solution I am looking for:
> arg_lst <- list(x=0, y=1)
> fn <- function(a_list = NULL, x=2, y=3, z=5, ...){
<missing code>
print(c(x, y, z))
}
> fn(a_list = arg_list, y=7)
Desired output:
x y z
0 7 5
I like a lot about #jdobres's approach, but I don't like the use of assign and the potential scoping breaks.
I also don't like the premise, that a function should be written in a special way for this to work. Wouldn't it be better to write a wrapper, much like do.call, to work this way with any function? Here is that approach:
Edit: solution based off of purrr::invoke
Thinking a bit more about this, purrr::invoke almost get's there - but it will result in an error if a list argument is also passed to .... But we can make slight modifications to the code and get a working version more concisely. This version seems more robust.
library(purrr)
h_invoke = function (.f, .x = NULL, ..., .env = NULL) {
.env <- .env %||% parent.frame()
args <- c(list(...), as.list(.x)) # switch order so ... is first
args = args[!duplicated(names(args))] # remove duplicates
do.call(.f, args, envir = .env)
}
h_invoke(fn, arg_list, y = 7)
# [1] 0 7 5
Original version borrowing heavily from jdobres's code:
hierarchical_do_call = function(f, a_list = NULL, ...){
formal_args = formals() # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('f', 'a_list', '...')] = NULL # remove these two from formals
supplied_args <- as.list(match.call())[-1] # get the supplied arguments
supplied_args[c('f', 'a_list')] = NULL # ...but remove the argument list and the function
a_list[names(supplied_args)] = supplied_args
do.call(what = f, args = a_list)
}
fn = function(x=2, y=3, z=5) {
print(c(x, y, z))
}
arg_list <- list(x=0, y=1)
hierarchical_do_call(f = fn, a_list = arg_list, y=7)
# x y z
# 0 7 5
I'm not sure how "elegant" this is, but here's my best attempt to satisfy the OP's requirements. The if/else logic is actually pretty straightforward (no nesting needed, per se). The real work is in collecting and sanitizing the three different input types (formal defaults, the list object, and any supplied arguments).
fn <- function(a_list = NULL, x = 2, y = 3, z = 5, ...) {
formal_args <- formals() # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('a_list', '...')] <- NULL # remove these two from formals
supplied_args <- as.list(match.call())[-1] # get the supplied arguments
supplied_args['a_list'] <- NULL # ...but remove the argument list
# for each uniquely named item among the 3 inputs (argument list, defaults, and supplied args):
for (i in unique(c(names(a_list), names(formal_args), names(supplied_args)))) {
if (!is.null(supplied_args[[i]])) {
assign(i, supplied_args[[i]])
} else if (!is.null(a_list[[i]])) {
assign(i, a_list[[i]])
}
}
print(c(x, y, z))
}
arg_lst <- list(x = 0, y = 1)
fn(a_list = arg_lst, y=7)
[1] 0 7 5
With a little more digging into R's meta-programming functions, it's actually possible to pack this hierarchical assignment into its own function, which is designed to operate on the function environment that called it. This makes it easier to reuse this functionality, but it definitely breaks scope and should be considered dangerous.
The "hierarchical assignment" function, mostly the same as before:
hierarchical_assign <- function(a_list) {
formal_args <- formals(sys.function(-1)) # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('a_list', '...')] <- NULL # remove these two from formals
supplied_args <- as.list(match.call(sys.function(-1), sys.call(-1)))[-1] # get the supplied arguments
supplied_args['a_list'] <- NULL # ...but remove the argument list
# for each uniquely named item among the 3 inputs (argument list, defaults, and supplied args):
for (i in unique(c(names(a_list), names(formal_args), names(supplied_args)))) {
if (!is.null(supplied_args[[i]])) {
assign(i, supplied_args[[i]], envir = parent.frame())
} else if (!is.null(a_list[[i]])) {
assign(i, a_list[[i]], envir = parent.frame())
}
}
}
And the usage. Note that the the calling function must have an argument named a_list, and it must be passed to hierarchical_assign.
fn <- function(a_list = NULL, x = 2, y = 3, z = 5, ...) {
hierarchical_assign(a_list)
print(c(x, y, z))
}
[1] 0 7 5
I think do.call() does exactly what you want. It accepts a function and a list as arguments, the list being arguments for the functions. I think you will need a wrapper function to create this behavior of "overwriting defaults"
I have nested functions and wish to pass arguments to the deepest function. That deepest function will already have default arguments, so I will be updating those argument values.
My mwe is using plot(), but in reality I'm working with png(), with default height and width arguments.
Any suggestions?
f1 <- function(...){ f2(...)}
f2 <- function(...){ f3(...)}
f3 <- function(...){ plot(xlab="hello1", ...)}
#this works
f1(x=1:10,y=rnorm(10),type='b')
# I want to update the default xlab value, but it fails:
f1(x=1:10,y=rnorm(10),type='b', xlab='hello2')
In your f3(), "hello1" is not a default value for xlab in the list of function's formal arguments. It is instead the supplied value in the function body, so there's no way to override it:
f3 <- function(...){ plot(xlab="hello1", ...)}
I suspect you meant instead to do something like this.
f1 <- function(...){ f2(...)}
f2 <- function(...){ f3(...)}
f3 <- function(..., xlab="hello1") plot(..., xlab=xlab)
## Then check that it works
par(mfcol=c(1,2))
f1(x=1:10,y=rnorm(10),type='b')
f1(x=1:10,y=rnorm(10),type='b', xlab='hello2')
(Do notice that the formal argument xlab must follow the ... argument here, so that it can only be matched exactly (and not by partial matching). Otherwise, in the absence of an argument named xlab, it'll get matched by an argument named x, potentially (and actually here) causing you a lot of grief.)
My usual approach for modifying arguments in ... is as follows:
f1 = function(...) {
dots = list(...)
if (!('ylab' %in% names(dots))) {
dots$ylab = 'hello'
}
do.call(plot, dots)
}
# check results
f1(x = 1:10, y = rnorm(10))
f1(x = 1:10, y = rnorm(10), ylab = 'hi')
What happens here is that ... is captured in a list called dots. Next, R checks if this list dots contains any information about ylab. If there is no information, we set it to a specified value. If there is information, we do nothing. Last, do.call(a, b) is a function that basically stands voor execute function a with arguments b.
edit
This works better with multiple default arguments (and probably also better in general).
f1 = function(...) {
# capture ... in a list
dots = list(...)
# default arguments with their values
def.vals = list(bty = 'n', xlab = 'hello', las = 1)
# find elements in dots by names of def.vals. store those that are NULL
ind = unlist(lapply(dots[names(def.vals)], is.null))
# fill empty elements with default values
dots[names(def.vals)[ind]] = def.vals[ind]
# do plot
do.call(plot, dots)
}
f1(x = 1:10, y = rnorm(10), ylab = 'hi', bty = 'l')
Simple question, I hope. I want to write a plotting function that has a default value for the y-axis label if the user doesn't specify. I'd also like to allow the ... argument for other plotting parameters, and allow the user to set ylab manually. But I can't figure out how to do this.
# simple scatterplot function with a default ylab
scatter <- function(x,y, ...) {
plot(x, y, ylab="Default y-axis label", ...)
}
# generate data
x <- rnorm(100)
y <- x+rnorm(100)
# use the default
scatter(x,y)
# here I want to use my own label, but I get an error!
scatter(x, y, ylab="New y-axis label")
The error I get is:
Error in plot.default(x, y, ylab = "Default y-axis label", ...) :
formal argument "ylab" matched by multiple actual arguments
I understand the problem, but I don't know the best way to fix it. Thanks for the help!
EDIT: I realize I can do something like
scatter <- function(x,y,ylab = "Default y-axis label", ...) {
plot(x, y, ylab= ylab, ...)
}
...but if I'm writing a package to submit to CRAN, and I have lots of default options I'd like to fiddle with, I don't want to have to document all these standard plotting arguments because they're used in my function definition.
Try doing this instead:
scatter <- function(x,y,ylab = "Default y-axis label", ...) {
plot(x, y, ylab= ylab, ...)
}
Expanding slightly on Arun's answer, this is a sketch of one route to take if you have many arguments:
def_args <- list(ylab = "Default Label",xlab = "Default Label")
scatter <- function(x,y, ...) {
cl <- as.list(match.call())[-1L]
do.call("plot",c(cl,def_args[!names(def_args) %in% names(cl)]))
}
Some thought would be needed to decide how you want to handle partial matching of arguments (if at all). e.g. perhaps something like this:
scatter <- function(x,y, ...) {
cl <- as.list(match.call())[-1L]
names(cl) <- match.arg(names(cl),
names(formals(plot.default)),several.ok = TRUE)
do.call("plot",c(cl,def_args[!names(def_args) %in% names(cl)]))
}
would handle partial matching of arguments.
One way using match.call to check if ylab has been specified as an argument:
scatter <- function(x,y, ...) {
mcall = as.list(match.call())[-1L]
if (!"ylab" %in% names(mcall))
plot(x, y, ylab="Default y-axis label", ...)
else plot(x, y, ...)
}
As mentioned under comment list(...) is a nicer way to get just the dots argument expanded than having to get all the formal arguments with match.call.
You might also try using pmatch instead of %in% for partial matching of arguments.
I use a function to build an argument list. In my case, I do not care about partially matching argument names, which is good because this won't support it.
# Create a list of input arguments.
# Allow arguments to be specified multiple times, first definition wins.
# The resulting list is intended to be passed to do.call().
make.args <- function(..., PRE.ARGS=list(), POST.ARGS=list()) {
a <- list()
l <- c(PRE.ARGS, list(...), POST.ARGS)
for (name in unique(names(l))) {
a[[name]] <- l[[name]] # First occurrence will be found.
}
return(a)
}
An example of its use:
plot.rate <- function(col, cond=NULL, ...) {
col <- paste(col, collapse=' + ')
f <- paste(col, '~ Rate')
if (!is.null(cond)) {
cond <- paste(cond, collapse=' + ')
f <- paste(f, cond, sep='|')
}
arg.list <- make.args(...
, x = as.formula(f)
, main=col
, grid=TRUE
, scales=list(x=list(alternating=1) # bottom(/left)
, y=list(alternating=3)) # both
, xlab='x RTM'
)
do.call(xyplot, arg.list)
}
I'm working in R and need to pass arguments to a function so that they can be used as arguments when calling another function within the original. In the example below you can see that I'm interested in calling interiorFunc() every time primaryFunc() is called but the value of the first parameter is dependent on the existence of a second parameter. If I declare 'parameter 2' then I want a different set of arguments than if I don't declare 'parameter 2' in the function call. Here is the definition for the interior function:
interiorFunc(data, resp, param1, param2)
{
if(missing(param2))
{
print(paste("Do analysis without parameter 2 on dataset of size",nrow(data),"with response",resp)
}else{
print(paste("Do analysis with parameter 2 on dataset of size",nrow(data),"with response",resp))
}
}
And here is the function that calls it:
primaryFunc <- function(dataset, ...)
{
if(parameter 2 has been declared in the call to primaryFunc)
{
results <- interiorFunc(dataset, ...)
}else{
modifedData <- sample(dataset, 2*dataset, replace = TRUE)
results <- interiorFunc(modifiedData, ...)
}
return(results)
}
The function call would either be:
interiorFuncResults <- primaryFunc(dataset, response, parameter1)
or
interiorFuncResults <- primaryFunc(dataset, response, parameter1, parameter2)
so I need to determine prior to calling the interior function if it's 'parameter2' value has been passed in. Here is a definition of interiorFunc() to make this example reproducible:
Thank you for your help.
I think one of the common strategies is to filter the names,
sub <- function(x, y, param=NULL, ...){
if(!is.null(param))
message(param, "is being used") else
message("not seeing it")
}
main <- function(a=1, b=2, ..., c=3){
dots <- list(...)
if("param" %in% names(dots))
sub(a, b, ...) else
sub(a, b, ...)
}
main(z=2)
main(param = 2)
which, of course, assumes that ... only will receive fully named arguments.