How can I get the current function within a function for recursive applying? Here is a trivial example:
myfun <- function(x) {
if(is.list(x)){
lapply(x, myfun)
} else {
length(x)
}
}
I would like to make it anonymous instead, however I don't know how to tell lapply to use the current function when it has no name. I tried Recall but that doesn't work:
(function(x) {
if(is.list(x)){
lapply(x, Recall)
} else {
length(x)
}
})(cars)
Also match.call()[[1]] doesn't help for anonymous functions.
It is sys.function(0) , for example to compute the square of a list recursively :
(function(x) {
if(length(x)>2){
lapply(x,sys.function(0))
} else {
x^2
}
})(list(1,2,3))
[[1]]
[1] 1
[[2]]
[1] 4
[[3]]
[1] 9
What you are looking for is, I think, sys.function:
> (function() print(sys.function(1)))()
function() print(sys.function(1))
Recall actually says:
local for another way to write anonymous recursive functions.
The idea is that you define the name locally:
local(myfun <- function(...) { ... myfun(...) ... })
and it is not defined outside.
Related
I have a function myfun which among other arguments has one that is a user supplied function, say f. This function may have any number of arguments, including maybe none. Here is a simple example:
myfun = function(f, ...) { f()}
Now calls to myfun might be
myfun( f=function() rnorm(10) )
myfun( f=function(m) rnorm(10, m) )
I don't want to use the ellipse argument ... inside of f, so my question is whether there is any other way to determine inside of myfun how many arguments the function f has? If f has no arguments it is then passed to the Rcpp routine doA.cpp, but if it has one or more arguments it is passed to doB.cpp. So I need to know inside myfun which it is.
Here is a toy example which hopefully makes it clearer what I am after:
myfun = function(f) {
numarg = number.of.arguments(f)
if(numarg==0) return(doA.cpp(f))
else return(doB.cpp(f))
}
so I need a "function" number.of.arguments, that is some way to determine numarg.
Based on your specific use-case, your best bet might be to query the formal arguments of f. However, note that there are several caveats with this method, which I note below.
f = function (f) {
if (length(formals(f)) == 0L) {
doA.cpp(f)
} else {
doB.cpp(f)
}
}
The caveats are that formals does not work for primitive functions: formals(mean) works, but formals(sum) returns NULL. Furthermore, formals counts ... as a single argument. So if you want to handle ... differently you'll have to do this manually:
if ('...' %in% names(formals(f))) {
# `...` is present
} else {
# `...` is not present
}
A more robust method when the user supplies the arguments is to find the length of the ... args via ...length().
You could then pass the ... arguments to doB.cpp inside a list, for instance:
myfun = function(f, ...) {
if (...length() == 0L) {
doA.cpp(f)
} else {
doB.cpp(f, list(...))
}
}
Konrad's is just what I need! Also, I learned about the formals function, which I had not seen before. Its limitations as discussed by Konrad won't matter for my case because the functions are ones the users have to write anyway, and I won't use ... . So, thanks!
Wolfgang
This is what I may code in R.
myfun = function(f, ...) { f(...)}
myfun( f=function(m) rnorm(10, m), m )
After getting comment from #Wolfgang Rolke, the question becomes better understood. Here is my second attempt.
myfun = function(f, ...) {
argg <- c(as.list(environment()), list(...))
numarg=length(argg)
if (numarg==1) { return( f()) }
if (numarg==2) { return(f(argg[[2]])) }
}
myfun( f=function() rnorm(10) )
myfun( f=function(m=2) rnorm(10, m) )
To easily verify the result, one may do the following:
myfun( f=function() mean(rnorm(10))) # it returns something like 0.07599287
myfun( f=function(m=10) mean(rnorm(10, m))) # it returns 9.49364
I want to write a function in R which grabs the name of a variable from the context of its caller's caller. I think the problem I have is best understood by asking how to compose deparse and substitute. You can see that a naive composition does not work:
# a compose operator
> `%c%` = function(x,y)function(...)x(y(...))
# a naive attempt to combine deparse and substitute
> desub = deparse %c% substitute
> f=function(foo) { message(desub(foo)) }
> f(log)
foo
# this is how it is supposed to work
> g=function(foo) { message(deparse(substitute(foo))) }
> g(log)
log
I also tried a couple of variations involving eval.parent but with no luck. Any help is appreciated.
Clarification: I'm not looking for a synonym for deparse(substitute(...)), e.g. match.call()[[2]] - what I'm looking for is a way to define a function
desub = function(foo) {
...
# What goes here?
}
such that the definition of f above produces the same answer as g. It should look like this:
> f=function(foo) { message(desub(foo)) }
> f(log)
log
Perhaps match.call could be of use in the body of desub above, but I'd like to know how. Thanks!
As you surmised, this is an issue with environments. The reason why the function f does not give log when you call f(log), is that the environment in which substitute is called, namely the evaluation environment of desub, does not contain a binding to log.
The remedy is to evaluate the call to substitute in the proper environment, and modify desub accordingly:
desub <- function(x, env = parent.frame()) {
deparse(eval(substitute(substitute(x)), envir = env))
}
Now f does what it was intended to do:
f(log)
#> log
Thanks to #egnha and #akrun for the brave attempts. After playing around a bit I found a solution that works.
This fragment:
desub <- function(y) {
e1=substitute(y)
e2=do.call(substitute,list(e1), env=parent.frame())
deparse(e2)
}
gives:
> f <- function(x) message(desub(x))
> f(log)
log
Update:
With help from Mark Bravington on the R-devel list, I was able to generalize this to multiple frames. I thought I should post it here, because it's a bit more useful than the above, and because there was a tricky workaround involving (possibly buggy?) behavior in parent.frame().
# desub(v,0)=="v"
# desub(v,1)==deparse(substitute(v))
# desub(v,2)==name of v in grandparent's frame
# etc.
desub = function(y,n=1) {
env=environment();
for(i in 0:n) {
y = do.call(substitute, list(substitute(y)), env=env)
env = do.call(my_mvb_parent, list(), env=env)
}
deparse(y)
}
# helper:
#
# - using mvb.parent.frame fixes problems with capture.output and
# weird cycling behavior in the built-in parent.frame
#
# - this wrapper makes mvb.parent.frame not throw an error when we get
# to globalenv()
my_mvb_parent=function() {
library(mvbutils)
tryCatch(
mvb.parent.frame(2),
error=function(e) { globalenv()})
}
if(1) {
# example code
g2=function(t) {
for(i in 0:5) {
res=desub(t,i);
print(res);
res1=capture.output(desub(t,i))
stopifnot(capture.output(res)==res1)
}
}
g1=function(z) g2(z)
g=function(y) g1(y)
g(log)
# prints:
## [1] "t"
## [1] "z"
## [1] "y"
## [1] "log"
## [1] "log"
## [1] "log"
}
learning R with, The Art of R Programming.
Until about 1/2 through he has simply defined a new function like this:
fnc=function(a,b){
return(a) }
But now is doing stuff like this:
> g
function() {
t <- function(x) return(x^2)
return(t)
}
> g()
function(x) return(x^2)
Is this the same as saying:
g=function(x) return(x^2)
What is the g in the first block?
Running the exact code he has does not work for me, it just prints out what I had in g.
Thank you everyone.
If your code transposition from book to SO is accurate, the author is defining a function that returns a function:
g <- function() {
t <- function(x) return(x^2)
return(t)
}
We can see that if we execute it:
g()
## function(x) return(x^2)
## <environment: 0x7fd7c5aa7d10>
And, we can use the fact that it returns a function by passing in a parameter to what it returns either this way:
g()(10)
## 100
or this way:
squareIt <- g()
squareIt(10)
## 100
Lets say I have a function that accepts variables that are always part of a list.
myfun <- function(x$name,y$name) {
# stuff
}
What I'd like to do is get the names used.
alist <- list(Hello=1,Goodbye=2)
myfun(alist$Hello, alist$Goodbye) {
# I want to be able to work with the characters "Hello" and "Goodby" in here
}
So, within my function, how would I get the characters "Hello" and "Goodbye". Given alist$Hello and alist$Goodbye
I recall that plot.default does this with deparse(substitute(:
a <- list(a="hello",b=c(1,2,3))
f <- function(x,y) { print(deparse(substitute(x))); print(deparse(substitute(y))) }
f(a$a,a$b)
#[1] "a$a"
#[1] "a$b"
Something like this, perhaps:
myfun <- function(x) { print(substitute(x))}
myfun(iris$Sepal.Length)
## iris$Sepal.Length
I'd create the function with a list argument:
myfun <- function(l) {
print(names(alist))
}
myfun(alist)
# [1] "Hello" "Goodbye"
test is a function to check if an object exists in the global environment, is not empty, and belongs to a particular class.
test <- function(foo, response=TRUE) {
if (missing(foo)) {
response <- FALSE
}
if (response) {
if (!exists(as.character(substitute(foo)), envir = .GlobalEnv)) {
response <- FALSE
}
}
if (response) {
response <- ifelse(class(foo) != "numeric", FALSE, TRUE)
}
return(response)
}
Now in foobar and a dozen other functions, I want to make sure foo is the right kind of object I want before proceeding with anything else.
foobar <- function(foo)
{
if(test(foo)) {
cat ("Yes, I have foo! \n")
}
if(!test(foo)) {
cat("Sorry, not a valid foo")
}
}
>ls()
[1] "foobar" "test"
>test(a)
[1] FALSE
>a <- "foobar"
>test(a)
[1] FALSE
>a <- 1
>test(a)
[1] TRUE
>foobar(a)
Sorry, not a valid foo
>
# what the???
>ls()
[1] "a" "foobar" "test"
>foo <- 1
>foobar(foo)
Yes, I have foo!
>
Objects loose their original names when handed off more than once. The copies get assigned new localnames. You need to grab the name on the first pass and then test with ls()
foobar <- function(foo)
{ fooname <- deparse(substitute(foo)); print(fooname)
if(test(fooname) ) {
cat ("Yes, I have foo! \n")
}
if(!test(fooname) ) {
cat("Sorry, not a valid foo")
}
}
test <- function(foo, response=TRUE) {
if (missing(foo)) {
response <- FALSE
}
if (response) {
if ( foo %in% ls( envir = .GlobalEnv) ) {
response <- TRUE }else {response <- FALSE}
}
return(response)
}
foobar(after)
# [1] "after"
#Yes, I have foo!
To verify, the problem is in the fact that the substitute is nested.
When R looks at foobar(a), it runs test(foo) within the foobar function, and so the variable that the test function looks at is called foo.
I'll start with a toy example to make things easier to explain. The library function, like your test function, interprets its argument via the variable name. i.e. library(MASS) loads the 'MASS' library, not the string that is contained inside the variable 'MASS'.
Now I'll make a function f that just calls library - this mirrors your foobar function:
f <- function(x) {
library(x)
}
Now let's try:
> f(MASS)
Error in library(x) : there is no package called ‘x’
Oh no! It didn't work! How come? Because remember, within the library code, it substitutes the variable passed in. i.e. library <- function(lib,...) substitute(lib).
So f(MASS) goes to function(x) library(x), and hence it's like I typed library(x) straight into the command line -- library is only trying to load x, and not x's value, MASS.
OK, we can fix this: we just need to change library(x) to library(substitute(x)), since substitute(x) is MASS and we'll then end up with library(MASS), right?
f <- function(x) {
library(substitute(x))
}
Let's try:
> f(MASS)
Error in library(substitute(x)) : 'package' must be of length 1
Urgh, what happened? Within f, the substitute(x) is not being evaluated, because library purposefully doesn't evaluate the expression it gets fed, because then typing library(MASS) in the command line wouldn't work.
So we really want to save substitute(x) as a variable and then perform library on that variable.
The only problem is that even if we do y <- substitute(x); library(y) within f, we always run into this problem that the argument fed into library is never evaluated. So doing this will cause the same as the first error: 'there is no package called y'.
How can we fix this? We need to somehow indirectly call library with substitute(x) as the argument, where substitute(x) is evaluated.
Aha! We can use do.call! (note: I didn't come up with this on my own, I was guided by this post to the R mailing list on nested substitutes:
f <- function(x) {
do.call(library,list(substitute(x)))
}
This does exactly what we want - it calls library but passes substitute(x) in as the library. It evaluates substitute(x) first, since we haven't directly written library(substitute(x)). nifty right?
> f(MASS) # no error!
# see if MASS is loaded - check if function 'lda' is there:
> exists('lda',mode='function')
[1] TRUE # huzzah!
Solution for your case
So, applying this lesson to your question, try:
foobar <- function(foo)
{
if ( do.call(test,list(substitute(foo))) ) # see the do.call & substitute?
cat ("Yes, I have foo! \n")
else
cat("Sorry, not a valid foo")
}
Let's see:
> ls()
[1] "foobar" "test"
> test(a)
[1] FALSE
> a <- 'foobar'
> test(a)
[1] FALSE
> a <- 1
> test(a)
[1] TRUE
> foobar(a)
Yes, I have foo!
Huzzah! (by the way: thanks for asking this question, because the answer is something I've always wanted to know).