Make S4 object act as an S3 class? - r

Question

I would like to write an S4 object such that it can be passed to methods that only take an S3 object. (It seems like setOldClass() might be related to this but it's not clear to me from the documentation?)
e.g. for a minimal example imagine I have the S3 class and function:
myS3 <- list(a = 1, b = 2)
class(myS3) <- "myS3class"
myS3function.myS3class <- function(x) x$a + x$b
and I have the S4 object
setClass("myS4class", representation(a = "numeric", b = "numeric"))
obj <- new("myS4class", a = 1, b = 2)
Is there anything I can do such that
myS3function.myS3class(obj)
gives me same thing as
myS3function.myS3class(myS3)
by modifying only the S4 class?
Edit My rationale for this approach is to take advantage of all existing methods for the S3 class (that may generally come from other packages, etc) without having to rewrite them. I realize one approach is simply to write a coercion method (setAs()) that would turn my S4 object into and S3 object, but then a user would always have to perform this step manually. (While it works, I'm also a bit unclear whether it is bad practice to use setAs() to take an S4 class to an S3 class, rather than mapping between S4 classes).
From the way I read the documentation of setOldClass, it sounds like this can make S3 objects act like S4 objects? Is that correct? If so, my question then is if it possible to do the reverse (maybe by setting the prototype in the S4 class?).
If this is not possible, how about an explanation of the rationale why this would be a bad idea?

Answer 1

Add a method to your S4 class to convert it to being an S3 class.
setGeneric(
"as.myS3class",
function(object)
{
standardGeneric("as.myS3class")
}
)
setMethod(
"as.myS3class",
signature(object = "myS4class"),
function(object)
{
structure(list(a = object#a, b = object#b), class = "myS3class")
}
)
Then you can call the S3 method like this:
myS3function(as.myS3class(obj))

Answer 2

A successful solution is indeed buried in the documentation of setOldClass:
## Examples of S3 classes with guaranteed attributes
## an S3 class "stamped" with a vector and a "date" attribute
## Here is a generator function and an S3 print method.
## NOTE: it's essential that the generator checks the attribute classes
stamped <- function(x, date = Sys.time()) {
if(!inherits(date, "POSIXt"))
stop("bad date argument")
if(!is.vector(x))
stop("x must be a vector")
attr(x, "date") <- date
class(x) <- "stamped"
x
}
print.stamped <- function(x, ...) {
print(as.vector(x))
cat("Date: ", format(attr(x,"date")), "\n")
}
## Now, an S4 class with the same structure:
setClass("stamped4", contains = "vector", representation(date = "POSIXt"))
## We can use the S4 class to register "stamped", with its attributes:
setOldClass("stamped", S4Class = "stamped4")
selectMethod("show", "stamped")
## and then remove "stamped4" to clean up
removeClass("stamped4")
someLetters <- stamped(sample(letters, 10),
ISOdatetime(2008, 10, 15, 12, 0, 0))
st <- new("stamped", someLetters)
st
# show() method prints the object's class, then calls the S3 print method.
stopifnot(identical(S3Part(st, TRUE), someLetters))
# creating the S4 object directly from its data part and slots
new("stamped", 1:10, date = ISOdatetime(1976, 5, 5, 15, 10, 0))
Note that the S4 object can use the S3 print method. What surprised me is that this works for other methods that are defined for the S3 class but not the S4 class even without additional calls to selectMethod. I illustrate this with a more detailed example about my use case with ape::phylo object here: http://carlboettiger.info/2013/10/07/nexml-phylo-class-extension.html

Answer 3

If you want to reuse the one function for both S3 and S4 classes, and not change it, you can write your own definition for $:
f <- function(x, name)
slot(x, name)
setMethod("$", signature=c(x="myS4class"), definition=f)
myS3function.myS4class(obj)
# [1] 3
This seems rather dubious to me, though. For starters, you'll probably also need a similar method for [[, since a function could reference a list element either way:
setMethod("[[", signature=c(x="myS4class", i="character"),
definition=function(x, i) slot(x, i))
And you'll need methods for assignment as well:
setMethod("$<-", signature=c(x="myS4class", value="numeric"),
definition=function(x, name, value) `slot<-`(x, name, check=TRUE, value))
setMethod("[[<-", signature=c(x="myS4class", i="character", value="numeric"),
definition=function(x, i, value) `slot<-`(x, i, check=TRUE, value))
But then you have the problem of referencing by number:
obj[[1]]
# Error in obj[[1]] : this S4 class is not subsettable
So you need yet another method:
g <- function(x, i)
{
slots <- names(getClass("myS4class")#slots)
slot(x, slots[i])
}
setMethod("[[", signature=c(x="myS4class", i="numeric"), g)
All up, it seems like a lot of work for not much gain.