对于给定的引用类方法,如何确定它是否被继承?更笼统地说,如何确定继承树有多远?
例如,如果我的设置是:
A <- setRefClass("A",
methods = list(foo = function() whosMethod())
)
B <- setRefClass("B",
contains = "A",
methods = list(bar = function() whosMethod())
)
b <- B()
理想情况下,我想whosMethod()
给我类似的东西
> b$foo()
[1] "A" # or maybe a numeric value like: [1] 1L
> b$bar()
[1] "B" # or maybe a numeric value like: [1] 0L
请注意,这与明显不同class(.self)
,"B"
在上面的示例中总是会返回。
除了方法(例如自定义事件)之外,我还希望其他方法具有类似继承的行为。我的方法可以raise(someEvent)
并且在实例化期间,我通过事件处理程序来处理这些事件,例如
MyDatabase <- setRefClass(....)
datasourceA <- MyDatabase(....,
eventHandlers = list(
someEvent = function() message("Hello from myObj!"),
beforeInsert = function(data) {
if (!dataIsValid(data))
stop("Data is not valid!")
}
)
)
现在,如果子类定义了一个已经由父类定义的事件处理程序,那么我需要知道哪个事件处理程序应该被覆盖。特别是,如果一个methodA()
登记handlerA()
的someEvent
和methodB()
在子类中注册handlerB()
了相同的事件,当试图注册handlerA()
在methodA()
我需要知道的是,我在一个父类的方法,这样,如果handlerB()
已经注册,我不重写。
能够从子方法调用父事件处理程序(如callSuper()
方法可用的方法)也很好。
尝试这个:
methodsPerClass <- function(x) {
if (!inherits(x, "envRefClass")) {
stop("This only works for Reference Class objects")
}
## Get all superclasses of class of 'x' //
supercl <- selectSuperClasses(getClass(class(b)), directOnly=FALSE)
## Get all methods per superclass //
out <- lapply(c(class(x), supercl), function(ii) {
## Get generator object //
generator <- NULL
if (inherits(getClass(ii), "refClassRepresentation")) {
generator <- getRefClass(ii)
}
## Look up method names in class defs //
out <- NULL
if (!is.null(generator)) {
out <- names(Filter(function(x) {
attr(x, "refClassName") == generator$className
},
as.list(generator$def@refMethods))
)
}
return(out)
})
names(out) <- supercl
## Filter out the non-reference-classes //
idx <- which(sapply(out, is.null))
if (length(idx)) {
out <- out[-idx]
}
## Nicer name for actual class of 'x' //
idx <- which(names(out) == "envRefClass")
if (length(idx)) {
names(out)[idx] <- class(x)
}
return(out)
}
我敢肯定,为了消除最后的“ idx”部分,可以提出一种更好的方法来过滤掉非引用类,但是它可以工作。
这将为您提供:
methodsPerClass(x=b)
$A
[1] "bar"
$B
[1] "foo"
$.environment
[1] "import" "usingMethods" "show" "getClass" "untrace"
[6] "export" "callSuper" "copy" "initFields" "getRefClass"
[11] "trace" "field"
whosMethod <- function(x, method) {
mthds <- methodsPerClass(x=x)
out <- lapply(method, function(m) {
pattern <- paste0("^", m, "$")
idx <- which(sapply(mthds, function(ii) {
any(grepl(pattern, ii))
}))
if (!length(idx)) {
stop(paste0("Invalid method '", m,
"' (not a method of class '", class(x), "')"))
}
out <- names(idx)
})
names(out) <- method
return(out)
}
这将为您提供:
whosMethod(x=b, method="foo")
$foo
[1] "B"
whosMethod(x=b, method=c("foo", "bar"))
$foo
[1] "B"
$bar
[1] "A"
whosMethod(x=b, method=c("foo", "bar", "nonexisting"))
Error in FUN(c("foo", "bar", "nonexisting")[[3L]], ...) :
Invalid method 'nonexisting' (not a method of class 'B')
对类“ B”的所有方法运行它:
whosMethod(x=b, method=unlist(methodsPerClass(x=b)))
$bar
[1] "A"
$foo
[1] "B"
$import
[1] ".environment"
$usingMethods
[1] ".environment"
$show
[1] ".environment"
$getClass
[1] ".environment"
$untrace
[1] ".environment"
$export
[1] ".environment"
$callSuper
[1] ".environment"
$copy
[1] ".environment"
$initFields
[1] ".environment"
$getRefClass
[1] ".environment"
$trace
[1] ".environment"
$field
[1] ".environment"
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句