在S3 * data.frame上调度自定义方法

时间:2014-03-25 18:02:38

标签: r r-s3

我想为a的乘法定义我自己的行为(方法) data.frame,具有新S3类的对象。但我无法弄清楚如何获得 方法调度找到我的方法。有办法吗?

首先,我定义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”,但通常S4调度仍然会找到带有oldClass“A”的S3对象。

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"

但是,这对Ops不起作用。

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

df的这种行为由Martin Morgan解释 (https://stackoverflow.com/a/12101238/3203184)和?方法,谁说如果 直接调用S3泛型,然后永远不会找到S4方法; 这似乎发生在 df中,因为a和df都是S3对象。

并且任何人也可以拨打setOldClass;问题不在于S4方法调度无法识别S3对象,而是在将两个S3对象传递给像{这样的方法时没有查找 {1}}。在这些情况下,直接调用S3泛型,并且没有任何数量的S4标签将导致S4调度。

*

所以现在我不知所措。我发现无法让setOldClass("A", S4Class="A") a*df # [1] "Ops.data.frame" # x y # 1 4 12 # 2 8 16 为我的S3对象发现S4方法,也无法编写取代data.frame方法的S3方法。

如果我愿意将标量作为S4对象,我可以得到我想要的调度:

*

但我真的希望将'a'作为S3对象。有两种方法(1) 让'a'成为S3,(2)定义我自己的Ops方法('A','data.frame')?

1 个答案:

答案 0 :(得分:0)

非常丑陋的方式:覆盖&#39; *&#39;功能

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)
}