基于基本 R 连接函数 c() 编写 S4 方法。使用省略号、点、

Question

我正在尝试编写一个方法来连接我定义的两个 S4 classes：

setClass("My_item",
         representation(contents = "vector"))

setClass("My_group",
         representation(members = "list"))

My_groupclass的每个实例的members都是My_itemclass的成员，但是我这里没有包含验证码强制执行该要求。

我希望基于来自基数 R 的 c() 为 My_group class 编写一个连接方法。它的输入将是任意数量（包括零）的元素，这些元素可能是My_item class 或 My_group class 成员的混合体。该方法应该 return My_group class 的单个成员，由输入中的所有 My_item 成员组成，就像 c(c(1, 2), 3) returns c(1, 2, 3).

我知道我的方法定义必须完全遵循 c() 的定义，因此必须采用以下形式：

setMethod(
  f = "c",
  signature = "My_group",
  definition = function(x, ..., recursive = FALSE) {
    [code to be written]
}
)

我的问题是关于完成这项工作的函数。

我可以编写一个直接的 R 函数来做我想做的事：

myf<- function(...){
  elements <- list(...) 
  if (length(elements) != 0) { 
    items <- unlist(lapply(
      elements,
      FUN = function(object) {
        if (is(object, "My_group")) {
          return(getMy_group(object))
        } else {
          return(object)
        }
      }
    ))
    object <- new("My_group",
                  members = items )
  } else {
    object <-  new("My_group")
  }
}

（getMy_group 是一种将 My_group class 的成员解压缩到其成员列表中的简单方法。）

如果我将 a1, a2, a3 定义为 My_item class 的成员，并将 g1 定义为具有成员 a1 和 a2,

a1 <- new("My_item", contents = c(1, 2, 3))
a2 <- new("My_item", contents = c( "x", "y", "z"))
a3 <- new("My_item", contents = c(0.1, 0.2, 0.3))

g1 <- new("My_group", members = list(a1, a2))

然后 myf(g1, a3) return 一个 My_group 有 3 个成员，根据需要。

R>str(myf(g1, a3))
Formal class 'My_group' [package ".GlobalEnv"] with 1 slot
  ..@ members:List of 3
  .. ..$ :Formal class 'My_item' [package ".GlobalEnv"] with 1 slot
  .. .. .. ..@ contents: num [1:3] 1 2 3
  .. ..$ :Formal class 'My_item' [package ".GlobalEnv"] with 1 slot
  .. .. .. ..@ contents: chr [1:3] "x" "y" "z"
  .. ..$ :Formal class 'My_item' [package ".GlobalEnv"] with 1 slot
  .. .. .. ..@ contents: num [1:3] 0.1 0.2 0.3

但是如果我使用与函数 myf 中相同的代码来定义我的方法，如下所示：

setMethod(
  f = "c",
  signature = "My_group",
  definition = function(x, ..., recursive = FALSE) {
    elements <- list(...) 
    if (length(elements) != 0) { 
      items <- unlist(lapply(
        elements,
        FUN = function(object) {
          if (is(object, "My_group")) {
            return(getMy_group(object))
          } else {
            return(object)
          }
        }
      )) 
      object <- new("My_group",
                    members = items)
    } else {
      object <- new("My_group")
    }

    return(object)
  }
)

我得到了错误的答案：


 R>c(g1, a3)
An object of class "My_group"
Slot "members":
[[1]]
An object of class "My_item"
Slot "contents":
[1] 0.1 0.2 0.3

该方法似乎忽略了 g1。

我怀疑我误解了 c() 定义中出现的对我来说神秘的 x 的作用，但在我的诊断中我无法得到比这更进一步的信息。

编辑：根据 JDL 关于我使用 setClassUnion 的有用且合理的建议，我使用一个简单的方法编写了以下内容，该方法应该只是 return 提供给 c() 的参数：

    setClassUnion("mySortOfThing",c("My_item","My_group"))
    setMethod(
     f = "c",
     signature = "mySortOfThing",
     definition = function(x, ..., recursive = FALSE) {
      elements <- list(...)
      return(elements)
     }
    )

但是我发现

    g3 <- c(g1, a3) 
    R>str(g3)
    List of 1
     $ :Formal class 'My_item' [package ".GlobalEnv"] with 1 slot
      .. ..@ contents: num [1:3] 0.1 0.2 0.3

我显然还是出错了。

第二次编辑：alan o'callaghan 的建议解决了问题。作为记录，我现在的方法是：

setMethod(
  f = "c",
  signature = "My_union",
  definition = function(x, ..., recursive = FALSE) {
    elements <- list(x, ...)
    if (length(elements) != 0) { 
      items <- unlist(lapply(
        elements,
        FUN = function(object) {
          if (is(object, "My_group")) {
            return(getMy_group(object))
          } else {
            return(object)
          }
        }
      ))

      object <- new("My_group",
                    members = items)
    } else {
      object <- new("My_group")
    }

    return(object)
  }
)

产生：

R>c(g1, a3)
An object of class "My_group"
Slot "members":
[[1]]
An object of class "My_item"
Slot "contents":
[1] 1 2 3


[[2]]
An object of class "My_item"
Slot "contents":
[1] "x" "y" "z"


[[3]]
An object of class "My_item"
Slot "contents":
[1] 0.1 0.2 0.3

这正是我想要的。

Answer 1

目前，如果构成 ... 的参数不都具有相同的 class，则无法使用 ... 到 select 方法。所以如果你喂 c 一堆 my_item 对象或一堆 my_group 对象，你的方法有效，但如果你喂它混合物则不行。

来自 dotsMethods 的帮助页面：

“当所有匹配“...”的参数都来自指定的 class 或来自某些子 class 时，将为此类函数定义的方法将被 select 编辑和调用class.

[...]

当您的计算适用于多个现有 class 时，一种方便的方法可能是通过调用 setClassUnion 来定义这些 class 的联合。"

所以推荐的方法是创建一个 class 联合：

setClassUnion("mySortOfThing",c("my_item","my_group"))

然后为 c 编写一个方法，该方法使用 mySortOfThing 作为其对 ...、

的签名

编辑：

给定的代码有一个单独的问题，因为 c 匹配它的参数 positionally。在 c 的默认定义中，只有 ... 参数。该问题定义了一个带有参数 x,...,recursive 的方法，这可能意味着第一个参数没有到达您期望的位置并且可能会被忽略。如果你需要一个单独的参数 x 那么你必须把它放在之后和 ....

Answer 2

如 JDL 所述，x 用于方法分派。您的函数忽略了它，只使用 ...。这应该有效（未经测试）

setMethod(
  f = "c",
  signature = "My_group",
  definition = function(x, ..., recursive = FALSE) {
    elements <- list(x, ...) 
    if (length(elements) != 0) { 
      items <- unlist(lapply(
        elements,
        FUN = function(object) {
          if (is(object, "My_group")) {
            return(getMy_group(object))
          } else {
            return(object)
          }
        }
      )) 
      object <- new("My_group",
                    members = items)
    } else {
      object <- new("My_group")
    }

    return(object)
  }
)

基于基本 R 连接函数 c() 编写 S4 方法。使用省略号、点、

Writing S4 method based on base R concatenation function c(). Use of ellipsis, dots ,

methods

r

concatenation

ellipsis

s4