Пользовательский класс, наследующий `data.frame` и метод замены

Question

Я определил класс (tdtfile), который наследует 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 столбцы, а не только первый ... может кто-нибудь то, что мне не хватает?

Благодарим за помощь.

С уважением, Джох

Answer 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 как суперкласс. Композиция над наследованием!