Exámen práctico SAA Resuelto

Author

Jesús Turpín Aroca

Published

December 12, 2023

Instrucciones previas

  • Completa la plantilla de código y sube el archivo .qmd a la actividad del examen del aula virtual.

Información del dataset y carga de datos decathlon_df:

Este conjunto de datos contiene resultados reales de la prueba de atletismo decatlón masculino de 2012. Solo se han tenido en cuenta marcas iguales o superiores a 6500 puntos.

En esta competición, los atletas realizan 10 pruebas de atletismo de pista (carreras y saltos) y campo (lanzamientos). La posición en cada prueba no es lo imporante para puntuar, sino la marca obtenida en cada una. Cada registro o marca tiene una puntuación asociada según unas tablas reglamentarias. En carreras, un tiempo inferior otorga mayor puntuación, mientras que en saltos y lanzamientos, la puntuación es mejor a mayor distancia.

El análisis de datos en este deporte es fundamental para programar y optimizar los entrenenamientos de los atletas de élite, pues ciertos estudios demuestran que hay determinadas pruebas que tienen un peso mayor sobre la puntuación total.

Normalmente, este tipo de competición se divide en dos días. Los eventos del primer día incluyen 100 metros, salto de longitud, lanzamiento de peso, salto de altura y 400 metros. Los eventos del segundo día incluyen 110 metros vallas, lanzamiento de disco, salto con pértiga, lanzamiento de jabalina y 1500 metros.

Variables:

  • Total: Puntuación total.

  • Name: Nombre del atleta.

  • Surname: Apellido del atleta.

  • X100m: Marca en la prueba de velocidad 100m, en segundos.

  • LJ: Marca en la prueba de salto de lonjitud, en metros.

  • SP: Marca en la prueba de lanzamiento de peso, en metros.

  • HJ: Marca en la prueba de salto de altura, en metros.

  • X400m: Marca en la prueba de 400m lisos, en segundos.

  • X110H: Marca en la prueba de 110m vallas, en segundos.

  • DT: Marca en la prueba de lanzamiento de disco, en metros.

  • PV: Marca en la prueba de salto con pértiga, en metros.

  • JT: Marca en la prueba de lanzamiento de jabalina, en metros.

  • X1500m: Marca en la prueba de medio fondo 1500m, en segundos

  • First.day: Puntuación de las 5 primeras pruebas (Día 1)

  • Second.day: Puntuación de las 5 pruebas siguentes (del Día 2)

Librerías:

## Librerías
library(tidyverse)
if(!require("scar")) {
  install.packages("scar")
}
library(scar)

if(!require("corrplot")) {
  install.packages("corrplot")
}
library(corrplot)
if(!require("broom")) {
  install.packages("broom")
}
library(broom)

Carga de datos:

data("decathlon_raw")
set.seed(133)
decathlon_df <- decathlon_raw %>%
  group_by(Name, Surname) %>%
  slice_max(order_by = Total, n = 1) %>%
  ungroup()
glimpse(decathlon_df)
Rows: 613
Columns: 15
$ Total      <int> 7324, 6611, 7059, 6910, 7010, 7214, 6573, 6715, 8064, 6652,…
$ Name       <chr> "Aaron", "Abdoljalil", "Achim", "Adam", "Adam", "Adam", "Ad…
$ Surname    <chr> "Young", "Toomaj", "Lehner", "Bjorling", "Hromcik", "Salzma…
$ X100m      <dbl> 10.94, 11.39, 11.56, 11.24, 11.23, 11.13, 11.31, 11.12, 11.…
$ LJ         <dbl> 6.68, 6.71, 6.69, 7.00, 7.11, 6.25, 6.69, 6.33, 7.26, 6.66,…
$ SP         <dbl> 12.75, 12.51, 15.21, 12.36, 12.17, 11.34, 11.40, 12.19, 14.…
$ HJ         <dbl> 1.84, 2.02, 1.85, 1.77, 1.84, 1.85, 1.87, 1.90, 2.07, 1.83,…
$ X400m      <dbl> 48.46, 52.36, 53.62, 50.71, 50.68, 48.59, 49.78, 49.19, 49.…
$ X110H      <dbl> 14.85, 15.57, 16.18, 15.43, 15.59, 14.82, 15.41, 15.30, 14.…
$ DT         <dbl> 33.91, 39.16, 48.60, 34.88, 36.60, 37.40, 24.50, 33.11, 41.…
$ PV         <dbl> 4.80, 3.70, 3.90, 3.95, 4.40, 4.70, 4.45, 4.20, 4.82, 4.20,…
$ JT         <dbl> 47.70, 57.42, 55.30, 54.03, 46.85, 45.77, 38.86, 34.50, 60.…
$ X1500m     <dbl> 277.41, 361.78, 286.70, 282.29, 284.98, 262.22, 288.55, 282…
$ First.day  <int> 3813, 3690, 3609, 3634, 3712, 3590, 3616, 3677, 4184, 3417,…
$ Second.day <int> 3511, 2921, 3450, 3276, 3298, 3624, 2957, 3038, 3880, 3235,…

1. Medidas de centralidad y dispersión (1 pts)

Observa y compara las medidas de dispersión sobre los puntos conseguidos en el primer y segundo día. Completa los chunks para justificar tu respuesta.

Indica:

1.1 Desviación estándar de los puntos de cada día: (0.25 Pts)

sd_dias <- decathlon_df %>%
  select(First.day, Second.day) %>%
  sapply(sd) 
sd_dias
 First.day Second.day 
  239.7776   299.8819

1.2 Rango de los puntos de cada día: (0.25 Pts)

rango_dias <- decathlon_df %>%
  select(First.day, Second.day) %>%
  sapply(function(x) {return(range(x)[2]-range(x)[1])}) 
rango_dias
 First.day Second.day 
      1604       1767

1.3 Media y mediana de los puntos de cada día: (0.25 Pts)

decathlon_df %>%
  select(First.day, Second.day) %>%
  sapply(mean)
 First.day Second.day 
  3726.259   3406.507 
decathlon_df %>%
  select(First.day, Second.day) %>%
  sapply(median)
 First.day Second.day 
      3696       3354

1.4 Nombre y apellido más común y su frecuencia de aparición (si hubiera varios, indicar todos): (0.25 Pts)

decathlon_df %>%
  select(Name, Surname) %>%
  lapply(DescTools::Mode)
$Name
[1] "Michael"
attr(,"freq")
[1] 8

$Surname
[1] "Gonzalez" "Johnson"  "Smith"    "Thomas"  
attr(,"freq")
[1] 3

2. Distribución y posición de los datos (1,5 pts)

2.1 (0,25 Pts) Observa la distribución de los datos de las marcas de las 10 pruebas:

decathlon_df %>%
  select(-First.day, -Second.day) %>%
  pivot_longer(cols = c(-Total, -Name, -Surname), names_to = "Prueba", values_to = "marca") %>%
  ggplot(aes(x = marca)) +
    geom_histogram(bins = 10)+
    labs(
      title = "Distribución Marcas",
      x = "marca"
    ) +
  facet_wrap(~ Prueba, scales = "free")+
    theme_bw()

¿Son distribuciones simétricas y que tienden a una normal aproximadamente? Son aproximadamente simétricas y tienden a una normal

2.2 (0,25 Pts) Dibuja el histograma de los puntos totales con ggplot. Para obtener el número de bins, utiliza la fórmula de Sturges:

\[k = 1 + \log_2(N)\] siendo k el nº de barras del histograma y N el tamaño de la muestra

# Fórmula de Sturges
nbins <- round(log2(nrow(decathlon_df)) + 1)
nbins
[1] 10
decathlon_df %>%
  ggplot(aes(x = Total))+
  geom_histogram(bins = nbins)+
  theme_bw()

Según el histograma, ¿Es simétrica la distribución de los puntos totales? ¿A qué se debe? Justifica tu respuesta. Pista: vuelve a leer el primer párrafo de la información del dataset. No es simétrica, pues la muestra está sesgada, tal y como describe el dataset, solamente se han tenido en cuenta valores a partir de 6500 puntos.

2.3 (0.5 Pts) La siguiente gráfica, muestra los diagramas de caja y bigote para cada una de las pruebas. Los registros han sido estandarizados por z-score. A partir de la gráfica, indica para el atleta Aston Eaton (nº 1 en el ranking 2012) y para todas las pruebas si su marca fue un valor atípico y si en caso afirmativo, indica si además, fue la mejor respecto a sus rivales. ¿En qué prueba obtuvo peor rendimiento relativo a sus rivales?

decathlon_df %>%
  mutate_if(is.double, scale) %>%
  select(-First.day, -Second.day) %>%
  mutate(Eaton = Total > 9000) %>%
  pivot_longer(cols = c(-Total, -Name, -Surname, -Eaton), names_to = "Prueba", values_to = "marca_zscore") %>%
  ggplot(aes(x = Prueba, y = marca_zscore, color = Eaton)) +
    geom_boxplot() +
    labs(
      title = "Marcas",
      x = "Prueba",
      y = "marca_zscore"
    ) +
    theme_bw()

  • X100m: Atípico y el mejor

  • LJ: Atípico y el mejor

  • SP:

  • HJ:

  • X400m: Atípico y el mejor

  • X110H: Atípico

  • DT:

  • PV:

  • JT:

  • X1500m:

Peor especialidad de las 10 en términos relativos a los otros atletas: JT

decathlon_df %>%
  #mutate_if(is.double, scale) %>%
  select(-First.day, -Second.day) %>%
  mutate(Eaton = Total > 9000) %>%
  arrange((desc(PV))) %>%
  mutate(rank_HJ = row_number()) %>%
  filter(Eaton)
# A tibble: 1 × 15
  Total Name   Surname X100m    LJ    SP    HJ X400m X110H    DT    PV    JT
  <int> <chr>  <chr>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1  9039 Ashton Eaton    10.2  8.23  14.2  2.05  46.7  13.7  42.8   5.3  58.9
# ℹ 3 more variables: X1500m <dbl>, Eaton <lgl>, rank_HJ <int>
  # pivot_longer(cols = c(-Total, -Name, -Surname, -Eaton), names_to = "Prueba", values_to = "marca_zscore") %>%
  # arrange(desc(JT))

2.4 (0.5 Pts) Transforma las 4 variables que están expresadas en tiempo a velocidad en metros/segundo, teniendo en cuenta los metros de cada prueba. Repite la visualización anterior con las modificaciones hechas. Al cambiar las unidades de segundos a m/s, se invierten los diagramas.

decathlon_df %>%
  mutate(X100m = 100/X100m, X110H = 110/X110H, #convierte los tiempos en velocidad
         X1500m = 1500/X1500m, X400m = 400/X400m) %>%
  mutate_if(is.double, scale) %>%
  select(-First.day, -Second.day) %>%
  mutate(Eaton = Total > 9000) %>%
  pivot_longer(cols = c(-Total, -Name, -Surname, -Eaton), names_to = "Prueba", values_to = "marca_zscore") %>%
  ggplot(aes(x = Prueba, y = marca_zscore, color = Eaton)) +
    geom_boxplot() +
    labs(
      title = "Marcas",
      x = "Prueba",
      y = "marca_zscore"
    ) +
    theme_bw()

3. Relación entre variables, correlación y regresión lineal simple. (2 Pts)

3.1 (0,5 Pts) Grafica la matriz de correlación de las 10 pruebas. Explica las correlaciones más fuertes y trata de justificar su lógica de aquellas positivas que superan 0.60 y la más fuerte de todas las negativas. Utiliza el método number para ver los resultados con mayor precisión.

Mayor correlación positiva: SP, DT. Explicación: Son pruebas de lanzamiento y los atletas requieren características físicas similares (fuerza)

Otras correlaciones > 0.6: X100m, X400m. Explicación: ambas son pruebas de velocidad, aunque X400m requiere algo más de resistencia

Mayor correlación negativa: X100m, LJ. Explicación: hay que ser rápido para realizar un salto de longitud largo.

decathlon_df %>%
  select_if(is.double) %>%
  cor() %>%
  corrplot(method = "number")

Basándote en las pruebas del día 1 y en la matriz de correlación, elige la que crees que puede ser la mejor variable predictora para estimar las marcas de 4 de las pruebas del día 2 con un modelo de regresión lineal simple. Utiliza el dataframe normalizado y con las marcas de tiempo pasadas a velocidad. decathlon_scaled

  • X110H en función de … X100m

  • DT en función de … SP

  • JT en función de … SP

  • x1500m en función de … X400

decathlon_scaled <- decathlon_df %>%
  mutate(X100m = 100/X100m, X110H = 110/X110H,
         X1500m = 1500/X1500m, X400m = 400/X400m) %>%
  mutate_if(is.double, scale) 
lm_X110H <- lm(X110H ~ X100m, data = decathlon_scaled)
glance(lm_X110H)
# A tibble: 1 × 12
  r.squared adj.r.squared sigma statistic  p.value    df logLik   AIC   BIC
      <dbl>         <dbl> <dbl>     <dbl>    <dbl> <dbl>  <dbl> <dbl> <dbl>
1     0.263         0.262 0.859      219. 1.66e-42     1  -776. 1557. 1570.
# ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>
lm_DT <- lm(DT ~ SP, data = decathlon_scaled)
glance(lm_DT)
# A tibble: 1 × 12
  r.squared adj.r.squared sigma statistic   p.value    df logLik   AIC   BIC
      <dbl>         <dbl> <dbl>     <dbl>     <dbl> <dbl>  <dbl> <dbl> <dbl>
1     0.575         0.575 0.652      828. 9.79e-116     1  -607. 1220. 1233.
# ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>
lm_JT <- lm(JT ~ SP, data = decathlon_scaled)
glance(lm_JT)
# A tibble: 1 × 12
  r.squared adj.r.squared sigma statistic  p.value    df logLik   AIC   BIC
      <dbl>         <dbl> <dbl>     <dbl>    <dbl> <dbl>  <dbl> <dbl> <dbl>
1     0.352         0.350 0.806      331. 1.87e-59     1  -737. 1479. 1492.
# ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>
lm_x1500m <- lm(X1500m ~ X400m, data = decathlon_scaled)
glance(lm_x1500m)
# A tibble: 1 × 12
  r.squared adj.r.squared sigma statistic  p.value    df logLik   AIC   BIC
      <dbl>         <dbl> <dbl>     <dbl>    <dbl> <dbl>  <dbl> <dbl> <dbl>
1     0.213         0.212 0.888      166. 1.01e-33     1  -796. 1598. 1611.
# ℹ 3 more variables: deviance <dbl>, df.residual <int>, nobs <int>

¿Qué modelo explica mejor la varianza de los datos?

DT vs SP. Ambas son pruebas de lanzamiento y su coeficiente de determinación es superior En concreto 0.5753535, lo cual indica que el modelo explica el 57 % de la varianza de ambas variables.

4. Variable aleatoria y distribuciones de probabilidad (1,50 Pts)

Eres responsable de un videojuego de simulación atletismo que está en fase de desarrollo. Te toca trabajar en la prueba de salto de longitud. En esa prueba, cada atleta realiza una carrera de aceleración previa al salto, tomando una distancia que cada atleta elige y fija para llegar sin pasarse a la línea de salto (tabla).

La distancia de la carrera del atleta previa al salto es variable aleatoria. En el momento del salto, la distancia restante de la zapatilla del atleta al límite reglamentario debe ser positiva o cero (ajuste perfecto), si es negativa, significa que el atleta se ha pasado y el salto se considera como nulo.

Descripción de la imagen

4.1 (0,25 Pts) Si el ajuste de talonamiento inicial sigue una distribución normal, con media 5 cm y desviación estándar de 5 cm. ¿Cuál es la probabilidad de que el salto resulte nulo, rebasando la tabla? En esa situación, la distancia de la punta del pie a la tabla sería negativa.

pnorm(0, 5, 5)
[1] 0.1586553

4.2 (0,25 Pts) Supongamos que el primer salto es bueno y el jugador, decide arriesgar y adelantar la carrera 7,5 cm para ajustar al máximo en los dos intentos restantes. Realiza dos simulaciones de saltos usando -2,5 cm como media y 5 cm de desviación estándar. Utiliza la semilla ‘13’ para reproductividad.

set.seed(13)
rnorm(2, -2.5, 5)
[1]  0.2716347 -3.9013597

¿Qué precisión se consiguió en el cada uno de los intentos? ¿Alguno resultó nulo? ¿Cuál?

4.3 (0,25) Calcula la probabilidad de resultado nulo en cada salto tras el ajuste anterior y guárdalo en la variable p.

p <- pnorm(0, -2.5, 5)
p
[1] 0.6914625

4.4 (0.25 Pts) Usando p, calcula de forma manual (usando aritmética) la probabilidad de obtener, al menos, un salto válido en los dos intentos restantes, suponiendo que los sucesos son independientes.

# Ambos nulos: p**2
## Posibilidades: nn, nv, vn, vv --> la suma de todas las opciones es 1
## Posibilidades de al menos uno válido --> 1-p(nn)

## Si ambos saltos son independientes, la probabilidad de nulo en ambos saltos es p*p (p al cuadrado)

# No ambos nulos:
1-p**2
[1] 0.5218797

4.5 (0.25 Pts) Realiza el mismo cálculo usando la distribución binomial a partir del valor de p y dos intentos. Considera éxito como salto válido 1-p. Deberías llegar al mismo resultado.

1-dbinom(0, 2, 1-p)
[1] 0.5218797
#dbinom(0, 2, 1-p) es la probabilidad de 0 éxitos, siendo 2 el nº de intentos y 1-p la probabilidad de éxito (salto válido)

4.6 (0.25 Pts) La computadora simula tres saltos para cada uno de los otros 11 atletas usando la distribución binomial, con probabilidad de salto válido 1-p. Usa la semilla ‘14’. ¿Algún atleta obtuvo 3 nulos y se quedó sin puntuar? ¿Cuál?

set.seed(14)
rbinom(11, 3, 1-p )
 [1] 0 1 2 1 3 1 2 1 1 1 2