Group generic methods for Ops (for time-series)

Question

I try to define a class Ops inheritance on a S3 class that is a list and has a time serie inside the list.

tsnewobject_a <- structure(list(data=ts(1:10,frequency=4,start=2010)),
                           class="newclass")
tsnewobject_b <- structure(list(data=ts(10:1,frequency=4,start=2010)),
                           class="newclass")

## Step 1 : with S3 only (note : I don't want to modify Ops.ts)

Ops.newclass <- function(e1,e2) {
  if (inherits(e1,"newclass")) e1 <- e1$data
  if (inherits(e2,"newclass")) e2 <- e2$data
  get(.Generic)(e1,e2)
}

tsnewobject_a+tsnewobject_b
#      Qtr1 Qtr2 Qtr3 Qtr4
# 2010   11   11   11   11
# 2011   11   11   11   11
# 2012   11   11 

# It works !

tsnewobject_a+1
#      Qtr1 Qtr2 Qtr3 Qtr4
# 2010    2    3    4    5
# 2011    6    7    8    9
# 2012   10   11 

# It works !

1+tsnewobject_a
#      Qtr1 Qtr2 Qtr3 Qtr4
# 2010    2    3    4    5
# 2011    6    7    8    9
# 2012   10   11 

# It works !

tsnewobject_a+ts(1:10,frequency=4,start=2010)
# Error in tsnewobject_a + ts(1:10, frequency = 4, start = 2010) : 
#   non-numeric argument to binary operator
# In addition: Warning message:
# Incompatible methods ("Ops.newclass", "Ops.ts") for "+" 

# It doesn't work (it's expected)

ts(1:10,frequency=4,start=2010)+tsnewobject_a
# Error in ts(1:10, frequency = 4, start = 2010) + tsnewobject_a : 
#   non-numeric argument to binary operator
# In addition: Warning message:
# Incompatible methods ("Ops.ts", "Ops.newclass") for "+" 

# It doesn't work (it's expected)

Due to S3 double dispatch, it doesn't work with a simple method. And as I don't want to override Ops.ts (it's for a package) I have to find something.

## Step 2 : setOldClass to complete S3 with a small s4 fix

setOldClass("newclass")
setMethod("Ops",signature = c("newclass","ts"),function(e1,e2) callGeneric(e1$data,e2))
setMethod("Ops",signature = c("ts","newclass"),function(e1,e2) callGeneric(e1,e2$data))

tsnewobject_a+ts(1:10,frequency=4,start=2010)

# Error in tsnewobject_a + ts(1:10, frequency = 4, start = 2010) : 
#   non-numeric argument to binary operator
# In addition: Warning message:
# Incompatible methods ("Ops.newclass", "Ops.ts") for "+" 

# Still doesn't work

ts(1:10,frequency=4,start=2010)+tsnewobject_a

# Error in ts(1:10, frequency = 4, start = 2010) + tsnewobject_a : 
#   non-numeric argument to binary operator
# In addition: Warning message:
# Incompatible methods ("Ops.ts", "Ops.newclass") for "+" 

# Still doesn't work

It seems strange to me, as Ops is a S4 group generic. Shouldn't it call the available S4 methods, then, if there is none, go to S3 ? What happens and how could it be fixed ?

score 2 · Answer 1 · answered Mar 24 '23 at 18:31

The members of the Ops group are internally generic. Dispatch is performed by the C-level function DispatchGroup, which looks for S4 methods only if one or both of the arguments is an S4 object. setOldClass("newclass") does not make isS4(<newclass>) true, so your S4 methods are never dispatched:

setOldClass("newclass")
isS4(structure(0, class = "newclass"))
## [1] FALSE

To make this work, define newclass as an S4 subclass of ts, which already has an S4 definition in package methods:

showClass("ts") # has slots .Data, tsp, .S3Class
setClass("newclass", contains = "ts")
showClass("newclass")

setAs("ts", "S3", 
      function(from) {
          if (isS4(from)) 
              structure(from@.Data, tsp = from@tsp, class = "ts") 
          else from
      })
setAs("ts", "S4",
      function(from) {
          if (isS4(from)) 
              from 
          else {
              dat. <- as.vector(from)
              tsp. <- tsp(from)
              new("ts", data = dat., start = tsp.[1L], end = tsp.[2L], frequency = tsp.[3L])
          }
      })
setMethod("Ops", c("ts", "ts"), 
          function(e1, e2) {
              callGeneric(if (isS4(e1)) as(e1, "S3") else e1,
                          if (isS4(e2)) as(e2, "S3") else e2)
          })

a <- ts(1:10, start = 2010, frequency = 4)
b <- as(a, "S4")

aa <- a + a
identical(a + b, aa)
## [1] TRUE
identical(b + a, aa)
## [1] TRUE
identical(b + b, aa)
## [1] TRUE

You'll find the relevant details in ?setOldClass, ?S3Part, and ?`ts-class`, but everything is a bit scattered.

P.S.: I defined my own coercion methods because the methods inherited from package methods didn't seem to work as documented. I'm going to investigate a bit more, in case I'm wrong (which often happens), in which case I'll edit the answer.

Group generic methods for Ops (for time-series)

1 Answers1

Linked