Examen MCAN 4°
Dennis Meza
2025-05-08
Problema 1
Se realizó una investigación para conocer el Índice de Masa Corporal (IMC) de cuatro poblaciones distintas ubicadas en el Sur de Jalisco, una vez creado el estudio y el diseño, el tamaño de muestra arrojo la cantidad de 30 personas. Los resultados se presentan en al Tabla 1.
Tabla 1. Municipios del Sur de Jalisco:
## Sayula Gomez_Farias Zacoalco Techaluta
## 1 25 29 29 27
## 2 25 25 29 31
## 3 29 25 29 27
## 4 27 29 29 25
## 5 25 25 29 27
## 6 29 29 27 25
## 7 29 29 27 29
## 8 29 29 25 27
## 9 25 27 29 27
## 10 29 29 25 25
## 11 29 29 31 29
## 12 29 31 29 29
## 13 25 25 25 25
## 14 25 25 25 25
## 15 29 25 29 25
## 16 29 25 27 25
## 17 31 29 25 25
## 18 31 29 25 29
## 19 29 25 27 29
## 20 27 25 27 25
## 21 25 29 27 29
## 22 25 25 25 25
## 23 27 29 25 31
## 24 29 29 25 29
## 25 31 29 31 29
## 26 29 31 25 25
## 27 31 31 25 25
## 28 29 29 29 31
## 29 25 27 27 25
## 30 29 29 25 25Se aplicó el test de Shapiro-Wilk para conocer la distribución de los datos. Se encontró que los valores segrían una distribución No normal.
Posterior a eso, decidí transformar los datos (Logarítmica: log;Raíz cuadrada:sqrt;Inverse:(1/x)) y conocer la homogeneidad de varianza con el propósito de cumplir con el supuesto de normalidad requerido por muchas pruebas estadísticas paramétricas, como el ANOVA. Debido a que estas pruebas tienen mayor poder estadístico en comparación con las no paramétricas.
Transformación de datos:
# Transformaciones
transformaciones <- list(
Original = datos,
Log = log(datos + 1), # +1 para evitar log(0)
Sqrt = sqrt(datos),
Inverse = 1 / (datos + 1)
)
# Visualización de las transformaciones
cat("\n **Datos Originales y Transformados:**\n")##
## **Datos Originales y Transformados:**for (nombre in names(transformaciones)) {
cat("\n Transformación:", nombre, "\n")
print(head(transformaciones[[nombre]]))
}##
## Transformación: Original
## Sayula Gomez_Farias Zacoalco Techaluta
## 1 25 29 29 27
## 2 25 25 29 31
## 3 29 25 29 27
## 4 27 29 29 25
## 5 25 25 29 27
## 6 29 29 27 25
##
## Transformación: Log
## Sayula Gomez_Farias Zacoalco Techaluta
## 1 3.258097 3.401197 3.401197 3.332205
## 2 3.258097 3.258097 3.401197 3.465736
## 3 3.401197 3.258097 3.401197 3.332205
## 4 3.332205 3.401197 3.401197 3.258097
## 5 3.258097 3.258097 3.401197 3.332205
## 6 3.401197 3.401197 3.332205 3.258097
##
## Transformación: Sqrt
## Sayula Gomez_Farias Zacoalco Techaluta
## 1 5.000000 5.385165 5.385165 5.196152
## 2 5.000000 5.000000 5.385165 5.567764
## 3 5.385165 5.000000 5.385165 5.196152
## 4 5.196152 5.385165 5.385165 5.000000
## 5 5.000000 5.000000 5.385165 5.196152
## 6 5.385165 5.385165 5.196152 5.000000
##
## Transformación: Inverse
## Sayula Gomez_Farias Zacoalco Techaluta
## 1 0.03846154 0.03333333 0.03333333 0.03571429
## 2 0.03846154 0.03846154 0.03333333 0.03125000
## 3 0.03333333 0.03846154 0.03333333 0.03571429
## 4 0.03571429 0.03333333 0.03333333 0.03846154
## 5 0.03846154 0.03846154 0.03333333 0.03571429
## 6 0.03333333 0.03333333 0.03571429 0.03846154Evaluación de normalidad `
# Función para evaluar normalidad
evaluar_normalidad <- function(df) {
p_values <- sapply(df, function(x) shapiro.test(x)$p.value)
return(p_values)
}
# Evaluar normalidad para cada transformación
resultados_normalidad <- lapply(transformaciones, evaluar_normalidad)
# Mostrar resultados
knitr::kable(resultados_normalidad, caption = "Resultados de normalidad (p-values)")
|
|
|
|
# Selección automática
mejor_transformacion <- names(resultados_normalidad)[which.max(sapply(resultados_normalidad, min))]
cat("\n **La mejor transformación seleccionada es:**", mejor_transformacion, "\n")##
## **La mejor transformación seleccionada es:** OriginalGraficos de normalidad
Con los resultados anteriores, podemos ver que la mejor opción, fue siempre la original. A pesar de los intentos de las transformaciones, la normamidad no cambió, continuó siendo: NO normal``
Sin embargo,
##
## **Resultados del Test de Homocedasticidad (Levene):**## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 3 0.1395 0.9362
## 116Gráfico
Los datos son NO normales, pero las varianzas son homogéneas. El test de Levene se demostró que existe homocedasticidad, pero al no cumplir normalidad, el uso de Kruskal-Wallis era más adecuado.
##
## **Resultado del Test de Kruskal-Wallis:**##
## Kruskal-Wallis rank sum test
##
## data: Valor by Municipio
## Kruskal-Wallis chi-squared = 4.0526, df = 3, p-value = 0.2558##
## **Resultado del Test ANOVA:**## Df Sum Sq Mean Sq F value Pr(>F)
## Municipio 3 18.0 5.989 1.343 0.264
## Residuals 116 517.2 4.459Sin embargo, ambos resultados, tanto ANOVA como Kruskal-Wallis, indican que no hay de diferencias significativas.
Como pruebas adicionales se realizó una correlación de Spearman:
##
## 🔍 **Matriz de Correlación (Spearman):**## Sayula Gomez_Farias Zacoalco Techaluta
## Sayula 1.00000000 0.5017143 -0.1174247 0.05524399
## Gomez_Farias 0.50171428 1.0000000 -0.1464242 0.16841694
## Zacoalco -0.11742472 -0.1464242 1.0000000 0.36642768
## Techaluta 0.05524399 0.1684169 0.3664277 1.00000000
Conclusión del análisis
La única correlación que es moderada es entre Sayula y Gómez_Farias (0.50), lo cual sugiere cierta relación en las distribuciones de datos.
Las demás correlaciones son muy débiles o prácticamente nulas, indicando que los datos entre esos municipios son independientes en su comportamiento.
Zacoalco y Techaluta presentan una ligera relación (0.36), pero no es suficientemente fuerte para considerarse significativa sin un análisis adicional.
Como analisis final, se realizó una regresión lineal de los datos para evaluar si existe una relación significativa entre los municipios que mostraron la correlación más alta en el análisis anterior: Sayula y Gómez_Farias.
# Modelo de Regresión Lineal
modelo <- lm(Sayula ~ Gomez_Farias, data = datos)
# Resumen del Modelo
summary(modelo)##
## Call:
## lm(formula = Sayula ~ Gomez_Farias, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.4904 -1.5207 0.5096 1.2710 2.5096
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 14.2103 4.6112 3.082 0.00458 **
## Gomez_Farias 0.4924 0.1658 2.970 0.00605 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.904 on 28 degrees of freedom
## Multiple R-squared: 0.2396, Adjusted R-squared: 0.2124
## F-statistic: 8.821 on 1 and 28 DF, p-value: 0.006049
# Análisis de Residuos
residuos <- residuals(modelo)
predichos <- predict(modelo)
# Gráfico de Residuos vs. Valores Ajustados
ggplot(data.frame(predichos, residuos), aes(x = predichos, y = residuos)) +
geom_point(color = "blue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
labs(
title = "Análisis de Residuos vs. Valores Ajustados",
x = "Valores Ajustados",
y = "Residuos"
) +
theme_minimal()
# QQ-Plot de Residuos
qqnorm(residuos)
qqline(residuos, col = "red")
Debido a que los datos no se ajustaban correctamente al modelo, se realizó una transformación del modelo para mejorar la normalidad de los residuos, corregir problemas de heterocedasticidad y apturar relaciones no lineales.
# Transformación Logarítmica
datos$Sayula_log <- log(datos$Sayula + 1)
datos$Gomez_Farias_log <- log(datos$Gomez_Farias + 1)
# Nuevo Modelo de Regresión
modelo_log <- lm(Sayula_log ~ Gomez_Farias_log, data = datos)
# Resumen del Modelo
summary(modelo_log)##
## Call:
## lm(formula = Sayula_log ~ Gomez_Farias_log, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.12413 -0.05467 0.01897 0.04400 0.08843
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.7314 0.5557 3.116 0.00421 **
## Gomez_Farias_log 0.4854 0.1656 2.932 0.00665 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.067 on 28 degrees of freedom
## Multiple R-squared: 0.2348, Adjusted R-squared: 0.2075
## F-statistic: 8.594 on 1 and 28 DF, p-value: 0.00665# Gráfico de Regresión Transformada
ggplot(datos, aes(x = Gomez_Farias_log, y = Sayula_log)) +
geom_point(color = "blue") +
geom_smooth(method = "lm", color = "red", se = FALSE) +
labs(
title = "Regresión Lineal (Transformación Logarítmica)",
x = "Gómez_Farias (log)",
y = "Sayula (log)"
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
# Análisis de Residuos
residuos_log <- residuals(modelo_log)
predichos_log <- predict(modelo_log)
# Gráfico de Residuos vs. Valores Ajustados
ggplot(data.frame(predichos_log, residuos_log), aes(x = predichos_log, y = residuos_log)) +
geom_point(color = "blue") +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
labs(
title = "Análisis de Residuos (Transformación Logarítmica)",
x = "Valores Ajustados (log)",
y = "Residuos"
) +
theme_minimal()
# QQ-Plot de Residuos
qqnorm(residuos_log)
qqline(residuos_log, col = "red")
# Transformación Raíz Cuadrada
datos$Sayula_sqrt <- sqrt(datos$Sayula)
datos$Gomez_Farias_sqrt <- sqrt(datos$Gomez_Farias)
# Modelo de Regresión
modelo_sqrt <- lm(Sayula_sqrt ~ Gomez_Farias_sqrt, data = datos)
# Resumen del Modelo
summary(modelo_sqrt)##
## Call:
## lm(formula = Sayula_sqrt ~ Gomez_Farias_sqrt, data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.33505 -0.14678 0.05011 0.12012 0.23839
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.7027 0.8724 3.098 0.00440 **
## Gomez_Farias_sqrt 0.4888 0.1657 2.951 0.00634 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1817 on 28 degrees of freedom
## Multiple R-squared: 0.2372, Adjusted R-squared: 0.21
## F-statistic: 8.707 on 1 and 28 DF, p-value: 0.006344# Modelo Polinomial de segundo grado
modelo_poly <- lm(Sayula ~ poly(Gomez_Farias, 2), data = datos)
# Resumen del Modelo
summary(modelo_poly)##
## Call:
## lm(formula = Sayula ~ poly(Gomez_Farias, 2), data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3133 -1.6566 0.6867 0.8133 2.6867
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 27.867 0.350 79.613 <2e-16 ***
## poly(Gomez_Farias, 2)1 5.655 1.917 2.949 0.0065 **
## poly(Gomez_Farias, 2)2 1.500 1.917 0.783 0.4406
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.917 on 27 degrees of freedom
## Multiple R-squared: 0.2564, Adjusted R-squared: 0.2014
## F-statistic: 4.656 on 2 and 27 DF, p-value: 0.01831Sin embargo, ninguna transformación logró cumplir todos los supuestos.
# Visualización de Residuos
par(mfrow = c(2, 2))
# Modelo Logarítmico
qqnorm(residuals(modelo_log), main = "QQ-Plot Logarítmico")
qqline(residuals(modelo_log), col = "red")
# Modelo Raíz Cuadrada
qqnorm(residuals(modelo_sqrt), main = "QQ-Plot Raíz Cuadrada")
qqline(residuals(modelo_sqrt), col = "red")
# Modelo Polinomial
qqnorm(residuals(modelo_poly), main = "QQ-Plot Polinomial")
qqline(residuals(modelo_poly), col = "red")
Por otro lado, intentamos con una regresión por Quantile (τ = 0.5) para ajustar el modelo de regresión en distintos niveles (quantiles) de la distribución de la variable dependiente (Y).
# Instalar librería necesaria
# install.packages("quantreg")
library(quantreg)## Loading required package: SparseM# Regresión Quantile
modelo_quantile <- rq(Sayula ~ Gomez_Farias, data = datos, tau = 0.5)
# Resumen del Modelo
summary(modelo_quantile)## Warning in rq.fit.br(x, y, tau = tau, ci = TRUE, ...): Solution may be
## nonunique##
## Call: rq(formula = Sayula ~ Gomez_Farias, tau = 0.5, data = datos)
##
## tau: [1] 0.5
##
## Coefficients:
## coefficients lower bd upper bd
## (Intercept) 0.00000 0.00000 34.56131
## Gomez_Farias 1.00000 0.10272 1.00000# Visualización del Modelo Quantile
ggplot(datos, aes(x = Gomez_Farias, y = Sayula)) +
geom_point(color = "blue") +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(
title = "Regresión Quantile (Mediana) entre Sayula y Gómez_Farias",
x = "Gómez_Farías",
y = "Sayula"
) +
theme_minimal()
En conclusión, el modelo por Quantiles fue el más robusto porque no depende de la normalidad en los residuos.
Conclusiones Generales
No se encontrarón diferencias estadisticamente significativas en el Índice de Masa Corporal (IMC) de las cuatro poblaciones de la región Sur de Jalisco.
Por otro lado, sí hubo correlación moderada positiva entre Gómez_Farías y Sayula. Esto significa que, cuando Gómez_Farías aumentaba, Sayula también tendía a aumentar.Sin embargo, cuando intentamos ajustar un modelo para predecir valores de Sayula en función de Gómez_Farías, el modelo no logró explicar mucho de la variabilidad. Esto sugiere que, si bien existe una relación moderada, otros factores no contemplados en el modelo podrían estar influyendo en los cambios observados en Sayula.