I'm using the following construct in a package,
## two functions in the global environment
funa <- function(x) x^2
funb <- function(x) x^3
## called within a function, fine
fun_wrap <- function(){
lapply(c('funa', 'funb'), do.call, list(x=3))
}
fun_wrap()
[[1]]
[1] 9
[[2]]
[1] 27
but I've just been bitten by the fact that it won't work if the functions are in a different (local) frame,
## same construct, but the functions are local
fun_wrap1 <- function(){
funa1 <- function(x) x^2
funb1 <- function(x) x^3
lapply(c('funa1', 'funb1'), do.call, list(x=3))
}
## now it fails
fun_wrap1()
##Error in FUN(c("funa1", "funb1")[[1L]], ...) :
## could not find function "funa1"
I've tried passing envir=parent.frame(2) to do.call() (doesn't work); frankly the help page of ?parent.frame goes way over my head. Any hint for a more robust use of do.call?
Note that the list of functions comes as a character vector, passed from another piece of code; I prefer not to pass the functions directly.
Edit: one more twist... I thought I'd illustrated the right problem with my toy example, but the actual code I'm using is slightly different, in the sense that I'm calling fun_wrap1 within a separate function. The proposed solutions fail in this context.
fun_wrap1 <- function(funs){
lapply(funs, do.call, args=list(x=3), envir=environment())
}
foo <- function(){
funa1 <- function(x) x^2
funb1 <- function(x) x^3
fun_wrap1(c('funa1', 'funb1'))
}
foo()
##Error in FUN(c("funa1", "funb1")[[1L]], ...) :
## could not find function "funa1"
(and the same happens with the match.fun approach)
I can get it to work by passing an optional environment to fun_wrap1,
fun_wrap1 <- function(funs, e=parent.frame()){
lapply(funs, do.call, args=list(x=3), envir=e)
}
foo <- function(){
funa1 <- function(x) x^2
funb1 <- function(x) x^3
fun_wrap1(c('funa1', 'funb1'))
}
foo()
and that's hopefully it.
This seems to work, but i'm not sure if it has other implications I'm not considering:
fun_wrap1 <- function(){
funa1 <- function(x) x^2
funb1 <- function(x) x^3
lapply(c('funa1', 'funb1'), do.call, args=list(x=3), envir=environment())
}
fun_wrap1()
#[[1]]
#[1] 9
#
#[[2]]
#[1] 27
So this is essentially equivalent to having the lapply statement as:
lapply(
c('funa1', 'funb1'),
function(f) do.call(f, args=list(x=3), envir=environment() )
)
Evidently if we evaluate the functions in fun_wrap2 it works. The problem with the approach in the question is that the character strings get converted to functions inside one of the processing functions which changes the lookup path.
fun_wrap2 <- function(){
funa1 <- function(x) x^2
funb1 <- function(x) x^3
nms <- c("funa1", "funb1")
funs <- lapply(nms, match.fun)
lapply(funs, do.call, list(x=3))
}
fun_wrap2()
A slightly simpler version of #g-grothendieck's answer. Rather than using the function names, we just put the functions themselves into the list that is fed to lapply.
fun_wrap1 <- function(){
funa1 <- function(x) x^2
funb1 <- function(x) x^3
lapply(list(funa1, funb1), do.call, list(x=3))
}
fun_wrap1()
Related
I am facing some problem with the apply function passing on arguments to a function when not needed. I understand that apply don't know what to do with the optional arguments and just pass them on the function.
But anyhow, here is what I would like to do:
First I want to specify a list of functions that I would like to use.
functions <- list(length, sum)
Then I would like to create a function which apply these specified functions on a data set.
myFunc <- function(data, functions) {
for (i in 1:length(functions)) print(apply(X=data, MARGIN=2, FUN=functions[[i]]))
}
This works fine.
data <- cbind(rnorm(100), rnorm(100))
myFunc(data, functions)
[1] 100 100
[1] -0.5758939 -5.1311173
But I would also like to use additional arguments for some functions, e.g.
power <- function(x, p) x^p
Which don't work as I want to. If I modify myFunc to:
myFunc <- function(data, functions, ...) {
for (i in 1:length(functions)) print(apply(X=data, MARGIN=2, FUN=functions[[i]], ...))
}
functions as
functions <- list(length, sum, power)
and then try my function I get
myFunc(data, functions, p=2)
Error in FUN(newX[, i], ...) :
2 arguments passed to 'length' which requires 1
How may I solve this issue?
Sorry for the wall of text. Thank you!
You can use Curry from functional to fix the parameter you want, put the function in the list of function you want to apply and finally iterate over this list of functions:
library(functional)
power <- function(x, p) x^p
funcs = list(length, sum, Curry(power, p=2), Curry(power, p=3))
lapply(funcs, function(f) apply(data, 2 , f))
With your code you can use:
functions <- list(length, sum, Curry(power, p=2))
myFunc(data, functions)
I'd advocate using Colonel's Curry approach, but if you want to stick to base R you can always:
funcs <- list(length, sum, function(x) power(x, 2))
which is roughly what Curry ends up doing
One option is to pass the parameters in a list with the arguments needed for each function. You can add those parameters to the others needed for apply using c and then use do.call to call the function. Something like this. I also wrap all the output in a list here rather than using print; your usage may vary.
power <- function(x, p) x^p
myFunc <- function(data, functions, parameters) {
lapply(seq_along(functions), function(i) {
p0 <- list(X=data, MARGIN=2, FUN=functions[[i]])
do.call(apply, c(p0, parameters[[i]]))
})
}
d <- matrix(1:6, nrow=2)
functions <- list(length, sum, power)
parameters <- list(NULL, NULL, p=3)
myFunc(d, functions, parameters)
You can use lazyeval package:
library(lazyeval)
my_evaluate <- function(data, expressions, ...) {
lapply(expressions, function(e) {
apply(data, MARGIN=2, FUN=function(x) {
lazy_eval(e, c(list(x=x), list(...)))
})
})
}
And use it like this:
my_expressions <- lazy_dots(sum = sum(x), sumpow = sum(x^p), length_k = length(x)*k )
data <- cbind(rnorm(100), rnorm(100))
my_evaluate(data, my_expressions, p = 2, k = 2)
Certainly a very basic question but I do not have the answer:
I have a vector of function:
func1 <- function(u) u
func2 <- function(u) NA
func3 <- function(u) 1
funcs = c(func1, func2, func3)
I loop over every function using sapply, and I want to find a function command that retrieves the name of the function:
res=sapply(funcs, function(f){
command(f)
})
So that res is then:
c("func1","func2","func3")
Although there is no way to get the names if funcs is created with c, here is a convenience function for creating funcs that preserves the names:
cn <- function(...)
{
# call c() on parameters supplied, adding names
cnames <- sapply(as.list(substitute(list(...)))[-1L],as.character)
out <- c(...)
names(out) <- cnames
return(out)
}
funcs = cn(func1, func2, func3)
How about this approach:
flist<-ls(patt='func*')
flist[1]
[1] "func1"
do.call(flist[1],list(5))
# 5
So consider the following chunk of code which does not work as most people might expect it to
#cartoon example
a <- c(3,7,11)
f <- list()
#manual initialization
f[[1]]<-function(x) a[1]+x
f[[2]]<-function(x) a[2]+x
f[[3]]<-function(x) a[3]+x
#desired result for the rest of the examples
f[[1]](1)
# [1] 4
f[[3]](1)
# [1] 12
#attempted automation
for(i in 1:3) {
f[[i]] <- function(x) a[i]+x
}
f[[1]](1)
# [1] 12
f[[3]](1)
# [1] 12
Note that we get 12 both times after we attempt to "automate". The problem is, of course, that i isn't being enclosed in the function's private environment. All the functions refer to the same i in the global environment (which can only have one value) since a for loop does not seem to create different environment for each iteration.
sapply(f, environment)
# [[1]]
# <environment: R_GlobalEnv>
# [[2]]
# <environment: R_GlobalEnv>
# [[3]]
# <environment: R_GlobalEnv>
So I though I could get around with with the use of local() and force() to capture the i value
for(i in 1:3) {
f[[i]] <- local({force(i); function(x) a[i]+x})
}
f[[1]](1)
# [1] 12
f[[3]](1)
# [1] 12
but this still doesn't work. I can see they all have different environments (via sapply(f, environment)) however they appear to be empty (ls.str(envir=environment(f[[1]]))). Compare this to
for(i in 1:3) {
f[[i]] <- local({ai<-i; function(x) a[ai]+x})
}
f[[1]](1)
# [1] 4
f[[3]](1)
# [1] 12
ls.str(envir=environment(f[[1]]))
# ai : int 1
ls.str(envir=environment(f[[3]]))
# ai : int 3
So clearly the force() isn't working like I was expecting. I was assuming it would capture the current value of i into the current environment. It is useful in cases like
#bad
f <- lapply(1:3, function(i) function(x) a[i]+x)
#good
f <- lapply(1:3, function(i) {force(i); function(x) a[i]+x})
where i is passed as a parameter/promise, but this must not be what's happening in the for-loop.
So my question is: is possible to create this list of functions without local() and variable renaming? Is there a more appropriate function than force() that will capture the value of a variable from a parent frame into the local/current environment?
This isn't a complete answer, partly because I'm not sure exactly what the question is (even though I found it quite interesting!).
Instead, I'll just present two alternative for-loops that do work. They've helped clarify the issues in my mind (in particular by helping me to understand for the first time why force() does anything at all in a call to lapply()). I hope they'll help you as well.
First, here is one that's a much closer equivalent of your properly function lapply() call, and which works for the same reason that it does:
a <- c(3,7,11)
f <- list()
## `for` loop equivalent of:
## f <- lapply(1:3, function(i) {force(i); function(x) a[i]+x})
for(i in 1:3) {
f[[i]] <- {X <- function(i) {force(i); function(x) a[i]+x}; X(i)}
}
f[[1]](1)
# [1] 4
Second, here is one that does use local() but doesn't (strictly- or literally-speaking) rename i. It does, though, "rescope" it, by adding a copy of it to the local environment. In one sense, it's only trivially different from your functioning for-loop, but by focusing attention on i's scope, rather than its name, I think it helps shed light on the real issues underlying your question.
a <- c(3,7,11)
f <- list()
for(i in 1:3) {
f[[i]] <- local({i<-i; function(x) a[i]+x})
}
f[[1]](1)
# [1] 4
Will this approach work for you?
ff<-list()
for(i in 1:3) {
fillit <- parse(text=paste0('a[',i,']+x' ))
ff[[i]] <- function(x) ''
body(ff[[i]])[1]<-fillit
}
It's sort of a lower-level way to construct a function, but it does work "as you want it to."
An alternative for force() that would work in a for-loop local environment is
capture <- function(...) {
vars<-sapply(substitute(...()), deparse);
pf <- parent.frame();
Map(assign, vars, mget(vars, envir=pf, inherits = TRUE), MoreArgs=list(envir=pf))
}
Which can then be used like
for(i in 1:3) {
f[[i]] <- local({capture(i); function(x) a[i]+x})
}
(Taken from the comments in Josh's answer above)
I would like use a function that uses the standard deparse(substitute(x)) trick within lapply. Unfortunately I just get the argument of the loop back. Here's my completely useless reproducible example:
# some test data
a <- 5
b <- 6
li <- list(a1=a,b2=b)
# my test function
tf <- function(obj){
nm <- deparse(substitute(obj))
res <- list(myName=nm)
res
}
tf(a)
#returns
$myName
[1] "a"
which is fine. If I use lapply I either get [[1L]] or the x argument of an anonymous function.
lapply(li,function(x) tf(x))
# returns
$a1
$a1$myName
[1] "x"
$b2
$b2$myName
[1] "x"
Is there any way to obtain the following?
$a1
$a1$myName
[1] "a1"
$b2
$b2$myName
[1] "b1"
If there's anything more general on deparse(substitute(x)) and lapply I'd also eager to know.
EDIT:
The problem as opposed to using an anonymous function that accepts multiple arguments and can thus use the name of the object and the object itself does not work because, the tf function will only accept one argument. So this does not work here...
A possible solution :
lapply(li, function(x) {
call1 <- sys.call(1)
call1[[1]] <- as.name("names")
call1 <- call1[1:2]
nm <- eval(call1)
y <- deparse(substitute(x))
y <- gsub("\\D", "", y)
y <- as.numeric(y)
list(myname=nm[y])
})
This is not really a problem, but I'm wondering if there is a more elegant solution:
Lets say i have a vector vec <- rlnorm(10) and I want to apply a not vectorized function to it, e.g. exp (ignore for the moment that it is vectorized), I can do
sapply( vec, exp )
But when the function I want to apply is nested, the expression becomes directly less simple:
sapply( vec, function(x) exp( sqrt(x) ) )
This happens to me all the time with the apply and plyr family.
So my question is, is there in general an elegant way to nest (or pipe) functions without defining explicitly an (anonymous) function function(x){...}? Something like
# notrun
sapply( vec, sqrt | exp )
or similar.
See the examples for ?Reduce:
## Iterative function application:
Funcall <- function(f, ...) f(...)
## Compute log(exp(acos(cos(0))
Reduce(Funcall, list(log, exp, acos, cos), 0, right = TRUE)
Here's a more bare-bones implementation with a slightly different interface:
Compose <- function(x, ...)
{
lst <- list(...)
for(i in rev(seq_along(lst)))
x <- lst[[i]](x)
x
}
sapply(0, Compose, log, exp, acos, cos)
The package functional includes a Compose function.
library(functional)
id <- Compose(exp, log)
id(2) # 2
Its implementation is simple enough to include in your source, if, say, you don't need the rest of the stuff in the functional package.
R> Compose
function (...)
{
fs <- list(...)
if (!all(sapply(fs, is.function)))
stop("Argument is not a function")
function(...) Reduce(function(x, f) f(x), fs, ...)
}
<environment: namespace:functional>