Capítulo 3 Tablas de contingencia

Además de la manera clásica que tenemos en R para generar una tabla de contingencia con base::table() podemos nosotros generar esta. Aquí se dejan tres maneras de hacer una tabla de contingencia apropiada con un data frame, para esto utilizaremos una bas da datos pública con datos de 120 años de las olimpiadas (Athens 1896-Rio 2016) obtenidos de este enlace.

olympics <- read_csv("athlete_events.csv") %>% distinct()
olympics
# A tibble: 269,731 × 15
      ID Name    Sex     Age Height Weight Team   NOC   Games  Year Season City 
   <dbl> <chr>   <chr> <dbl>  <dbl>  <dbl> <chr>  <chr> <chr> <dbl> <chr>  <chr>
 1     1 A Diji… M        24    180     80 China  CHN   1992…  1992 Summer Barc…
 2     2 A Lamu… M        23    170     60 China  CHN   2012…  2012 Summer Lond…
 3     3 Gunnar… M        24     NA     NA Denma… DEN   1920…  1920 Summer Antw…
 4     4 Edgar … M        34     NA     NA Denma… DEN   1900…  1900 Summer Paris
 5     5 Christ… F        21    185     82 Nethe… NED   1988…  1988 Winter Calg…
 6     5 Christ… F        21    185     82 Nethe… NED   1988…  1988 Winter Calg…
 7     5 Christ… F        25    185     82 Nethe… NED   1992…  1992 Winter Albe…
 8     5 Christ… F        25    185     82 Nethe… NED   1992…  1992 Winter Albe…
 9     5 Christ… F        27    185     82 Nethe… NED   1994…  1994 Winter Lill…
10     5 Christ… F        27    185     82 Nethe… NED   1994…  1994 Winter Lill…
# … with 269,721 more rows, and 3 more variables: Sport <chr>, Event <chr>,
#   Medal <chr>

Nuestro objetivo por el momento es obtener una tabla de contingencia donde se relacionen el tipo de medallas y la edad de los que obtuvieron una medalla. La primera propuesta es determinar cuantas medallas se obtuvieron por edad para después separar los datos por las distintas edades y con cada uno de esos datos obtener cuantas medallas de bronce, plata y oro se obtuvieron incluyendo los casos donde no se tiene registro de algún participante con cierta edad que haya ganado algún tipo específico de medalla.

get_n <- function(df, Medalla){
  nu <- df %>% filter(Medal == Medalla)
  if(dim(nu)[1] == 0){
    return(integer(1))
  }else{
    return(nu$n)
  }
}

medals_by_age <- olympics %>% filter(!is.na(Medal) & !is.na(Age)) %>% 
  group_by(Age) %>% count(Medal) %>%
  nest() %>% 
  mutate(Bronze = map_int(data, ~get_n(.x,"Bronze")), 
         Silver = map_int(data, ~get_n(.x,"Silver")),
         Gold = map_int(data, ~get_n(.x,"Gold"))) %>% 
  dplyr::select(-data)

medals_by_age
# A tibble: 61 × 4
# Groups:   Age [61]
     Age Bronze Silver  Gold
   <dbl>  <int>  <int> <int>
 1    10      1      0     0
 2    11      0      1     0
 3    12      3      3     0
 4    13      2      7     7
 5    14     18     30    27
 6    15     54     67    75
 7    16    105    129   116
 8    17    172    163   199
 9    18    286    294   280
10    19    469    441   459
# … with 51 more rows

En la siguiente propuesta se obtendrá el resultado anterior de una manera sencilla, así que primero se muestra antes de crear la tabla de contingencia.

medals_by_age <- olympics %>% filter(!is.na(Medal) & !is.na(Age)) %>%
  group_by(Age, Medal) %>%
  tally() %>% 
  spread(Medal, n, fill = 0)

medals_by_age
# A tibble: 61 × 4
# Groups:   Age [61]
     Age Bronze  Gold Silver
   <dbl>  <dbl> <dbl>  <dbl>
 1    10      1     0      0
 2    11      0     0      1
 3    12      3     0      3
 4    13      2     7      7
 5    14     18    27     30
 6    15     54    75     67
 7    16    105   116    129
 8    17    172   199    163
 9    18    286   280    294
10    19    469   459    441
# … with 51 more rows

Ya con este resultado, es sencillo crear nuestra tabla de contingencia

table_medals <- matrix(c(medals_by_age$Bronze, medals_by_age$Silver, medals_by_age$Gold), 
                       nrow = 3, byrow = T)
colnames(table_medals) <- medals_by_age$Age
rownames(table_medals) <- c("Bronze", "Silver", "Gold")
table_medals
       10 11 12 13 14 15  16  17  18  19  20  21   22   23   24   25   26  27
Bronze  1  0  3  2 18 54 105 172 286 469 692 899 1081 1116 1106 1045 1001 890
Silver  0  1  3  7 30 67 129 163 294 441 638 860  982 1142 1048 1023  947 937
Gold    0  0  0  7 27 75 116 199 280 459 674 925 1096 1136 1135 1056  976 863
        28  29  30  31  32  33  34  35  36  37 38 39 40 41 42 43 44 45 46 47 48
Bronze 747 704 523 424 307 236 217 153 115 103 75 62 63 47 41 37 34 28 26 17 16
Silver 785 588 549 425 347 264 205 156 135  93 81 61 66 51 38 32 44 27 28 13 15
Gold   802 649 527 400 357 292 217 176 133  81 89 65 74 43 42 32 38 20 24 24 21
       49 50 51 52 53 54 55 56 57 58 59 60 61 63 64 65 66 68 69 71 72 73
Bronze 19  8 11 15  5  4  5  4  4  3  1  2  2  3  1  1  0  0  1  1  1  0
Silver 15 13  7  8  8  7  7  6  1  6  3  6  4  2  0  0  2  2  1  1  1  1
Gold   15 12  4 12  6 15  1 10  2  3  2  4  0  4  2  0  0  0  0  0  0  0

Lo anterior puede ser obtenido con la función tabyl(). Esta función nos permitirá crear tablas de conteo a partir de una data frame con mencionar las variables que deseamos; se recomienda leer el siguiente vingette para obtener más información; además de revisar el paquete janitor del cual proviene dicha función.

table_medals_efficent <- olympics %>% filter(!is.na(Medal) & !is.na(Age)) %>% 
  tabyl(Medal, Age)
table_medals_efficent
  Medal 10 11 12 13 14 15  16  17  18  19  20  21   22   23   24   25   26  27
 Bronze  1  0  3  2 18 54 105 172 286 469 692 899 1081 1116 1106 1045 1001 890
   Gold  0  0  0  7 27 75 116 199 280 459 674 925 1096 1136 1135 1056  976 863
 Silver  0  1  3  7 30 67 129 163 294 441 638 860  982 1142 1048 1023  947 937
  28  29  30  31  32  33  34  35  36  37 38 39 40 41 42 43 44 45 46 47 48 49 50
 747 704 523 424 307 236 217 153 115 103 75 62 63 47 41 37 34 28 26 17 16 19  8
 802 649 527 400 357 292 217 176 133  81 89 65 74 43 42 32 38 20 24 24 21 15 12
 785 588 549 425 347 264 205 156 135  93 81 61 66 51 38 32 44 27 28 13 15 15 13
 51 52 53 54 55 56 57 58 59 60 61 63 64 65 66 68 69 71 72 73
 11 15  5  4  5  4  4  3  1  2  2  3  1  1  0  0  1  1  1  0
  4 12  6 15  1 10  2  3  2  4  0  4  2  0  0  0  0  0  0  0
  7  8  8  7  7  6  1  6  3  6  4  2  0  0  2  2  1  1  1  1

Con esta tabla, ya podemos realizar una prueba \(\chi^2\). ¿Que se interpreta del siguiente resultado? ¿Necesitaríamos modificar algo en la tabla anterior para tener una mayor confianza de los resultados?

chisq.test(table_medals_efficent)

    Pearson's Chi-squared test

data:  table_medals_efficent
X-squared = 132.57, df = 120, p-value = 0.204