Verwenden von Attributen von `ftable` zum Extrahieren von Daten

Question

Ich verwende manchmal die ftable-Funktion rein für seine Darstellung von hierarchischen Kategorien. Manchmal, wenn die Tabelle groß ist, möchte ich die Tabelle vor der Verwendung weiter unterteilen.

Sagen wir, wir beginnen mit:

mytable <- ftable(Titanic, row.vars = 1:3) 
mytable 
##     Survived No Yes 
## Class Sex Age     
## 1st Male Child   0 5 
##    Adult   118 57 
##  Female Child   0 1 
##    Adult   4 140 
## 2nd Male Child   0 11 
##    Adult   154 14 
##  Female Child   0 13 
##    Adult   13 80 
## 3rd Male Child   35 13 
##    Adult   387 75 
##  Female Child   17 14 
##    Adult   89 76 
## Crew Male Child   0 0 
##    Adult   670 192 
##  Female Child   0 0 
##    Adult   3 20 

str(mytable) 
## ftable [1:16, 1:2] 0 118 0 4 0 154 0 13 35 387 ... 
## - attr(*, "row.vars")=List of 3 
## ..$ Class: chr [1:4] "1st" "2nd" "3rd" "Crew" 
## ..$ Sex : chr [1:2] "Male" "Female" 
## ..$ Age : chr [1:2] "Child" "Adult" 
## - attr(*, "col.vars")=List of 1 
## ..$ Survived: chr [1:2] "No" "Yes" 
## NULL 

Da es keine dimnames sind, kann ich nicht Daten in der gleichen Art und Weise extrahieren, dass ich mit einem Objekt, das dimnames hat. Zum Beispiel gibt es keine Möglichkeit für mich, alle "Kind" -Werte direkt aus den Klassen "1st" und "3rd" zu extrahieren.

Mein derzeitiger Ansatz besteht darin, es in eine table zu konvertieren, die Extraktion durchzuführen und sie dann wieder in eine ftable umzuwandeln.

Beispiel:

mytable[c("1st", "3rd"), , "Child", ] 
## Error: incorrect number of dimensions 

## Only the underlying data are seen as having dims 
dim(mytable) 
## [1] 16 2 

## I'm OK with the "Age" column being dropped in this case.... 
ftable(as.table(mytable)[c("1st", "3rd"), , "Child", ]) 
##    Survived No Yes 
## Class Sex     
## 1st Male    0 5 
##  Female   0 1 
## 3rd Male   35 13 
##  Female   17 14 

aber ich mag diesen Ansatz nicht, weil das gesamte Layout manchmal ändert sich, wenn man nicht aufpasst. Vergleichen Sie es mit dem folgenden, die die Anforderung von subsetting nur Kinder entfernt und fügt die Anforderung von subsetting nur diejenigen, die nicht überlebt haben:

ftable(as.table(mytable)[c("1st", "3rd"), , , "No"]) 
##    Age Child Adult 
## Class Sex     
## 1st Male   0 118 
##  Female   0  4 
## 3rd Male   35 387 
##  Female  17 89 

Ich mag es nicht, dass das gesamte Layout der Zeilen und Spalten geändert hat. Das ist ein klassischer Fall von mit mir erinnern drop = FALSE zu verwenden Dimensionen zu halten, wenn eine einzelne Säule extrahiert wird:

ftable(as.table(mytable)[c("1st", "3rd"), , , "No", drop = FALSE]) 
##     Survived No 
## Class Sex Age    
## 1st Male Child   0 
##    Adult   118 
##  Female Child   0 
##    Adult   4 
## 3rd Male Child   35 
##    Adult   387 
##  Female Child   17 
##    Adult   89 

Ich weiß, es gibt viele Möglichkeiten, um die Daten zu erhalten, die ich will, beginnend mit subsetting aus dem rohen Daten und dann meine ftable, aber für diese Frage, lassen Sie uns davon ausgehen, dass das nicht möglich ist.

Das Endziel ist es, einen Ansatz zu haben, mit dem ich aus einer ftable das Anzeigeformat der verschachtelten "Zeile" Hierarchie beibehalten kann.

Gibt es andere Lösungen? Können wir die Attribute row.vars und col.vars verwenden, um Daten aus einem ftable zu extrahieren und seine Formatierung beizubehalten?

Mein aktueller Ansatz funktioniert auch nicht für hierarchische Spalten, daher hoffe ich, dass die vorgeschlagene Lösung auch diese Fälle behandeln kann.

Beispiel:

tab2 <- ftable(Titanic, row.vars = 1:2, col.vars = 3:4) 
tab2 
##    Age  Child  Adult  
##    Survived No Yes No Yes 
## Class Sex         
## 1st Male    0 5 118 57 
##  Female    0 1  4 140 
## 2nd Male    0 11 154 14 
##  Female    0 13 13 80 
## 3rd Male    35 13 387 75 
##  Female    17 14 89 76 
## Crew Male    0 0 670 192 
##  Female    0 0  3 20 

Notiere die Verschachtelung von "Alter" und "überlebt".

meinen aktuellen Ansatz versuchen:

ftable(as.table(tab2)[c("1st", "3rd"), , , , drop = FALSE]) 
##     Survived No Yes 
## Class Sex Age     
## 1st Male Child   0 5 
##    Adult   118 57 
##  Female Child   0 1 
##    Adult   4 140 
## 3rd Male Child   35 13 
##    Adult   387 75 
##  Female Child   17 14 
##    Adult   89 76 

Ich kann zurück zu bekommen, was ich will mit:

ftable(as.table(tab2)[c("1st", "3rd"), , , , drop = FALSE], row.vars = 1:2, col.vars = 3:4) 

Aber ich bin die Hoffnung, etwas direkter.

Answer 1

Hier ist, was ich in der Lage war irgendwie zusammen zu hacken, mit some help von Axeman:

replace_empty_arguments <- function(a) { 
    empty_symbols <- vapply(a, function(x) { 
    is.symbol(x) && identical("", as.character(x)), 0) 
    } 
    a[!!empty_symbols] <- 0 
    lapply(a, eval) 
} 

`[.ftable` <- function (inftable, ...) { 
    if (!class(inftable) %in% "ftable") stop("input is not an ftable") 
    tblatr <- attributes(inftable)[c("row.vars", "col.vars")] 
    valslist <- replace_empty_arguments(as.list(match.call()[-(1:2)])) 
    x <- sapply(valslist, function(x) identical(x, 0)) 
    TAB <- as.table(inftable) 
    valslist[x] <- dimnames(TAB)[x] 
    temp <- as.matrix(expand.grid(valslist)) 
    out <- ftable(
    `dimnames<-`(`dim<-`(TAB[temp], lengths(valslist)), valslist), 
    row.vars = seq_along(tblatr[["row.vars"]]), 
    col.vars = seq_along(tblatr[["col.vars"]]) + length(tblatr[["row.vars"]])) 
    names(attributes(out)[["row.vars"]]) <- names(tblatr[["row.vars"]]) 
    names(attributes(out)[["col.vars"]]) <- names(tblatr[["col.vars"]]) 
    out 
} 

Probieren Sie es mit den Beispielen aus der Frage heraus:

mytable[c("1st", "3rd"), , "Child", ] 
##     Survived No Yes 
## Class Sex Age     
## 1st Male Child   0 5 
##  Female Child   0 1 
## 3rd Male Child   35 13 
##  Female Child   17 14 

mytable[c("1st", "3rd"), , , "No"] 
##     Survived No 
## Class Sex Age    
## 1st Male Child   0 
##    Adult   118 
##  Female Child   0 
##    Adult   4 
## 3rd Male Child   35 
##    Adult   387 
##  Female Child   17 
##    Adult   89 

tab2[c("1st", "3rd"), , , ] 
##    Age  Child  Adult  
##    Survived No Yes No Yes 
## Class Sex         
## 1st Male    0 5 118 57 
##  Female    0 1  4 140 
## 3rd Male    35 13 387 75 
##  Female    17 14 89 76 

Answer 2

Sobald die Daten aggregiert Frequenzen durch Kombination von Faktoren, wie es mit dem Datensatz Titanic der Fall ist, ist es wohl einfacher, die Rohdaten zu unterteilen und tabellarisieren für die Anzeige, anstatt das Ausgabeobjekt zu manipulieren.

Ich erkenne, dass das OP fragt nach Lösungen mit ftable, aber mit den hin und her in den Kommentaren anderen Ideen, ich dachte, ich würde eine andere Sicht auf diese Frage, weil es einen Weg, um gleichzeitig die Untermenge darstellt Daten und generieren die hierarchische Struktur der Kontingenztabellen ohne benutzerdefinierte Funktionen.

Hier ist ein Ansatz mit dem tables-Paket, das die hierarchische Struktur der Titanic Daten bewahrt, sowie die Beseitigung von Zellen, die leer sind, wenn wir den Datenrahmen unterteilen.

Zuerst wir die eingehende Tabelle als Datenrahmen, so dass wir es unter der tabular()-Funktion Teilmenge kann.

library(titanic) 
df <- as.data.frame(Titanic) 

Dann benutzen wir tables::tabular() während die Daten in dem mit dem Extrakt Operator data= Argumente subsetting [, und verwenden Sie DropEmpty() Druck Zeilen und Spalten zu vermeiden, in denen Freq == 0. Wir verwenden auch Heading(), um unerwünschte Überschriften für Freq und sum zu unterdrücken.

tabular((Class * Sex) ~ (Age)*Survived*Heading()*Freq*Heading()*sum*DropEmpty(empty=0), 
     data=df[df$Class %in% c("1st","3rd") & df$Age=="Child",]) 

... und die Ausgabe:

> tabular((Class * Sex) ~ (Age)*Survived*Heading()*Freq*Heading()*sum*DropEmpty(empty=0), 
+   data=df[df$Class %in% c("1st","3rd") & df$Age=="Child",]) 

       Age   
       Child  
       Survived  
Class Sex No  Yes 
1st Male 0  5 
     Female 0  1 
3rd Male 35  13 
     Female 17  14 

Wenn wir entfernen DropEmpty(), replizieren wir die gesamte Struktur tabellarisch auf den Faktor Variablen in der Tabelle basiert.

> # remove DropEmpty() to replicate entire factor structure 
> tabular((Class * Sex) ~ (Age)*Survived*Heading()*Freq*Heading()*sum, 
+   data=df[df$Class %in% c("1st","3rd") & df$Age=="Child",]) 

       Age      
       Child  Adult  
       Survived  Survived  
Class Sex No  Yes No  Yes 
1st Male 0  5 0  0 
     Female 0  1 0  0 
2nd Male 0  0 0  0 
     Female 0  0 0  0 
3rd Male 35  13 0  0 
     Female 17  14 0  0 
Crew Male 0  0 0  0 
     Female 0  0 0  0 
> 

Replizieren der zweiten und dritten Beispiele aus dem OP ist auch einfach.

> # second example from question 
> tabular((Class * Sex * Age) ~ Survived*Heading()*Freq*Heading()*sum*DropEmpty(empty=0), 
+   data=df[df$Class %in% c("1st","3rd") & df$Survived=="No",]) 

        Survived 
Class Sex Age No  
1st Male Child 0  
       Adult 118  
     Female Child 0  
       Adult 4  
3rd Male Child 35  
       Adult 387  
     Female Child 17  
       Adult 89  
> # third example from question 
> tabular((Class * Sex) ~ (Age)*Survived*Heading()*Freq*Heading()*sum*DropEmpty(empty=0), 
+   data=df[df$Class %in% c("1st","3rd"),]) 

       Age      
       Child  Adult  
       Survived  Survived  
Class Sex No  Yes No  Yes 
1st Male 0  5 118  57 
     Female 0  1 4  140 
3rd Male 35  13 387  75 
     Female 17  14 89  76 
>