Многократные отправки одного перегруженного оператора в S3 (в R)

Question

Я хочу перегрузить '*' (оператор умножения) в R при использовании класса S3.

Я вижу, что * уже является универсальным в системе, но я также хочу, чтобы он "generic2", то есть отправлял по второму аргументу.

Вариант использования следующий: скажем, мой класс называется "Struct". Я хочу иметь возможность учесть все эти три случая

Struct * Struct 
Struct * Number
Number * Struct

Однако я обнаружил, что если я разрешу диспетчеризацию по второму аргументу, (уже существующая) диспетчеризация по первому аргументу будет отменена!

Есть ли способ, которым я могу сделать это в 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)"
}

Дает мне ...

> 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')"
> 

Если я использую это, вместо

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

Тогда отправка по первому аргументу работает, и происходит обратное:

> 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')"
> 

Похоже, они определенно перезаписывают друг друга.

Есть идеи о том, как оба могут мирно и продуктивно сосуществовать?

Answer 1

Вы можете проверить внутри функции:

'*.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

например. :

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"

---

Как указано здесь диспетчеризация работает для обоих аргументов со следующим правилом:

Если метод найден только для одного аргумента или найден тот же метод для обоих это используется. Если найдены разные методы, есть предупреждение о «несовместимых методах»: в этом случае или если никакой метод не найдено для любого аргумента внутренний метод.

Так, например, поскольку есть также определение метода *.difftime, эти случаи будут давать странные результаты с предупреждениями:

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 "*" 

пока они работают:

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"