roopinheritancer-s4

R S4 inheritance - issues with validity testing and optional slots


I am trying to create a class B containing another class A with optional slots (the object should be created even if no arguments are passed when defining class A) :

When defining class A and creating an instance, validity testing is fine (detection of empty slots is ok):

setClass("A",
         slots = c(x="numeric", y = "character"),
         prototype = list(
           x = numeric(0),
           y = character(0)
         ),
         validity=function(object){
           if(length(object@x) == 0){
             warning("x slot is empty")
           }
           if(length(object@y) == 0){
             warning("y slot is empty")
           }
           return(TRUE)
         })

setMethod("initialize", signature = "A",
          definition = function(.Object, x, y)
          {
            if (!missing(x)) {
              .Object@x <- x
            } else {
              .Object@x <- numeric(0)
            }
            if (!missing(y)) {
              .Object@y <- y
            } else {
              .Object@y <- character(0)
            }
            validObject(.Object)
            return(.Object)
          } )

new("A", x=1:10)
# warning message "validityMethod(object) : y slot is empty"

But when creating class B object as follows, I get validity messages even if arguments are passed, and they are duplicated:

setClass("B",
         slots = c(a = "data.frame"),
         contains = "A",
         validity = function(object) {
           if (length(object@a) == 0) {
             warning("a is empty")
           }
           return(TRUE)
           })

setMethod("initialize", signature = "B",
          definition = function(.Object, a, ...)
          {
            .Object@a <- a
            .Object <- callNextMethod(.Object, ...)
            validObject(.Object)
            return(.Object)
          } )

new("B", a = data.frame(10), x = 5, y = "c")

# gives warning messages: 
#1: in validityMethod(object) : x slot is empty
#2: in validityMethod(object) : y slot is empty
#3: in validityMethod(object) : x slot is empty
#4: in validityMethod(object) : y slot is empty

When an argument is really missing, I get the additional message (again duplicated):

new("B", a = data.frame(10), x = 5)

# warning:
#
#1: in validityMethod(object) : x slot is empty
#2: in validityMethod(object) : y slot is empty
#3: in validityMethod(as(object, superClass)) : y slot is empty
#4: in validityMethod(object) : x slot is empty
#5: in validityMethod(object) : y slot is empty
#6: in validityMethod(as(object, superClass)) : y slot is empty

How can I avoid these duplicated messages and make them work (only when arguments are really missing)?


Solution

  • A few things:

    Putting that all together:

    setClass("A", slots = c(x = "numeric", y = "character"))
    setMethod("initialize", "A",
              function(.Object, ...) {
                  .Object <- callNextMethod()
                  if (length(.Object@x) == 0L)
                      warning("zero-length 'x' slot")
                  if (length(.Object@y) == 0L)
                      warning("zero-length 'y' slot")
                  .Object
              })
    
    setClass("B", contains = "A", slots = c(a = "data.frame"))
    setMethod("initialize", "B",
              function(.Object, ...) {
                  .Object <- callNextMethod()
                  if (length(.Object@a) == 0L)
                      warning("zero-length 'a' slot")
                  .Object
              })
    
    > new("A")
    An object of class "A"
    Slot "x":
    numeric(0)
    
    Slot "y":
    character(0)
    
    Warning messages:
    1: In initialize(value, ...) : zero-length 'x' slot
    2: In initialize(value, ...) : zero-length 'y' slot
    > new("B")
    An object of class "B"
    Slot "a":
    data frame with 0 columns and 0 rows
    
    Slot "x":
    numeric(0)
    
    Slot "y":
    character(0)
    
    Warning messages:
    1: In .nextMethod(.Object = .Object) : zero-length 'x' slot
    2: In .nextMethod(.Object = .Object) : zero-length 'y' slot
    3: In initialize(value, ...) : zero-length 'a' slot
    > new("B", y = "")
    An object of class "B"
    Slot "a":
    data frame with 0 columns and 0 rows
    
    Slot "x":
    numeric(0)
    
    Slot "y":
    [1] ""
    
    Warning messages:
    1: In .nextMethod(.Object = .Object, ... = ...) : zero-length 'x' slot
    2: In initialize(value, ...) : zero-length 'a' slot