如何在R中的S3對象上定義應用程序方法？ （就像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

您不能在沒有循環的情況下調用函數列表中的每個函數。

我尚未完全理解所有要求，但這應該可以幫助您開始：

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"

Answer 2

經過一番思考，我想出了一種方法來解決這個問題，但這並不是完美的，如果有人能找到一種使函數調用隱式/透明的方法，那將是很好的。

因此，現在我只在對象上使用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)

但現在就可以了...