## reset inherited methods of group members ## (contributed by Martin Morgan, 2011-2-9) setClass("A", representation("numeric")) a <- new("A") setMethod("Logic", c("A", "A"), function(e1, e2) FALSE) res0 <- a & a # inherit &,A,A-method setMethod("Logic", c("A", "A"), function(e1, e2) TRUE) stopifnot(a & a) removeMethod("Logic", c("A", "A")) stopifnot(logical() == a & a) removeClass("A") ### Find inherited group methods: if(require(Matrix)) { ## , lib.loc = .Library sm <- selectMethod("-", c("dgCMatrix", "numeric"))# direct match with "Arith" s2 <- selectMethod("-", c("dtCMatrix", "numeric"))# ambiguity match with "Arith" stopifnot(sm@generic == "Arith", s2@generic == "Arith") } ## was not ok in R 2.14.x ## some tests of callGeneric(). It's reccommended for use with group generics setGeneric("f1", signature=c("a"), function(..., a) standardGeneric("f1")) setMethod("f1", c(a="ANY"), function(..., a) list(a=a, ...)) setMethod("f1", c(a="missing"), function(..., a) callGeneric(a=1, ...)) f2 <- function(b,c,d, a) { if (missing(a)) f1(b=b, c=c, d=d) else f1(a=a, b=b, c=c, d=d) } ## use callGeneric both directly (f1) and indirectly (f2) ## Latter failed pre rev. 66408; Bug ID 15937 stopifnot(identical(c(1,2,3,4), as.vector(unlist(f1(2,3,4))))) stopifnot(identical(c(1,2,3,4), as.vector(unlist(f2(2,3,4))))) ## test callGeneric() with no arguments. This is rarely used ## because nearly all applications use the groups Ops, etc. ## whose members are primitives => must supply args to callGeneric Hide <- setClass("Hide", slots = c(data = "vector"), contains = "vector") unhide <- function(obj) obj@data setGeneric("%p%", function(e1, e2) e1 + e2, group = "Ops2") setGeneric("%gt%", function(e1, e2) e1 > e2, group = "Ops2") setGroupGeneric("Ops2", function(e1,e2)NULL, knownMembers = c("%p%","%gt%")) setMethod("Ops2", c("Hide", "Hide"), function(e1, e2) { e1 <- unhide(e1) e2 <- unhide(e2) callGeneric() }) setMethod("Ops2", c("Hide", "vector"), function(e1, e2) { e1 <- unhide(e1) callGeneric() }) setMethod("Ops2", c("vector", "Hide"), function(e1, e2) { e2 <- unhide(e2) callGeneric() }) h1 <- Hide(data = 1:10) h2 <- Hide(data = (1:10)*.5+ 0.5) stopifnot(all.equal(h1%p%h2, h1@data + h2@data)) stopifnot(all.equal(h1 %gt% h2, h1@data > h2@data)) removeClass("Hide") for(g in c("f1", "%p%", "%gt%", "Ops2")) removeGeneric(g)