[Rd] Problem with S4 inheritance: unexpected re-initialization?

[Herve Pages]

Hi Cristian,

cstrato wrote:
[...]
> Although SubSubClassB1 and SubSubClassB2 differ only slightly, the results
> for "subsubB1" are correct, while "subsubB2" gives a wrong result, see:
>> subsubB2 <- new("SubSubClassB2", filename="MyFileNameB2",
> nameB="MyNameB")
>> subsubB2
> An object of class "SubSubClassB2"
> Slot "nameB2":
> [1] "MyNameB"
> 
> Slot "nameB":
> [1] ""
> 
> Slot "filename":
> [1] "MyFileNameB2"

I think that the problem has to do with the way you use callNextMethod() in your
"initialize" method for SubSubClassB2:

  setMethod("initialize", "SubSubClassB2",
    function(.Object, nameB2="MyNameB2", ...) {
       cat("------initialize:SubSubClassB2------\n")
       cat("SubSubClassB2:init:class(.Object) = ", class(.Object), "\n", sep="")
       if (nameB2 == "") nameB2 <- "DefaultNameB2";
       cat("SubSubClassB2:init:nameB2 = ", nameB2, "\n", sep="")
       .Object <- callNextMethod(.Object, nameB2=nameB2, ...)
       .Object at nameB2 <- nameB2
       .Object
    }
  )

As a side note: I don't understand why you want to define a default value for
the 'nameB2' argument since you have defined a prototype for the SubSubClassB2
class (with a different default value for the 'nameB2' slot).

Try this instead:

  setMethod("initialize", "SubSubClassB2",
    function(.Object, ...) {
       cat("------initialize:SubSubClassB2------\n")
       cat("SubSubClassB2:init:class(.Object) = ", class(.Object), "\n", sep="")
       .Object <- callNextMethod()
       if (.Object at nameB2 == "") .Object at nameB2 <- "DefaultNameB2"
       .Object
    }
  )

It gives you what you want:

  > new("SubSubClassB2", filename="MyFileNameB2", nameB="MyNameB")
  ------initialize:SubSubClassB2------
  SubSubClassB2:init:class(.Object) = SubSubClassB2
  ------initialize:SubClassB------
  SubClassB:init:class(.Object) = SubSubClassB2
  ------initialize:BaseClass------
  BaseClass:init:class(.Object) = SubSubClassB2
  BaseClass:init:filename = MyFileNameB2
  An object of class "SubSubClassB2"
  Slot "nameB2":
  [1] "NameB2"

  Slot "nameB":
  [1] "MyNameB"

  Slot "filename":
  [1] "MyFileNameB2"


[...]
> 
> In contrast, for "SubSubClassB2" I get the following sequence of events:
>> subsubB2 <- new("SubSubClassB2", filename="MyFileNameB2",
> nameB="MyNameB")
> ------initialize:SubSubClassB2
> ------initialize:SubClassB
> ------initialize:BaseClass
> ------setValidity:BaseClass
> ------initialize:SubClassB
> ------initialize:BaseClass
> ------setValidity:BaseClass
> ------setValidity:SubClassB
> ------setValidity:SubClassB
> ------initialize:SubClassB
> ------initialize:BaseClass
> ------setValidity:BaseClass
> ------setValidity:SubClassB
> ------setValidity:SubSubClassB2

I can reproduce this behaviour with a _much_ simple and shorter code:

  setClass("A",
    representation(a="character"),
    prototype(a="a0")
  )
  setValidity("A",
    function(object) {
        cat("------setValidity:A------\n")
        tmp <- class(object)
        TRUE
    }
  )
  setMethod("initialize", "A",
    function(.Object, ...) {
        cat("------initialize:A------\n")
        callNextMethod()
    }
  )

  setClass("B",
    contains="A",
    representation(b="character")
  )
  setValidity("B",
    function(object) {
        cat("------setValidity:B------\n")
        TRUE
    }
  )
  setMethod("initialize", "B",
    function(.Object, ...) {
        cat("------initialize:B------\n")
        callNextMethod()
    }
  )

Then I get this:

  > b <- new("B", b="hello")
  ------initialize:B------
  ------initialize:A------
  ------setValidity:A------
  ------initialize:A------
  ------setValidity:B------

Why is initialize:A called twice? I have no idea (bug?) but I agree with you that
this is unexpected. Note that this line

  tmp <- class(object)

in setValidity:A is what triggers the extra call to initialize:A. If you remove
it, things work as expected. Very strange!

Cheers,
H.


> sessionInfo()
R version 2.5.0 alpha (2007-03-30 r40957)
x86_64-unknown-linux-gnu

locale:
LC_CTYPE=en_US;LC_NUMERIC=C;LC_TIME=en_US;LC_COLLATE=en_US;LC_MONETARY=en_US;LC_MESSAGES=en_US;LC_PAPER=en_US;LC_NAME=C;LC_ADDRESS=C;LC_TELEPHONE=C;LC_MEASUREMENT=en_US;LC_IDENTIFICATION=C

attached base packages:
[1] "stats"     "graphics"  "grDevices" "utils"     "datasets"  "methods"
[7] "base"



> 
> Furthermore, the slot "filename" is first initialized correctly to
> "filename=MyFileNameB2", but then it is twice initialized incorrectly
> to "filename=ERROR_FileName", indicating that it may not have been
> initialized at all. I do not understand this behavior, why is this so?
> 
> I really hope that this time the code below is acceptable to you.
> Thank you for your help.
> Best regards
> Christian
> 
> # - - - - - - - - - - - - - - - - BEGIN - - - - - - - - - - - - - - - -
> - - - -
> setClass("BaseClass",
>   representation(filename = "character", "VIRTUAL"),
>   prototype(filename = "DefaultFileName")
> )
> 
> setClass("SubClassB",
>   representation(nameB = "character"),
>   contains=c("BaseClass"),
>   prototype(nameB = "NameB")
> )
> 
> setClass("SubSubClassB1",
>   contains=c("SubClassB")
> )
> 
> setClass("SubSubClassB2",
>   representation(nameB2 = "character"),
>   contains=c("SubClassB"),
>   prototype(nameB2 = "NameB2")
> )
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> setMethod("initialize", "BaseClass",
>   function(.Object, filename="",  ...) {
>      cat("------initialize:BaseClass------\n")
>      cat("BaseClass:init:class(.Object) = ", class(.Object), "\n", sep="")
>      if (filename == "" || nchar(filename) == 0) filename <-
> "ERROR_FileName"
>      cat("BaseClass:init:filename = ", filename, "\n", sep="")
>      .Object <- callNextMethod(.Object, filename=filename, ...)
>      .Object at filename <- filename
>      .Object
>   }
> )
> 
> setValidity("BaseClass",
>   function(object) {
>      cat("------setValidity:BaseClass------\n")
>      cat("BaseClass:val:class(.Object) = ", class(object), "\n", sep="")
>      msg <- NULL
>      if (!(is.character(object at filename)))
>         msg <- cat("missing filename\n")
>      cat("BaseClass:val:filename = ",object at filename, "\n", sep="")
>      if (is.null(msg)) TRUE else msg
>   }
> )
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> setMethod("initialize", "SubClassB",
>   function(.Object, nameB="",  ...) {
>      cat("------initialize:SubClassB------\n")
>      cat("SubClassB:init:class(.Object) = ", class(.Object), "\n", sep="")
>      .Object <- callNextMethod(.Object, nameB=nameB, ...)
>      .Object at nameB = nameB
>      .Object
>   }
> )
> 
> setValidity("SubClassB",
>   function(object) {
>      cat("------setValidity:SubClassB------\n")
>      cat("SubClassB:val:class(object) = ", class(object), "\n", sep="")
>      msg <- NULL
>      if (!(is.character(object at nameB) && length(object at nameB) > 0))
>         msg <- cat("missing nameB\n")
>      cat("SubClassB:val:nameB = ",object at nameB, "\n", sep="")
>      if (is.null(msg)) TRUE else msg
>   }
> )
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> setMethod("initialize", "SubSubClassB1",
>   function(.Object, ...) {
>      cat("------initialize:SubSubClassB1------\n")
>      cat("SubSubClassB1:init:class(.Object) = ", class(.Object), "\n",
> sep="")
>      .Object <- callNextMethod(.Object, ...)
>      .Object
>   }
> )
> 
> setValidity("SubSubClassB1",
>   function(object) {
>      cat("------setValidity:SubSubClassB1------\n")
>      cat("SubSubClassB1:val:class(object) = ", class(object), "\n", sep="")
>      return(TRUE)
>   }
> )
> 
> # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
> setMethod("initialize", "SubSubClassB2",
>   function(.Object, nameB2="MyNameB2", ...) {
>      cat("------initialize:SubSubClassB2------\n")
>      cat("SubSubClassB2:init:class(.Object) = ", class(.Object), "\n",
> sep="")
>      if (nameB2 == "") nameB2 <- "DefaultNameB2";
>      cat("SubSubClassB2:init:nameB2 = ", nameB2, "\n", sep="")
>      .Object <- callNextMethod(.Object, nameB2=nameB2, ...)
>      .Object at nameB2 <- nameB2
>      .Object
>   }
> )
> 
> setValidity("SubSubClassB2",
>   function(object) {
>      cat("------setValidity:SubSubClassB2------\n")
>      cat("SubSubClassB2:val:class(object) = ", class(object), "\n", sep="")
>      msg <- NULL;
>      if (!(is.character(object at nameB2) && length(object at nameB2) > 0))
>         msg <- cat("missing nameB2\n")
>      cat("SubClassB:val:nameB2 = ",object at nameB2, "\n", sep="")
>      if (is.null(msg)) TRUE else msg
>   }
> )
> 
> # - - - - - - - - - - - - - - - END - - - - - - - - - - - - - - - - -