我正在嘗試撰寫一個專門回傳與輸入長度相同的數字向量的 S4 類。我想我很接近了；我現在遇到的問題是我只能從我的 GlobalEnv 中的函式創建新類。
library(S4Vectors)
setClass("TransFunc", contains = c("function"), prototype = function(x) x)
TransFunc <- function(x) {
if (missing(x)) return(new("TransFunc"))
new2("TransFunc", x)
}
.TransFunc.validity <- function(object) {
msg <- NULL
if (length(formals(object)) > 1) {
msg <- c(msg, "TransFunc must only have one argument.")
}
res1 <- object(1:5)
res2 <- object(1:6)
if (length(res1) != 5 || length(res2) != 6) {
msg <- c(msg, "TransFunc output length must equal input length.")
}
if (!class(res1) %in% c("numeric", "integer")) {
msg <- c(msg, "TransFunc output must be numeric for numeric inputs.")
}
if (is.null(msg)) return(TRUE)
msg
}
setValidity2(Class = "TransFunc", method = .TransFunc.validity)
mysqrt <- TransFunc(function(x) sqrt(x))
mysqrt <- TransFunc(sqrt) ## Errors... why??
## Error in initialize(value, ...) :
## 'initialize' method returned an object of class “function” instead
## of the required class “TransFunc”
讓類直接從函式繼承的好處是能夠將它們用作常規函式：
mysqrt(1:5)
## [1] 1.000000 1.414214 1.732051 2.000000 2.236068
body(mysqrt) <- expression(sqrt(x)^2)
mysqrt(1:10)
## [1] 1 2 3 4 5 6 7 8 9 10
為什么在全域環境之外傳遞函式時會出錯？
uj5u.com熱心網友回復：
它不起作用，sqrt因為 sqrt 是primitive.
我不知道有任何函式只接受一個引數并且不是原始的。因此，我降低了您的有效性以演示您的代碼如何與預加載包中的其他功能一起使用：
#using your class definition and counstructor
.TransFunc.validity <- function(object) {
msg <- NULL
res1 <- object(1:5)
if (!class(res1) %in% c("numeric", "integer")) {
msg <- c(msg, "TransFunc output must be numeric for numeric inputs.")
}
if (is.null(msg)) return(TRUE)
msg
}
setValidity2(Class = "TransFunc", method = .TransFunc.validity)
以下是默認版本的結果 mean
mymean <- TransFunc(mean.default)
mymean(1:5)
[1] 3
這是通過修改initialize您的類以捕獲原語并將它們轉換為閉包的解決方法：
#I modified the class definition to use slots instead of prototype
setClass("TransFunc", contains = c("function"))
TransFunc <- function(x) {
if (missing(x)) return(new("TransFunc"))
new2("TransFunc", x)
}
# Keeping your validity I changed initilalize to:
setMethod("initialize", "TransFunc",
function(.Object, .Data = function(x) x , ...) {
if(typeof(.Data) %in% c("builtin", "special"))
.Object <- callNextMethod(.Object, function(x) return(.Data(x)),...)
else
.Object <- callNextMethod(.Object, .Data, ...)
.Object
})
我得到以下結果
mysqrt <- TransFunc(sqrt)
mysqrt(1:5)
[1] 1.000000 1.414214 1.732051 2.000000 2.236068
編輯：
@ekoam 在評論中為您的班級提出了更通用的 initilaize 版本：
setMethod("initialize", "TransFunc", function(.Object, ...)
{maybe_transfunc <- callNextMethod();
if (is.primitive(maybe_transfunc))
.Object@.Data <- maybe_transfunc
else .Object <- maybe_transfunc;
.Object})
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/414272.html
標籤：