# NOT RUN {
## A class that extends a registered S3 class inherits that class' S3
## methods.
setClass("myFrame", contains = "data.frame",
slots = c(timestamps = "POSIXt"))
df1 <- data.frame(x = 1:10, y = rnorm(10), z = sample(letters,10))
mydf1 <- new("myFrame", df1, timestamps = Sys.time())
## "myFrame" objects inherit "data.frame" S3 methods; e.g., for `[`
# }
# NOT RUN {
<!-- % random -->
mydf1[1:2, ] # a data frame object (with extra attributes)
# }
# NOT RUN {
## a method explicitly for "myFrame" class
setMethod("[",
signature(x = "myFrame"),
function (x, i, j, ..., drop = TRUE)
{
S3Part(x) <- callNextMethod()
x@timestamps <- c(Sys.time(), as.POSIXct(x@timestamps))
x
}
)
# }
# NOT RUN {
mydf1[1:2, ]
# }
# NOT RUN {
setClass("myDateTime", contains = "POSIXt")
now <- Sys.time() # class(now) is c("POSIXct", "POSIXt")
nowLt <- as.POSIXlt(now)# class(nowLt) is c("POSIXlt", "POSIXt")
mCt <- new("myDateTime", now)
mLt <- new("myDateTime", nowLt)
## S3 methods for an S4 object will be selected using S4 inheritance
## Objects mCt and mLt have different S3Class() values, but this is
## not used.
f3 <- function(x)UseMethod("f3") # an S3 generic to illustrate inheritance
f3.POSIXct <- function(x) "The POSIXct result"
f3.POSIXlt <- function(x) "The POSIXlt result"
f3.POSIXt <- function(x) "The POSIXt result"
stopifnot(identical(f3(mCt), f3.POSIXt(mCt)))
stopifnot(identical(f3(mLt), f3.POSIXt(mLt)))
## An S4 object selects S3 methods according to its S4 "inheritance"
setClass("classA", contains = "numeric",
slots = c(realData = "numeric"))
Math.classA <- function(x) { (getFunction(.Generic))(x@realData) }
setMethod("Math", "classA", Math.classA)
x <- new("classA", log(1:10), realData = 1:10)
stopifnot(identical(abs(x), 1:10))
setClass("classB", contains = "classA")
y <- new("classB", x)
stopifnot(identical(abs(y), abs(x))) # (version 2.9.0 or earlier fails here)
## an S3 generic: just for demonstration purposes
f3 <- function(x, ...) UseMethod("f3")
f3.default <- function(x, ...) "Default f3"
## S3 method (only) for classA
f3.classA <- function(x, ...) "Class classA for f3"
## S3 and S4 method for numeric
f3.numeric <- function(x, ...) "Class numeric for f3"
setMethod("f3", "numeric", f3.numeric)
## The S3 method for classA and the closest inherited S3 method for classB
## are not found.
f3(x); f3(y) # both choose "numeric" method
## to obtain the natural inheritance, set identical S3 and S4 methods
setMethod("f3", "classA", f3.classA)
f3(x); f3(y) # now both choose "classA" method
## Need to define an S3 as well as S4 method to use on an S3 object
## or if called from a package without the S4 generic
MathFun <- function(x) { # a smarter "data.frame" method for Math group
for (i in seq(length = ncol(x))[sapply(x, is.numeric)])
x[, i] <- (getFunction(.Generic))(x[, i])
x
}
setMethod("Math", "data.frame", MathFun)
## S4 method works for an S4 class containing data.frame,
## but not for data.frame objects (not S4 objects)
try(logIris <- log(iris)) #gets an error from the old method
## Define an S3 method with the same computation
Math.data.frame <- MathFun
logIris <- log(iris)
# }
# NOT RUN {
# }
Run the code above in your browser using DataLab