データを抽出するために「ftable」の属性を使用する

Question

私は時々、ftableの機能を純粋に階層的なカテゴリの提示のために使用します。ただし、テーブルが大きい場合は、使用する前にテーブルをさらにサブセット化したい場合もあります。

は、我々が始まるしているとしましょう：

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 

何dimnamesがないので、私は私がdimnamesを持つオブジェクトの場合と同じ方法でデータを抽出することはできません。たとえば、 "1st"クラスと "3rd"クラスからすべての "Child"値を直接抽出する方法はありません。

私の現在のアプローチは、tableに変換し、抽出してftableに変換することです。

例：

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 

注意しないなら、全体のレイアウトが時々変わるのでしかし、私はこのアプローチを好みません。私は、行と列の全体的なレイアウトが変更されたことを好きではない

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 

：子供だけをサブセット化の要件を削除し、生存しなかったサブセットのみの要件を追加し、以下、とそれを比較してください。これは、単一の列が抽出されたときの寸法を維持するためにdrop = FALSEを使用することを覚えておくことの古典的なケースです：

私は生のサブセットで始まる、私は必要なデータを取得する 多くの方法があります知っている

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 

データを作成してftableとしていますが、この質問ではそれは不可能と仮定しましょう。

最終的な目標は、ネストされた「行」階層の表示形式を維持してftableから抽出できるようにするアプローチです。

他の解決方法はありますか？ row.varsとcol.vars属性を使用してftableからデータを抽出し、フォーマットを保持できますか？

---

私の現在のアプローチは、階層の列では動作しませんので、私は提案された解決策はまた、これらのケースを扱うことができることを願っています。

例：

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 

注 "年齢" と "生き残った" のネスティング。

は私の現在のアプローチを試してみてください：

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 

私は戻って私が欲しいものを得ることができます：

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

しかし、私はより直接的な何かを願っています。ここで

Answer 1

は、私は一種のAxemanからsome helpと、一緒にハックすることができたものです。データはに集約されると

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

：

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 
} 

は、質問からの例でそれを試してみてください出力データを操作するのではなく、表示のために生データをサブセット化して表にすることは間違いなく簡単です。

OPはftableを使用して解決策を尋ねますが、コメント欄の前後で他のアイデアを募集していますが、この質問を別の方法で投稿すると思いました。カスタム関数を使用せずにコンティンジェンシーテーブルの階層構造を生成することができます。

データパッケージの階層構造を保持し、データフレームのサブセットを作成するときに空のセルを削除する方法があります。

最初に着信テーブルをデータフレームとしてキャストし、tabular()の機能の間にサブセット化できるようにします。

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

その後、我々は、抽出演算子[でdata=引数でデータをサブセット化しながら、tables::tabular()を使用し、Freq == 0印刷行と列を避けるためにDropEmpty()を使用しています。また、Heading()を使用して、Freqとsumの不要な見出しを抑制します。

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

...と出力：

> 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 

我々はDropEmpty()を削除した場合、我々は、テーブル内の因子変数に基づいて、全体の表形式の構造を複製します。

> # 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 
> 

OPから2番目と3番目の例を複製することも簡単です。

> # 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 
>