如何以规范的方式将aslist扩展到S4对象

时间:2015-05-21 23:27:03

标签: r s4

我在将S4对象转换回列表时遇到了一些麻烦。例如,以下嵌套的S4类:

setClass("nssItem", 
         representation(value = "numeric", text = "character", prefix = "character", type = "character"),
         prototype(value = as.numeric(NA), text = as.character(NA), prefix = as.character(NA), type = as.character(NA))

         ) 

setClass("geckoNss", representation(absolute = "character", item = "nssItem"))

geckoNss类的对象包含nssItem类的对象。从概念上讲,这似乎是一个允许嵌套的类似列表的结构。

然而,

> temp <- new("nssItem")
> as.list(temp)
Error in as.list.default(temp) : 
  no method for coercing this S4 class to a vector

我理解这个错误,也就是说,我实际上没有定义as.listnssItem类的含义或适用方式。尽管如此,这似乎是一种非常自然的操作。我如何将as.list的定义扩展到我定义的所有新类?

2 个答案:

答案 0 :(得分:3)

这是第二种更通用的解决方案。它使用一个超类,您可以从中派生所有用户定义的类。说明位于#条评论中。

#this is an "empty" superclass that characterises all user-defined classes
setClass("user_defined_class")

#we create an as.list method for this new superclass (this time an S4 method)
setMethod("as.list",signature(x="user_defined_class"),function(x) {
  mapply(function(y) {
    #apply as.list if the slot is again an user-defined object
    #therefore, as.list gets applied recursively
    if (inherits(slot(x,y),"user_defined_class")) {
      as.list(slot(x,y))
    } else {
      #otherwise just return the slot
      slot(x,y)
    }
  },
slotNames(class(x)),
SIMPLIFY=FALSE)
})

setClass("nssItem", 
     representation(value = "numeric",
                    text = "character",
                    prefix = "character",
                    type = "character"),
     prototype(value = as.numeric(NA),
               text = as.character(NA),
               prefix = as.character(NA),
               type = as.character(NA)),
     #note the contains argument that flags the nssItem class as user-defined
     contains="user_defined_class")

setClass("geckoNss",
         representation(absolute = "character", item = "nssItem"),
         #the same for the geckoNss class
         contains="user_defined_class")

现在为每个类创建一个对象

temp <- new("nssItem")
tempGecko<-new("geckoNss")

强制temp列出

as.list(temp)
#$value
#[1] NA
#
#$text
#[1] NA
#
#$prefix
#[1] NA
#
#$type
#[1] NA

tempGecko对象

as.list(tempGecko)
#$absolute
#character(0)
#
#$item
#$item$value
#[1] NA
#
#$item$text
#[1] NA
#
#$item$prefix
#[1] NA
#
#$item$type
#[1] NA

答案 1 :(得分:1)

我不确定我是否理解了关于&#34;嵌套&#34;正确,但这里有一些关于如何将as.list扩展到S4类的代码。正如Alex在评论中所指出的,这些实际上是S3对象上使用的S4方法。这也有效。您可以在Combining S4 and S3 methods in a single function

找到关于此主题的精彩摘要
as.list.nssItem=function(from) mapply(function(x) slot(from,x),
                                      slotNames("nssItem"),
                                      SIMPLIFY=FALSE)

现在让我们在as.list对象nssItem上尝试temp(在帖子中定义)

as.list(temp)
#$value
#[1] NA
#
#$text
#[1] NA
#
#$prefix
#[1] NA
#
#$type
#[1] NA

编辑:我想我现在明白你的意思是嵌套了。执行上面的代码后,定义一个新的geckoNss对象

tempGecko<-new("geckoNss")

as.list扩展到班级geckoNss

as.list.geckoNss=function(from) mapply(function(x) {
  if (x=="item") as.list(slot(from,x)) else slot(from,x)
  },
  slotNames("geckoNss"),
  SIMPLIFY=FALSE)

现在将as.list应用于您的geckoNss对象tempGecko

as.list(tempGecko)

#$absolute
#character(0)
#
#$item
#$item$value
#[1] NA
#
#$item$text
#[1] NA
#
#$item$prefix
#[1] NA
#
#$item$type
#[1] NA

根据Alex的评论,下面是一种更为一般的扩展方式as.list

#save old function definition (just in case...)
as.list.default.save=as.list.default

定义新的默认方法

as.list.default=function(x) {
  if (class(x)=='list') {
    x
  } else if (class(x)%in%c('nssItem','geckoNss')) {
    mapply(function(slot_name) as.list(slot(x,slot_name)),
           slotNames(class(x)),
           SIMPLIFY=FALSE)
  } else {
    .Internal(as.vector(x, "list"))
  }
}

您仍然需要输入所有用户定义的类c('nssItem','geckoNss')的向量。我还没有能够找到一个返回这些类的函数。 结果不像上面那样很好......

as.list(temp)

#$value
#$value[[1]]
#[1] NA
#
#
#$text
#$text[[1]]
#[1] NA
#
#
#$prefix
#$prefix[[1]]
#[1] NA
#
#
#$type
#$type[[1]]
#[1] NA