R S4class包含另一个S4class的列表

时间:2017-06-08 15:26:55

标签: r lapply s4

我有一个问题验证我班“class2”的有效性;它由'class1'对象列表组成。我想验证确实如此:

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");
        });            
    });

问题是lapply返回不被接受的值:

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

我通过测试列表的第一个元素来检查问题来自于lapply,这是正常工作:

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

我尝试过矢量化,但这不会改变问题。

有没有办法验证slotListName确实是'class1'对象的列表?

非常感谢!

1 个答案:

答案 0 :(得分:0)

The problem with your function is that it gives an error for an invalid object. It's supposed to return a diagnostic message, with the S4 object construction machinery taking care of the error.

Here's how you can do it using the recommended approach, which is to define methods for initialize and setValidity. See ?setClass for more details.

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())