From cstrato at aon.at  Wed Apr  4 17:02:53 2007
From: cstrato at aon.at (cstrato)
Date: Wed, 04 Apr 2007 17:02:53 +0200
Subject: [Rd] Problem with S4 inheritance: unexpected re-initialization?
In-Reply-To: <4612CCAB.1080809@fhcrc.org>
References: <46112187.3090009@aon.at> <4612CCAB.1080809@fhcrc.org>
Message-ID: <4613BE1D.5000507@aon.at>

Dear Herve

Thank you for your helpful comments, and I especially appreciate that
you tried to run my package. I will try to answer each point separately.

Herve Pages wrote:
> Hi Christian,
>
> I can only give you a few reasons why IMO it is very unlikely that anybody
> will be able to help you on this, with the current form of your post.
>
> 1) Unless you have a really good reason to do so, don't attach a package
>    to your post. Do your best to provide a few lines of code that anybody
>    can easily copy and paste into their session.
>   
Sorrowly, sometimes, a few lines of code are not sufficient to show
the problem. Furthermore, most of the time there are complaints that
people do not provide enough information, an issue I wanted to avoid.

At the end of my answer I provide now the minimal necessary code for
people to easily copy-paste into their session.

Nevertheless, I also attach the same code as package, since some
problems only appear when compiling the package, concretely:
The behavior of the attached package is completely different, when
I "exportMethods("initialize")" in the NAMESPACE file or not. To see
the changes, please comment-out this one line in the NAMESPACE file.

> 2) Your package is messy (yes I looked at it). You have far too many classes
>    with far too many slots that we don't care about. If you could provide
>    the smallest possible set of classes with the smallest possible set of slots
>    with the smallest possible set of generics and methods that still allow to
>    reproduce the issue you want to show us, that would help!
>   
You are correct, I wanted to provide a complete demo-package. As
mentioned above, I provide now the minimal necessary code (at least
I hope so).

> 3) You show us an example where BaseClass is VIRTUAL (which is indeed how it is
>    defined in your package) and then an example where BaseClass is NOT VIRTUAL.
>    How can we reproduce the latter? Don't expect people to go into your package,
>    change the class definition, reinstall, restart R and then run your example!
>   
I thought, it would be easy for developers to understand what I mean
and to simply comment-out the one line in the definition of BaseClass.

> 4) Note that for clarity and conformance to almost universal convention, it's
>    better to use arrows pointing from derived classes to base classes
>    in your inheritance tree.
>   
Sorry, my mistake.

> 5) It's good to provide the inheritance tree, but it's better when it's complete.
>    I've looked at what you actually have in your package and the complete
>    inheritance tree is something like this:
>
>      BaseClass <- SubClassA
>                <- SubClassB <- SubSubClassA
>                             <- SubSubClassB
>
>    Where is the SubClassA class in the inheritance tree that you included in your
>    post below?
>   
Sorry, my mistake.

> 6) Another thing I note is that you have a naming problem: any reason why you name
>    "SubSubClassA" a subclass of SubClassB? Given that you also have defined SubClassA,
>    this can only lead to confusion!
>   
Again, you are correct, my mistake. Here is the corrected inheritance tree:

   BaseClass <- SubClassA
             <- SubClassB <- SubSubClassB1
             <- SubClassB <- SubSubClassB2

> 7) You need to use proper terminology if you expect people to follow you. In your post
>    below, every time you instanciate a class you say that your are creating it:
>      o "First, I need to create SubClassA..."
>      o "I create both subclasses, SubSubClassA and SubSubClassB..."
>      o etc...
>    Creating a class is not the same as instanciating it!
>   
You are correct, this was confusing. I meant, theat I create an object,
which is probably the same as instanciating a class?

Here is the actual code to use:
 > subA <- 
new("SubClassA",filename="OutSubA",filedir="/Volumes/CoreData/CRAN/",namesubA="NameSubA")
 > subsubB1 <- 
new("SubSubClassB1",filename="MyFileNameB1",filedir="/Volumes/CoreData/",subA=subA)
 > subsubB2 <- 
new("SubSubClassB2",filename="MyFileNameB2",filedir="/Volumes/CoreExtra",subA=subA)

> 8) You start your examples by "First, I need to create SubClassA..." so you are
>    introducing us a class that doesn't show up in your inheritance tree so we don't
>    know how it is related to the other classes. Also you say that you "need" to
>    create SubClassA but we have no idea why!
>   
Once again you are correct, this was confusing. I need to create object
"subA" of class SubClassA, since it is a slot of SubClassB, and needs to
be included in the instanciation of objects "subsubB1" and "subsubB2".

> 9) You have a slot in SubClassB that is of class SubClassA! This means "a SubClassB
>    object _is_ a BaseClass object and it _has_ a slot that is itself a BaseClass
>    object (since a SubClassA object is a BaseClass object too)". I hope that this
>    is really what you want... but maybe this could be related to the fact that you
>    see 2 instanciations of BaseClass when you instanciate SubSubClassA or SubSubClassB.
>   
This is the most IMPORTANT point and may be the cause of my problems:
YES, both SubClassA and SubClassB are derived from BaseClass, AND
SubClassA is a slot of SubClassB. This is what I want indeed!

In real OOP languages such as C++ and Java this is no problem, and I
really hope that this is possible when using S4 classes, too.

> 10) You have several different issues (initialize called multiple times when you expect
>     only 1 time, setValidity not called, etc..). May be they are related, maybe they
>     are not. If you can isolate those problems and make a separate post for each of them,
>     that would help too.
>   
Once again, you are correct, and normally I post these poblems seperately.
However, since I discovered all these problems while trying to solve the
main problem with my classes myself, I have mentioned them in my post.

> You'll be surprised, but once you've made the effort to follow those recommendations,
> it's most likely that you will have a better understanding of what's going on. And you
> might even be able to sort out these issues by yourself!
>   
As you see, I tried to follow most (all?) of your recommendations, but
sorrowly, the problem remains the same.

When you copy-paste the code below and then do:
subA <- 
new("SubClassA",filename="OutSubA",filedir="/Volumes/CoreData/CRAN/",namesubA="NameSubA")
subsubB1 <- 
new("SubSubClassB1",filename="MyFileNameB1",filedir="/Volumes/CoreData/",subA=subA)
subsubB2 <- 
new("SubSubClassB2",filename="MyFileNameB2",filedir="/Volumes/CoreExtra",subA=subA)

you will see that "subA" and "subsubB1" give the correct result, but
"subsubB2" results in the error that "filename" is missing, although it
is supplied.

> Cheers,
> H.
>
>
>   
Thus, I would really appreciate any help.

Best regards
Christian

# - - - - - - - - - - - - - - - - - - BEGIN - - - - - - - - - - - - - - 
- - - - - - -
setClass("BaseClass",
   representation(filename = "character",
                  filedir  = "character",
                  "VIRTUAL"
#                  filedir  = "character"
   ),
   prototype(filename = character(),
             filedir  = as.character(getwd())
   )
)#BaseClass

setClass("SubClassA",
   representation(namesubA = "character"),
   contains=c("BaseClass"),
   prototype(namesubA = "")
)#SubClassA

setClass("SubClassB",
   representation(subA = "SubClassA",
                  data = "data.frame"
   ),

   contains=c("BaseClass"),

   prototype(subA = new("SubClassA"),
             data = data.frame(matrix(nr=0,nc=0))
   )
)#SubClassB

setClass("SubSubClassB1",
   contains=c("SubClassB")
)#SubSubClassB1

setClass("SubSubClassB2",
   representation(namesubsubB2 = "character"),
   contains=c("SubClassB"),
   prototype(namesubsubB2 = "MySubSubB2")
)#SubSubClassB2

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
- - - -
validMsg <- function(msg, result) {
   if (is.character(result)) {
      append(msg, result);
   } else {
      msg;
   }#if
}#validMsg

pathFile <- function(filename=character(0), filedir=character(0)) {
   print("------pathFile------")

   if (length(filename) != 0) {
      filename <- basename(filename);
   }#if
   if (length(filename) == 0) {
      filename <- as.character("ERROR_MISSING_FILENAME");
   }#if
   if (dirname(filename) != ".") {
      filedir <- dirname(filename);
   }#if
   if (filedir == "" || filedir == ".") {
      filedir <- as.character(getwd());
   }#if
   if (substr(filedir, nchar(filedir), nchar(filedir)) == "/") {
      filedir <- substr(filedir, 0, nchar(filedir)-1);
   }#if
   dirfile <- paste(filedir, "/", filename, sep="");
   return(dirfile);
}#pathFile

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
- - - -
"initialize.BaseClass" <-
function(.Object, filename=character(), filedir=as.character(getwd()), 
...) {
   print("------initialize:BaseClass------")
print(paste("BaseClass:init:class(.Object) = ", class(.Object)))

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

   dirfile <- pathFile(filename, filedir);
print(paste("BaseClass:init:dirfile = ", dirfile))

   .Object <- callNextMethod(.Object, filename=filename, 
filedir=filedir, ...);

   .Object at filename <- filename;
   .Object at filedir  <- filedir;
   .Object;
}#initialize.BaseClass

setMethod("initialize", "BaseClass", initialize.BaseClass);

setValidity("BaseClass",
   function(object) {
      print("------setValidity:BaseClass------")
print(paste("BaseClass:val:class(object) = ", class(object)))
      msg <- NULL;

      if (!(is.character(object at filedir))) {
#      if (is.na(file.dir(object at filedir))) {
         msg <- validMsg(msg,
                         paste(sQuote("filedir"), "is not a system 
directory"));
      }#if
print(paste("BaseClass:val:filedir = ",object at filedir))

      if (is.null(msg)) TRUE else msg;
   }
)#setValidity

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
- - - -
"initialize.SubClassA" <-
function(.Object, namesubA="MyNameSubA", ...) {
   print("------initialize:SubClassA------")
print(paste("SubClassA:init:class(.Object) = ", class(.Object)))

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

   if (namesubA == "") {
      namesubA <- "DefaultNameSubA";
   }#if
print(paste("SubClassA:init:namesubA = ", namesubA))

   .Object <- callNextMethod(.Object, namesubA=namesubA, ...);

   .Object at namesubA <- namesubA;
#validObject(.Object);
   .Object;
}#initialize.SubClassA

setMethod("initialize", "SubClassA", initialize.SubClassA);

setValidity("SubClassA",
   function(object) {
      print("------setValidity:SubClassA------")
print(paste("SubClassA:val:class(object) = ", class(object)))
      msg <- NULL;

      strg <- object at namesubA;
      if (!(is.character(strg) && nchar(strg) > 0)) {
         msg <- validMsg(msg, paste(sQuote("namesubA"), "is missing"));
      }#if
print(paste("SubClassA:val:namesubA = ",object at namesubA))

      if (is.null(msg)) TRUE else msg;
   }
)#setValidity

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
- - - -
"initialize.SubClassB" <-
function(.Object, subA=new("SubClassA"), data = data.frame(), ...) {
   print("------initialize:SubClassB------")
print(paste("SubClassB:init:class(.Object) = ", class(.Object)))

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

   .Object <- callNextMethod(.Object, subA=subA, data=data, ...);

   .Object at subA = subA;
   .Object at data = data;
   .Object;
}#initialize.SubClassB

setMethod("initialize", "SubClassB", initialize.SubClassB);

setValidity("SubClassB",
   function(object) {
      print("------setValidity:SubClassB------")
print(paste("SubClassB:val:class(object) = ", class(object)))
      msg <- NULL;

      ## check filename
      strg <- object at filename;
#      if (!(is(strg, "character") && nchar(strg) > 0)) {
      if (!(is.character(strg) && length(strg) > 0)) {
         msg <- validMsg(msg, paste(sQuote("filename"), "is missing"));
      }#if
print(paste("SubClassB:val:filename = ",object at filename))

      if (is.null(msg)) TRUE else msg;
   }
)#setValidity

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
- - - -
"initialize.SubSubClassB1" <-
function(.Object, ...) {
   print("------initialize:SubSubClassB1------")
print(paste("SubSubClassB1:init:class(.Object) = ", class(.Object)))

   .Object <- callNextMethod(.Object, ...);
#validObject(.Object);
   .Object;
}#initialize.SubSubClassB1

setMethod("initialize", "SubSubClassB1", initialize.SubSubClassB1);

setValidity("SubSubClassB1",
   function(object) {
      print("------setValidity:SubSubClassB1------")
print(paste("SubSubClassB1:val:class(.Object) = ", class(object)))
      msg <- NULL;

      if (is.null(msg)) TRUE else msg;
   }
)#setValidity

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
- - - -
"initialize.SubSubClassB2" <-
function(.Object, namesubsubB2="MyNamesubsubB2", ...) {
   print("------initialize:SubSubClassB2------")
print(paste("SubSubClassB2:init:class(.Object) = ", class(.Object)))

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

   ## set default subsubnameB
   if (namesubsubB2 == "") {
      namesubsubB2 <- "DefaultNamesubsubB";
   }#if
print(paste("SubSubClassB2:init:namesubsubB2 = ", namesubsubB2))

   .Object <- callNextMethod(.Object, namesubsubB2=namesubsubB2, ...);

   .Object at namesubsubB2 <- namesubsubB2;
#validObject(.Object);
   .Object;
}#initialize.SubSubClassB2

setMethod("initialize", "SubSubClassB2", initialize.SubSubClassB2);

setValidity("SubSubClassB2",
   function(object) {
      print("------setValidity:SubSubClassB2------")
print(paste("SubSubClassB2:val:class(object) = ", class(object)))
      msg <- NULL;

      ## check subsubnameB
      strg <- object at namesubsubB2;
      if (!(is.character(strg) && nchar(strg) > 0)) {
         msg <- validMsg(msg, paste(sQuote("namesubsubB2"), "is missing"));
      }#if
print(paste("SubSubClassB2:val:namesubsubB2 = ",object at namesubsubB2))

      if (is.null(msg)) TRUE else msg;
   }
)#setValidity

# - - - - - - - - - - - - - - - - END  - - - - - - - - - - - - - - - - - 
- - - - - -

-------------- next part --------------
A non-text attachment was scrubbed...
Name: myclasspkg2_0.1.1.tar.gz
Type: application/x-gzip
Size: 3445 bytes
Desc: not available
Url : https://stat.ethz.ch/pipermail/r-devel/attachments/20070404/0546a913/attachment.gz 


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