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

问题

let's assume you have one S4 class "A", and a subclass "B" which has additional features. Each have their own validity checks in place - B should only check the additional features. Now in the initialization of B, I would like to start out from an object of class A, and then amend it with the additional features. However, this creates problems, and I guess I am somewhere violating R's assumptions in this example.

Here's the dummy code:

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)

If I try to create the "test" object, I get:

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

Do you know how I could do better?

Thanks a lot in advance! Best regards Daniel

回答1:

A convenient test of the assumptions in S4 is that new() called with no arguments on a non-VIRTUAL class needs to return a valid object. Your class does not pass this test

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

One option would provide a default value to z in the initialize method, or (my preference) to use a prototype in the class definition coupled with a constructor. Also the validity function is supposed to return TRUE (if valid) or a character vector describing how it is not valid. So I wrote your class 'A' as

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

(the return value of setClass() just wraps new() in a more semantically rich function call).

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

Instead of using the initialize method (which is tricky to implement correctly -- it's a copy constructor as well) I'd write

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

which behaves as expected

> 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

I think the extension of these principles to "B" should be straight-forward, and a good "exercise for the reader"!

回答2:

Just to complete Martin's answer, here is the full solution to my problem:

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

Thanks again Martin for the extremely fast and perfect help! best regards Daniel

来源：https://stackoverflow.com/questions/27744214/how-to-use-validity-functions-correctly-with-inherited-s4-classes-in-r

标签

inheritance