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:

Validity methods should return TRUE or a character string containing a condition message. The caller of the validity method (typically validObject) decides what to do with the condition message (i.e., whether to signal a condition (typically an error) with that message). In any case, objects of a formal class are valid or invalid, never quasi-valid or quasi-invalid, so having validObject throw a warning instead of an error is really unusual. If you want to warn a user calling new about zero-length slots without suggesting that they are invalid, then move the tests for zero-length slots from the validity methods into the initialize methods.
Zero-length prototypes are automatic, so you don't need to set prototype= here.
The if (<missing>) <assign prototype> else <assign value> pattern in your initialize methods is kludge. The default method does all of that already, so dispatch to it.

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