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 <mtmor...@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@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@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@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@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@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]]
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
