Define S3 Group generics for incompatible classes

Question

Say, I am implementing a custom S3 class, called "myclass":

myvec <- 1:5
class(myvec) <- "myclass"

I define Group Ops generics so that the class is preserved after standard operations.

Ops.myclass <- function(e1, e2) {
  if(is(e1, "myclass")) {
    e1 <- unclass(e1)
    structure(NextMethod(), class="myclass")
  } else if(is(e2, "myclass")) {
    e2 <- unclass(e2)
    structure(NextMethod(), class="myclass")
  }
}

Now my class is preserved with, for example, addition:

1 + myvec  # still has myclass
myvec + 1  # still has myclass

However, when I do this for objects that have their own Group generics, I get into issues:

myvec + Sys.Date()
[1] 19454 19455 19456 19457 19458
attr(,"class")
[1] "myclass"
Warning message:
Incompatible methods ("Ops.myclass", "+.Date") for "+"

Not only does it produce a warning, but in addition the result is different:

unclass(myvec) + Sys.Date()
[1] "2023-04-07" "2023-04-08" "2023-04-09" "2023-04-10" "2023-04-11"

Question: How can I resolve this warning and make this operation return the same result it would return if myvec didn't have a class?

Basically I want myclass to have it's own Group Generics, but act subserviently in case of a conflict and give priority to the other class, when in collision.

Mikael Jagan · Accepted Answer · 2023-04-06T21:51:04.217

AFAICT, you are out of luck with R < 4.3.0. I was going to suggest defining S4 methods like:

setOldClass("zzz")
setMethod("Ops", c("zzz", "zzz"), function(e1, e2) <do stuff>)
setMethod("Ops", c("zzz", "ANY"), function(e1, e2) <do stuff>)
setMethod("Ops", c("ANY", "zzz"), function(e1, e2) <do stuff>)

because S4 generic functions perform S4 dispatch before S3 dispatch (if they are also S3 generic). Then, in theory, S3 dispatch ambiguities would never be detected.

But then I remembered that all members of the Ops group are internally generic and so do not dispatch S4 methods when neither argument is an S4 object, as in the <zzz> + <Date> case.

R 4.3.0 introduces a new generic function chooseOpsMethod to allow users to specify how S3 dispatch ambiguities should be resolved for members of the Ops group. It is documented in ?Ops and of course in ?chooseOpsMethod. I will assume that you have read the relevant sections and just suggest this:

.S3method("chooseOpsMethod", "zzz", 
          function(x, y, mx, my, cl, reverse) TRUE)
.S3method("Ops", "zzz",
          function(e1, e2) {
              if (inherits(e1, "zzz")) {
                  class(e1) <- NULL
                  cl <- oldClass(e2)
              } else {
                  class(e2) <- NULL
                  cl <- oldClass(e1)
              }
              r <- callGeneric(e1, e2)
              ## Do not assign a class to 'r' if the "other" argument inherits
              ## from a class with a method for this generic function ...
              if (is.null(cl) ||
                  (all(match(paste0(   "Ops", ".", cl), .S3methods(   "Ops"), 0L) == 0L) && 
                   all(match(paste0(.Generic, ".", cl), .S3methods(.Generic), 0L) == 0L)))
                  class(r) <- "zzz"
              r
          })

x <- structure(0:5, class = "zzz")
x + x
## [1]  0  2  4  6  8 10
## attr(,"class")
## [1] "zzz"
x + 0
## [1] 0 1 2 3 4 5
## attr(,"class")
## [1] "zzz"
0 + x
## [1] 0 1 2 3 4 5
## attr(,"class")
## [1] "zzz"
x + .Date(0L)
## [1] "1970-01-01" "1970-01-02" "1970-01-03" "1970-01-04" "1970-01-05" "1970-01-06"
.Date(0L) + x
## [1] "1970-01-01" "1970-01-02" "1970-01-03" "1970-01-04" "1970-01-05" "1970-01-06"

That works only because there is no chooseOpsMethod.Date and because chooseOpsMethod.default returns FALSE unconditionally. Someone else could come along and register a chooseOpsMethod.Date returning TRUE, spoiling the behaviour of <Date> + <zzz>, but that is the risk you take by relying on S3 instead of S4 ...

Define S3 Group generics for incompatible classes

1 Answers1