r - 对 Ops 的通用方法进行分组(针对时间序列)

Question

我尝试在 S3 类上定义类 Ops 继承，该类是一个列表，并且列表内有一个时间序列。

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)

由于 S3 双重调度，它无法使用简单的方法工作。因为我不想覆盖 Ops.ts(它是一个包)，所以我必须找到一些东西。

## 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

这对我来说似乎很奇怪，因为 Ops 是一个 S4 组通用的。难道它不应该调用可用的 S4 方法，然后，如果没有，则转到 S3 吗？发生了什么以及如何解决？

Answer 1

Ops的成员组是内部通用的。调度由 C 级函数 DispatchGroup 执行，仅当一个或两个参数是 S4 对象时才查找 S4 方法。 setOldClass("newclass")不使isS4(<newclass>) true，因此您的 S4 方法永远不会被调度:

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

要实现此功能，请定义 newclass作为 ts 的 S4 子类，它已经在包 methods 中有一个 S4 定义:

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

setAs("ts", "S3", 
      function(from) {
          if (isS4(from)) 
              structure(<a href="https://stackoverflow.com/cdn-cgi/l/email-protection" class="__cf_email__" data-cfemail="563024393b167812372237" rel="noreferrer noopener nofollow">[email protected]</a>, 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

您可以在 ?setOldClass 中找到相关详细信息, ?S3Part ，和?`ts-class` ，但是一切都有点分散。

---

P.S.:我定义了自己的强制方法，因为从包 methods 继承的方法似乎不像文档那样工作。我将进行更多调查，以防万一我错了(这种情况经常发生)，在这种情况下我将编辑答案。