From gmbecker at ucdavis.edu  Thu May 28 18:57:44 2015
From: gmbecker at ucdavis.edu (Gabriel Becker)
Date: Thu, 28 May 2015 09:57:44 -0700
Subject: [Rd] S4 inheritance and old class
In-Reply-To: <55672675.7020104@fredhutch.org>
References: <CAMDmGSbB+0wOfCCfnpBY4ENDkrKozb0iaUFW10sXprDp_7WTEw@mail.gmail.com>
	<55672675.7020104@fredhutch.org>
Message-ID: <CADwqtCMHX1K5kNSid2RtRDYLfGjD+YDXnJiPu8SiX9H0ADqhrA@mail.gmail.com>

The problem seems to be with coercion, actually, not validity methods per
se:

> myd
Object of class "D"
<S4 Type Object>
attr(,"class")
[1] "AOldclass"
Slot "D":
character(0)

Slot "C":
character(0)

Slot "B":
character(0)

Slot "A":
character(0)

> as(myd, "B")
Object of class "AOldclass"
<S4 Type Object>
attr(,"class")
[1] "AOldclass"

This comes from the coercion method that is automatically generated for
going from D to B. Recreating what as() does, we get (emphasis mine, of
course):

> thisClass = "D"
> Class = "B"
>    where <- .classEnv(thisClass, mustFind = FALSE)
> coerceMethods <- methods:::.getMethodsTable(coerceFun,
environment(coerceFun),
+ inherited=TRUE)
> asMethod = methods:::.quickCoerceSelect(thisClass, Class, coerceFun,
+ coerceMethods, where)
> asMethod
Method Definition:

function (from, to = "B", *strict = TRUE*)

*if (strict) {    S3Part(from)*
} else from

Signatures:
        from to
target  "D"  "B"
defined "D"  "B"

Since S3 classes can't have validity methods anyway, I would conjecture
that passing strict = FALSE to the line

           errors <- c(errors, anyStrings(validityMethod(as(object,
                superClass))))

in validObject() would fix this.  I haven't tested that hypothesis though,
so there may be cases where such a patch breaks other functionality.

~G


On Thu, May 28, 2015 at 7:30 AM, Martin Morgan <mtmorgan at fredhutch.org>
wrote:

> On 05/28/2015 02:49 AM, Julien Id? wrote:
>
>> Hey everyone,
>>
>> I would like to develop a package using S4 classes.
>> I have to define several S4 classes that inherits from each others as
>> follow:
>>
>> # A <- B <- C <- D
>>
>> I also would like to define .DollarNames methods for these class so, if I
>> have understood well, I also have to define an old class as follow:
>>
>> # AOld <- A <- B <- C <- D
>>
>> setOldClass(Classes = "AOld")
>>
>> setClass(
>>    Class = "A",
>>    contains = "AOld",
>>    slots = list(A = "character")
>> )
>>
>> .DollarNames.A <- function(x, pattern)
>>    grep(pattern, slotNames(x), value = TRUE)
>>
>
> Instead of setOldClass, define a $ method on A
>
>     setMethod("$", "A", function(x, name) slot(x, name))
>
> And then
>
>   a = new("A")
>   a$<tab>
>   d = new("D")
>   d$<tab>
>
> I don't know about the setOldClass problem; it seems like a bug.
>
> Martin Morgan
>
>
>
>> setClass(
>>    Class = "B",
>>    contains = "A",
>>    slots = list(B = "character"),
>>    validity = function(object){
>>      cat("Testing an object of class '", class(object),
>>          "'' with valitity function of class 'B'", sep = "")
>>      cat("Validity test for class 'B': ", object at A, sep = "")
>>      return(TRUE)
>>    }
>> )
>>
>> setClass(
>>    Class = "C",
>>    contains = c("B"),
>>    slots = list(C = "character"),
>>    validity = function(object){
>>      cat("Testing an object of class '", class(object),
>>          "'' with valitity function of class 'C'", sep = "")
>>      cat("Validity test for class 'C': ", object at A, sep = "")
>>      return(TRUE)
>>    }
>> )
>>
>> setClass(
>>    Class = "D",
>>    contains = "C",
>>    slots = list(D = "character"),
>>    validity = function(object){
>>      cat("Testing an object of class '", class(object),
>>          "'' with valitity function of class 'D'", sep = "")
>>      cat("Validity test for class 'D': ", object at A, sep = "")
>>      return(TRUE)
>>    }
>> )
>>
>> My problem is that when I try to create an object of class "D" and test
>> its
>> validity
>>
>> validObject(new("D"))
>>
>> it seems that at some point the object is coerced to an object of class
>> "AOld" and tested by the validity function of class "B". What am I missing
>> here?
>>
>> Julien
>>
>>         [[alternative HTML version deleted]]
>>
>> ______________________________________________
>> R-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>>
>
> --
> Computational Biology / Fred Hutchinson Cancer Research Center
> 1100 Fairview Ave. N.
> PO Box 19024 Seattle, WA 98109
>
> Location: Arnold Building M1 B861
> Phone: (206) 667-2793
>
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>



-- 
Gabriel Becker, PhD
Computational Biologist
Bioinformatics and Computational Biology
Genentech, Inc.

	[[alternative HTML version deleted]]



[Rd] S4 inheritance and old class
Gabriel Becker