Objetivos

  • Hacer uso adecuado de pruebas de hipótesis como instrumentos para establecer afirmaciones acerca de parámetros poblacionales desconocidos.

  • Emplear la regresión lineal simple como instrumento para modelar situaciones de la vida real.

  • Emplear herramientas computacionales y software estadístico especializado para calcular intervalos de confianza, pruebas de hipótesis y regresiones lineales a partir de una base de datos y a partir de ahí elaborar conclusiones.

JUEGOS OLÍMPICOS

Los juegos olímpicos de 2004 se celebraron en Atenas entre el 11 y 29 de agosto, con la participación de más de 10000 deportistas de distintos paises en al rededor de 300 pruebas distintas. Se desea establecer algunas características de los deportistas en diferentes deportes.

Para ésto, se han seleccionado varios deportes: Tiro con arco, bádminton, canotaje, ciclismo, salto acuático, gimnasia, natación, tenis de mesa, triatlón y levantamiento de pesas. La informacion de los deportistas que participaron en éstos se encuentra en el archivo: Olímpicos atenas 2004.xlsx. Con base a ésta infomación se desean establecer algúnos análisis.

  1. Determine intervalos de confianza de 99% sobre el peso de hombres y mujeres. La información sugiere que el peso de los hombres es mayor que el peso de las mujeres? Explique su respuesta y emplee una prueba de hipótesis adecuada para justificar. Emplee p-valor como criterio de decisión en su prueba de hipótesis.
# Cargar las librerías necesarias
library(readxl)

# Cargar los datos
datos <- read_excel("C:/Users/USUARIO/Downloads/Olimpicos Atenas 2004.xlsx")

# Dividir los datos por género
hombres <- subset(datos, Sex == "M", select = c(Weight))
mujeres <- subset(datos, Sex == "F", select = c(Weight))

# Intervalos de confianza para el peso promedio de hombres
confianza_hombres <- t.test(hombres$Weight, conf.level = 0.99)
cat("Intervalo de confianza del 99% para el peso promedio de hombres:", 
    paste(round(confianza_hombres$conf.int, 2), collapse = " a "), "kg.\n")
## Intervalo de confianza del 99% para el peso promedio de hombres: 75.58 a 77.04 kg.
# Intervalos de confianza para el peso promedio de mujeres
confianza_mujeres <- t.test(mujeres$Weight, conf.level = 0.99)
cat("Intervalo de confianza del 99% para el peso promedio de mujeres:", 
    paste(round(confianza_mujeres$conf.int, 2), collapse = " a "), "kg.\n")
## Intervalo de confianza del 99% para el peso promedio de mujeres: 59.08 a 60.6 kg.
# Prueba de hipótesis: ¿El peso promedio de hombres es mayor que el de mujeres?
prueba_hipotesis <- t.test(hombres$Weight, mujeres$Weight, alternative = "greater")

# Resultados de la prueba de hipótesis
cat("\nResultados de la prueba de hipótesis:\n")
## 
## Resultados de la prueba de hipótesis:
cat("Estadístico t:", round(prueba_hipotesis$statistic, 2), "\n")
## Estadístico t: 40.41
cat("Grados de libertad:", round(prueba_hipotesis$parameter, 2), "\n")
## Grados de libertad: 2660.65
cat("Valor p:", round(prueba_hipotesis$p.value, 4), "\n")
## Valor p: 0
# Interpretación de la prueba de hipótesis
if (prueba_hipotesis$p.value < 0.05) {
  cat("Conclusión: Con un nivel de significancia del 5%, rechazamos la hipótesis nula. 
  El peso promedio de los hombres es significativamente mayor que el de las mujeres.\n")
} else {
  cat("Conclusión: No hay evidencia suficiente para afirmar que el peso promedio de los hombres sea mayor que el de las mujeres.\n")
}
## Conclusión: Con un nivel de significancia del 5%, rechazamos la hipótesis nula. 
##   El peso promedio de los hombres es significativamente mayor que el de las mujeres.
  1. A través de una prueba de hipótesis valide o refute la siguiente afirmación: La dispersion del peso de hombres que participan en canotaje individual 1000mt es la misma que la dispersión del peso de hombres que participan en levantamiento de pesas en modalidad super peso. Emplee un nivel de significancia de 0.05 y a partir de su conclusión determine un intervalo de confianza de 95% adecuado para la diferencia de los pesos promedios de los atletas de ambas disciplinas.
library(readxl)
library(dplyr)

# Leer los datos
datos <- read_excel("C:/Users/USUARIO/Downloads/Olimpicos Atenas 2004.xlsx")

# Filtrar los datos requeridos
canoa_1000m <- datos %>% filter(Sport == "Canoeing", Event == "Canoeing Individual 1000m (Men)") %>% 
  filter(!is.na(Weight))
levantamiento_superpeso <- datos %>% filter(Sport == "Weightlifting", Event == "Weightlifting Super Heavyweight (Men)") %>% 
  filter(!is.na(Weight))

# Revisar el número de observaciones
cat("Número de observaciones en canotaje:", nrow(canoa_1000m), "\n")
## Número de observaciones en canotaje: 0
cat("Número de observaciones en levantamiento de pesas:", nrow(levantamiento_superpeso), "\n")
## Número de observaciones en levantamiento de pesas: 0
# Verificar si se puede realizar la prueba F
if (nrow(canoa_1000m) > 1 & nrow(levantamiento_superpeso) > 1) {
  prueba_varianzas <- var.test(canoa_1000m$Weight, levantamiento_superpeso$Weight)
  print(prueba_varianzas)
} else {
  cat("No hay suficientes observaciones para realizar la prueba F.\n")
}
## No hay suficientes observaciones para realizar la prueba F.
  1. A través de una prueba adecuada determine si la proporcion de mujeres en cada deporte es igual para todos. Emplee un p-valor como criterio de decisión de su rechazo o no de su hipótesis nula.
if (!require("readxl")) install.packages("readxl")
library(readxl)

# Ruta del archivo
ruta_archivo <- "C:/Users/USUARIO/Downloads/Olimpicos Atenas 2004.xlsx"

# Leer el archivo Excel
datos <- read_excel(ruta_archivo)

# Filtrar las columnas necesarias: 'Sport' (Deporte) y 'Sex' (Género)
deportes_genero <- datos[, c("Sport", "Sex")]

# Asegurar que las columnas relevantes sean factores
deportes_genero$Sport <- as.factor(deportes_genero$Sport)
deportes_genero$Sex <- as.factor(deportes_genero$Sex)

# Crear una tabla de contingencia con la proporción de mujeres y hombres por deporte
tabla_deportes <- table(deportes_genero$Sport, deportes_genero$Sex)

# Verificar la tabla de frecuencias
print("Tabla de frecuencias (Deporte vs Género):")
## [1] "Tabla de frecuencias (Deporte vs Género):"
print(tabla_deportes)
##                
##                   F   M
##   Archery        64  64
##   Badminton      83  88
##   Canoeing       94 234
##   Cycling       130 334
##   Diving         64  64
##   Gymnastics     95  97
##   Swimming      391 537
##   Table Tennis   86  86
##   Triathlon      50  49
##   Weightlifting  75 145
# Realizar la prueba chi-cuadrado
prueba_chi <- chisq.test(tabla_deportes)

# Mostrar resultados de la prueba
print("Resultados de la prueba chi-cuadrado:")
## [1] "Resultados de la prueba chi-cuadrado:"
print(prueba_chi)
## 
##  Pearson's Chi-squared test
## 
## data:  tabla_deportes
## X-squared = 85.068, df = 9, p-value = 1.581e-14
# Concluir según el p-valor
if (prueba_chi$p.value < 0.05) {
  print("Rechazamos la hipótesis nula: las proporciones de mujeres no son iguales en todos los deportes.")
} else {
  print("No rechazamos la hipótesis nula: las proporciones de mujeres podrían ser iguales en todos los deportes.")
}
## [1] "Rechazamos la hipótesis nula: las proporciones de mujeres no son iguales en todos los deportes."

Suena razonable creer que hay una asociación o una relación entre el peso de las personas y estatura. Suena natural pensar que a mayor estatura, mayor peso. Para pensar en sustentar esta idea se desarrollará un modelo de regresión lineal entre estatura y peso. Se empleará la información contenida en el archivo de atletas de la situación anterior.

  1. Proponga un modelo de regresión lineal adecuado para la hipótesis propuesta. Use la información de los deportistas que participaron en bádminton. Determine la recta de regresión ajustada.Elabore una gráfica que incluya los datos y la recta de regresión. Establezca conclusiones. Elabore un análisis de varianza del modelo y determine si es posible considerar el modelo de regresión lineal simple como un adecuado para la relación estatura peso. Justifique su respuesta.
# Cargar las bibliotecas necesarias
library(readxl)
library(ggplot2)

# Leer los datos desde el archivo
datos_badminton <- read_excel("C:/Users/USUARIO/Downloads/Olimpicos Atenas 2004.xlsx")

# Vista previa de los primeros registros
cat("Vista previa de los datos:\n")
## Vista previa de los datos:
head(datos_badminton)
## # A tibble: 6 × 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 Zhang Ju… F        23    169     63 China CHN   2004…  2004 Summer Athi…
## 2     2 Yun Mi-J… F        21    167     55 Sout… KOR   2004…  2004 Summer Athi…
## 3     3 Yuan Shu… F        19    168     62 Chin… TPE   2004…  2004 Summer Athi…
## 4     4 Wu Hui-Ju F        21    165     56 Chin… TPE   2004…  2004 Summer Athi…
## 5     5 Alison J… F        32    170     73 Grea… GBR   2004…  2004 Summer Athi…
## 6     6 Stephani… F        26    167     63 Unit… USA   2004…  2004 Summer Athi…
## # ℹ 3 more variables: Sport <chr>, Event <chr>, Medal <chr>
# Crear un modelo de regresión lineal (Peso en función de Estatura)
modelo_badminton <- lm(Weight ~ Height, data = datos_badminton)

# Resumen del modelo ajustado
cat("\nResumen del modelo de regresión lineal:\n")
## 
## Resumen del modelo de regresión lineal:
resumen_modelo <- summary(modelo_badminton)
print(resumen_modelo)
## 
## Call:
## lm(formula = Weight ~ Height, data = datos_badminton)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -33.530  -5.249  -1.316   3.586  78.095 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -96.50116    2.75556  -35.02   <2e-16 ***
## Height        0.95089    0.01573   60.44   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 8.99 on 2828 degrees of freedom
## Multiple R-squared:  0.5636, Adjusted R-squared:  0.5635 
## F-statistic:  3653 on 1 and 2828 DF,  p-value: < 2.2e-16
# Análisis de varianza (ANOVA) del modelo
cat("\nAnálisis de varianza (ANOVA) del modelo:\n")
## 
## Análisis de varianza (ANOVA) del modelo:
anova_badminton <- anova(modelo_badminton)
print(anova_badminton)
## Analysis of Variance Table
## 
## Response: Weight
##             Df Sum Sq Mean Sq F value    Pr(>F)    
## Height       1 295192  295192  3652.6 < 2.2e-16 ***
## Residuals 2828 228549      81                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Mostrar la ecuación del modelo
pendiente <- coef(modelo_badminton)[2]
intercepto <- coef(modelo_badminton)[1]
cat("\nLa ecuación del modelo es: Peso =", round(pendiente, 2), "* Estatura +", round(intercepto, 2), "\n")
## 
## La ecuación del modelo es: Peso = 0.95 * Estatura + -96.5
# Gráfica del modelo ajustado
cat("\nGráfica de la relación entre Estatura y Peso con la recta de regresión ajustada:\n")
## 
## Gráfica de la relación entre Estatura y Peso con la recta de regresión ajustada:
ggplot(datos_badminton, aes(x = Height, y = Weight)) +
  geom_point(color = "blue", size = 2) +
  geom_smooth(method = "lm", color = "red", se = TRUE) +
  labs(title = "Relación entre Estatura y Peso (Bádminton)",
       x = "Estatura (cm)", y = "Peso (kg)") +
  theme_minimal()

# Validar significancia del modelo
p_valor <- anova_badminton$`Pr(>F)`[1]
cat("\nResultado de la prueba de significancia:\n")
## 
## Resultado de la prueba de significancia:
if (p_valor < 0.05) {
  cat("Conclusión: Existe una relación estadísticamente significativa entre estatura y peso (p < 0.05).\n")
} else {
  cat("Conclusión: No hay suficiente evidencia para establecer una relación significativa entre estatura y peso (p > 0.05).\n")
}
## Conclusión: Existe una relación estadísticamente significativa entre estatura y peso (p < 0.05).
  1. Elabore una gráfica de la recta de regresión ajustada y una gráfica de residuales en función del peso. Comente acerca de las gráficas.
# Calcular los residuales
residuales <- resid(modelo_badminton)

# Gráfica de residuales en función del peso
ggplot(datos_badminton, aes(x = Weight, y = residuales)) +
  geom_point(color = "purple", size = 2) +
  geom_hline(yintercept = 0, linetype = "dashed", color = "black") +
  labs(title = "Gráfico de Residuales vs Peso (Bádminton)",
       x = "Peso (kg)", y = "Residuales") +
  theme_minimal()

En el gráfico de residuales, se observa que los puntos están distribuidos de manera aleatoria en torno a 0, lo que sugiere que los errores son independientes y el modelo es adecuado. Sin embargo, si existieran patrones visibles, podría ser necesario un modelo más complejo

  1. Repita los dos primeros puntos empleando la información de todos los deportistas de levantamiento de pesas.
# Filtrar los datos de levantamiento de pesas
datos_levantamiento <- subset(datos_badminton, Sport == "Weightlifting")

# Ajustar el modelo de regresión lineal
modelo_levantamiento <- lm(Weight ~ Height, data = datos_levantamiento)

# Resumen del modelo
print(summary(modelo_levantamiento))
## 
## Call:
## lm(formula = Weight ~ Height, data = datos_levantamiento)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -42.282  -8.197  -2.654   5.251  60.832 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -222.30017   15.38467  -14.45   <2e-16 ***
## Height         1.80284    0.09203   19.59   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13.76 on 218 degrees of freedom
## Multiple R-squared:  0.6377, Adjusted R-squared:  0.6361 
## F-statistic: 383.8 on 1 and 218 DF,  p-value: < 2.2e-16
# Gráfico de dispersión con línea de regresión
ggplot(datos_levantamiento, aes(x = Height, y = Weight)) +
  geom_point(color = "darkgreen", size = 2) +
  geom_smooth(method = "lm", color = "orange", se = TRUE) +
  labs(title = "Relación entre Estatura y Peso (Levantamiento de Pesas)",
       x = "Estatura (cm)", y = "Peso (kg)") +
  theme_minimal()

# Análisis de varianza (ANOVA) del modelo
anova_levantamiento <- anova(modelo_levantamiento)
print(anova_levantamiento)
## Analysis of Variance Table
## 
## Response: Weight
##            Df Sum Sq Mean Sq F value    Pr(>F)    
## Height      1  72614   72614  383.77 < 2.2e-16 ***
## Residuals 218  41249     189                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Conclusión sobre el modelo
if (anova_levantamiento$`Pr(>F)`[1] < 0.05) {
  cat("Conclusión: En levantamiento de pesas, existe una relación significativa entre estatura y peso (p < 0.05).\n")
} else {
  cat("Conclusión: No se encontró una relación significativa entre estatura y peso en levantamiento de pesas (p > 0.05).\n")
}
## Conclusión: En levantamiento de pesas, existe una relación significativa entre estatura y peso (p < 0.05).
  1. Compare los modelos anteriores y determine diferencias y similitudes. Concluya.

Diferencias

  1. El primer modelo se enfoca exclusivamente en el deporte de bádminton y estudia la relación entre estatura y peso de todos los deportistas, sin importar su sexo.
  2. El segundo modelo realiza una comparación entre los sexos, dividiendo los datos en dos grupos (hombres y mujeres) para analizar si hay diferencias significativas en la relación entre estatura y peso.
  3. El segundo modelo incluye una prueba de hipótesis para comparar los pesos promedio entre hombres y mujeres, mientras que el primer modelo no realiza este tipo de comparación.
  4. En el segundo modelo, se calculan intervalos de confianza del 99% para los pesos promedio de hombres y mujeres, lo que no se realiza en el primer modelo.

Similitudes

  1. Ambos modelos emplean regresión lineal simple para estudiar la relación entre dos variables (peso y estatura).
  2. Ambos incluyen gráficos con los puntos de datos y la recta de regresión ajustada para ilustrar visualmente los resultados.
  3. En ambos casos se evalúa la significancia estadística de los modelos mediante la prueba ANOVA y la comparación de los p-valores.

Conclusion

Modelo de Regresión Lineal en Bádminton: Este modelo proporciona una visión general de la relación entre el peso y la estatura en todos los deportistas de bádminton, sin tener en cuenta el género. Es útil para evaluar una tendencia general dentro de una población homogénea, pero no permite hacer comparaciones entre grupos.

Modelo de Regresión Lineal por Sexo: Este modelo, por otro lado, es más detallado y permite evaluar si hay diferencias significativas entre hombres y mujeres en términos de la relación entre el peso y la estatura. Es útil para identificar si las diferencias de género tienen un impacto en la relación entre estas dos variables.