S3 style dispatching for S3 objects using formal method definitions

Question

Related to this question, but slightly different and hopefully more clear.

I am looking for a clean way to formally register methods for both S4 and S3 classes, but without relying on the terrible S3-dot-naming-scheme for dispatching. An example:

setClass("foo");
setClass("bar");

setGeneric("test", function(x, ...){
    standardGeneric("test");
});

setMethod("test", "bar", function(x, ...){
    return("success (bar).");
});

obj1 <- 123;
class(obj1) <- "bar";
test(obj1);

This example shows how we can register a test method for S3 objects of class bar, without the need to name the function test.bar, which is great. However, the limitation is if we register methods this way, they will only be dispatched to the first S3 class of the object. E.g:

obj2 <- 123;
class(obj2) <- c("foo", "bar");
test(obj2);

This doesn't work, because S4 method dispatching will only try class foo and its superclasses. How could this example be extended so that it will automatically select the test method for bar when no appropriate method for foo was found? E.g. S3 style dispatching but without having to go back to naming everything test.foo and test.bar?

So in summary: how to create a generic function that uses formal method dispatching, but in addition fall back on the second, third, etc class of an object for S3 objects with multiple classes.

Answer 1

?setOldClass will give the answer:

setOldClass(c("foo", "bar"))

setGeneric("test", function(x, ...)standardGeneric("test"))
setMethod("test", "bar", function(x, ...)return("success (bar)."))

Answer 2

You could write a method

test = function(x, ...) UseMethod("test")

setGeneric("test")

.redispatch = function(x, ...)
{
    if (is.object(x) && !isS4(x) && length(class(x)) != 1L) {
        class(x) = class(x)[-1]
        callGeneric(x, ...)
    } else callNextMethod(x, ...)
}

setMethod(test, "ANY", .redispatch)

But I personally wouldn't mix S3 and S4 in this way.