3

我定义了一个类 ( 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列的对象，而不仅仅是第一个……任何人都可以发现我缺少的东西吗？

谢谢您的帮助。

真诚的，乔

4

1 回答 1

1

您的方法行为不端的原因是i,j和drop在您的方法中自动可用[，我相信这仅仅是[泛型工作方式的结果。这意味着您需要将这些参数按名称传递给[.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"

顺便说一句，如果提取/替换的工作与它们在数据帧上的工作完全相同，我会考虑重写该类以拥有一个包含数据帧的插槽，而不是将 data.frame 作为超类。组合优于继承！

于 2013-02-25T08:57:46.153 回答