How could I define an application method on an S3 object in R? (like a "function object" in c++)

Question

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)

Answer 1

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...

Answer 2

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"