Extract function parameters and default values from any function - r

Is there a way to extract the parameters and their respective default values of any given function from outside the function?
For example, given:
myfunc <- function(a, b = 1) { print(c(a, b)) }
I'm looking for some function that will return:
list(a = NULL, b = 1)
or some variation thereof.

You are looking for formals().
formals(myfunc)
# $a
#
#
# $b
# [1] 1
If you needed NULL for a, you could do some checking. a will be of the "name" class and empty.
lapply(formals(myfunc), function(x) if(is.name(x) & !nzchar(x)) NULL else x)
# $a
# NULL
#
# $b
# [1] 1

Related

When returning a function with a passed parameter, how does the parameter get stored?

Below is a contrived example of passing a parameter to a returned function. I would like to have the returned function evaluate param to 2, and in fact, that's what it does!!
However, how does this work? When I print the function, it shows "param" and not "2". But when I debug(), I confirm that param is in fact 2.
f <- function(x, param = 2) {
my_cdf <- ecdf(x)
function(new_x) {
my_cdf(new_x) * param
}
}
g <- f(1:10)
g
# > function(new_x) {
# > my_cdf(new_x) * param
# > }
As param is not defined in the function in which it is used, param is looked up in the environment in wihch the function that uses it was defined and param = 2 in that environment. This is referred to as lexical scoping.
If you want to have param actually substituted into the function then try substitute like this:
f <- function(x, param = 2) {
my_cdf <- ecdf(x)
F <- function(new, x)
my_cdf(new_x) * param
body(F) <- do.call("substitute", list(body(F), list(param = param)))
F
}
f(1:10)
This chapter from Advanced R has greater detail on what is happening.
A few examples from that chapter:
as.list(environment(g))
# $my_cdf
# Empirical CDF
# Call: ecdf(x)
# x[1:10] = 1, 2, 3, ..., 9, 10
#
# $x
# [1] 1 2 3 4 5 6 7 8 9 10
#
# $param
# [1] 2
library(pryr)
unenclose(g)
# function (new_x)
# {
# (function (v)
# .approxfun(x, y, v, method, yleft, yright, f))(new_x) * 2
# }

How do I extract arguments in a function (written as a string) in R?

Let suppose I have defined a function by f <- function(x,y,z) {...}.
I would like to be able to transform an expression calling that function into a list of the parameters called by that function; it is the opposite of the do.call function.
For example, let us say I have such a function f, and I also have a string "f(2,1,3)".
How can I transform the string "f(2,1,3)" into the list of the parameters list(x=1,y=2,z=3)?
After you've parsed your character string into an R expression, use match.call() to match supplied to formal arguments.
f <- function(x,y,z) {}
x <- "f(1,2,3)"
ee <- parse(text = x)[[1]]
cc <- match.call(match.fun(ee[[1]]), ee)
as.list(cc)[-1]
# $x
# [1] 1
#
# $y
# [1] 2
#
# $z
# [1] 3
Alternatively:
f <- function(x,y,z) {...}
s <- "f(x = 2, y = 1, z = 3)"
c <- as.list(str2lang(s))
c[-1]
# $x
# [1] 2
#
# $y
# [1] 1
#
# $z
# [1] 3
I was looking for a solution to this a while ago in order to reconstruct a function call from a string. Hopefully this will be of use to someone who is looking for a solution to a similar problem.

R populate list by its values

Say I have a list:
> fs
[[1]]
NULL
[[2]]
NULL
[[3]]
NULL
[[4]]
[1] 61.90298 58.29699 54.90104 51.70293 48.69110
I want to "reverse fill" the rest of the list by using it's values. Example:
The [[3]] should have the function value of [[4]] pairs:
c( myFunction(fs[[4]][1], fs[[4]][2]), myFunction(fs[[4]][2], fs[[4]][3]), .... )
The [[2]] should have myFunction values of [[3]] etc...
I hope that's clear. What's the right way to do it? For loops? *applys? My last attempt, which leaves 1-3 empty:
n = length(fs)
for (i in rev(1:(n-1)))
child_fs = fs[[i+1]]
res = c()
for (j in 1:(i+1))
up = v(child_fs[j])
do = v(child_fs[j+1])
this_f = myFunction(up, do)
res[j] = this_f
fs[[i]] = res
Make fs easily reproducible
fs <- list(NULL, NULL, NULL, c(61.90298, 58.29699, 54.90104, 51.70293, 48.69110))
To be able to show an example, make a trivial myFunction
myFunction <- function(a, b) {a + b}
You can loop over all but the last positions in fs (in reverse order), and compute each. Just call myFunciton with the vectors which are the next higher position's vectors without the last and without the first element.
for (i in rev(seq_along(fs))[-1]) {
fs[[i]] <- myFunction(head(fs[[i+1]], -1), tail(fs[[i+1]], -1))
}
That assumes myFunction is vectorized (given vectors for inputs, will give a vector for output). If it isn't, you can easily make a version which is.
myFunction <- function(a, b) {a[[1]] + b[[1]]}
for (i in rev(seq_along(fs))[-1]) {
fs[[i]] <- Vectorize(myFunction)(head(fs[[i+1]], -1), tail(fs[[i+1]], -1))
}
In either case, you get
> fs
[[1]]
[1] 453.2 426.8
[[2]]
[1] 233.398 219.802 206.998
[[3]]
[1] 120.200 113.198 106.604 100.394
[[4]]
[1] 61.90298 58.29699 54.90104 51.70293 48.69110
Really, what you have is a starting point
start <- c(61.90298, 58.29699, 54.90104, 51.70293, 48.69110)
a function you want to apply (I made this one up which adds 1 everywhere and deletes the last element)
myFunction <- function(x) head(x + 1, -1L)
and the number of times you want to apply the function (recursively):
n <- 3L
So I would write a function to apply the function n times recursively, then reverse the output list:
apply.n.times <- function(fun, n, x)
if (n == 0L) list(x) else c(list(x), Recall(fun, n - 1L, fun(x)))
rev(apply.n.times(myFunction, n, start))
# [[1]]
# [1] 64.90298 61.29699
#
# [[2]]
# [1] 63.90298 60.29699 56.90104
#
# [[3]]
# [1] 62.90298 59.29699 55.90104 52.70293
#
# [[4]]
# [1] 61.90298 58.29699 54.90104 51.70293 48.69110
Here is a one-line solution (if myFunction can be replaced with something like sum, or in this case rowSums):
Reduce( function(x,y) rowSums( embed(y,2) ), fs, right=TRUE, accumulate=TRUE )
If myFunction needs to accept 2 values and do something with them then this can be expanded a bit to:
Reduce( function(x,y) apply( embed(y,2), 1, function(z) myFunction(z[1],z[2]) ),
fs, right=TRUE, accumulate=TRUE )

match.call with default arguments

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

R - merge lists with overwrite and recursion

Suppose I have two lists with names,
a = list( a=1, b=2, c=list( d=1, e=2 ), d=list( a=1, b=2 ) )
b = list( a=2, c=list( e=1, f=2 ), d=3, e=2 )
I'd like to recursively merge those lists, overwriting entries if the second argument contains conflicting values. I.e. the expected output would be
$a
[1] 2
$b
[1] 2
$c
$c$d
[1] 1
$c$e
[1] 1
$c$f
[1] 2
$d
[1] 3
$e
[1] 2
Any hint?
I am not so sure if a custom function is necessary here. There is a function utils::modifyList() to perform this exact same operation! See modifyList for more info.
a <- list( a=1, b=2, c=list( d=1, e=2 ), d=list( a=1, b=2 ) )
b <- list( a=2, c=list( e=1, f=2 ), d=3, e=2 )
modifyList(a, b) # updates(modifies) 'a' with 'b'
Which gives the following
$a
[1] 2
$b
[1] 2
$c
$c$d
[1] 1
$c$e
[1] 1
$c$f
[1] 2
$d
[1] 3
$e
[1] 2
I think you'll have to write your own recursive function here.
A function that takes in two lists, list1 and list2.
If:
list1[[name]] exists but not list2[[name]], use list1[[name]];
list1[[name]] exists as well as list2[[name]] and both are not lists, use list2[[name]];
otherwise, recurse with list1[[name]] and list2[[name]] as the new lists.
Something like:
myMerge <- function (list1, list2) {
allNames <- unique(c(names(list1), names(list2)))
merged <- list1 # we will copy over/replace values from list2 as necessary
for (x in allNames) {
# convenience
a <- list1[[x]]
b <- list2[[x]]
if (is.null(a)) {
# only exists in list2, copy over
merged[[x]] <- b
} else if (is.list(a) && is.list(b)) {
# recurse
merged[[x]] <- myMerge(a, b)
} else if (!is.null(b)) {
# replace the list1 value with the list2 value (if it exists)
merged[[x]] <- b
}
}
return(merged)
}
Caveats - if your lists to be merged are weird, you might get weird output. For example:
a <- list( a=list(a=1, b=2), b=3 )
b <- list( a=2 )
Then your merged list has a=2, b=3. This is because the value from b$a overrides the value from a$a, even though a$a is a list (you did not specify what would happen if this were the case). However it is simple enough to modify myMerge to handle these sorts of cases. Just remember - use is.list to test if it's a list, and is.null(myList$a) to see if entry a exists in list myList.
Here is the "vectorized" version using sapply:
merge.lists <- function(a, b) {
a.names <- names(a)
b.names <- names(b)
m.names <- sort(unique(c(a.names, b.names)))
sapply(m.names, function(i) {
if (is.list(a[[i]]) & is.list(b[[i]])) merge.lists(a[[i]], b[[i]])
else if (i %in% b.names) b[[i]]
else a[[i]]
}, simplify = FALSE)
}

Resources