R: passing values to eval in nested functions - r

I want to pass some query to lower level function that uses 'eval'. Here's a simplified example:
f1 <- function(x, q) eval(substitute(q), envir=x)
f2 <- function(x, q) f1(x, q)
What's happening:
> x <- data.frame(a=1:5)
> f1(x, a<3)
[1] TRUE TRUE FALSE FALSE FALSE
> f2(x, a<3)
Error in eval(expr, envir, enclos) : object 'a' not found
While I would like f2 to produce the same output like f1. Argument 'q' is some general query that is going to be evaluated on 'x'. I keep the example simple and general but I want to extend it's behavior on more complicated functions and queries. The thing that matters to me is how to "pass" the query "q" so that eval knows what to do with it no matter how many levels of nested functions there were before.
How can I do that? Thanks!

You can do:
f1 <- function(x, q) eval(substitute(q), envir=x)
f2 <- function(x, q) eval(substitute(f1(x, q)))
y <- data.frame(a=1:5)
f1(y, a<3)
f2(y, a<3)

Because you defined just x. You need:
> f2(x, x$a<3)
> [1] TRUE TRUE FALSE FALSE FALSE

Related

How to have missing() parameter also be missing in recursive call when the parameter has a default value?

My R function uses missing() to switch between two alternative ways of specifying input data. However, if the input is a factor, I want to automatically apply the function on the factor levels instead, so I make a recursive call. Now I have the problem that I forward all arguments to the recursive call, so none of the parameters are missing anymore! How do I make a recursive call with all the parameters missing that are also missing in the parent call?
Minimal example:
f <- function(a, b = 1){
print(missing(b))
if(length(a)>0) f(a = a[-1], b = b)
}
f(1:2) prints:
[1] TRUE
[1] FALSE
[1] FALSE
What I want is
[1] TRUE
[1] TRUE
[1] TRUE
This works when b has no default value, so f is instead
f <- function(a, b){
...
Also of course I have the option to switch the recursive call using if(missing(b))
if(missing(b)) f(a = a[-1]) else f(a = a[-1], b = b)
... but this gets complicated for multiple parameters and also deprives me of the option to learn something about the strange wonders of parameter handling in R ;-)
You can capture the call with match.call, and substitute a for a[-1] in the call. Then instead of calling the function with arguments, use do.call, which will only supply the arguments initially put into the function in the recursive calls.
f <- function(a, b = 1){
print(missing(b))
call_list <- as.list(match.call())[-1]
if(length(a) > 0) {
a <- a[-1]
call_list$a <- a
do.call(f, call_list)
}
}
f(1:2)
#> [1] TRUE
#> [1] TRUE
#> [1] TRUE

How to supply (logical) operators as arguments to function

Is it possible to supply logical (or arithmetic) operators as arguments to R functions. Check this SO question that share the theme.
f1 <- function(a, b) a>b
Then
> f1(1,2)
[1] FALSE
How can I implement an operator that allows me to for instance change the function test, e.g.
f2 <- function(a, b, operator = c('<', '>', '==')) { ... }
Then I would like
> f2(1, 2, '<')
[1] TRUE
In R, all operators are functions. So, you only need to get the operator function and call it.
f2 <- function(a, b, operator) getFunction(operator)(a, b)
f2(1, 2, '<')
#[1] TRUE
Here's another option:
foo <- function(a, b, operator) {
f <- match.fun(match.arg(operator, choices = c('<', '>', '==')))
f(a,b)
}
foo(1,2, ">")
#[1] FALSE
foo(1,2, "==")
#[1] FALSE
foo(1,2, "+")
# Show Traceback
#
# Rerun with Debug
# Error in match.arg(operator, choices = c("<", ">", "==")) :
# 'arg' should be one of “<”, “>”, “==”
Using match.arg allows you to restrict it to certain functions. match.fun then gets the actual function.
In case you don't need the restriction to certain inputs, you can skip the match.arg and just use match.fun.
One way to do this is to use eval(parse(...)) methodology, i.e.
f1 <- function(a, b, op){
eval(parse(text = paste0(a, op, b)))
}
f1(1, 2, '<')
#[1] TRUE
f1(3, 3, '==')
#[1] TRUE
f1(3, 4, '==')
#[1] FALSE

R functions: passing arguments with ellipsis

I have a question regarding base R usage. It might be asked before, however I wasn't able to find solution to my problem.
I have a function that calls another function. Arguments to second function are passed using ellipsis (...). However, I get error message: object "OBJECT" not found.
f1 <- function(a, ...) {
print(a)
f2(...)
}
f2 <- function(...) {
print(b == TRUE)
print(runif(c))
}
f1(2, b = FALSE, c = 2)
Which gives me: Error in print(b == TRUE) : object 'b' not found.
I know that it is possible to get around this problem using args <- list(...) and then calling each argument separately, but I imagine that this gets complicated when having lots of arguments (not only two).
Question
How to pass arguments from f1 to f2 using ellipsis?
So the ellipses are used to save you specifying all the arguments of f2 in the arguments of f1. Though when you declare f2, you still have to treat it like a normal function, so specify the arguments b and c.
f1 <- function(a, ...) {
print(a)
f2(...)
}
# Treat f2 as a stand-alone function
f2 <- function(b, c) {
print(b == TRUE)
print(runif(c))
}
f1(2, b=FALSE, c=2)
[1] 2
[1] FALSE
[1] 0.351295 0.9384728

What's the best way to do arithmetic on functions in R?

In math, when combining functions, you can indicate this using ordinary arithmetic operations, e.g.
u = 2*x
v = log(x)
and then simply
f = u + v
I do a lot of numerical work where you have to construct complicated math operations. It would be very helpful to be able to use a notation more like this one. For example, in R it might look like
f <- function.arithmetic('u+v', args=c('x'))
With some nonstandard evaluation, this might even be as simple as
f(x) %def% u + v
where u and v are already defined functions of x.
Is there a simple way to set up this syntax? For example, breaking down the expression and substituting u(x) and v(x) wherever they occur -- then doing an ordinary eval. (I would trust an existing parsing function more than some hack that I write. And I know that "parse" doesn't do this.)
Answers already suggested would work, but they seem more complicated than writing
f <- function(x) u(x) + v(x)
If the expression is more complicated, this notation starts getting harder to read. I want to set up something simpler, more easily readable, and closer to the above mathematical notation.
Here are a couple of approaches:
1) Ops/Math This could be done using S3 or S4. We illustrate S3 only.
Compose <- function(f, g) {
if (missing(g)) structure(f, class = c("functional", "function"))
else Compose(function(...) f(g(...)))
}
Ops.functional <- function(e1, e2) {
op <- match.fun(.Generic)
Compose( if (is.numeric(e1)) function(...) op(e1, e2(...))
else if (is.numeric(e2)) function(...) op(e1(...), e2)
else function(...) op(e1(...), e2(...)))
}
Math.functional <- function(x, ...) {
op <- match.fun(.Generic)
Compose(op, x)
}
Here are two examples:
u <- Compose(function(x) 2*x)
v <- Compose(log)
(u + v)(pi/2) # example 1
## [1] 3.593175
(exp(u*v) / (1 + u^2 + v^2)) (pi/2) # example 2
## [1] 0.3731149
Note: that u could have alternately been defined as u <- 2 * Compose(identity) . In fact, we could define:
Id <- Compose(identity)
u <- 2*Id
v <- log(Id)
2) Define your own functions This is not really much work. Likely less than a page to define all common functions. This could be done using the %...% infix operators but if you really want to go the infix route (1) above seems preferable. So with this approach we keep it simple. The following could be enhanced to allow numeric arguments to be regarded as constant functions as we did in (1).
Plus <- function(f, g) function(...) f(...) + g(...)
Plus(function(x) 2*x, log)(pi/2)
## [1] 3.593175
This is G.Grothendieck's answer cast in the form of an infix "+"-operator:
`%+%` <- function(f1, f2) { function(x) {f1(x) +f2(x)} }
f <- cos %+% sin
f
#-----
function(x) {f1(x) +f2(x)}
<environment: 0x7ffccd7eeea8>
#-------
f(0)
#[1] 1
There are also examples of functional composition on the 'funprog' page which needs to be pulled up with one of the function names, for instance?Reduce. Can also be defined to accept additional arguments:
`%+%` <- function(f1, f2) { function(x,...) {f1(x,...) +f2(x,...)} }
f2 <- dt %+% dt
#-- testing---
> f2(0)
Error in f1(x, ...) : argument "df" is missing, with no default
> f2(0, 6)
[1] 0.7654655
> dt(0,6)
[1] 0.3827328
To see how this is handled internally you can recover the definition by examining the environment stored with the resulting closure:
> ls(envir=environment(f2) )
[1] "f1" "f2"
> environment(f2)$f1
function (x, df, ncp, log = FALSE)
{
if (missing(ncp))
.Call(C_dt, x, df, log)
else .Call(C_dnt, x, df, ncp, log)
}
<bytecode: 0x7ffcc63e8ff8>
<environment: namespace:stats>
The problem with your example is that you did not define the u and v in an R-functional manner. Presumably this would not be the situation with your proposed use case.
> u = function(x,...)2*x
> v = function(x,...) (log(x))
> f <- u %+% v
> f(4)
[1] 9.386294
Some of this style of programming may be supported by Hadley's lazyeval package:
> require(lazyeval)
Loading required package: lazyeval
> help(pac=lazyeval)
> lazy_eval(interp(~ u + v, u = sum(1:10), v=sum(1:5)) )
[1] 70
> x <- 1:10; y=1:5
> lazy_eval(interp(~ u + v, u = sum(x), v=sum(y)) )
[1] 70
> lazy_eval(interp(~ u / v, u = sum(x), v=sum(y)) )
[1] 3.666667
> lazy_eval(interp(~ log(u) / v, u = sum(x), v=sum(y)) )
[1] 0.2671555
But I have encountered some puzzles that I cannot really understand:
e2 <- ~ exp(u * v)/(1 + x)^2
lazy_eval(interp(e2, u = sum(x)/100, v=sum(y)/100) )
#[1] 0.271499668 0.120666519 0.067874917 0.043439947 0.030166630 0.022163238 0.016968729
#[8] 0.013407391 0.010859987 0.008975196
exp( sum(x)/100 +sum(y)/100 )/(1+x)^2
[1] 0.50343818 0.22375030 0.12585954 0.08055011 0.05593758 0.04109699 0.03146489 0.02486114
[9] 0.02013753 0.01664258

Passing on an argument from a wrapper to an inner function when argument is allowed to be missing in inner function - possible?

I have a function which has the argument arg which is allowed to be missing. If it is missing it is assigned some value within foo.
foo <- function(x, arg) {
if (missing(arg))
arg <- TRUE
arg
}
I want to write a wrapper that calls foo for several elements of a list using sapply or lapply. And I want to pass on the arg argument as follows.
foo_wrapper <- function(x, arg) {
sapply(x, foo, arg=arg)
}
This will throw an error as arg is not found when it is evaluated within foo_wrapper.
> m <- list(1,2,3)
> foo(m)
[1] TRUE
> foo_wrapper(m)
Error in FUN(X[[1L]], ...) : argument "arg" is missing, with no default
Now, I could use the dots arguments for this purpose, which would work.
foo_wrapper <- function(x, ...) {
sapply(x, foo, ...)
}
> m <- list(1,2,3)
> foo(m)
[1] TRUE
> foo_wrapper(m)
[1] TRUE TRUE TRUE
Still, I would like to know if there is a way to include the arg argument in the wrapper function explicitly, not pass it via the dots argument.
Is there a way?
You could check for whether arg is missing before calling sapply:
foo_wrapper <- function(x, arg)
if(missing(arg)) sapply(x, foo) else sapply(x, foo, arg=arg)
but it's probably cleaner just to use ....

Resources