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.
<- read_csv("athlete_events.csv") %>% distinct()
olympics 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.
<- function(df, Medalla){
get_n <- df %>% filter(Medal == Medalla)
nu if(dim(nu)[1] == 0){
return(integer(1))
else{
}return(nu$n)
}
}
<- olympics %>% filter(!is.na(Medal) & !is.na(Age)) %>%
medals_by_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"))) %>%
::select(-data)
dplyr
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.
<- olympics %>% filter(!is.na(Medal) & !is.na(Age)) %>%
medals_by_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
<- matrix(c(medals_by_age$Bronze, medals_by_age$Silver, medals_by_age$Gold),
table_medals 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.
<- olympics %>% filter(!is.na(Medal) & !is.na(Age)) %>%
table_medals_efficent 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