r - style - tags$div shiny

Usando atributos de `ftable` para extraer datos

Question

A veces uso la función ftable únicamente para su presentación de categorías jerárquicas. Sin embargo, a veces, cuando la tabla es grande, me gustaría subdividir más la tabla antes de usarla.

Digamos que estamos empezando con:

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

Como no hay dimnames , no puedo extraer datos de la misma manera que lo haría con un objeto que tiene dimnames . Por ejemplo, no hay forma de que pueda extraer directamente todos los valores "secundarios" de las clases "1ª" y "3ª".

Mi enfoque actual es convertirlo en una table , realizar la extracción y luego volver a convertirlo en una ftable .

Ejemplo:

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

Sin embargo, no me gusta este enfoque porque el diseño general a veces cambia si no se tiene cuidado. Compárelo con lo siguiente, que elimina el requisito de subcontratar solo a los niños y agrega el requisito de subcontratar solo a los que no sobrevivieron:

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

No me gusta que el diseño general de las filas y columnas haya cambiado. Ese es un caso clásico de tener que recordar usar drop = FALSE para mantener las dimensiones cuando se extrae una sola columna:

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

Sé que hay muchas formas de obtener los datos que quiero, comenzando con la subconjunto de los datos sin procesar y luego haciendo mi ftable , pero para esta pregunta, asumamos que eso no es posible.

El objetivo final es tener un enfoque que me permita extraer de una ftable conserva el formato de visualización de la jerarquía "fila" anidada.

¿Hay otras soluciones a esto? ¿Podemos utilizar los row.vars y col.vars para extraer datos de una ftable y conservar su formato?

Mi enfoque actual tampoco funciona para las columnas jerárquicas, así que espero que la solución propuesta también pueda manejar esos casos.

Ejemplo:

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

Tenga en cuenta la anidación de "Edad" y "Sobrevivió".

Prueba mi enfoque actual:

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

Puedo volver a lo que quiero con:

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

Pero espero algo más directo.

Answer 1

Esto es lo que pude hackear juntos, con la ayuda de 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
}

Pruébalo con los ejemplos de la pregunta:

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

Una vez que los datos se agregan a las frecuencias mediante la combinación de factores, como es el caso con el conjunto de datos Titanic , se puede argumentar que es más fácil subcontratar los datos sin procesar y tabularlos para su visualización en lugar de manipular el objeto de salida.

Reconozco que el OP solicita soluciones utilizando la ftable , pero con la parte posterior y posterior de la sección de comentarios que solicita otras ideas, pensé que publicaría una opinión diferente sobre esta pregunta porque ilustra una manera de subconjuntar los datos y generar los datos simultáneamente. Estructura jerárquica de las tablas de contingencia sin funciones personalizadas.

Este es un enfoque que utiliza el paquete de tables que preserva la estructura jerárquica de los datos del Titanic , así como la eliminación de celdas que están vacías cuando subjuntamos el marco de datos.

Primero, emitimos la tabla entrante como un marco de datos para poder subconjuntarla durante la función tabular() .

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

Luego usamos tables::tabular() tiempo que subcontratamos los datos en el argumento data= con el operador de extracción [ , y usamos DropEmpty() para evitar la impresión de filas y columnas donde Freq == 0 . También utilizamos Heading() para suprimir los encabezados no deseados para Freq y sum .

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

... y la salida:

> 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

Si eliminamos DropEmpty() , DropEmpty() la estructura tabular completa en función de las variables de factores en la tabla.

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

Replicar el segundo y tercer ejemplo del OP también es sencillo.

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