I want to construct
f <- function(...) {
g <- function(x) x ^ 2
list(...)
}
so that I can invoke using f(g(4)) and have list(...) result in list(16).
In general I will define several temporary functions inside f that the user can invoke when calling f(...).
I have experimented with assign and newenvironment but have just gotten more confused. Help with an elegant solution is appreciated.
The reason for wanting this is that I want a function in the Hmisc package, drawPlot to be able to let the users specify generically named functions as input for building up a series of graphical elements, and I don't want to reserve these generic-type names. E.g.:
d <- drawPlot(Curve(), Points()) # interactively make a curve and
# a set of points
I'm guessing you in fact need something more elaborate than this, but the following does what you've asked for in your supplied example:
f <- function(...) {
g <- function(x) x ^ 2
list(eval(substitute(...)))
}
f(g(4))
# [[1]]
# [1] 16
Or, if users may supply one or more function calls, something like this:
f <- function(...) {
g <- function(x) x ^ 2
h <- function(x) 100*x
cc <- as.list(substitute(list(...))[-1])
res <- list()
for(i in seq_along(cc)) {
res[[i]] <- eval(cc[[i]])
}
res
}
f(g(4), h(5))
# [[1]]
# [1] 16
#
# [[2]]
# [1] 500
Very similar to this answer but I think maybe more extensible and closer to your original idea:
match.fun_wrapper <- function(...) {
# `match.fun` searches in the parent environment of the environment that
# calls `match.fun`, so this wrapper is a hack to be able to search in
# the current environment rather than the parent of the current environemnt
match.fun(...)
}
f <- function(fun, ...) {
g <- function(x) x ^ 2
fun <- match.fun_wrapper(substitute(fun))
fun(...)
}
If you wanted to do away with match.fun, you could also do away with the wrapper hack:
f <- function(fun, ...) {
g <- function(x) x ^ 2
fun(...)
}
It looks to me like what you're trying to do is something like this:
f <- function(fun, ...) {
g <- function(x) x ^ 2
h <- function(x) x ^ 3
i <- function(x) x ^ 4
switch(fun,
'g' = g(...),
'h' = h(...),
'i' = i(...))
}
> f('g', 3)
[1] 9
> f('h', 3)
[1] 27
> f('i', 3)
[1] 81
It's not obvious why you would want to, unless you're just trying to encapsulate functions with similar names inside different namespaces and using this as a hacky workaround for the fact R doesn't offer fully-featured classes. If that's the case, you can also just use actual namespaces, i.e. put your functions inside a package so they're called by package::g(arg) instead of f('g', arg).
Related
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)
For example, suppose I would like to be able to define a function that returned the name of the assignment variable concatenated with the first argument:
a <- add_str("b")
a
# "ab"
The function in the example above would look something like this:
add_str <- function(x) {
arg0 <- as.list(match.call())[[1]]
return(paste0(arg0, x))
}
but where the arg0 line of the function is replaced by a line that will get the name of the variable being assigned ("a") rather than the name of the function.
I've tried messing around with match.call and sys.call, but I can't get it to work. The idea here is that the assignment operator is being called on the variable and the function result, so that should be the parent call of the function call.
I think that it's not strictly possible, as other solutions explained, and the reasonable alternative is probably Yosi's answer.
However we can have fun with some ideas, starting simple and getting crazier gradually.
1 - define an infix operator that looks similar
`%<-add_str%` <- function(e1, e2) {
e2_ <- e2
e1_ <- as.character(substitute(e1))
eval.parent(substitute(e1 <- paste0(e1_,e2_)))
}
a %<-add_str% "b"
a
# "ab"
2 - Redefine := so that it makes available the name of the lhs to the rhs through a ..lhs() function
I think it's my favourite option :
`:=` <- function(lhs,rhs){
lhs_name <- as.character(substitute(lhs))
assign(lhs_name,eval(substitute(rhs)), envir = parent.frame())
lhs
}
..lhs <- function(){
eval.parent(quote(lhs_name),2)
}
add_str <- function(x){
res <- paste0(..lhs(),x)
res
}
a := add_str("b")
a
# [1] "ab"
There might be a way to redefine <- based on this, but I couldn't figure it out due to recursion issues.
3 - Use memory address dark magic to hunt lhs (if it exists)
This comes straight from: Get name of x when defining `(<-` operator
We'll need to change a bit the syntax and define the function fetch_name for this purpose, which is able to get the name of the rhs from a *<- function, where as.character(substitute(lhs)) would return "*tmp*".
fetch_name <- function(x,env = parent.frame(2)) {
all_addresses <- sapply(ls(env), pryr:::address2, env)
all_addresses <- all_addresses[names(all_addresses) != "*tmp*"]
all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)
x_address <- tracemem(x)
untracemem(x)
x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))
ind <- match(x_address_short, all_addresses_short)
x_name <- names(all_addresses)[ind]
x_name
}
`add_str<-` <- function(x,value){
x_name <- fetch_name(x)
paste0(x_name,value)
}
a <- NA
add_str(a) <- "b"
a
4- a variant of the latter, using .Last.value :
add_str <- function(value){
x_name <- fetch_name(.Last.value)
assign(x_name,paste0(x_name,value),envir = parent.frame())
paste0(x_name,value)
}
a <- NA;add_str("b")
a
# [1] "ab"
Operations don't need to be on the same line, but they need to follow each other.
5 - Again a variant, using a print method hack
Extremely dirty and convoluted, to please the tortured spirits and troll the others.
This is the only one that really gives the expected output, but it works only in interactive mode.
The trick is that instead of doing all the work in the first operation I also use the second (printing). So in the first step I return an object whose value is "b", but I also assigned a class "weird" to it and a printing method, the printing method then modifies the object's value, resets its class, and destroys itself.
add_str <- function(x){
class(x) <- "weird"
assign("print.weird", function(x) {
env <- parent.frame(2)
x_name <- fetch_name(x, env)
assign(x_name,paste0(x_name,unclass(x)),envir = env)
rm(print.weird,envir = env)
print(paste0(x_name,x))
},envir = parent.frame())
x
}
a <- add_str("b")
a
# [1] "ab"
(a <- add_str("b") will have the same effect as both lines above. print(a <- add_str("b")) would also have the same effect but would work in non interactive code, as well.
This is generally not possible because the operator <- is actually parsed to a call of the <- function:
rapply(as.list(quote(a <- add_str("b"))),
function(x) if (!is.symbol(x)) as.list(x) else x,
how = "list")
#[[1]]
#`<-`
#
#[[2]]
#a
#
#[[3]]
#[[3]][[1]]
#add_str
#
#[[3]][[2]]
#[1] "b"
Now, you can access earlier calls on the call stack by passing negative numbers to sys.call, e.g.,
foo <- function() {
inner <- sys.call()
outer <- sys.call(-1)
list(inner, outer)
}
print(foo())
#[[1]]
#foo()
#[[2]]
#print(foo())
However, help("sys.call") says this (emphasis mine):
Strictly, sys.parent and parent.frame refer to the context of the
parent interpreted function. So internal functions (which may or may
not set contexts and so may or may not appear on the call stack) may
not be counted, and S3 methods can also do surprising things.
<- is such an "internal function":
`<-`
#.Primitive("<-")
`<-`(x, foo())
x
#[[1]]
#foo()
#
#[[2]]
#NULL
As Roland pointed, the <- is outside of the scope of your function and could only be located looking at the stack of function calls, but this fail. So a possible solution could be to redefine the '<-' else than as a primitive or, better, to define something that does the same job and additional things too.
I don't know if the ideas behind following code can fit your needs, but you can define a "verbose assignation" :
`:=` <- function (var, value)
{
call = as.list(match.call())
message(sprintf("Assigning %s to %s.\n",deparse(call$value),deparse(call$var)))
eval(substitute(var <<- value))
return(invisible(value))
}
x := 1:10
# Assigning 1:10 to x.
x
# [1] 1 2 3 4 5 6 7 8 9 10
And it works in some other situation where the '<-' is not really an assignation :
y <- data.frame(c=1:3)
colnames(y) := "b"
# Assigning "b" to colnames(y).
y
# b
#1 1
#2 2
#3 3
z <- 1:4
dim(z) := c(2,2)
#Assigning c(2, 2) to dim(z).
z
# [,1] [,2]
#[1,] 1 3
#[2,] 2 4
>
I don't think the function has access to the variable it is being assigned to. It is outside of the function scope and you do not pass any pointer to it or specify it in any way. If you were to specify it as a parameter, you could do something like this:
add_str <- function(x, y) {
arg0 <-deparse(substitute(x))
return(paste0(arg0, y))
}
a <- 5
add_str(a, 'b')
#"ab"
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'm trying to get the names of arguments in the global environment within a function. I know I can use substitute to get the name of named arguments, but I would like to be able to do the same thing with ... arguments. I kinda got it to work for the first element of ... but can't figure out how to do it for the rest of the elements. Any idea how to get this working as intended.
foo <- function(a,...)
{
print(substitute(a))
print(eval(enquote(substitute(...))))
print(sapply(list(...),function(x) eval(enquote(substitute(x)),env=.GlobalEnv)))
}
x <- 1
y <- 2
z <- 3
foo(x,y,z)
x
y
[[1]]
X[[1L]]
[[2]]
X[[2L]]
The canonical idiom here is deparse(substitute(foo)), but the ... needs slightly different processing. Here is a modification that does what you want:
foo <- function(a, ...) {
arg <- deparse(substitute(a))
dots <- substitute(list(...))[-1]
c(arg, sapply(dots, deparse))
}
x <- 1
y <- 2
z <- 3
> foo(x,y,z)
[1] "x" "y" "z"
I would go with
foo <- function(a, ...) {
print( n <- sapply(as.list(substitute(list(...)))[-1L], deparse) )
n
}
Then
foo(x,y,z)
# [1] "y" "z"
Related question was previously on StackOverflow:
How to use R's ellipsis feature when writing your own function? Worth reading.
Second solution, using match.call
foo <- function(a, ...) {
sapply(match.call(expand.dots=TRUE)[-1], deparse)
}
I would like to write a function that handles multiple data types. Below is an example that works but seems clunky. Is there a standard (or better) way of doing this?
(It's times like this I miss Matlab where everything is one type :>)
myfunc = function(x) {
# does some stuff to x and returns a value
# at some point the function will need to find out the number of elements
# at some point the function will need to access an element of x.
#
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
x.vec <- as.vector(as.matrix(as.data.frame(x)))
n <- length(x.vec)
ret <- x.vec[n/3] # this line only for concreteness
return(ret)
}
Use S3 methods. A quick example to get you started:
myfunc <- function(x) {
UseMethod("myfunc",x)
}
myfunc.data.frame <- function(x) {
x.vec <- as.vector(as.matrix(x))
myfunc(x.vec)
}
myfunc.numeric <- function(x) {
n <- length(x)
ret <- x[n/3]
return(ret)
}
myfunc.default <- function(x) {
stop("myfunc not defined for class",class(x),"\n")
}
Two notes:
The ... syntax passes any additional arguments on to functions. If you're extending an existing S3 method (e.g. writing something like summary.myobject), then including the ... is a good idea, because you can pass along arguments conventionally given to the canonical function.
print.myclass <- function(x,...) {
print(x$keyData,...)
}
You can call functions from other functions and keep things nice and parsimonious.
Hmm, your documentation for the function is
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
and if one supplies an object as you claim is require, isn't it already a vector and not a matrix or a data frame, hence obviating the need for separate methods/specific handling?
> dat <- data.frame(A = 1:10, B = runif(10))
> class(dat[,1])
[1] "integer"
> is.vector(dat[,1])
[1] TRUE
> is.vector(dat$A)
[1] TRUE
> is.numeric(dat$A)
[1] TRUE
> is.data.frame(dat$A)
[1] FALSE
I would:
myfunc <- function(x) {
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
n <- length(x)
ret <- x[n/3] # this line only for concreteness
return(ret)
}
> myfunc(dat[,1])
[1] 3
Now, if you want to handle different types of objects and extract a column, then S3 methods would be a way to go. Perhaps your example is over simplified for actual use? Anyway, S3 methods would be something like:
myfunc <- function(x, ...)
UseMethod("myfunc", x)
myfunc.matrix <- function(x, j = 1, ...) {
x <- x[, j]
myfunc.default(x, ...)
}
myfunc.data.frame <- function(x, j = 1, ...) {
x <- data.matrix(x)
myfunc.matrix(x, j, ...)
}
myfunc.default <- function(x, ...) {
n <- length(x)
x[n/3]
}
Giving:
> myfunc(dat)
[1] 3
> myfunc(data.matrix(dat))
[1] 3
> myfunc(data.matrix(dat), j = 2)
[1] 0.2789631
> myfunc(dat[,2])
[1] 0.2789631
You probably should try to use an S3 method for writing a function that will handle multiple datatypes.
A good reference is here: http://www.biostat.jhsph.edu/~rpeng/biostat776/classes-methods.pdf