1 ¿De qué trata esta investigación?

Pregunta: ¿Existe una asociación entre el grupo de edad y el deporte olímpico practicado?

Trabajaremos con gimnasia, natación, atletismo y tiro deportivo. Estudiaremos cinco grupos de edad: menos de 20, 20–24, 25–29, 30–34 y 35+.

Pregunta Método
¿Los cinco grupos de edad tienen igual frecuencia? Ji-cuadrado de bondad de ajuste
¿El deporte y la edad están asociados? Ji-cuadrado de independencia
¿Los cuatro deportes tienen iguales perfiles de edad? Ji-cuadrado de homogeneidad
¿Qué tan intensa es la asociación? V de Cramér

Importante: los datos son reales, no simulados. Proceden del conjunto 120 Years of Olympic History: Athletes and Results (Randi Griffin, Kaggle). El estudio es observacional y no demuestra causalidad.

2 La base de datos y su preparación

El archivo athlete_events.csv tiene 271.116 filas originalmente. Para que el informe funcione en RStudio, ubique este .Rmd y athlete_events.csv en la misma carpeta. Al tejer el documento (Knit), R leerá el CSV desde esa carpeta.

archivo <- "athlete_events.csv"
if (!file.exists(archivo)) {
  stop("No encuentro athlete_events.csv. Guárdelo junto al archivo .Rmd.")
}
original <- read.csv(archivo, stringsAsFactors=FALSE)
cat("Filas originales:", nrow(original), "\n")
## Filas originales: 271116
str(original)
## 'data.frame':    271116 obs. of  15 variables:
##  $ ID    : int  1 2 3 4 5 5 5 5 5 5 ...
##  $ Name  : chr  "A Dijiang" "A Lamusi" "Gunnar Nielsen Aaby" "Edgar Lindenau Aabye" ...
##  $ Sex   : chr  "M" "M" "M" "M" ...
##  $ Age   : int  24 23 24 34 21 21 25 25 27 27 ...
##  $ Height: int  180 170 NA NA 185 185 185 185 185 185 ...
##  $ Weight: num  80 60 NA NA 82 82 82 82 82 82 ...
##  $ Team  : chr  "China" "China" "Denmark" "Denmark/Sweden" ...
##  $ NOC   : chr  "CHN" "CHN" "DEN" "DEN" ...
##  $ Games : chr  "1992 Summer" "2012 Summer" "1920 Summer" "1900 Summer" ...
##  $ Year  : int  1992 2012 1920 1900 1988 1988 1992 1992 1994 1994 ...
##  $ Season: chr  "Summer" "Summer" "Summer" "Summer" ...
##  $ City  : chr  "Barcelona" "London" "Antwerpen" "Paris" ...
##  $ Sport : chr  "Basketball" "Judo" "Football" "Tug-Of-War" ...
##  $ Event : chr  "Basketball Men's Basketball" "Judo Men's Extra-Lightweight" "Football Men's Football" "Tug-Of-War Men's Tug-Of-War" ...
##  $ Medal : chr  NA NA NA "Gold" ...
colSums(is.na(original))[c("ID","Year","Season","Age","Sport")]
##     ID   Year Season    Age  Sport 
##      0      0      0   9474      0

Seleccionamos los cuatro deportes de verano, quitamos edades faltantes y dejamos una sola fila por atleta, edición y deporte. Esto evita contar varias veces a quien compitió en varias pruebas del mismo deporte en una edición.

deportes <- c("Gymnastics","Swimming","Athletics","Shooting")
etiquetas <- c("Gimnasia","Natación","Atletismo","Tiro deportivo")
edades <- c("<20","20-24","25-29","30-34","35+")

d <- subset(original, Season=="Summer" & Sport %in% deportes & !is.na(Age))
d <- d[!duplicated(d[c("ID","Year","Season","Sport")]), ]
d$grupo_edad <- cut(d$Age, breaks=c(-Inf,19,24,29,34,Inf),
                    labels=edades, right=TRUE)
d$deporte <- factor(d$Sport, levels=deportes, labels=etiquetas)
d$grupo_edad <- factor(d$grupo_edad, levels=edades, ordered=TRUE)

cat("Registros analizados:", nrow(d), "\n")
## Registros analizados: 53093
stopifnot(nrow(d)==53093)

La unidad de análisis es una participación atleta–edición–deporte. Una persona puede aparecer en varias ediciones; por ello la independencia entre todas las observaciones no está garantizada.

3 Tablas de contingencia

Una tabla de contingencia cruza dos variables categóricas. Cada celda indica cuántas participaciones tienen esa combinación de edad y deporte.

t <- table(d$deporte, d$grupo_edad)
t
##                 
##                    <20 20-24 25-29 30-34   35+
##   Gimnasia        1335  1872  1102   334    87
##   Natación        4872  4947  1506   223    37
##   Atletismo       2009 11824 10763  4023  1122
##   Tiro deportivo   205   959  1473  1530  2870
addmargins(t)
##                 
##                    <20 20-24 25-29 30-34   35+   Sum
##   Gimnasia        1335  1872  1102   334    87  4730
##   Natación        4872  4947  1506   223    37 11585
##   Atletismo       2009 11824 10763  4023  1122 29741
##   Tiro deportivo   205   959  1473  1530  2870  7037
##   Sum             8421 19602 14844  6110  4116 53093
round(prop.table(t, 1)*100, 2)  # porcentajes dentro de cada deporte
##                 
##                    <20 20-24 25-29 30-34   35+
##   Gimnasia       28.22 39.58 23.30  7.06  1.84
##   Natación       42.05 42.70 13.00  1.92  0.32
##   Atletismo       6.75 39.76 36.19 13.53  3.77
##   Tiro deportivo  2.91 13.63 20.93 21.74 40.78

Ejemplo de lectura: en natación hay 4.872 participaciones de menores de 20 años. Su porcentaje es:

100*t["Natación","<20"]/sum(t["Natación",])
## [1] 42.054

3.1 Gráfico 1: composición porcentual por deporte

p1 <- ggplot(as.data.frame(prop.table(t,1)),
             aes(x=Var1, y=Freq*100, fill=Var2)) +
  geom_col(width=.75) +
  scale_fill_manual(values=c("#102A43","#2474C6","#56A7D8",
                             "#F28C45","#E5B45A")) +
  labs(title="Distribución porcentual de edades por deporte",
       x="Deporte", y="Porcentaje dentro del deporte (%)",
       fill="Grupo de edad") +
  theme_minimal(base_size=12)
print(p1)

ggsave("grafico_1_edades_por_deporte.png",p1,width=10,height=6,dpi=180)

Interpretación: natación presenta una alta proporción de menores de 20 años; tiro deportivo concentra una proporción alta de personas de 35 años o más. Estos patrones son descriptivos.

4 La idea del ji-cuadrado

Las pruebas ji-cuadrado comparan frecuencias observadas (\(O\)) y esperadas (\(E\)) bajo una hipótesis nula:

\[\chi^2=\sum\frac{(O-E)^2}{E}\]

Para la tabla de independencia:

\[E_{ij}=\frac{(\text{total fila }i)(\text{total columna }j)} {\text{total general}}\]

Ejemplo: gimnasia y menores de 20 años.

filas <- rowSums(t)
columnas <- colSums(t)
n <- sum(t)
E <- outer(filas,columnas)/n
round(E,2)
##                    <20   20-24  25-29   30-34     35+
## Gimnasia        750.22  1746.3 1322.4  544.33  366.69
## Natación       1837.48  4277.2 3239.0 1333.21  898.12
## Atletismo      4717.17 10980.4 8315.1 3422.63 2305.65
## Tiro deportivo 1116.13  2598.1 1967.4  809.83  545.54
O_ej <- t["Gimnasia","<20"]
E_ej <- E["Gimnasia","<20"]
aporte_ej <- (O_ej-E_ej)^2/E_ej
cat("Observada:",O_ej,"\n")
## Observada: 1335
cat("Esperada:",round(E_ej,2),"\n")
## Esperada: 750.22
cat("Aporte de la celda:",round(aporte_ej,2),"\n")
## Aporte de la celda: 455.83
aporte <- (t-E)^2/E
chi_manual <- sum(aporte)
gl_manual <- (nrow(t)-1)*(ncol(t)-1)
cat("Chi-cuadrado manual:",round(chi_manual,2),
    "; grados de libertad:",gl_manual,"\n")
## Chi-cuadrado manual: 24090 ; grados de libertad: 12

El valor esperado de esta celda es aproximadamente 750,22; se observaron 1.335. Esta celda aporta parte de la diferencia total.

5 Los tres tipos de prueba ji-cuadrado

Prueba Pregunta Grados de libertad
Bondad de ajuste ¿Una variable sigue una distribución propuesta? \(k-1\)
Independencia ¿Dos variables categóricas están asociadas? \((f-1)(c-1)\)
Homogeneidad ¿Distintos grupos tienen la misma distribución? \((f-1)(c-1)\)

5.1 Bondad de ajuste: ¿las edades se distribuyen uniformemente?

Se propone como referencia teórica ilustrativa un 20 % para cada grupo. No se afirma que sea una expectativa histórica real.

  • \(H_0\): cada grupo de edad representa el 20 %.
  • \(H_1\): al menos un grupo tiene otra proporción.
  • \(\alpha=0,05\).
obs <- colSums(t)
g <- chisq.test(obs, p=rep(1/5,5))
obs
##   <20 20-24 25-29 30-34   35+ 
##  8421 19602 14844  6110  4116
g
## 
##  Chi-squared test for given probabilities
## 
## data:  obs
## X-squared = 15633, df = 4, p-value <2e-16
g$expected
##   <20 20-24 25-29 30-34   35+ 
## 10619 10619 10619 10619 10619
cat("Chi-cuadrado:",round(unname(g$statistic),2),"\n")
## Chi-cuadrado: 15633
cat("gl:",unname(g$parameter),"\n")
## gl: 4
cat("p:",format.pval(g$p.value,digits=3),"\n")
## p: <2e-16

Interpretación: el estadístico es aproximadamente 15.632,59 con 4 gl y p < 0,001. Se rechaza \(H_0\): los grupos de edad no se distribuyen uniformemente.

5.2 Gráfico 2: observadas y esperadas

bondad_df <- data.frame(
  grupo=rep(names(obs),2),
  tipo=rep(c("Observada","Esperada (20 %)"),each=length(obs)),
  frecuencia=c(as.numeric(obs),as.numeric(g$expected))
)
p2 <- ggplot(bondad_df,aes(grupo,frecuencia,fill=tipo)) +
  geom_col(position="dodge") +
  scale_fill_manual(values=c("Observada"="#2474C6",
                             "Esperada (20 %)"="#E5B45A")) +
  labs(title="Bondad de ajuste: frecuencias observadas y esperadas",
       x="Grupo de edad",y="Número de registros",fill="Frecuencia") +
  theme_minimal(base_size=12)
print(p2)

ggsave("grafico_2_bondad_ajuste.png",p2,width=10,height=6,dpi=180)

5.3 Independencia: ¿el deporte está asociado con la edad?

  • \(H_0\): deporte y grupo de edad son independientes.
  • \(H_1\): existe una asociación entre deporte y grupo de edad.
  • \(\alpha=0,05\).
ct <- chisq.test(t,correct=FALSE)
ct
## 
##  Pearson's Chi-squared test
## 
## data:  t
## X-squared = 24090, df = 12, p-value <2e-16
round(ct$expected,2)
##                 
##                      <20   20-24  25-29   30-34     35+
##   Gimnasia        750.22  1746.3 1322.4  544.33  366.69
##   Natación       1837.48  4277.2 3239.0 1333.21  898.12
##   Atletismo      4717.17 10980.4 8315.1 3422.63 2305.65
##   Tiro deportivo 1116.13  2598.1 1967.4  809.83  545.54
cat("Mínima frecuencia esperada:",round(min(ct$expected),2),"\n")
## Mínima frecuencia esperada: 366.69

Interpretación: \(\chi^2 \approx 24.089,79\), 12 gl y p < 0,001. Se rechaza \(H_0\): hay evidencia de asociación entre edad agrupada y deporte.

Todas las frecuencias esperadas superan 5, pero los valores p requieren cautela porque un atleta puede aparecer en más de una edición y la base no es una muestra aleatoria simple.

5.3.1 ¿Dónde se encuentran las diferencias?

Los residuos estandarizados ajustados (ct$stdres) muestran qué celdas tienen más (+) o menos (−) observaciones que las esperadas. Como referencia descriptiva, valores absolutos superiores a 2 son notables.

round(ct$stdres,2)
##                 
##                     <20  20-24  25-29  30-34    35+
##   Gimnasia        24.39   3.97  -7.48 -10.04 -15.93
##   Natación        87.28  14.58 -40.57 -36.56 -33.84
##   Atletismo      -64.82  15.28  47.69  16.45 -38.70
##   Tiro deportivo -31.92 -43.47 -14.10  28.88 111.25
res_df <- as.data.frame(as.table(ct$stdres))
names(res_df) <- c("Deporte","Edad","Residuo")

p3 <- ggplot(res_df,aes(x=Edad,y=Deporte,fill=Residuo)) +
  geom_tile(color="white",linewidth=.7) +
  geom_text(aes(label=round(Residuo,1)),size=3.5) +
  scale_fill_gradient2(low="#2474C6",mid="white",high="#F28C45",
                       midpoint=0) +
  labs(title="Mapa de calor: residuos ajustados",
       x="Grupo de edad",y="Deporte") +
  theme_minimal(base_size=12)
print(p3)

ggsave("grafico_3_mapa_residuos.png",p3,width=10,height=6,dpi=180)

5.4 Homogeneidad: ¿los cuatro deportes tienen iguales perfiles de edad?

  • \(H_0\): los cuatro deportes presentan la misma distribución de edades.
  • \(H_1\): al menos un deporte presenta una distribución diferente.

En esta tabla, la prueba de homogeneidad tiene el mismo cálculo y resultado numérico que la de independencia. Cambia la pregunta y el diseño de muestreo que justificaría cada interpretación. No son dos confirmaciones independientes.

cat("Chi-cuadrado:",round(unname(ct$statistic),2),"\n")
## Chi-cuadrado: 24090
cat("Grados de libertad:",unname(ct$parameter),"\n")
## Grados de libertad: 12
cat("Valor p:",format.pval(ct$p.value,digits=3),"\n")
## Valor p: <2e-16
round(prop.table(t,1)*100,2)
##                 
##                    <20 20-24 25-29 30-34   35+
##   Gimnasia       28.22 39.58 23.30  7.06  1.84
##   Natación       42.05 42.70 13.00  1.92  0.32
##   Atletismo       6.75 39.76 36.19 13.53  3.77
##   Tiro deportivo  2.91 13.63 20.93 21.74 40.78

6 V de Cramér: ¿qué tan fuerte es la asociación?

El valor p informa sobre evidencia estadística contra \(H_0\), pero no cuantifica la intensidad de la relación.

\[V=\sqrt{\frac{\chi^2}{n\min(f-1,c-1)}}\]

v <- sqrt(unname(ct$statistic)/(sum(t)*min(nrow(t)-1,ncol(t)-1)))
cat("Chi-cuadrado:",round(unname(ct$statistic),2),"\n")
## Chi-cuadrado: 24090
cat("n:",sum(t),"\n")
## n: 53093
cat("Factor mínimo:",min(nrow(t)-1,ncol(t)-1),"\n")
## Factor mínimo: 3
cat("V de Cramér:",round(v,3),"\n")
## V de Cramér: 0.389

Interpretación: \(V \approx 0,389\), una asociación de magnitud apreciable en este contexto. V no es un porcentaje ni prueba causalidad.

7 Gráfico 4: cantidad de registros por deporte

deporte_df <- data.frame(
  deporte=names(filas),
  registros=as.numeric(filas)
)
p4 <- ggplot(deporte_df,aes(x=deporte,y=registros,fill=deporte)) +
  geom_col(width=.65,show.legend=FALSE) +
  geom_text(aes(label=format(registros,big.mark=".",scientific=FALSE)),
            vjust=-.4,size=4) +
  scale_fill_manual(values=c("#2474C6","#56A7D8","#E5B45A","#F28C45")) +
  scale_y_continuous(expand=expansion(mult=c(0,.12))) +
  labs(title="Registros analizados por deporte",
       x="Deporte",y="Número de registros") +
  theme_minimal(base_size=12)
print(p4)

ggsave("grafico_4_muestra_deportes.png",p4,width=10,height=6,dpi=180)

8 Conclusiones y limitaciones

  1. Los cuatro deportes presentan perfiles de edad diferentes.
  2. La prueba de independencia muestra evidencia de asociación (\(\chi^2 \approx 24.089,79\); \(p<0,001\)).
  3. La V de Cramér ≈ 0,389 indica una asociación apreciable.
  4. La bondad de ajuste rechaza la distribución uniforme hipotética.
  5. Los datos abarcan distintas épocas y atletas repetidos en ediciones diferentes; los valores p deben interpretarse con cautela.
  6. La asociación no demuestra que la edad cause la elección del deporte.

Fuente: Griffin, R. 120 Years of Olympic History: Athletes and Results. Kaggle. Cálculos propios a partir de athlete_events.csv.

cat("Muestra:",sum(t),"\n")
## Muestra: 53093
cat("Bondad de ajuste: chi2 =",round(unname(g$statistic),2),
    "; gl =",unname(g$parameter),
    "; p =",format.pval(g$p.value),"\n")
## Bondad de ajuste: chi2 = 15633 ; gl = 4 ; p = <2e-16
cat("Independencia / homogeneidad: chi2 =",
    round(unname(ct$statistic),2),
    "; gl =",unname(ct$parameter),
    "; p =",format.pval(ct$p.value),"\n")
## Independencia / homogeneidad: chi2 = 24090 ; gl = 12 ; p = <2e-16
cat("V de Cramér =",round(v,3),"\n")
## V de Cramér = 0.389