I've been fascinated lately by Hadley Wickhams Non-standard Evaluation examples in R, but I'm not sure what I want to do is possible.
I want to have a closure-based environment where you pass expressions that get evaluated (in NSE ways), similar to how subset works. The problem though, is that to do so I think I need to fundamentally change how arguments are passed.
For example,
g <- function(setup_stuff){
function(x) {
substitute(x)
}
}
will give me the expression assigned to x if I so something like:
test <- g("Setup stuff")
test(1:10)
# 1:10
Similarly, I can do something like:
g <- function(setup_stuff){
function(x) {
sys.call(x)
}
}
Which will usually give me kind of what I'm looking for--a completely unevaluated argument list:
test <- g("setup variables")
test(1:10)
# test(1:10)
But this all relies on the idea that I pass variables the "standard" way, by delimiting assigned parameters with commas. I want to have something like:
g <- function(setup_stuff){
function(...) {
# Capture named expression(s) before evaluation
substitute(...)
}
}
Such that, for example, I can evaluate the arguments in a based on their named and the operators passed in, for example I've been trying to overload the logical operator &, but I just receive an error before the function to do NSE is even called:
test <- g("Setup stuff")
test(a=1 & b=2)
# > test(a=1 & b=2)
# Error: unexpected '=' in "test(a=1 & b="
I know I could probably do half-accomplish this by overloading the '&' and the '=' operator for some specific class, and just return the unevaluated call, but then a and b would need to be objects of that class, but I was wondering if I was missing something that someone can easily see?
Related
Why does curve not seem to work with elements extracted from a list?
Consider two seemingly identical functions, but built differently:
a <- function(value){
function(x) x + value
}
m <- lapply(1:3, a)
f <- a(1)
all.equal(f, m[[1]])
#[1] TRUE
curve works for f, but not m[[1]]:
> curve(m[[1]])
Error in curve(m[[1]]) :
'expr' must be a function, or a call or an expression containing 'x'
But it works if the object is extracted before:
d <- m[[1]]
curve(d)
Is there a reason for it?
curve() is a "magic" function that tries to interpret its input as an expression when possible; it doesn't always work.
#user2554330 comments that curve() is expecting (from ?curve):
The name of a function, or a call or an expression written as a function of x which will evaluate to an object of the same length as x.
Instead, m[[1]] is an expression that evaluates to a function. In contrast, d is the name of a function. You can get what you want using curve(m[[1]](x)) which makes the input an expression written as a function of x.
In the code below, R looks at the expression passed to curve() and asks whether is.name(sexpr) is TRUE. This test passes for f but fails for m[[1]] (if you want to test it outside of the function context, you need to compare is.name(quote(f)) and is.name(quote(m[[1]])).
Weirdly enough, plot(m[[1]]) does work (it calls plot.function(), which calls curve() with different arguments internally).
sexpr <- substitute(expr)
if (is.name(sexpr)) {
expr <- call(as.character(sexpr), as.name(xname))
}
else {
if (!((is.call(sexpr) || is.expression(sexpr)) && xname %in%
all.vars(sexpr)))
stop(gettextf("'expr' must be a function, or a call or an expression containing '%s'",
xname), domain = NA)
expr <- sexpr
}
Here is a simple example of a closure which is a function returning a function with embedded data (After http://adv-r.had.co.nz/Functional-programming.html#closures):
fFactory <- function(letter) {
function(Param) {
paste("Enclosed variable:", letter, "/ function parameter:", Param)
}
}
When the function is created, letter is used in the returned function:
> FUN <- fFactory("a")
> FUN("toto")
[1] "Enclosed variable: a / function parameter: toto"
It works because the variable letter is embedded in the environment of the function:
as.list(environment(FUN))
$letter
[1] "a"
If now we create functions in a list like this:
l <- list()
for(letter in letters) {
l[[letter]]$FUN <- fFactory(letter)
}
Normally, running the function for the item "a" must return the same result as before, but it's not the case:
> l[["a"]]$FUN("toto")
[1] "Enclosed variable: z / function parameter: toto"
Obviously because the environment embedded in the function is not the one we expected:
> as.list(environment(l[["a"]]$FUN))
$letter
[1] "z"
It returns the last closure created in the last item of the list for all closures in the list.
I suppose that I didn't misused the R language by doing so and that there is a bug in the language. Any of you can confirm that or explain me where is my mistake?
Force the evaluation of argument letter with, well, force().
fFactory2 <- function(letter) {
force(letter)
function(Param) {
paste("Enclosed variable:", letter, "/ function parameter:", Param)
}
}
l2 <- list()
for(letter in letters) {
l2[[letter]]$FUN <- fFactory2(letter)
}
l2[["a"]]$FUN("toto")
l2[["b"]]$FUN("toto")
l2[["w"]]$FUN("toto")
Here's an explanation (After #user2554330 answer):
In R, arguments to functions aren't evaluated until first used. So the arguments to all of the functions in your list are the global variable letter, which you change in the loop as you create them, but you never evaluate until you call them. So the functions first evaluate letter at the time of the first call, and you get strange results.
This is your error. #RuiBarradas gives you the fix. Here's an explanation:
In R, arguments to functions aren't evaluated until first used. So the arguments to all of the functions in your list are the global variable letter, which you change in the loop as you create them, but you never evaluate until you call them. So the functions first evaluate letter at the time of the first call, and you get strange results.
You can fix this problem in the way Rui said: force the argument to be evaluated before you create the function.
I did a test with nested return function in R, but without success. I came from Mathematica, where this code works well. Here is a toy code:
fstop <- function(x){
if(x>0) return(return("Positive Number"))
}
f <- function(x){
fstop(x)
"Negative or Zero Number"
}
If I evaluate f(1), I get:
[1] "Negative or Zero Number"
When I expected just:
[1] "Positive Number"
The question is: there is some non-standard evaluation I can do in fstop, so I can have just fstop result, without change f function?
PS: I know I can put the if direct inside f, but in my real case the structure is not so simple, and this structure would make my code simpler.
Going to stick my neck out and say...
No.
Making a function return not to its caller but to its caller's caller would involve changing its execution context. This is how things like return and other control-flow things are implemented in the source. See:
https://github.com/wch/r-source/blob/trunk/src/main/context.c
Now, I don't think R level code has access to execution contexts like this. Maybe you could write some C level code that could do it, but its not clear. You could always write a do_return_return function in the style of do_return in eval.c and build a custom version of R... Its not worth it.
So the answer is most likely "no".
I think Spacedman is right, but if you're willing to evaluate your expressions in a wrapper, then it is possible by leveraging the tryCatch mechanism to break out of the evaluation stack.
First, we need to define a special RETURN function:
RETURN <- function(x) {
cond <- simpleCondition("") # dummy message required
class(cond) <- c("specialReturn", class(cond))
attr(cond, "value") <- x
signalCondition(cond)
}
Then we re-write your functions to use our new RETURN:
f <- function(x) {
fstop(x)
"Negative or Zero"
}
fstop <- function(x) if(x > 0) RETURN("Positive Number") # Note `RETURN` not `return`
Finally, we need the wrapper function (wsr here stands for "with special return") to evaluate our expressions:
wsr <- function(x) {
tryCatch(
eval(substitute(x), envir=parent.frame()),
specialReturn=function(e) attr(e, "value")
) }
Then:
wsr(f(-5))
# [1] "Negative or Zero"
wsr(f(5))
# [1] "Positive Number"
Obviously this is a little hacky, but in day to day use would be not much different than evaluating expressions in with or calling code with source. One shortcoming is this will always return to the level you call wsr from.
I´m working on a R package that takes strings as function arguments. Now I want to use non-standard evaluation to allow for non-string input. Also, to keep the backwards compatibility, I´d like to keep the possibility for the functions to take strings.
Hadley gives an example with the subset function and suggests that every NES function should be accompanied by a standard evaluation function.
library(lazyeval)
# standard evaluation
subset2_ <- function(df, condition) {
r <- lazy_eval(condition, df)
r <- r & !is.na(r)
df[r, , drop = FALSE]
}
subset2_(mtcars, lazy(mpg > 31))
# NES can be written easily afterwards
subset2 <- function(df, condition) {
subset2_(df, lazy(condition))
}
While the SE function now also takes quoted input,
subset2_(mtcars, "mpg > 31")
the NSE function throws an error:
subset2(mtcars, "mpg > 31")
But I want the user to have the same function (the NSE function) for both quoted as well as unquoted arguments.
Any ideas?
The NSE function takes NSE input. That’s the point of this pattern, isn’t it?
subset2(mtcars, mpg > 31)
You can of course allow the NSE function to take character input as well but I’d advise against this — strongly. Don’t mix SE and NSE, there’s no advantage to be had, and it sows confusion (and potentially bugs, since you’re mixing domains).
That said, the following of course works:
subset2 <- function(df, condition) {
if (is.character(substitute(condition)))
subset2_(df, condition)
else
subset2_(df, lazy(condition))
}
If you want to allow NSE and SE in the same function for backwards compatibility reasons, I suggest phasing out the SE version in a future version, and adding a deprecation warning for now. To add the deprecation warning:
subset2 <- function(df, condition) {
if (is.character(substitute(condition))) {
msg = sprintf(paste0('Calling %s with a quoted expression is',
' deprecated. Pass an unquoted expression',
' instead, or use %s.'),
sQuote('subset2'), sQuote('subset2_'))
.Deprecated(msg = msg)
subset2_(df, condition)
}
else
subset2_(df, lazy(condition))
}
For the moment, at least, this is an exercise in learning for me, so the actual functions or their complexity is not the issue. Suppose I write a function whose argument list includes some input variables and a function name, passed as a string. This function then calculates some variables internally and "decides" how to feed them to the function name I've passed in.
For nonprimitive functions, I can do (for this example, assume non of my funcname functions have any arguments other than at most (x,y,z). If they did, I'd have to write some code to search for matching names(formals(get(funcname))) so as not to delete the other arguments):
foo <- function (a,b,funcname) {
x <- 2*a
y <- a+3*b
z <- -b
formals(get(funcname)) <- list(x=x, y=y, z=z)
bar <- get(funcname)()
return(bar)
}
And the nice thing is, even if the function funcname will execute without error even if it doesn't use x, y or z (so long as there are no other args that don't have defaults) .
The problem with "primitive" functions is I don't know any way to find or modify their formals. Other than writing a wrapper, e.g. foosin <-function(x) sin(x), is there a way to set up my foo function to work with both primitive and nonprimitive function names as input arguments?
formals(args(FUN)) can be used to get the formals of a primitive function.
You could add an if statement to your existing function.
> formals(sum)
# NULL
> foo2 <- function(x) {
if(is.primitive(x)) formals(args(x)) else formals(x)
## formals(if(is.primitive(x)) args(x) else x) is another option
}
> foo2(sum)
# $...
#
#
# $na.rm
# [1] FALSE
#
> foo2(with)
# $data
#
#
# $expr
#
#
# $...
Building on Richard S' response, I ended up doing the following. Posted just in case anyone else ever tries do things as weird as I do.
EDIT: I think more type-checking needs to be done. It's possible that coleqn could be
the name of an object, in which case get(coleqn) will return some data. Probably I need
to add a if(is.function(rab)) right after the if(!is.null(rab)). (Of course, given that I wrote the function for my own needs, if I was stupid enough to pass an object, I deserve what I get :-) ).
# "coleqn" is the input argument, which is a string that could be either a function
# name or an expression.
rab<-tryCatch(get(coleqn),error=function(x) {} )
#oops, rab can easily be neither NULL nor a closure. Damn.
if(!is.null(rab)) {
# I believe this means it must be a function
# thanks to Richard Scriven of SO for this fix to handle primitives
# we are not allowed to redefine primitive's formals.
qq <- list(x=x,y=y,z=z)
# matchup the actual formals names
# by building a list of valid arguments to pass to do.call
argk<-NULL
argnames<-names(formals(args(coleqn)))
for(j in 1:length(argnames) )
argk[j]<-which(names(qq)==argnames[1] )
arglist<-list()
for(j in 1:length(qq) )
if(!is.na(argk[j])) arglist[[names(qq)[j]]]<-qq[[j]]
colvar<- do.call(coleqn,arglist)
} else {
# the input is just an expression (string), not a function
colvar <- eval(parse(text=coleqn))
}
The result is an object generated either by the expression or the function just created, using variables internal to the main function (which is not shown in this snippet)