我在这里要解决的问题是需要应用（执行）一个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 =====
我已根据请求添加了一些基本示例代码。 我不确定会有多少，因此在此gist here中包含了完整的最小工作示例，包括运算符重载。
我仅在下面显示构造函数和辅助函数：
# 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)
答案 0 :(得分：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"
答案 1 :(得分：0)
经过一番思考，我想出了一种方法来解决这个问题，但这并不完美，如果有人能够找到一种使函数调用隐式/透明的方法，那将是很好的。
所以，现在我只在对象上使用call()机制，这似乎很好用。这是代码的相关部分，减去检查。我将如上所述在same gist上放置最新的完整版本。
# 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)
但是现在就可以了...