Imagine:
myfunct <- function(x, ...){
dots <- list(...)
...
}
How do I distinguish in the course of the function whether dots derived from myfunct('something') (no dots) or myfunct('something', NULL) (dots includes explicit NULL)?
In my experimentation both cases lead to is.null(dots) equating to TRUE.
Does it help ?
f <- function(x, ...){
missing(...)
}
> f(2)
[1] TRUE
> f(2, NULL)
[1] FALSE
g <- function(x, ...){
length(list(...))
}
> g(2)
[1] 0
> g(2, NULL)
[1] 1
I eventually came up with the following:
myfunct <- function(...)
{
my_dots <- match.call(expand.dots = FALSE)[['...']]
no_dots <- is.null(my_dots)
# Process the dots
if(!no_dots)
{
my_dots <- lapply(my_dots, eval)
}
# Exemplary return
return(my_dots)
}
This yields:
> myfunct(1)
[[1]]
[1] 1
> myfunct(NULL)
[[1]]
NULL
> myfunct()
NULL
> myfunct(1, NULL, 'A')
[[1]]
[1] 1
[[2]]
NULL
[[3]]
[1] "A"
Related
I want to write a decorator function that adds a counter to a function, counting the number of times it was called. E.g.
foo <- function(x) {x}
foo <- counter_decorator(foo)
foo(1)
foo(1)
# => the counter gets incremented with each call and has the value 2 now
The approach below basically works, but:
I want the inner function (which is returned by the decorator) to have the same formal args as the original function and not just ellipsis (i.e. ...). I am not sure how to accomplish that. Any ideas?
Not sure if the whole approach is a good one. Alternatives or improvements are appreciated.
Here is what I did so far:
# Init or reset counter
counter_init <- function() {
.counters <<- list()
}
# Decorate a function with a counter
#
# Each time the function is called the counter is incremented
#
# fun: function to be decorated
# fun_name: name in .counters list to store number of times in
#
counter_decorator <- function(fun, fun_name = NULL)
{
# use function name if no name is passed explicitly
if (is.null(fun_name)) {
fun_name <- deparse(substitute(fun))
}
fun <- force(fun) # deep copy to prevent infinite recursion
function(...) { # ==> ellipsis not optimal!
n <- .counters[[fun_name]]
if (is.null(n)) {
n <- 0
}
.counters[[fun_name]] <<- n + 1
fun(...)
}
}
Now let's create some functions and decorate them.
library(dplyr) # for pipe
# Create functions and decorate them with a counter
# create and decorate in second call
add_one <- function(x) {
x + 1
}
add_one <- counter_decorator(add_one)
# create and decorate the piping way by passing the fun_name arg
add_two <- {function(x) {
x + 2
}} %>% counter_decorator(fun_name = "add_two")
mean <- counter_decorator(mean)
counter_init()
for (i in 1:100) {
add_one(1)
add_two(1)
mean(1)
}
What we get in the .counters list is
> .counters
$add_one
[1] 100
$add_two
[1] 100
$mean
[1] 100
which is basically what I want.
1) The trace command can be used. Use untrace to undo the trace or set .counter to any desired value to start over again from that value.
f <- function(x) x
trace(f, quote(.counter <<- .counter + 1), print = FALSE)
.counter <- 0
f(1)
## [1] 1
f(1)
## [1] 1
.counter
## [1] 2
2) This variation stores the counter in an attribute of f.
f <- function(x) x
trace(f, quote(attr(f, "counter") <<- attr(f, "counter") + 1), print = FALSE)
attr(f, "counter") <- 0
f(1)
## [1] 1
f(1)
## [1] 1
attr(f, "counter")
## [1] 2
3) This variation stores the counter in an option.
f <- function(x) x
trace(f, quote(options(counter = getOption("counter", 0) + 1)), print = FALSE)
f(1)
## [1] 1
f(1)
## [1] 1
getOption("counter")
## [1] 2
This method stores the counter within the wrapper function itself instead of somewhere in the users environment or package environment. (There's nothing wrong with the latter; the former can be problematic or at least annoying/discourteous.)
The biggest side-effect (liability?) of this is when the package is detached or reloaded (i.e., during development), then the counter list is cleared/re-initialized.
counter_decorator <- function(fun) {
.counter <- 0L
fun2 <- function(...) {
.counter <<- .counter + 1L
cl <- match.call()
cl[[1]] <- fun
eval.parent(cl)
}
formals(fun2) <- formals(args(fun))
fun2
}
Demo:
foo <- function(x, y) x + y
foo2 <- counter_decorator(foo)
get(".counter", envir = environment(foo2))
# [1] 0
foo2(5, 9)
# [1] 14
foo2(5, 11)
# [1] 16
foo2(5, 13)
# [1] 18
get(".counter", envir = environment(foo2))
# [1] 3
Same formals:
formals(foo)
# $x
# $y
formals(foo2)
# $x
# $y
Edited (twice) to better track primitives where formals(.) is NULL; in that case, we can use formals(args(fun)).
Adapted for your preferred methodology, albeit with a little poetic liberty:
counters <- local({
.counters <- list()
function(init = FALSE) {
out <- .counters # will return counters *before* initialization
if (init) .counters <<- list()
out
}
})
counter_decorator <- function(fun, fun_name) {
if (missing(fun_name)) {
fun_name <- deparse(substitute(fun))
}
count <- get(".counters", envir = environment(counters))
count[[fun_name]] <- 0L
assign(".counters", count, envir = environment(counters))
fun2 <- function(...) {
.count <- get(".counters", envir = environment(counters))
.count[[fun_name]] <- if (is.null(.count[[fun_name]])) 1L else .count[[fun_name]] + 1L
assign(".counters", .count, envir = environment(counters))
cl <- match.call()
cl[[1]] <- fun
eval.parent(cl)
}
formals(fun2) <- formals(args(fun))
fun2
}
add_one <- function(x) {
x + 1
}
add_one <- counter_decorator(add_one)
add_two <- {function(x) {
x + 2
}} %>% counter_decorator(fun_name = "add_two")
new_mean <- counter_decorator(mean)
for (i in 1:100) {
add_one(1)
add_two(1)
new_mean(1)
}
counters()
# $add_one
# [1] 100
# $add_two
# [1] 100
# $mean
# [1] 100
formals(new_mean)
# $x
# $...
Initialization is not strictly required. Re-initialization returns the counters before reinitializing, so you don't need a double-call to get the values and then reset (and if you don't care about previous values, just ignore its return).
counters(TRUE)
# $add_one
# [1] 100
# $add_two
# [1] 100
# $mean
# [1] 100
counters()
# list()
add_one(10)
# [1] 11
counters()
# $add_one
# [1] 1
Is it possible to retrieve the function components of a function call? That is, is it possible to use as.list(match.call()) on another function call.
The background is, that I want to have a function that takes a function-call and returns the components of said function call.
get_formals <- function(x) {
# something here, which would behave as if x would be a function that returns
# as.list(match.call())
}
get_formals(mean(1:10))
# expected to get:
# [[1]]
# mean
#
# $x
# 1:10
The expected result is to have get_formals return as match.call() was called within the supplied function call.
mean2 <- function(...) {
as.list(match.call())
}
mean2(x = 1:10)
# [[1]]
# mean2
#
# $x
# 1:10
Another Example
The motivation behind this question is to check if a memoised function already contains the cached values. memoise has the function has_cache() but it needs to be called in a specific way has_cache(foo)(vals), e.g.,
library(memoise)
foo <- function(x) mean(x)
foo_cached <- memoise(foo)
foo_cached(1:10) # not yet cached
foo_cached(1:10) # cached
has_cache(foo_cached)(1:10) # TRUE
has_cache(foo_cached)(1:3) # FALSE
My goal is to log something if the function call is cached or not.
cache_wrapper <- function(f_call) {
is_cached <- has_cache()() # INSERT SOLUTION HERE
# I need to deconstruct the function call to pass it to has_cache
# basically
# has_cache(substitute(expr)[[1L]])(substitute(expr)[[2L]])
# but names etc do not get passed correctly
if (is_cached) print("Using Cache") else print("New Evaluation of f_call")
f_call
}
cache_wrapper(foo_cached(1:10))
#> [1] "Using Cache" # From the log-functionality
#> 5.5 # The result from the function-call
You can use match.call() to do argument matching.
get_formals <- function(expr) {
call <- substitute(expr)
call_matched <- match.call(eval(call[[1L]]), call)
as.list(call_matched)
}
get_formals(mean(1:10))
# [[1]]
# mean
#
# $x
# 1:10
library(ggplot2)
get_formals(ggplot(mtcars, aes(x = mpg, y = hp)))
# [[1]]
# ggplot
#
# $data
# mtcars
#
# $mapping
# aes(x = mpg, y = hp)
library(dplyr)
get_formals(iris %>% select(Species))
# [[1]]
# `%>%`
#
# $lhs
# iris
#
# $rhs
# select(Species)
Edit: Thanks for #KonradRudolph's suggestion!
The function above finds the right function. It will search in the scope of the parent of get_formals(), not in that of the caller. The much safer way is:
get_formals <- function(expr) {
call <- substitute(expr)
call_matched <- match.call(eval.parent(bquote(match.fun(.(call[[1L]])))), call)
as.list(call_matched)
}
The match.fun() is important to correctly resolve functions that are shadowed by a non-function object of the same name. For example, if mean is overwrited with a vector
mean <- 1:5
The first example of get_formals() will get an error, while the updated version works well.
Here's a way to do it that also gets the default values from the function if you didn't supply all the arguments:
get_formals <- function(call)
{
f_list <- as.list(match.call()$call)
func_name <- f_list[[1]]
p_list <- formals(eval(func_name))
f_list <- f_list[-1]
ss <- na.omit(match(names(p_list), names(f_list)))
if(length(ss) > 0) {
p_list[na.omit(match(names(f_list), names(p_list)))] <- f_list[ss]
f_list <- f_list[-ss]
}
unnamed <- which(!nzchar(sapply(p_list, as.character)))
if(length(unnamed) > 0)
{
i <- 1
while(length(f_list) > 0)
{
p_list[[unnamed[i]]] <- f_list[[1]]
f_list <- f_list[-1]
i <- i + 1
}
}
c(func_name, p_list)
}
Which gives:
get_formals(rnorm(1))
[[1]]
rnorm
$n
[1] 1
$mean
[1] 0
$sd
[1] 1
get_formals(ggplot2::ggplot())
[[1]]
ggplot2::ggplot
$data
NULL
$mapping
aes()
$...
$environment
parent.frame()
To get this to work one level in you could do something like:
foo <- function(f_call) {
eval(as.call(list(get_formals, call = match.call()$f_call)))
}
foo(mean(1:10))
[[1]]
mean
$x
1:10
$...
This answer is mostly based on Allens answer, but implements Konrads comment regarding the eval and eval.parent functions.
Additionally, some do.call is thrown in to finalise the cache_wrapper from the example above:
library(memoise)
foo <- function(x) mean(x)
foo_cached <- memoise(foo)
foo_cached(1:10) # not yet cached
#> [1] 5.5
foo_cached(1:10) # cached
#> [1] 5.5
has_cache(foo_cached)(1:10)
#> [1] TRUE
has_cache(foo_cached)(1:3)
#> [1] FALSE
# As answered by Allen with Konrads comment
get_formals <- function(call) {
f_list <- as.list(match.call()$call)
func_name <- f_list[[1]]
# changed eval to eval.parent as suggested by Konrad...
p_list <- formals(eval.parent(eval.parent(bquote(match.fun(.(func_name))))))
f_list <- f_list[-1]
ss <- na.omit(match(names(p_list), names(f_list)))
if(length(ss) > 0) {
p_list[na.omit(match(names(f_list), names(p_list)))] <- f_list[ss]
f_list <- f_list[-ss]
}
unnamed <- which(!nzchar(sapply(p_list, as.character)))
if(length(unnamed) > 0) {
i <- 1
while(length(f_list) > 0) {
p_list[[unnamed[i]]] <- f_list[[1]]
f_list <- f_list[-1]
i <- i + 1
}
}
c(func_name, p_list)
}
# check if the function works with has_cache
fmls <- get_formals(foo_cached(x = 1:10))
do.call(has_cache(eval(parse(text = fmls[1]))),
fmls[2])
#> [1] TRUE
# implement a small wrapper around has_cache that reports if its using cache
cache_wrapper <- function(f_call) {
fmls <- eval(as.call(list(get_formals, call = match.call()$f_call)))
is_cached <- do.call(has_cache(eval(parse(text = fmls[1]))),
fmls[2])
if (is_cached) print("Using Cache") else print("New Evaluation of f_call")
f_call
}
cache_wrapper(foo_cached(x = 1:10))
#> [1] "Using Cache"
#> [1] 5.5
cache_wrapper(foo_cached(x = 1:30))
#> [1] "New Evaluation of f_call"
#> [1] 5.5
Building on this SO question here I want to write a function that manipulates other functions by (1) setting each line visible () and by (2) wrapping withAutoprint({}) around the body of the function. First, I though some call to trace() would yield my desired result, but somehow I can't figure it out.
Here is a simple example:
# Input function foo
foo <- function(x)
{
line1 <- x
line2 <- 0
line3 <- line1 + line2
return(line3)
}
# some function which alters foo (here called make_visible() )
foo2 <- make_visible(foo)
# so that foo2 looks like this after being altered
foo2 <- function(x)
{
withAutoprint({
(line1 <- x)
(line2 <- 0)
(line3 <- line1 + line2)
(return(line3))
})
}
# example of calling foo2 and desired output/result
> foo2(2)
> (line1 <- x)
[1] 2
> (line2 <- 0)
[1] 0
> (line3 <- line1 + line2)
[1] 2
> (return(line3))
[1] 2
background / motivation
Turning functions visible line by line is helpful with longer custom functions when no real error is thrown, but the functions takes a wrong turn and returns and unwanted output. The alternative is using the debugger clicking next and checking each variable step by step. A function like make_visible might save some time here.
Use case
I see an actual use case for this kind of function, when debugging map or lapply functions which do not through an error, but produce an undesired result somewhere in the function that is being looped over.
Here's a solution that creates exactly the body of the solution you proposed in your question, with the addition of the 2 tests you used in your answer :
make_visible <- function(f) {
if (typeof(f) %in% c("special", "builtin")) {
stop("make_visible cannot be applied to primitive functions")
}
if (! typeof(f) %in% "closure") {
stop("make_visible only takes functions of type closures as argument")
}
f2 <- f
bod <- body(f)
if(!is.call(bod) || !identical(bod[[1]], quote(`{`)))
bod <- call("(",body(f))
else
bod[-1] <- lapply(as.list(bod[-1]), function(expr) call("(", expr))
body(f2) <- call("[[",call("withAutoprint", bod),"value")
f2
}
# solve foo issue with standard adverb way
foo <- function(x)
{
line1 <- x
line2 <- 0
line3 <- line1 + line2
return(line3)
}
foo2 <- make_visible(foo)
foo2
#> function (x)
#> withAutoprint({
#> (line1 <- x)
#> (line2 <- 0)
#> (line3 <- line1 + line2)
#> (return(line3))
#> })[["value"]]
foo2(2)
#> > (line1 <- x)
#> [1] 2
#> > (line2 <- 0)
#> [1] 0
#> > (line3 <- line1 + line2)
#> [1] 2
#> > (return(line3))
#> [1] 2
#> [1] 2
Here's another take, printing nicer as your own second proposal :
make_visible2 <- function(f) {
if (typeof(f) %in% c("special", "builtin")) {
stop("make_visible cannot be applied to primitive functions")
}
if (! typeof(f) %in% "closure") {
stop("make_visible only takes functions of type closures as argument")
}
f2 <- f
bod <- body(f)
if(!is.call(bod) || !identical(bod[[1]], quote(`{`))) {
bod <- bquote({
message(deparse(quote(.(bod))))
print(.(bod))
})
} else {
bod[-1] <- lapply(as.list(bod[-1]), function(expr) {
bquote({
message(deparse(quote(.(expr))))
print(.(expr))
})
})
}
body(f2) <- bod
f2
}
foo3 <- make_visible2(foo)
foo3
#> function (x)
#> {
#> {
#> message(deparse(quote(line1 <- x)))
#> print(line1 <- x)
#> }
#> {
#> message(deparse(quote(line2 <- 0)))
#> print(line2 <- 0)
#> }
#> {
#> message(deparse(quote(line3 <- line1 + line2)))
#> print(line3 <- line1 + line2)
#> }
#> {
#> message(deparse(quote(return(line3))))
#> print(return(line3))
#> }
#> }
foo3(2)
#> line1 <- x
#> [1] 2
#> line2 <- 0
#> [1] 0
#> line3 <- line1 + line2
#> [1] 2
#> return(line3)
#> [1] 2
I figured out two different approaches to my own question above. Both of them use something I would call 'deep function hacking' which is probably not a recommended way of doing this - at least it doesn't look like one should be doing this at all. Before playing around I didn't know this was even possible. Probably there are cleaner and more recommended ways of doing this, therefore I leave this questions open for other approaches.
First approach
I call the function of the first approach make_visible. Basically, this function constructs a new function using the body parts of foo and wrapping those with for loops in ( and then in withAutoprint. It is quite hacky, and only works on the first level of a function (it won't show the deeper structure of, for example, functions that use pipes).
make_visible <- function(.fx) {
if (typeof(.fx) %in% c("special", "builtin")) {
stop("`make_visible` cannot be applied to primitive functions")
}
if (! typeof(.fx) %in% "closure") {
stop("`make_visible` only takes functions of type closures as argument")
}
# make environment of .fx parent environment of new function environment
org_e <- environment()
fct_e <- environment(.fx)
parent.env(org_e) <- fct_e
# get formals and body of input function .f
fct_formals <- formals(.fx)
fct_body <- body(.fx)[-1]
# create a minimal example function for `(`
.f1 <- function(x) {
(x)
}
# extract its body
.f1_body <- body(.f1)[-1]
# build a new function .f2 by combining .f and .f1
.f2 <- function() {}
for (i in seq_along(1:length(fct_body))) {
.f1_body[[1]][[2]]<- fct_body[[i]]
body(.f2)[[1+i]] <- .f1_body[[1]]
}
# extract the body of new function .f2
.f2_body <- body(.f2)[-1]
# create a minimal example function .f3 for `withAutoprint`
.f3 <- function() {
withAutoprint({
x
})
}
# insert body part of .f2 into .f3
for (j in seq_along(1:length(.f2_body))) {
body(.f3)[[2]][[2]][[1+j]] <- .f2_body[[j]]
}
# give .f3 the formals of input function
formals(.f3) <- fct_formals
# return .f3 as new function
.f3
}
Which yields the following outcome:
foo2 <- make_visible(foo)
foo2(1)
> (line1 <- x)
> [1] 1
> (line2 <- 0)
> [1] 0
> (line3 <- line1 + line2)
> [1] 1
> (return(line3))
> [1] 1
This approach has a couple of downsides:
1. Wrapping the output of each line into brackets reduced the readability
2. Further, this approach returns a not the value of the original function, but a list with two elements, the original result value and a logical vector visible, which makes it harder to use the output of this function, especially when using it inside a map call.
foo2(1) %>% str
# > (line1 <- x)
# [1] 1
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 1
# > (return(line3))
# [1] 1
# List of 2
# $ value : num 1
# $ visible: logi TRUE
purrr::map(1:3, foo2)
# > (line1 <- x)
# [1] 1
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 1
# > (return(line3))
# [1] 1
# > (line1 <- x)
# [1] 2
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 2
# > (return(line3))
# [1] 2
# > (line1 <- x)
# [1] 3
# > (line2 <- 0)
# [1] 0
# > (line3 <- line1 + line2)
# [1] 3
# > (return(line3))
# [1] 3
# [[1]]
# [[1]]$value
# [1] 1
#
# [[1]]$visible
# [1] TRUE
#
#
# [[2]]
# [[2]]$value
# [1] 2
#
# [[2]]$visible
# [1] TRUE
#
#
# [[3]]
# [[3]]$value
# [1] 3
#
# [[3]]$visible
# [1] TRUE
Second approach
While make_visible is a direct approach on my idea of rewriting a function by making each line visible and wrapping it in withAutoprint the second approach rethinks the problem. It is a similar 'deep function hack', looping over body parts of the original function, but this time (1) printing them to console, (2) capturing their evaluated output, (3) printing this output to console, and then (4) actually evaluating each body part. Finally the original function is called and returned invisibly.
reveal <- function(.fx) {
if (typeof(.fx) %in% c("special", "builtin")) {
stop("`reveal` cannot be applied to primitive functions")
}
if (! typeof(.fx) %in% "closure") {
stop("`reveal` only takes functions of type closures as argument")
}
# environment handling
# get environment of .fx and make it parent.env of reveal
org_e <- environment()
fct_e <- environment(.fx)
parent.env(org_e) <- fct_e
# get formals of .fx
fct_formals <- formals(.fx)
# get body of .fx without first part {
fct_body <- body(.fx)[-1]
# define new function to return
.f2 <- function() {
# loop over the body parts of .fx
for (.i in seq_along(1:length(fct_body))) {
# print each body part
cat(paste0(as.list(fct_body)[.i],"\n"))
# check whether eval returns output and if not use eval_tidy
if (length(capture.output(eval(fct_body[[.i]]))) == 0) {
# write output of eval as string
out <- capture.output(rlang::eval_tidy(fct_body[[.i]]))
} else {
# write output of eval as string
out <- capture.output(eval(fct_body[[.i]]))
}
# print output of evaluation
cat(out, sep = "\n")
# evaluate
eval(fct_body[[.i]])
}
# get arguments
.args <- match.call(expand.dots = FALSE)[-1]
# run .fx with .args and return result invisibly
invisible(do.call(.fx, as.list(.args)))
}
# replace formals of .f2 with formals of .fx
formals(.f2) <- fct_formals
# replace environment of .f2 with env of reveal to which env of .fx is a parent environment
environment(.f2) <- org_e
# return new function .f2
.f2
}
The output looks similar but somewhat cleaner:
reveal(foo)(1)
> line1 <- x
> [1] 1
> line2 <- 0
> [1] 0
> line3 <- line1 + line2
> [1] 1
> return(line3)
> [1] 1
This second approach is better because it's more readable and it returns the same value as the original function. However, at the moment I havent't been able to make it work inside a map call. This is probably due to messing with the function environments.
foo2 <- reveal(foo)
purrr::map(1:3, foo2)
#> Error in (function (x) : object '.x' not found
I have a list like this:
x <- 1
y <- 2
z <- "something"
my_list <- list("x" = x, "y" = y, "z" = z)
> my_list
$x
[1] 1
$y
[1] 2
$z
"something"
in truth my list is very long including big text elements such that in output I can not recognise them easily. Therefore I want to put a dashed line after every element of the list in Output like
$x
[1] 1
-------------------------------------
$y
[1] 2
-------------------------------------
$z
[1] "something"
-------------------------------------
Something like this could work.
mylistprint <- function(x){
nn <- names(x)
ll <- length(x)
if (length(nn) != ll) {
nn <- paste("Component", seq.int(ll))
}
for (i in seq_len(ll)) {
cat(nn[i], ":\n")
print(x[[i]])
cat("\n")
cat(strrep("-", 25))
cat("\n")
}
invisible(x)
}
mylistprint(my_list)
The output of this would be:
x :
[1] 1
-------------------------
y :
[1] 2
-------------------------
z :
[1] "something"
-------------------------
Using mapply
Probably a nicer way to do this is using mapply, or at least it is much shorter.
fun1 <- function(x,y) cat(paste0('$', x), y,strrep("-", 25), sep = '\n')
x <- mapply(fun1, names(my_list), my_list)
This prints:
$x
1
-------------------------
$y
2
-------------------------
$z
something
-------------------------
Single line
x <- mapply(function(x,y) cat(paste0('$', x), y,strrep("-", 25), sep = '\n'), names(my_list), my_list)
Wrap it in a function if you want
print.list <- function(list) {
x <- mapply(function(x,y) cat(paste0('$', x), y,strrep("-", 25), sep = '\n'), names(list), list)
}
From my comments, you could run a for loop, printing each element of a list, then printing "--------...-----", then the next element of a list, put this into a function and you are done, for example,
lsprint <- function(list){
for (i in 1:length(list)){
print(names(my_list)[i])
print(my_list[[i]])
print('--------------------')
}
}
lsprint(my_list)
Returns,
[1] "x"
[1] 1
[1] "--------------------"
[1] "y"
[1] 2
[1] "--------------------"
[1] "z"
[1] "something"
[1] "--------------------"
Edit: Added so you get the name
As part of a function, I want to output a list of all the arguments and their values, including the default values. For example, a function with these arguments:
foo <- function(x=NULL,y=NULL,z=2) {
#formals()
#as.list(match.call())[-1]
#some other function?....
}
To give output as such:
> foo(x=4)
$x
[1] 4
$y
NULL
$z
[1] 2
formals does not update to give the values argument values when the function is called. match.call does, but does not provide the defaults of the arguments. Is there another function out there that will provide the output as I want?
Hopefully, this doesn't lead to dragons.
foo <- function(x=NULL,y=NULL,z=2) {
mget(names(formals()),sys.frame(sys.nframe()))
}
foo(x=4)
$x
[1] 4
$y
NULL
$z
[1] 2
print(foo(x=4))
$x
[1] 4
$y
NULL
$z
[1] 2
you can use a mix of the 2 , match.call and formals
foo <- function(x=NULL,y=NULL,z=2)
{
ll <- as.list(match.call())[-1] ##
myfor <- formals(foo) ## formals with default arguments
for ( v in names(myfor)){
if (!(v %in% names(ll)))
ll <- append(ll,myfor[v]) ## if arg is missing I add it
}
ll
}
For example :
foo(y=2)
$y
[1] 2
$x
NULL
$z
[1] 2
> foo(y=2,x=1)
$x
[1] 1
$y
[1] 2
$z
[1] 2
Here is an attempt to wrap this logic in a reusable function to drop in instead of match.call:
match.call.defaults <- function(...) {
call <- evalq(match.call(expand.dots = FALSE), parent.frame(1))
formals <- evalq(formals(), parent.frame(1))
for(i in setdiff(names(formals), names(call)))
call[i] <- list( formals[[i]] )
match.call(sys.function(sys.parent()), call)
}
It looks like it works:
foo <- function(x=NULL,y=NULL,z=2,...) {
match.call.defaults()
}
> foo(nugan='hand', x=4)
foo(x = 4, y = NULL, z = 2, ... = pairlist(nugan = "hand"))
foo <- function(x=NULL,y=NULL,z=2) {
X <- list(x,y,z); names(X) <- names(formals()); X
}
z <- foo(4)
z
#------
$x
[1] 4
$y
NULL
$z
[1] 4