Multiple dispatches on an a single overloaded operator in S3 (in R)

Question

I want to overload the '*' (multiplication operator) in R, when using an S3 class.

I see that * is already generic in the system, but I also want it "generic2", i.e. dispatching on the second argument.

The use case is as follows: Say my class is called "Struct". I want to be able to allow for all three of these cases

Struct * Struct 
Struct * Number
Number * Struct

However I found that if I allow for dispatching on the second argument, the (already present) dispatching on the first is overridden!

Is there a way that I can do this in S3?

# "generic1" already exists for '*'

'*' <- function(x,y){
  UseMethod('*2',y)
}

'*.Struct'<-function(x,y){
  # must both be structs, so dispatch 'normally' if not
  "times(1)"
}

`*2.Struct`<-function(x,y){
  # must both be structs, so dispatch 'normally' if not
  "times(2)"
}

Gives me...

> struct1 * struct2
[1] "times(2)"
> 2 * struct2
[1] "times(2)"
> struct1 * 2
Error in UseMethod("*2", y) : 
  no applicable method for '*2' applied to an object of class "c('double', 'numeric')"
> 

If I use this, instead

'*' <- function(x,y){ UseMethod('*',x)}

Then the dispatch on the first argument works, and the opposite happens:

> struct1 * 2
[1] "times(1)"
> struct1 * struct2
[1] "times(1)"
> 2* struct1 
Error in UseMethod("*", x) : 
  no applicable method for '*' applied to an object of class "c('double', 'numeric')"
> 

So it seems that they're definitely overwriting each other.

Any ideas about how both may coexist peacefully and productively?

Answer 1

You could check inside the function :

'*.Struct'<-function(x,y){
  if(inherits(x,'Struct') && inherits(y,'Struct'))
    "Struct*Struct"
  else if(inherits(y,'Struct'))
    "N*Struct"
  else
    "Struct*N"
}
# N.B.: you don't need to redefine `*`,`*2.Struct` etc

e.g. :

struct1=structure(5,class='Struct')
struct2=structure(3,class='Struct')

struct1*struct2
# [1] "Struct*Struct"
struct1*2
# [1] "Struct*N"
3*struct2
# [1] "N*Struct"

---

As stated here dispatching works on both arguments with the following rule :

If a method is found for just one argument or the same method is found for both, it is used. If different methods are found, there is a warning about ‘incompatible methods’: in that case or if no method is found for either argument the internal method is used.

So, for example since there's also a *.difftime method define, these cases will give odd results with warnings :

difftimeObj <- Sys.time()-Sys.time()

struct1*difftimeObj
# [1] 0
# attr(,"units")
# [1] "secs"
# attr(,"class")
# [1] "Struct"
# Warning message:
# Incompatible methods ("*.Struct", "*.difftime") for "*" 

difftimeObj*struct2
# Time difference of 0 secs
# Warning message:
# Incompatible methods ("*.difftime", "*.Struct") for "*" 

while these instead work :

struct1*unclass(difftimeObj)
# [1] "Struct*N"
unclass(difftimeObj)*struct2
# [1] "N*Struct"

# skipping dispatching
`*.Struct`(struct1, difftimeObj)
# [1] "Struct*N"
`*.Struct`(difftimeObj, struct2)
# [1] "N*Struct"