如何在 R 中对继承的 S4 类正确使用有效性函数

Question

假设您有一个 S4 class "A" 和一个具有附加功能的 subclass "B"。每个都有自己的有效性检查 - B 应该只检查附加功能。现在在B的初始化中，我想从classA的一个对象开始，然后用附加的特征修改它。然而，这会产生问题，我想我在这个例子中违反了 R 的假设。

这是虚拟代码：

setClass(Class="A",
         representation=
         representation(x="numeric"),
         validity=
         function(object){stopifnot(x > 0)})

setMethod("initialize",
          signature(.Object="A"),
          function(.Object,
                   ...,
                   z){
              x <- get("z") + 1
              callNextMethod(.Object,
                             ...,
                             x=x)
          })

setClass(Class="B",
         contains="A",
         representation=
         representation(y="numeric"),
         validity=
         function(object){stopifnot(y > 0)})

setMethod("initialize",
          signature(.Object="B"),
          function(.Object,
                   ...,
                   bla){

              .Object <- callNextMethod(.Object,
                                        ...)

              .Object@y <- .Object@x + bla
              return(.Object)
          })

test <- new("B",
            z=4,
            bla=5)

如果我尝试创建 "test" 对象，我得到：

Error in stopifnot(x > 0): object 'x' not found

你知道我怎样才能做得更好吗？

提前致谢！此致丹尼尔

Answer 1

对 S4 中假设的一个方便测试是 new() 在非 VIRTUAL class 上不带参数调用需要 return 一个有效对象。你的class没有通过这个测试

> validObject(new("A"))
Error in get("z") : argument "z" is missing, with no default

一个选项会在初始化方法中为 z 提供默认值，或者（我的偏好）在 class 定义中使用原型和构造函数。此外，有效性函数应该 return TRUE（如果有效）或描述其无效的字符向量。所以我把你的 class 'A' 写成

.A <- setClass(Class="A",
    representation(x="numeric"),
    prototype(x=1),
    validity= function(object) {
        msg <- NULL
        if (length(object@x) != 1 || object@x <= 0)
            msg <- c(msg, "'x' must be length 1 and > 0")
        if (is.null(msg)) TRUE else msg
    })

（setClass() 的 return 值只是将 new() 包裹在语义更丰富的函数调用中。

> validObject(.A())
[1] TRUE

我不使用 initialize 方法（这很难正确实现——它也是一个复制构造函数）我会写

A <- function(z, ...)
    .A(x=z+1, ...)

表现符合预期

> A()
Error in initialize(value, ...) (from valid.R!7685pfr#2) : 
  argument "z" is missing, with no default
> A(1)
An object of class "A"
Slot "x":
[1] 2

我认为将这些原则扩展到 "B" 应该是直截了当的，而且很好 "exercise for the reader"!

Answer 2

为了完成 Martin 的回答，这里是我的问题的完整解决方案：

.A <- setClass(Class="A",
               representation(x="numeric"),
               prototype(x=1),
               validity=
               function(object){
                   msg <- NULL
                   if (length(object@x) != 1 || object@x <= 0)
                       msg <- c(msg, "'x' must be length 1 and > 0")
                   if (is.null(msg)) TRUE else msg
               })

validObject(.A())

A <- function(z, ...)
{
    x <- z + 1
    .A(x=x, ...)
}

.B <- setClass(Class="B",
               representation(y="numeric"),
               prototype(y=2),
               contains="A",
               validity=
               function(object){
                   msg <- NULL
                   if (length(object@y) != 1 || object@y <= 0)
                       msg <- c(msg, "'y' must be length 1 and > 0")
                   if (is.null(msg)) TRUE else msg
               })

validObject(.B())

B <- function(bla, z, ...)
{
    obj <- A(z, ...)
    y <- obj@x + bla
    .B(obj, y=y, ...)
}

test <- B(z=4,
          bla=5)

再次感谢Martin 非常快速和完美的帮助！最好的祝福丹尼尔

如何在 R 中对继承的 S4 类正确使用有效性函数

How to use validity functions correctly with inherited S4 classes in R

inheritance

r

s4