Как я могу определить метод приложения для объекта S3 в R? (как «объект функции» в c ++)

Question

Проблема, которую я пытаюсь решить, заключается в необходимости применения (выполнения) объекта S3, который по сути является вектороподобной структурой. Это может содержать различные формулы, которые на каком-то этапе мне нужно оценить для одного аргумента, чтобы получить вектороподобный объект исходной формы, содержащий оценку составляющих его формул по данному аргументу.

Примерами этого (просто чтобы проиллюстрировать) может быть матрица преобразования, скажем, вращения, которая будет принимать угол поворота на угол, и создавать матрицу значений, на которую нужно умножить точку для данного вращения. Другим примером может быть вектор состояний в задаче классической механики. Тогда, учитывая t , v , a и т. Д., Он может вернуть s ...

Теперь я создал свой контейнерный объект в S3, и он в большинстве случаев работает нормально, используя универсальные методы; Я также нашел очень полезной систему перегрузки операторов Ops.myClass.

Чтобы завершить мой урок, все, что мне сейчас нужно, это способ указать его как исполняемый. Я вижу, что существуют различные механизмы, которые будут делать то, что я хочу частично, например, я предполагаю, что as.function() преобразует объект в поведение, которое я хочу, и что-то вроде lapply() может быть использовано для "обратного" применения аргумент к функциям. То, что я не уверен, как это сделать, это связать все это так, чтобы я мог сделать что-то вроде этого макета:

new_Object <- function(<all my function vector stuff spec>)
vtest <- new_Object(<say, sin, cos, tan>)
vtest(1)
   ==>
myvec(.8414709848078965 .5403023058681398 1.557407724654902)

(Да, я уже определил стандартную подпрограмму print(), которая сделает его красивым)

Приветствуются все предложения, примеры кода, ссылки на примеры.

PS =====

Я добавил несколько базовых примеров кода согласно запросу. Я не уверен, сколько будет слишком много, поэтому полный рабочий минимальный пример, включая перегрузку операторов, приведен в этом списке здесь .

Ниже показаны только функции конструктора и вспомогательные функции:

# 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)
}

Приведенный выше код ведет себя так:

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

Что мне нужно, так это чтобы это можно было сделать:

> s1(1)
[1] up(.8414709848078965 .5403023058681398 1.557407724654902)

Answer 1

После некоторой мысли, что я нашел способ приблизиться к этому, он не идеален, было бы замечательно, если бы кто-то мог найти способ сделать вызов функции неявным / прозрачным.

Итак, сейчас я просто использую механизм call() на объекте, и это, кажется, работает нормально. Вот соответствующая часть кода, за исключением проверок. Я поставлю последнюю полную версию на той же сути , как указано выше.

# 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)))
}

Теперь я могу сделать:

> s1 <- up(sin,cos,tan)
> length(s1)
[1] 3
> call(s1,1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
> 

Не так хорош, как моя конечная цель

> s1(1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)

но пока подойдет ...

Answer 2

Вы не можете вызывать каждую функцию в списке функций без цикла.

Я не полностью понимаю все требования, но это должно дать вам начало:

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"