R S4class contenant la liste d'un autre S4class

Question

J'ai un problème de vérification de la validité de ma classe 'class2'; il est fait d'une liste d'objets 'class1'. Je veux vérifier qu'il est bien le cas:

class2 <- setClass(

    Class = "class2", 

    slots = c(slotListName = "list"), 

    validity = function(object){ 

      lapply(object@slotListName, function(x){ 

      if(!identical(is(x), "class1")) 
       stop(" not a class1 object"); 
     });    
    }); 

Le problème est que retourne lapply valeurs qui ne sont pas acceptées:

Error in validObject(.Object) : 
invalid class “class2” object: 1: NULL 
invalid class “class2” object: 2: NULL 

J'ai vérifié que le problème provenait du lapply en testant seulement le premier élément de la liste, qui fonctionne bien:

if(!identical(is(object@slotListName[[1]]), "class1")) 
     stop("not a class1 object"); 

J'ai essayé de vectoriser mais cela ne change pas le problème.

Existe-t-il un moyen de vérifier que slotListName est bien une liste d'objets 'class1'?

Merci beaucoup!

Answer 1

Le problème avec votre fonction est qu'elle donne une erreur pour un objet invalide. Il est censé retourner un message de diagnostic, avec la machine de construction d'objet S4 en prenant soin de l'erreur.

Voici comment vous pouvez le faire en utilisant l'approche recommandée, qui consiste à définir des méthodes pour initialize et setValidity. Voir pour plus de détails.

class2 <- setClass("class2", slots=c(slotListName="list")) 

setMethod("initialize", "class2", function(.Object, lst) 
{ 
    .Object@slotListName <- lst 
    validObject(.Object) 
    .Object 
}) 

# returns TRUE if the object is valid, otherwise a diagnostic message 
setValidity("class2", function(object) 
{ 
    if(length(object@slotListName) < 1) 
     "must contain at least one class1 object" 
    else if(!all(sapply(object@slotListName, function(x) inherits(x, "class1")))) 
     "all objects in list must be class1" 
    else TRUE 
}) 


## testing 
x <- 42 
class(x) <- "class1" 
y <- 43 
class(y) <- "bad" 

l1 <- list(x, x, x) 
l2 <- list(x, x, y) 


## works 
obj1 <- class2(l1) 

## error: bad object in list 
obj2 <- class2(l2) 

## error: empty list 
obj3 <- class2(list())