Actividad 2 — Análisis de datos en R (Decathlon)

Portada

Pontificia Universidad Javeriana Cali
Curso: Análisis de Datos en R
Estudiante: Sebastián Bolaños
Actividad: 2 — Estadística descriptiva y relaciones bivariadas en decathlon
Fecha: septiembre 30, 2025

Introducción

En esta actividad se utiliza el conjunto de datos decathlon del paquete FactoMineR, que contiene los resultados de 41 atletas en diez pruebas del decatlón (cien metros, salto de longitud, lanzamiento de bala, salto de altura, cuatrocientos metros, 110 con vallas, disco, pértiga, jabalina y mil quinientos metros). Además incluye el ranking, el puntaje total y la competición (Decastar u Olympics).

El objetivo de esta primera parte es realizar un análisis descriptivo básico y explorar algunas relaciones bivariadas entre las pruebas. Los pasos principales son:

1. Cargar y describir los datos.
   
2. Calcular estadísticos descriptivos para cada prueba.
   
3. Estudiar la relación entre 100 m y 400 m.
   
4. Construir la matriz de correlaciones entre todas las pruebas.

Antes de empezar, cargamos los paquetes necesarios y los datos. Si alguno de los paquetes no está instalado, instálalo previamente con install.packages('nombre_del_paquete').

1 — Carga y descripción de los datos

Antes de cualquier análisis conviene inspeccionar el dataset: ver las columnas disponibles, los primeros registros y las medidas utilizadas en cada prueba. A continuación se muestra una vista preliminar de las diez primeras filas, con las pruebas y la competición. Para presentar la tabla de forma sencilla utilizamos knitr::kable, que funciona bien en documentos PDF sin requerir paquetes adicionales.

# Selección de columnas: atleta, pruebas y competición
vars_tests <- names(decathlon)[1:10]

preview_df <- dec_df %>%
  select(Athlete, all_of(vars_tests), Competition) %>%
  slice_head(n = 10)

knitr::kable(preview_df, caption = 'Vista preliminar de los datos (primeras 10 filas)')

Vista preliminar de los datos (primeras 10 filas)

Athlete	100m	Long.jump	Shot.put	High.jump	400m	110m.hurdle	Discus	Pole.vault	Javeline	1500m	Competition
SEBRLE	11.04	7.58	14.83	2.07	49.81	14.69	43.75	5.02	63.19	291.7	Decastar
CLAY	10.76	7.40	14.26	1.86	49.37	14.05	50.72	4.92	60.15	301.5	Decastar
KARPOV	11.02	7.30	14.77	2.04	48.37	14.09	48.95	4.92	50.31	300.2	Decastar
BERNARD	11.02	7.23	14.25	1.92	48.93	14.99	40.87	5.32	62.77	280.1	Decastar
YURKOV	11.34	7.09	15.19	2.10	50.42	15.31	46.26	4.72	63.44	276.4	Decastar
WARNERS	11.11	7.60	14.31	1.98	48.68	14.23	41.10	4.92	51.77	278.1	Decastar
ZSIVOCZKY	11.13	7.30	13.48	2.01	48.62	14.17	45.67	4.42	55.37	268.0	Decastar
McMULLEN	10.83	7.31	13.76	2.13	49.91	14.38	44.41	4.42	56.37	285.1	Decastar
MARTINEAU	11.64	6.81	14.57	1.95	50.14	14.93	47.60	4.92	52.33	262.1	Decastar
HERNU	11.37	7.56	14.41	1.86	51.10	15.06	44.99	4.82	57.19	285.1	Decastar

# Definimos una tabla con unidades de medida por cada prueba (segundos o metros)
unit_map <- c(
  'X100m'       = 's',
  'Long.jump'   = 'm',
  'Shot.put'    = 'm',
  'High.jump'   = 'm',
  'X400m'       = 's',
  'X110m.hurdle'= 's',
  'Discus'      = 'm',
  'Pole.vault'  = 'm',
  'Javeline'    = 'm',
  'X1500m'      = 's'
)

La variable Competition indica la competición en la que participó cada atleta (Decastar u Olympics). Las unidades de las pruebas son segundos para carreras y metros para las pruebas de salto o lanzamiento.

2 — Estadísticos descriptivos

Para cada una de las diez pruebas calculamos varios estadísticos: media, mediana, varianza, primer y tercer cuartil (Q1 y Q3), mínimo, máximo, rango y rango intercuartílico (IQR = Q3 − Q1). Esta información resume la tendencia central y la dispersión de las marcas. También añadimos la unidad correspondiente.

# Construir tabla con estadísticos descriptivos por prueba

resumen <- dec_df %>%
  summarise(across(
    all_of(vars_tests),
    list(
      media   = ~ mean(.x, na.rm = TRUE),
      mediana = ~ median(.x, na.rm = TRUE),
      var     = ~ var(.x, na.rm = TRUE),
      q1      = ~ quantile(.x, 0.25, na.rm = TRUE),
      q3      = ~ quantile(.x, 0.75, na.rm = TRUE),
      min     = ~ min(.x, na.rm = TRUE),
      max     = ~ max(.x, na.rm = TRUE)
    ),
    .names = '{.col}__{.fn}'
  )) %>%
  pivot_longer(everything(), names_to = c('variable','stat'), names_sep = '__') %>%
  pivot_wider(names_from = stat, values_from = value) %>%
  mutate(
    rango = max - min,
    iqr   = q3 - q1,
    unidad = unit_map[variable]
  ) %>%
  select(variable, unidad, media, mediana, var, q1, q3, min, max, rango, iqr)

# Redondear algunos valores para legibilidad
resumen_redondeado <- resumen %>% mutate(across(where(is.numeric), ~ round(.x, 3)))

knitr::kable(resumen_redondeado, caption = 'Estadísticos descriptivos por prueba (media, mediana, varianza, cuartiles, mínimos, máximos, rango e IQR)')

Estadísticos descriptivos por prueba (media, mediana, varianza, cuartiles, mínimos, máximos, rango e IQR)

variable	unidad	media	mediana	var	q1	q3	min	max	rango	iqr
100m	NA	10.998	10.98	0.069	10.85	11.14	10.44	11.64	1.20	0.29
Long.jump	m	7.260	7.30	0.100	7.03	7.48	6.61	7.96	1.35	0.45
Shot.put	m	14.477	14.57	0.680	13.88	14.97	12.68	16.36	3.68	1.09
High.jump	m	1.977	1.95	0.008	1.92	2.04	1.85	2.15	0.30	0.12
400m	NA	49.616	49.40	1.330	48.93	50.30	46.81	53.20	6.39	1.37
110m.hurdle	NA	14.606	14.48	0.223	14.21	14.98	13.97	15.67	1.70	0.77
Discus	m	44.326	44.41	11.410	41.90	46.07	37.92	51.65	13.73	4.17
Pole.vault	m	4.762	4.80	0.077	4.50	4.92	4.20	5.40	1.20	0.42
Javeline	m	58.317	58.36	23.298	55.27	60.89	50.31	70.52	20.21	5.62
1500m	NA	279.025	278.05	136.265	271.02	285.10	262.10	317.00	54.90	14.08

3 — Relación entre 100 m y 400 m

Para estudiar la relación entre las marcas de 100 m y 400 m calculamos el coeficiente de correlación de Pearson y su intervalo de confianza del 95 %. Además, representamos la dispersión de ambas variables con una línea de regresión.

# Selección robusta de las columnas (por si los nombres tienen prefijo X)

col100 <- names(decathlon)[grepl('100m', names(decathlon), ignore.case = TRUE)][1]
col400 <- names(decathlon)[grepl('400m', names(decathlon), ignore.case = TRUE)][1]

df34 <- dec_df %>%
  select(all_of(c(col100, col400))) %>%
  drop_na()

r_100_400 <- cor(df34[[col100]], df34[[col400]])

# Intervalo de confianza mediante la transformación de Fisher
fisher_z  <- 0.5 * log((1 + r_100_400) / (1 - r_100_400))
se_z      <- 1 / sqrt(nrow(df34) - 3)
z_crit    <- qnorm(0.975)
ci_low_z  <- fisher_z - z_crit * se_z
ci_high_z <- fisher_z + z_crit * se_z
ci_low_r  <- (exp(2 * ci_low_z) - 1) / (exp(2 * ci_low_z) + 1)
ci_high_r <- (exp(2 * ci_high_z) - 1) / (exp(2 * ci_high_z) + 1)

cor_tab <- tibble(
  Métrica = c('r (Pearson)', 'IC 95 % (límite inferior)', 'IC 95 % (límite superior)'),
  Valor   = c(r_100_400, ci_low_r, ci_high_r)
)

knitr::kable(cor_tab %>% mutate(Valor = round(Valor, 3)), caption = paste('Correlación entre', col100, 'y', col400))

Correlación entre 100m y 400m

Métrica	Valor
r (Pearson)	0.520
IC 95 % (límite inferior)	0.253
IC 95 % (límite superior)	0.714

# Diagrama de dispersión con recta de regresión
ggplot(df34, aes(x = !!sym(col100), y = !!sym(col400))) +
  geom_point(alpha = 0.85) +
  geom_smooth(method = 'lm', se = FALSE, color = 'blue') +
  labs(
    title = paste('Dispersión de', col100, 'y', col400),
    subtitle = paste('r =', round(r_100_400, 3)),
    x = paste0(col100, ' (s)'),
    y = paste0(col400, ' (s)')
  ) +
  theme_minimal()

`geom_smooth()` using formula = 'y ~ x'

4 — Matriz de correlaciones

Finalmente calculamos la matriz de correlaciones de Pearson entre todas las pruebas del decatlón. Mostramos los valores numéricos en una tabla y generamos un mapa de calor con el paquete corrplot.

# Matriz de correlaciones
M <- cor(dec_df[, vars_tests], use = 'pairwise.complete.obs')

# Tabla redondeada
M_round <- round(M, 3)

corr_df <- as.data.frame(M_round)
corr_df$Prueba <- rownames(corr_df)
corr_df <- corr_df %>% relocate(Prueba)

knitr::kable(corr_df, caption = 'Matriz de correlaciones (Pearson) entre las pruebas')

Matriz de correlaciones (Pearson) entre las pruebas

	Prueba	100m	Long.jump	Shot.put	High.jump	400m	110m.hurdle	Discus	Pole.vault	Javeline	1500m
100m	100m	1.000	-0.599	-0.356	-0.246	0.520	0.580	-0.222	-0.083	-0.158	-0.061
Long.jump	Long.jump	-0.599	1.000	0.183	0.295	-0.602	-0.505	0.194	0.204	0.120	-0.034
Shot.put	Shot.put	-0.356	0.183	1.000	0.489	-0.138	-0.252	0.616	0.061	0.375	0.116
High.jump	High.jump	-0.246	0.295	0.489	1.000	-0.188	-0.283	0.369	-0.156	0.172	-0.045
400m	400m	0.520	-0.602	-0.138	-0.188	1.000	0.548	-0.118	-0.079	0.004	0.408
110m.hurdle	110m.hurdle	0.580	-0.505	-0.252	-0.283	0.548	1.000	-0.326	-0.003	0.009	0.038
Discus	Discus	-0.222	0.194	0.616	0.369	-0.118	-0.326	1.000	-0.150	0.158	0.258
Pole.vault	Pole.vault	-0.083	0.204	0.061	-0.156	-0.079	-0.003	-0.150	1.000	-0.030	0.247
Javeline	Javeline	-0.158	0.120	0.375	0.172	0.004	0.009	0.158	-0.030	1.000	-0.180
1500m	1500m	-0.061	-0.034	0.116	-0.045	0.408	0.038	0.258	0.247	-0.180	1.000

# Mapa de calor de correlaciones
corrplot::corrplot(M, method = 'color', addCoef.col = 'black', tl.col = 'black', number.cex = 0.6)

---

Punto 5 — Boxplots de Discus y Javeline por competición

# Cargar paquetes y datos
library(FactoMineR)
library(dplyr)
library(ggplot2)
library(knitr)

# Cargar datos y preparar tibble
data(decathlon, package = 'FactoMineR')
dec_df <- as_tibble(decathlon, rownames = 'Athlete')

# Selección de columnas de interés (robusta a mayúsculas/minúsculas)
col_disc <- names(decathlon)[grepl('Discus', names(decathlon), ignore.case = TRUE)][1]
col_jav  <- names(decathlon)[grepl('Javel', names(decathlon), ignore.case = TRUE)][1]
col_evt  <- names(decathlon)[grepl('Competition', names(decathlon), ignore.case = TRUE)][1]

# Tabla resumen por competición: tamaño de grupo y medias/medianas
summary_p5 <- dec_df %>%
  group_by(.data[[col_evt]]) %>%
  summarise(
    n                 = n(),
    Discus_mediana    = median(.data[[col_disc]], na.rm = TRUE),
    Discus_media      = mean(.data[[col_disc]], na.rm = TRUE),
    Javeline_mediana  = median(.data[[col_jav]],  na.rm = TRUE),
    Javeline_media    = mean(.data[[col_jav]],  na.rm = TRUE),
    .groups           = 'drop'
  )

# Mostrar tabla
knitr::kable(summary_p5, caption = paste('Resumen por', col_evt, 'para Discus y', col_jav))

Resumen por Competition para Discus y Javeline

Competition	n	Discus_mediana	Discus_media	Javeline_mediana	Javeline_media
Decastar	13	44.410	44.21769	56.37	56.95462
OlympicG	28	44.505	44.37571	58.94	58.94893

# Boxplot de Discus por competición
p5_disc <- ggplot(dec_df, aes(x = .data[[col_evt]], y = .data[[col_disc]])) +
  geom_boxplot(outlier.colour = 'black', alpha = 0.9) +
  geom_jitter(width = 0.15, alpha = 0.5) +
  labs(title = paste('Discus por', col_evt),
       x = col_evt,
       y = paste0(col_disc, ' (m)')) +
  theme_minimal()

# Boxplot de Javeline por competición
p5_jav <- ggplot(dec_df, aes(x = .data[[col_evt]], y = .data[[col_jav]])) +
  geom_boxplot(outlier.colour = 'black', alpha = 0.9) +
  geom_jitter(width = 0.15, alpha = 0.5) +
  labs(title = paste(col_jav, 'por', col_evt),
       x = col_evt,
       y = paste0(col_jav, ' (m)')) +
  theme_minimal()

# Imprimir los boxplots
p5_disc

p5_jav

Punto 6 — Relación entre Long.jump y High.jump

# Paquetes ya cargados en el punto anterior (se omite recarga)

# Columnas de Long.jump y High.jump
col_lj <- names(decathlon)[grepl('Long.jump', names(decathlon), ignore.case = TRUE)][1]
col_hj <- names(decathlon)[grepl('High.jump', names(decathlon), ignore.case = TRUE)][1]

# Subconjunto de datos completo para estas dos variables
lj_hj_df <- dec_df %>%
  select(all_of(c(col_lj, col_hj))) %>%
  drop_na()

# Correlación
r_lj_hj <- cor(lj_hj_df[[col_lj]], lj_hj_df[[col_hj]])

# Modelo de regresión lineal
fit <- lm(lj_hj_df[[col_hj]] ~ lj_hj_df[[col_lj]])
sm  <- summary(fit)

# Tabla de coeficientes con IC del 95 %
coef_tab <- cbind(
  Estimado = sm$coefficients[, 1],
  `Error Std` = sm$coefficients[, 2],
  `t value` = sm$coefficients[, 3],
  `Pr(>|t|)` = sm$coefficients[, 4],
  confint(fit)
)
coef_tab <- round(coef_tab, 4)
coef_df <- data.frame(Term = rownames(coef_tab), coef_tab, row.names = NULL, check.names = FALSE)

knitr::kable(coef_df, caption = 'Coeficientes del modelo (High.jump ~ Long.jump) con IC 95 %')

Coeficientes del modelo (High.jump ~ Long.jump) con IC 95 %

Term	Estimado	Error Std	t value	Pr(>|t|)	2.5 %	97.5 %
(Intercept)	1.3755	0.3126	4.4000	0.0001	0.7432	2.0078
lj_hj_df[[col_lj]]	0.0828	0.0430	1.9255	0.0615	-0.0042	0.1698

# Métricas del modelo
r2     <- sm$r.squared
adjr2  <- sm$adj.r.squared
fstat  <- sm$fstatistic
p_glob <- pf(fstat[1], fstat[2], fstat[3], lower.tail = FALSE)

metrics_df <- data.frame(
  `r (Long.jump, High.jump)` = round(r_lj_hj, 4),
  `R^2`                      = round(r2, 4),
  `R^2 ajustado`             = round(adjr2, 4),
  `p-valor global (F)`       = signif(p_glob, 4),
  check.names = FALSE
)

knitr::kable(metrics_df, caption = 'Métricas del modelo de regresión')

Métricas del modelo de regresión

	r (Long.jump, High.jump)	R^2	R^2 ajustado	p-valor global (F)
value	0.2946	0.0868	0.0634	0.06148

# Gráfico de dispersión con recta de regresión
p6_scatter <- ggplot(lj_hj_df, aes(x = .data[[col_lj]], y = .data[[col_hj]])) +
  geom_point(alpha = 0.85) +
  geom_smooth(method = 'lm', se = TRUE) +
  labs(
    title    = paste('Relación entre', col_lj, 'y', col_hj),
    subtitle = paste('r =', round(r_lj_hj, 3), '| R² =', round(r2, 3)),
    x        = paste0(col_lj, ' (m)'),
    y        = paste0(col_hj, ' (m)')
  ) +
  theme_minimal()

# Gráfico de residuos vs ajustados
res_df <- data.frame(
  Ajustados = fitted(fit),
  Residuos  = residuals(fit)
)

p6_resid <- ggplot(res_df, aes(x = Ajustados, y = Residuos)) +
  geom_point(alpha = 0.7) +
  geom_hline(yintercept = 0) +
  labs(title = 'Residuos vs Ajustados', x = 'Ajustados', y = 'Residuos') +
  theme_minimal()

# QQ‑plot de residuos estandarizados
stdres <- rstandard(fit)
qq_df  <- data.frame(sample = stdres)

p6_qq <- ggplot(qq_df, aes(sample = sample)) +
  stat_qq() +
  stat_qq_line() +
  labs(title = 'QQ‑Plot de residuos estandarizados',
       x = 'Cuantiles teóricos', y = 'Cuantiles observados') +
  theme_minimal()

# Imprimir gráficos
p6_scatter

`geom_smooth()` using formula = 'y ~ x'

p6_resid

p6_qq

Punto 7 — Distribución de Pole.vault

# Cargar paquete moments para asimetría y curtosis
library(moments)

# Columna de Pole.vault
a <- names(decathlon)[grepl('Pole.vault', names(decathlon), ignore.case = TRUE)][1]
pv <- dec_df[[a]]
pv <- pv[!is.na(pv)]

# Métricas de forma
CV <- sd(pv) / mean(pv)
SK <- skewness(pv)
KT <- kurtosis(pv)

forma_df <- data.frame(
  Métrica = c('Coeficiente de variación (CV)', 'Asimetría', 'Curtosis'),
  Valor   = round(c(CV, SK, KT), 4),
  check.names = FALSE
)

knitr::kable(forma_df, caption = paste('Forma de la distribución de', a))

Forma de la distribución de Pole.vault

Métrica	Valor
Coeficiente de variación (CV)	0.0584
Asimetría	0.2329
Curtosis	2.5794

# Histograma
p7_hist <- ggplot(dec_df, aes(x = .data[[a]])) +
  geom_histogram(bins = 12, color = 'black', fill = 'lightblue') +
  labs(title = paste('Histograma de', a),
       x     = paste0(a, ' (m)'),
       y     = 'Frecuencia') +
  theme_minimal()

p7_hist

Punto 8 — Resumen gráfico y conclusiones

# Reutilizar algunos objetos de puntos anteriores
# Si no existen, se vuelven a crear de forma mínima

# Gráficos principales (p5_disc, p5_jav, p6_scatter, p7_hist)
# Se imprimen aquí para agruparlos en el informe final
p5_disc

p5_jav

p6_scatter

`geom_smooth()` using formula = 'y ~ x'

p7_hist

# Calcular top 3 correlaciones absolutas sin repetición
vars_tests <- names(decathlon)[1:10]
M <- cor(dec_df[, vars_tests], use = 'pairwise.complete.obs')
M_abs <- abs(M)
diag(M_abs) <- NA

get_top_pairs <- function(M_abs, M, n = 3) {
  pairs <- list()
  tmp  <- M_abs
  k <- 0
  while(k < n && any(!is.na(tmp))) {
    ij <- which(tmp == max(tmp, na.rm = TRUE), arr.ind = TRUE)[1, ]
    i  <- ij[1]; j <- ij[2]
    pairs[[length(pairs) + 1]] <- list(i = i, j = j, r = M[i, j])
    tmp[i, ] <- NA; tmp[, i] <- NA; tmp[j, ] <- NA; tmp[, j] <- NA
    k <- k + 1
  }
  pairs
}

pairs <- get_top_pairs(M_abs, M, 3)

corr_lines <- character(0)
for(p in pairs) {
  corr_lines <- c(corr_lines, sprintf('- %s vs %s: r = %.3f', colnames(M)[p$i], colnames(M)[p$j], p$r))
}

# Diferencias por competición (promedios)
diff_df <- dec_df %>%
  group_by(.data[[col_evt]]) %>%
  summarise(
    Discus_media   = mean(.data[[col_disc]], na.rm = TRUE),
    Javeline_media = mean(.data[[col_jav]], na.rm = TRUE),
    .groups        = 'drop'
  )

diff_lines <- paste(sprintf('%s: Discus prom. = %.2f m, Jabalina prom. = %.2f m',
                            diff_df[[col_evt]],
                            diff_df$Discus_media,
                            diff_df$Javeline_media), collapse = '\n')

# Relación long vs high
model_line <- sprintf('- Long.jump vs High.jump: r = %.3f, R² = %.3f', r_lj_hj, r2)

# Forma de pole vault
forma_line <- sprintf('- Pole.vault: CV = %.3f, asimetría = %.3f, curtosis = %.3f (≈3 normal)', CV, SK, KT)

# Imprimir conclusiones
cat('### Conclusiones\n\n')

### Conclusiones

cat('**Principales correlaciones:**\n')

**Principales correlaciones:**

if(length(corr_lines) > 0) {
  cat(paste(corr_lines, collapse = '\n'))
  cat('\n\n')
} else {
  cat('No se identificaron correlaciones destacadas.\n\n')
}

- Discus vs Shot.put: r = 0.616
- 400m vs Long.jump: r = -0.602
- 110m.hurdle vs 100m: r = 0.580

cat('**Diferencias por competición:**\n')

**Diferencias por competición:**

cat(diff_lines, '\n\n')

Decastar: Discus prom. = 44.22 m, Jabalina prom. = 56.95 m
OlympicG: Discus prom. = 44.38 m, Jabalina prom. = 58.95 m 

cat('**Relación Long.jump–High.jump:**\n')

**Relación Long.jump–High.jump:**

cat(model_line, '\n\n')

- Long.jump vs High.jump: r = 0.295, R² = 0.087 

cat('**Forma de Pole.vault:**\n')

**Forma de Pole.vault:**

cat(forma_line, '\n')

- Pole.vault: CV = 0.058, asimetría = 0.233, curtosis = 2.579 (≈3 normal) 

---