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
The problem I am trying to tackle here is needing to apply (execute) an S3 object which is essentially a vector-like structure. This may contain various formulas which at some stage I need to evaluate for a single argument, in order to get back a vector-like object of the original shape, containing the evaluation of its constituent formulas at the given argument.
Examples of this (just to illustrate) might be a matrix of transformation - say rotation - which would take the angle to rotate by, and produce a matrix of values by which to multiply a point, for the given rotation. Another example might be the vector of states in a problem in classical mechanics. Then given t, v, a, etc, it could return s...
Now, I have created my container object in S3, and its working fine in most respects, using generic methods; I also found the Ops.myClass system of operator overloading very useful.
To complete my class, all I need now is a way to specify it as executable.
I see that there are various mechanisms that will do what I want in part, for instance I suppose that as.function() will convert the object to behave as I want, and something like lapply() could be used for the "reverse" application of the argument to the functions. What I am not sure how to do is link it all up so that I can do something like this mock-up:
new_Object <- function(<all my function vector stuff spec>)
vtest <- new_Object(<say, sin, cos, tan>)
vtest(1)
==>
myvec(.8414709848078965 .5403023058681398 1.557407724654902)
(Yes, I have already specified a generic print() routine that will make it appear nice)
All suggestions, sample code, links to examples are welcome.
PS =====
I have added some basic example code as per request.
I am not sure how much would be too much, so the full working minimal example, including operator overloading is in this gist here.
I am only showing the constructor and helper functions below:
# constructor
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <-function(...){
vec <- unlist(list(...),use.names = FALSE)
new_Struct("up",vec)
}
down <-function(...){
vec <- unlist(list(...),use.names = FALSE)
new_Struct("down",vec)
}
The above code behaves thus:
> u1 <- up(1,2,3)
> u2 <- up(3,4,5)
> d1 <- down(u1)
> d1
[1] down(1, 2, 3)
> u1+u2
[1] up(4, 6, 8)
> u1+d1
Error: '+' not defined for opposite tuple types
> u1*d1
[1] 14
> u1*u2
[,1] [,2] [,3]
[1,] 3 4 5
[2,] 6 8 10
[3,] 9 12 15
> u1^2
[1] 14
> s1 <- up(sin,cos,tan)
> s1
[1] up(.Primitive("sin"), .Primitive("cos"), .Primitive("tan"))
> s1(1)
Error in s1(1) : could not find function "s1"
What I need, is for it to be able to do this:
> s1(1)
[1] up(.8414709848078965 .5403023058681398 1.557407724654902)
You can not call each function in a list of functions without a loop.
I'm not fully understanding all requirements, but this should give you a start:
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec) || is.function(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <- function(...) UseMethod("up")
up.default <- function(...){
vals <- list(...)
stopifnot(all(vapply(vals, is.vector, FUN.VALUE = logical(1))))
vec <- unlist(vals, use.names = FALSE)
new_Struct("up",vec)
}
up.function <- function(...){
funs <- list(...)
stopifnot(all(vapply(funs, is.function, FUN.VALUE = logical(1))))
new_Struct("up", function(x) new_Struct("up", sapply(funs, do.call, list(x))))
}
up(1, 2, 3)
#[1] 1 2 3
#attr(,"class")
#[1] "Struct"
#attr(,"type")
#[1] "up"
up(1, 2, sin)
#Error in up.default(1, 2, sin) :
# all(vapply(vals, is.vector, FUN.VALUE = logical(1))) is not TRUE
up(sin, 1, 2)
#Error in up.function(sin, 1, 2) :
# all(vapply(funs, is.function, FUN.VALUE = logical(1))) is not TRUE
s1 <- up(sin, cos, tan)
s1(1)
#[1] 0.8414710 0.5403023 1.5574077
#attr(,"class")
#[1] "Struct"
#attr(,"type")
#[1] "up"
After some thought I have come up with a way to approach this, it's not perfect, it would be great if someone could figure out a way to make the function call implicit/transparent.
So, for now I just use the call() mechanism on the object, and that seems to work fine. Here's the pertinent part of the code, minus checks. I'll put up the latest full version on the same gist as above.
# constructor
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <- function(...){
vec <- unlist(list(...), use.names = FALSE)
new_Struct("up",vec)
}
down <- function(...){
vec <- unlist(list(...), use.names = FALSE)
new_Struct("down",vec)
}
# generic print for tuples
print.Struct <- function(s){
outstr <- sprintf("%s(%s)", attributes(s)$type, paste(c(s), collapse=", "))
print(noquote(outstr))
}
# apply the structure - would be nice if this could be done *implicitly*
call <- function(...) UseMethod("call")
call.Struct <- function(s,x){
new_Struct(attributes(s)$type, sapply(s, do.call, list(x)))
}
Now I can do:
> s1 <- up(sin,cos,tan)
> length(s1)
[1] 3
> call(s1,1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
>
Not as nice as my ultimate target of
> s1(1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
but it will do for now...
I'm running several tests for a given object x. For a given test (being a test a function that returns TRUE or FALSE when applied to an object) it is quite easy, as you can do lapply(x, test). For example:
# This would return TRUE
lapply('a', is.character)
However, I would like to create a function pass_tests, which would be able to combine multiple tests, i.e. that it could run something like this:
pass_tests('a', is.character | is.numeric)
Therefore, it should combine multiple functions given in an argument of the function, combining its result when testing an object x. In this case, it would return whether 'a' is character OR numeric, which would be TRUE. The following line should return FALSE:
pass_tests('a', is.character & is.numeric)
The idea is that it could be flexible for different combinations , e.g.:
pass_tests(x, test1 & (test2 | test3))
Any idea if functions can be logically combined this way?
Another option would be to use the pipes
library(magrittr) # or dplyr
"a" %>% {is.character(.) & is.numeric(.)}
#FALSE
"a" %>% {is.character(.) | is.numeric(.)}
#TRUE
1 %>% {is.finite(.) & (is.character(.) | is.numeric(.))}
#TRUE
Edit: used in a function with string
pass_test <- function(x, expr) {
x %>% {eval(parse(text = expr))}
}
pass_test(1, "is.finite(.) & (is.character(.) | is.numeric(.))")
#TRUE
The argument expr can be a string or an expression as in expression(is.finite(.) & (is.character(.) | is.numeric(.))).
Here's another way to do it by creating infix operators.
`%and%` <- function(lhs, rhs) {
function(...) lhs(...) & rhs(...)
}
`%or%` <- function(lhs, rhs) {
function(...) lhs(...) | rhs(...)
}
(is.character %and% is.numeric)('a')
#> [1] FALSE
(is.character %or% is.numeric)('a')
#> [1] TRUE
These can be chained together. However, it will not have the normal AND/OR precedence. It will be evaluated left-to-right.
(is.double %and% is.numeric %and% is.finite)(12)
#> [1] TRUE
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
What I'm trying to do is trivial but I've not found a clear solution to it:
For instance, I have the following function:
sample.function <- function(a, b, named="test") {
...
}
I wish I could inspect the function and obtain the arguments (maybe as an R list), given ret is the returned value of the desired function, fhe following assertions should be all True
ret <- magicfunction(sample.function)
ret[[1]] == "a"
ret[[2]] == "b"
ret$named == "test"
can it be done?
Here are a few things you can look at, inside or outside of the function.
> f <- function(FUN = sum, na.rm = FALSE) {
c(formals(f), args(f), match.fun(FUN))
}
> f()
$FUN
sum
$na.rm
[1] FALSE
[[3]]
function (FUN = sum, na.rm = FALSE)
NULL
[[4]]
function (..., na.rm = FALSE) .Primitive("sum")
This will work if the function encloses its body with brace brackets (which nearly all functions do). It gives a list whose names are the argument names and whose values are the defaults:
sample.function <- function(a, b, named="test") {} # test function
L <- as.list(formals(sample.function))); L
## $a
##
## $b
##
## $named
## [1] "test"
This is slightly longer but works even for functions whose bodies are not surrounded by brace brackets:
head(as.list(args(sample.function)), -1)
# same output
head(as.list(args(sin)), -1) # sin has no {}
## $x
Returning to the first example, to examine the default values for missing:
sapply(L, identical, formals(function(x) {})$x)
## a b named
## TRUE TRUE FALSE
Revised