Использование атрибутов `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
>
