# NOT RUN {
## callNextMethod() used for the Math, Math2 group generic functions
## A class to automatically round numeric results to "d" digits
rnum <- setClass("rnum", slots = c(d = "integer"), contains = "numeric")
## Math functions operate on the rounded numbers, return a plain
## vector. The next method will always be the default, usually a primitive.
setMethod("Math", "rnum",
function(x)
callNextMethod(round(as.numeric(x), x@d)))
setMethod("Math2", "rnum",
function(x, digits)
callNextMethod(round(as.numeric(x), x@d), digits))
## Examples of callNextMethod with two arguments in the signature.
## For arithmetic and one rnum with anything, callNextMethod with no arguments
## round the full accuracy result, and return as plain vector
setMethod("Arith", c(e1 ="rnum"),
function(e1, e2)
as.numeric(round(callNextMethod(), e1@d)))
setMethod("Arith", c(e2 ="rnum"),
function(e1, e2)
as.numeric(round(callNextMethod(), e2@d)))
## A method for BOTH arguments from "rnum" would be ambiguous
## for callNextMethod(): the two methods above are equally valid.
## The method chooses the smaller number of digits,
## and then calls the generic function, postponing the method selection
## until it's not ambiguous.
setMethod("Arith", c(e1 ="rnum", e2 = "rnum"),
function(e1, e2) {
if(e1@d <= e2@d)
callGeneric(e1, as.numeric(e2))
else
callGeneric(as.numeric(e1), e2)
})
## For comparisons, callNextMethod with the rounded arguments
setMethod("Compare", c(e1 = "rnum"),
function(e1, e2)
callNextMethod(round(e1, e1@d), round(e2, e1@d)))
setMethod("Compare", c(e2 = "rnum"),
function(e1, e2)
callNextMethod(round(e1, e2@d), round(e2, e2@d)))
## similarly to the Arith case, the method for two "rnum" objects
## can not unambiguously use callNextMethod(). Instead, we rely on
## The rnum() method inhertited from Math2 to return plain vectors.
setMethod("Compare", c(e1 ="rnum", e2 = "rnum"),
function(e1, e2) {
d <- min(e1@d, e2@d)
callGeneric(round(e1, d), round(e2, d))
})
set.seed(867)
x1 <- rnum(10*runif(5), d=1L)
x2 <- rnum(10*runif(5), d=2L)
x1+1
x2*2
x1-x2
## Simple examples to illustrate callNextMethod with and without arguments
B0 <- setClass("B0", slots = c(s0 = "numeric"))
## and a function to illustrate callNextMethod
f <- function(x, text = "default") {
str(x) # print a summary
paste(text, ":", class(x))
}
setGeneric("f")
setMethod("f", "B0", function(x, text = "B0") {
cat("B0 method called with s0 =", x@s0, "\n")
callNextMethod()
})
b0 <- B0(s0 = 1)
## call f() with 2 arguments: callNextMethod passes both to the default method
f(b0, "first test")
## call f() with 1 argument: the default "B0" is not passed by callNextMethod
f(b0)
## Now, a class that extends B0, with no methods for f()
B1 <- setClass("B1", slots = c(s1 = "character"), contains = "B0")
b1 <- B1(s0 = 2, s1 = "Testing B1")
## the two cases work as before, by inheriting the "B0" method
f(b1, b1@s1)
f(b1)
B2 <- setClass("B2", contains = "B1")
## And, a method for "B2" that calls with explicit arguments.
## Note that the method selection in callNextMethod
## uses the class of the *argument* to consistently select the "B0" method
setMethod("f", "B2", function(x, text = "B1 method") {
y <- B1(s0 = -x@s0, s1 ="Modified x")
callNextMethod(y, text)
})
b2 <- B2(s1 = "Testing B2", s0 = 10)
f(b2, b2@s1)
f(b2)
## Be careful: the argument passed must be legal for the method selected
## Although the argument here is numeric, it's still the "B0" method that's called
setMethod("f", "B2", function(x, text = "B1 method") {
callNextMethod(x@s0, text)
})
## Now the call will cause an error:
tryCatch(f(b2), error = function(e) cat(e$message,"\n"))
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab