Combining S4 and S3 Methods in a Single Function

Combining S4 and S3 methods in a single function

The section "Methods for S3 Generic Functions" of ?Methods suggest an S3 generic, an S3-style method for S4 classes, and the S4 method itself.

setClass("A")                    # define a class

f3 <- function(x, ...)           # S3 generic, for S3 dispatch    
    UseMethod("f3")
setGeneric("f3")                 # S4 generic, for S4 dispatch, default is S3 generic
f3.A <- function(x, ...) {}      # S3 method for S4 class
setMethod("f3", "A", f3.A)       # S4 method for S4 class

The S3 generic is needed to dispatch S3 classes.

The setGeneric() sets the f3 (i.e., the S3 generic) as the default, and f3,ANY-method is actually the S3 generic. Since 'ANY' is at (sort of) the root of the class hierarchy, any object (e.g., S3 objects) for which an S4 method does not exist ends up at the S3 generic.

The definition of an S3 generic for an S4 class is described on the help page ?Methods. I think, approximately, that S3 doesn't know about S4 methods, so if one invokes the S3 generic (e.g., because one is in a package name space where the package knows about the S3 f3 but not the S4 f3) the f3 generic would not find the S4 method. I'm only the messenger.

Method dispatch when mixing S3 and S4

In order for S3 methods to be registered, the generic has to be available. Here, I write a simple foo method for merMod objects:

> library(lme4)
> foo.merMod = function(object, ...) { "foo" }

> showMethods(class = "merMod")

Function ".DollarNames":
 <not an S4 generic function>

Function "complete":
 <not an S4 generic function>

Function "formals<-":
 <not an S4 generic function>

Function "functions":
 <not an S4 generic function>
Function: getL (package lme4)
x="merMod"

Function "prompt":
 <not an S4 generic function>
Function: show (package methods)
object="merMod"

> methods(class = "merMod")
 [1] anova          as.function    coef           confint        cooks.distance
 [6] deviance       df.residual    drop1          extractAIC     family        
[11] fitted         fixef          formula        getL           getME         
[16] hatvalues      influence      isGLMM         isLMM          isNLMM        
[21] isREML         logLik         model.frame    model.matrix   ngrps         
[26] nobs           plot           predict        print          profile       
[31] ranef          refit          refitML        rePCA          residuals     
[36] rstudent       show           sigma          simulate       summary       
[41] terms          update         VarCorr        vcov           weights              

Neither list includes foo. But if we define the generic, then it shows up in methods() results:

> foo = function(object, ...) UseMethod("foo")
> methods(class = "merMod")
 [1] anova          as.function    coef           confint        cooks.distance
 [6] deviance       df.residual    drop1          extractAIC     family        
[11] fitted         fixef          foo            formula        getL          
[16] getME          hatvalues      influence      isGLMM         isLMM         
[21] isNLMM         isREML         logLik         model.frame    model.matrix  
[26] ngrps          nobs           plot           predict        print         
[31] profile        ranef          refit          refitML        rePCA         
[36] residuals      rstudent       show           sigma          simulate      
[41] summary        terms          update         VarCorr        vcov          
[46] weights       

Now it includes foo

Similarly, in your example, methods() will reveal the existence of cld if you do library(multcomp), because that is where the generic for cld sits.

Adding S4 dispatch to base R S3 generic

The mis-dispatch occurs because the body of the generic is not "standard" (I think the rationale is that, since you've done something other than invoke standardGeneric("merge"), you know what you're doing so no automatic default; maybe I'm making this up and it's really a bug). Solutions are to set a standard generic allowing for the default dispatch

setGeneric("merge")

or to explicitly provide standard dispatch

setGeneric("merge", function(x, y, ...) standardGeneric("merge"))

or explicitly specify a default method

setGeneric("merge", function(x, y, ...){
  cat("generic dispatch\n")
  standardGeneric("merge")
}, useAsDefault=base::merge)

emulating multiple dispatch using S3 for + method - possible?

You can do it by defining +.a and +.b as the same function. For example:

a <- "a"
class(a) <- "a"
b <- "b"
class(b) <- "b"

`+.a` <- function(e1, e2){
  paste(class(e1), "+", class(e2))
}
`+.b` <- `+.a`

a+a
# [1] "a + a"
a+b
# [1] "a + b"
b+a
# [1] "b + a"
b+b
# [1] "b + b"

# Other operators won't work
a-a
# Error in a - a : non-numeric argument to binary operator

If you define Ops.a and Ops.b, it will also define the operation for other operators, which can be accessed by .Generic in the function:

##### Start a new R session so that previous stuff doesn't interfere ####
a <- "a"
class(a) <- "a"
b <- "b"
class(b) <- "b"

Ops.a <- function(e1, e2){
  paste(class(e1), .Generic, class(e2))
}

Ops.b <- Ops.a

a+a
# [1] "a + a"
a+b
# [1] "a + b"
b+a
# [1] "b + a"
b+b
# [1] "b + b"

# Ops covers other operators besides +
a-a
# [1] "a - a"
a*b
# [1] "a * b"
b/b
# [1] "b / b"

Update: one more thing I discovered while playing with this. If you put this in a package, you'll get the "non-numeric argument" error and "incompatible operators" warning. This is because R is only OK with the multiple operators if they are exactly the same object, with the same address in memory -- but somehow in the building and loading of a package, the two functions lose this exact identity. (You can check this by using pryr::address())

One thing I've found that works is to explicitly register the S3 methods when the package is loaded. For example, this would go inside your package:

# Shows the classes of the two objects that are passed in
showclasses <- function(e1, e2) {
  paste(class(e1), "+", class(e2))
}    

.onLoad <- function(libname, pkgname) {
  registerS3method("+", "a", showclasses)
  registerS3method("+", "b", showclasses)
}

In this case, the two methods point to the exact same object in memory, and it works (though it's a bit of a hack).

Can we combine S3 flexibility with S4 representation checking?

The easiest thing would be to write a validation function for each class and pass objects through it before S3 method dispatch or within each class's method. Here's an example with a simple validation function called check_example_class for an object of class "example_class":

check_example_class <- function(x) {
  stopifnot(length(x) == 2)
  stopifnot("a" %in% names(x))
  stopifnot("b" %in% names(x))
  stopifnot(is.numeric(x$a))
  stopifnot(is.character(x$b))
  NULL
}
print.example_class <- function(x, ...) {
    check_example_class(x)
    cat("Example class object where b =", x$b, "\n")
    invisible(x)
}

# an object of the class
good <- structure(list(a = 1, b = "foo"), class = "example_class")

# an object that pretends to be of the class
bad <- structure(1, class = "example_class")

print(good) # works
## Example class object where b = foo
print(bad)  # fails
## Error: length(x) == 2 is not TRUE

function to return all S3 methods applicable to an object

Here's an attempt to replicate the "standard" behavior

classMethods <- function(cl) {
    if(!is.character(cl)) {
        cl<-class(cl)
    }
    ml<-lapply(cl, function(x) {
        sname <- gsub("([.[])", "\\\\\\1", paste0(".", x, "$"))
        m <- methods(class=x)
        data.frame(
            m=as.vector(m), 
            c=x, n=sub(sname, "", as.vector(m)),
            attr(m,"info"),
            stringsAsFactors=F
        )
    })
    df<-do.call(rbind, ml)
    df<-df[!duplicated(df$n),]
    structure(df$m, 
        info=data.frame(visible=df$visible, from=df$from), 
        class="MethodsFunction")
}

And then you can try it out with

g <- glm(y~x,data=data.frame(x=1:10,y=1:10))
classMethods(g)
#or classMethods(c("glm","lm"))

and that will return

 [1] add1.glm*           anova.glm           confint.glm*        cooks.distance.glm*
 [5] deviance.glm*       drop1.glm*          effects.glm*        extractAIC.glm*    
 [9] family.glm*         formula.glm*        influence.glm*      logLik.glm*        
[13] model.frame.glm     nobs.glm*           predict.glm         print.glm          
[17] residuals.glm       rstandard.glm       rstudent.glm        summary.glm        
[21] vcov.glm*           weights.glm*        alias.lm*           case.names.lm*     
[25] dfbeta.lm*          dfbetas.lm*         dummy.coef.lm*      hatvalues.lm       
[29] kappa.lm            labels.lm*          model.matrix.lm     plot.lm            
[33] proj.lm*            qr.lm*              simulate.lm*        variable.names.lm* 

   Non-visible functions are asterisked

It's not as elegant or short as Josh's, but I think its a good recreation of the default behavior. It's funny to see that the methods function is itself mostly just a grep across all known function names. I borrowed the gsub stuff from there.

What does S3 methods mean in R?

Most of the relevant information can be found by looking at ?S3 or ?UseMethod, but in a nutshell:

S3 refers to a scheme of method dispatching. If you've used R for a while, you'll notice that there are print, predict and summary methods for a lot of different kinds of objects.

In S3, this works by:

• setting the class of objects of
  interest (e.g.: the return value of a
  call to method glm has class glm)
• providing a method with the general
  name (e.g. print), then a dot, and
  then the classname (e.g.:
  print.glm)
• some preparation has to have been
  done to this general name (print)
  for this to work, but if you're
  simply looking to conform yourself to
  existing method names, you don't need
  this (see the help I refered to
  earlier if you do).

To the eye of the beholder, and particularly, the user of your newly created funky model fitting package, it is much more convenient to be able to type predict(myfit, type="class") than predict.mykindoffit(myfit, type="class").

There is quite a bit more to it, but this should get you started. There are quite a few disadvantages to this way of dispatching methods based upon an attribute (class) of objects (and C purists probably lie awake at night in horror of it), but for a lot of situations, it works decently. With the current version of R, newer ways have been implemented (S4 and reference classes), but most people still (only) use S3.

---

Related Topics