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
>