Использование атрибутов `ftable` для извлечения данных

Я иногда использую функцию 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. Например, для меня нет возможности напрямую извлекать все значения "Ребенок" из классов "1-й" и "3-й".

Мой текущий подход состоит в том, чтобы преобразовать его в 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)

Но я надеюсь на что-то более прямое.

Ответ 1

Вот что мне удалось раздобыть вместе с некоторой помощью от 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
}

Попробуйте с примерами из вопроса:

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

Ответ 2

Как только данные агрегируются по частотам с помощью комбинации факторов, как это имеет место с набором данных Titanic, возможно, легче подмножить необработанные данные и вывести их в таблицу для отображения, а не манипулировать выходным объектом.

Я понимаю, что OP запрашивает решения с использованием ftable, но, взад и вперед в разделе комментариев, запрашивая другие идеи, я думал, что опубликую другой вопрос по этому вопросу, потому что он иллюстрирует способ одновременного подмножества данных и генерировать иерархическую структуру таблиц непредвиденных ситуаций без пользовательских функций.

Вот подход, использующий пакет tables, который сохраняет иерархическую структуру данных Titanic, а также исключает ячейки, которые пусты, когда мы подмножаем фрейм данных.

Сначала мы передаем входящую таблицу как фрейм данных, чтобы мы могли ее подмножить во время tabular().

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

Затем мы используем tables::tabular(), подмножая данные в аргументе data= с оператором extract [ и используем DropEmpty(), чтобы избежать печати строк и столбцов, где Freq == 0. Мы также используем 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 также проста.

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