自定义类继承`data.frame`和替换方法

时间:2013-02-24 06:31:53

标签: r dataframe

我定义了一个继承tdtfile的类(data.frame)。我现在正在尝试定义一个[.data.frame - 等效的替换方法来返回类tdtfile而不是data.frame的适当对象,但我遇到了麻烦。

以下是我正在做的事情:

# Define Class
setClass("tdtfile",
  representation(Comment = "character"),
   prototype(Comment = NULL),
   contains = c("data.frame"))

# Construct instance and populate
test <- new("tdtfile",Comment="Blabla")
df <- data.frame(A=seq(26),B=LETTERS)
for(sName in names(getSlots("data.frame"))){
  slot(test,sName) <- slot(df,sName)
}

# "Normal" data.frame behavior (loss of slot "Comment")
str(test[1])
# Works as well - will be trying to use that below
`[.data.frame`(test,1)

# Try to change replacement method in order to preserve slot structure 
# while accessing data.frame functionality
setMethod(
  `[`,
  signature=signature(x="tdtfile"),
  function(x, ...){
    # Save the original
    storedtdt <- x
    # Use the fact that x is a subclass to "data.frame"
    tmpDF <- `[.data.frame`(x, ...)
    # Reintegrate the results
    if(inherits(x=tmpDF,what="data.frame")){
      for(sName in names(getSlots("data.frame"))){
        slot(storedtdt,sName) <- slot(tmpDF,sName)
      }
      return(storedtdt)
    } else {
      return(tmpDF)
    }
  })

# Method does not work - data.frame remains complete. WHY?
str(test[1])

# Cleanup
#removeMethod(
#  `[`,
#  signature=signature(x="tdtfile"))

调用类似

的内容时
tdtfile[1]

这会返回一个tdtfile对象,其中包含所有data.frame列,而不仅仅是第一列...有人能发现我缺少的内容吗?

感谢您的帮助。

此致,约翰

1 个答案:

答案 0 :(得分:1)

您的方法行为不当的原因是ijdrop会自动在您的[方法中提供,我相信这仅仅是因为[通用作品。这意味着您需要将这些参数按名称传递给[.data.frame,而不是依赖...。不幸的是,这反过来又让你有责任正确处理各种形式的索引。

这是一个经过修改的方法定义,它可以完成一项不错的工作,但在drop参数的某些用法下,它可能与纯数据帧索引的行为完全不同:

setMethod(
    `[`,
    signature=signature(x="tdtfile"),
    function(x, ...){
        # Save the original
        storedtdt <- x
        # Use the fact that x is a subclass to "data.frame"
        Nargs <- nargs()
        hasdrop <- "drop" %in% names(sys.call())
        if(Nargs==2) {
            tmpDF <- `[.data.frame`(x, i=TRUE, j=i, ..., drop=FALSE)
        } else if((Nargs==3 && hasdrop)) {
            tmpDF <- `[.data.frame`(x, i=TRUE, j=i, ..., drop)
        } else if(hasdrop) {
            tmpDF <- `[.data.frame`(x, i, j, ..., drop)
        } else {
            tmpDF <- `[.data.frame`(x, i, j, ...)
        }
        # Reintegrate the results
        if (inherits(x=tmpDF, what="data.frame")){
            for(sName in names(getSlots("data.frame"))){
                slot(storedtdt, sName) <- slot(tmpDF, sName)
            }
            return(storedtdt)
        } else {
            return(tmpDF)
        }
    })

测试对象的一些示例:

> head(test[1])
Object of class "tdtfile"
  A
1 1
2 2
3 3
4 4
5 5
6 6
Slot "Comment":
[1] "Blabla"

> test[1:2,]
Object of class "tdtfile"
  A B
1 1 A
2 2 B
Slot "Comment":
[1] "Blabla"

我不确定是否有更规范的方式来做到这一点。也许正在尝试查看一些S4软件包的源代码?

编辑:这是一种与上述提取方法类似的替换方法。在直接调用[<-之前,这个显式地将对象强制转换为数据框,主要是为了避免在[<-.data.frame执行时发出警告。同样,行为与纯数据帧替换方法不完全相同,但可以做更多的工作。

setMethod(
    `[<-`,
    signature=signature(x="tdtfile"),
    function(x, ..., value){
        # Save the original
        storedtdt <- x
        # Use the fact that x is a subclass to "data.frame"
        Nargs <- nargs()
        if (any(!names(sys.call()) %in% c("", "i", "j", "value"))) {
            stop("extra arguments are not allowed")
        }
        tmpDF <- data.frame(x)
        if(Nargs==3) {
             if (missing(i)) i <- j
             tmpDF[i] <- value
        } else if(Nargs==4) {
             tmpDF[i, j] <- value
        }
        # Reintegrate the results
        for(sName in names(getSlots("data.frame"))){
            slot(storedtdt, sName) <- slot(tmpDF, sName)
        }   
        return(storedtdt)
    })

示例:

> test[2] <- letters
> test[1,"B"] <- "z"
> test$A[1:3] <- 99
> head(test)
Object of class "tdtfile"
   A B
1 99 z
2 99 b
3 99 c
4  4 d
5  5 e
6  6 f
Slot "Comment":
[1] "Blabla"

顺便说一句,如果提取/替换工作完全与数据帧一样重要,我会考虑重写类以包含一个包含数据帧的插槽,而不是拥有数据.frame作为超类。继承的构成!