在S3 *数据框上调用自定义方法的派遣

Question

我希望能够为一个新的S3类对象与一个data.frame相乘定义自己的行为（方法）。但是我不知道如何让methods dispatch找到我的方法。有什么办法吗？

首先，我定义了S3对象'a'（oldClass "A"）和'df'（oldClass "data.frame"）：

a <- 4
oldClass(a) <- "A"
df <- data.frame(x=1:2,y=3:4)

我接着使用trace(Ops.data.frame, edit=TRUE) 在第一行添加print("Ops.data.frame")。这样，我就知道何时调用Ops.data.frame函数。以下是示例：

a*df
# [1] "Ops.data.frame"
# x  y
# 1 4 12
# 2 8 16

我可以为类“A”定义一个S3方法。

Ops.A <- function(e1, e2) {
  print("Ops.A")
  oldClass(e1) <- oldClass(e1)[oldClass(e1) != "A"]
  oldClass(e2) <- oldClass(e2)[oldClass(e2) != "A"]
  callGeneric(e1, e2)
}

这个函数会被调用对于a的情况，但不会对于df的情况。

# This successfully calls Ops.A
a*a
# [1] "Ops.A"
# [1] 16

# But this throws an error
a*df
# Error in a * df : non-numeric argument to binary operator
# In addition: Warning message:
#   Incompatible methods ("Ops.A", "Ops.data.frame") for "*" 

所以那样做行不通。

remove(Ops.A)

使用S4方法如何？这需要定义S4类“A”，但通常具有oldClass“ A”的S3对象仍将被S4分派找到。

setClass("A", list("numeric")) # Required to define a method for "A"
setGeneric("ATypicalMethod", function(e1, e2) {print("ATypicalMethod - default")})
setMethod("ATypicalMethod", signature=c("A","A"), function(e1, e2) {print("ATypicalMethod - A,A")})
ATypicalMethod(a,a)
# [1] "ATypicalMethod - A,A"

然而，对于运维人员来说，这并不适用。

setMethod("Ops", signature=c("A","data.frame"), function(e1, e2) {
  print("Ops(A,data.frame)")
  callGeneric(e1@.Data, e2)
})
# Nope - when the scalar is an S3 object, we never find Ops(A,data.frame):
a*df
# [1] "Ops.data.frame"
# x  y
# 1 4 12
# 2 8 16

马丁·摩根（https://dev59.com/ymct5IYBdhLWcg3wa83p#12101238）和?Methods解释了这种a df的行为。他们指出，如果直接调用S3通用函数，则永远不会找到S4方法；因为a和df都是S3对象，所以这种情况似乎正在发生。

而且，即使调用setOldClass也没有帮助；问题不在于S3对象无法被S4方法识别，而是在像*这样的方法中传递两个S3对象时，S3对象不会被查找。在这些情况下，将直接调用S3通用函数，无论S4标记有多少也无法进行S4分派。

setOldClass("A", S4Class="A")
a*df
# [1] "Ops.data.frame"
# x  y
# 1 4 12
# 2 8 16

现在我很困惑。我找不到任何方法让*发现我的S3对象的S4方法，也找不到任何方法编写S3方法来替代data.frame方法。

如果我愿意将标量变成S4对象，我可以得到我想要的分派：

a <- new("A", 4)
a*df
# [1] "Ops(A,data.frame)"
# [1] "Ops.data.frame"
# x  y
# 1 4 12
# 2 8 16

但我真的希望将'a'保留为S3对象。有没有一种方法既使'a'成为S3又定义自己的Ops('A', 'data.frame')方法？

- pangia

---

@Roland - 对的。那么有什么解决办法，还是我必须放弃？ - pangia

我相信你不能用S3做到这一点。我对S4了解不够，无法完全回答这个问题。 - Roland

@Roland - 好的，这是一个有用的部分答案。谢谢。 - pangia

谢谢你的想法，@Karl，但是我已经添加了另一个段落和代码块（从“而且调用setOldClass也没有帮助”开始）来解释为什么setOldClass不起作用。 - pangia

我猜你已经考虑过使用自定义运算符了吧... - Karl Forner

Answer 1

非常丑陋的方式：覆盖 '*' 函数

a <- 4
oldClass(a) <- "A"
df <- data.frame(x=1:2,y=3:4)

my_add_df <- function(e1, e2) {
  print('my_add_df')
  print(e1)
  print(e2)
}

`*` <- function(e1, e2) {
  if (inherits(e1, 'A') && inherits(e2, 'data.frame'))
    my_add_df(e1, e2)
  else 
    .Primitive("*")(e1, e2)
}

a <- 4
oldClass(a) <- "A"
df <- data.frame(x=1:2,y=3:4)

my_add_df <- function(e1, e2) {
  print('my_add_df')
  print(e1)
  print(e2)
}

`*` <- function(e1, e2) {
  if (inherits(e1, 'A') && inherits(e2, 'data.frame'))
    my_add_df(e1, e2)
  else 
    .Primitive("*")(e1, e2)
}

- Karl Forner