En este trabajo se analizan los supuestos fundamentales de la regresión lineal utilizando datos del conjunto Gapminder. Se plantean dos modelos: uno simple, que evalúa la relación entre la expectativa de vida femenina y el número de médicos por cada 1000 habitantes, y otro múltiple, que analiza cómo el uso de anticonceptivos y la educación femenina influyen en la tasa de fecundidad.

El objetivo es verificar el cumplimiento de los supuestos de linealidad, normalidad de los residuos y homocedasticidad, además de la multicolinealidad en el modelo múltiple. A través de gráficos y pruebas estadísticas, se busca evaluar la validez y confiabilidad de los modelos, así como comprender cómo las violaciones a los supuestos pueden afectar las conclusiones del análisis.

Cargamos los datos:

data <- read.csv("supuestos.csv")

Regresion Simple

Ajustamos el modelo lineal simple:

m1 <- lm(lifExpFem ~ doctor, data = data)
summary(m1)
## 
## Call:
## lm(formula = lifExpFem ~ doctor, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -20.053  -5.513   1.614   6.222  14.067 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  61.6726     0.8568   71.98   <2e-16 ***
## doctor        5.3042     0.4314   12.29   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7.771 on 170 degrees of freedom
##   (22 observations deleted due to missingness)
## Multiple R-squared:  0.4706, Adjusted R-squared:  0.4675 
## F-statistic: 151.1 on 1 and 170 DF,  p-value: < 2.2e-16

El modelo muestra una relación positiva y significativa entre la cantidad de médicos y la expectativa de vida femenina. El intercepto es 61.67, indicando la expectativa promedio cuando no hay médicos (sin interpretación práctica). El coeficiente de doctor = 5.30 significa que por cada médico adicional por cada 1000 habitantes, la expectativa de vida femenina aumenta en promedio 5.3 años.Se explica aproximadamente el 47% de la variabilidad en la expectativa de vida femenina (R² = 0.4706), lo que representa un ajuste moderado. El estadístico F = 151.1 (p < 0.001) confirma que la relación es estadísticamente significativa. En conjunto, el modelo indica que una mayor disponibilidad de médicos se asocia con una mayor esperanza de vida femenina.

Supuesto 1

Normalidad:

library(ggplot2)
library(broom)
## Warning: package 'broom' was built under R version 4.3.3
df <- data.frame(
  yhat = fitted.values(m1),
  res  = rstandard(m1)
)

ggplot(df, aes(sample = res)) +
  stat_qq(color = "blue") +
  stat_qq_line(linewidth = 1) +
  labs(x = "Cuantiles teóricos", y = "Cuantiles muestrales") +
  theme_minimal(base_size = 14)

El gráfico Q-Q muestra que los puntos se alinean casi completamente sobre la línea diagonal, con ligeras desviaciones en los extremos. Esto indica que los residuos se aproximan a una distribución normal, por lo que el supuesto de normalidad se cumple razonablemente bien. Las pequeñas desviaciones en las colas no representan una violación seria y pueden atribuirse a variabilidad natural en los datos.

Prueba:

shapiro.test(df$res)
## 
##  Shapiro-Wilk normality test
## 
## data:  df$res
## W = 0.9619, p-value = 0.000122

Media de errores:

mean(df$res)
## [1] -0.001717297

La media de los residuos estandarizados es -0.0017, muy cercana a cero, lo que confirma que los errores se distribuyen simétricamente alrededor del promedio. No obstante, la prueba de Shapiro-Wilk presenta un valor p de 0.0001 (< 0.05), por lo que se rechaza la normalidad de los residuos. Esto indica que los errores no siguen una distribución normal de forma estricta, aunque la desviación observada no parece considerable en términos prácticos.

Supuesto 2

Varianza constante (homocedasticidad):

ggplot(df, aes(x = yhat, y = res)) +
  geom_point(alpha = 0.6, color = "blue") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") +
  labs(x = "Valores ajustados", y = "Residuales estandarizados") +
  theme_minimal(base_size = 14)

El gráfico de residuos vs valores ajustados muestra que los puntos no se distribuyen de manera completamente aleatoria alrededor de la línea cero, sino que presentan una ligera tendencia curvilínea. Esto sugiere que la relación entre las variables podría no ser perfectamente lineal y que existe cierta variación en los residuos según el nivel de los valores ajustados. Aun así, el patrón no es severo, por lo que el modelo puede considerarse aceptable, aunque la linealidad no se cumple de forma estricta.

Prueba:

library(lmtest)
## Warning: package 'lmtest' was built under R version 4.3.3
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.3.3
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
bptest(m1)
## 
##  studentized Breusch-Pagan test
## 
## data:  m1
## BP = 6.7478, df = 1, p-value = 0.009386

El valor p obtenido en la prueba de Breusch-Pagan es 0.009 (< 0.05), por lo que se rechaza la hipótesis nula de homocedasticidad. Esto indica que los residuos no presentan varianza constante, es decir, existe heterocedasticidad en el modelo. En consecuencia, los errores estándar pueden estar subestimados o sobrestimados, afectando la precisión de las pruebas de significancia de los coeficientes.

Supuesto 3

Independencia (autocorrelación):

library(ggplot2)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
df1 <- data.frame(
  res = rstandard(m1)
) %>%
  mutate(orden = 1:length(res))

ggplot(df1, aes(x = orden, y = res)) +
  geom_point(alpha = 0.6, color = "blue") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "grey40") +
  labs(x = "Orden/tiempo", y = "Residuales estandarizados") +
  theme_minimal(base_size = 14)

El gráfico de residuos en función del orden muestra que los puntos se distribuyen de manera aleatoria alrededor de la línea cero, sin mostrar tendencias ni patrones sistemáticos. Esto indica que los errores son independientes entre sí y no existe autocorrelación, por lo que el supuesto de independencia de los residuos se cumple adecuadamente.

Prueba:

library(lmtest)
dwtest(m1)
## 
##  Durbin-Watson test
## 
## data:  m1
## DW = 1.9794, p-value = 0.4393
## alternative hypothesis: true autocorrelation is greater than 0

El estadístico de Durbin-Watson es 1.98, valor muy cercano a 2, y el p-value de 0.4393 es mayor que 0.05. Por lo tanto, no se rechaza la hipótesis nula de independencia de los residuos. Esto indica que no existe autocorrelación y que los errores son independientes entre sí, cumpliéndose el supuesto de independencia del modelo.

Conclusión general del modelo lineal simple

El modelo que relaciona la expectativa de vida femenina con la cantidad de médicos por cada 1000 habitantes muestra un ajuste adecuado y una relación positiva y significativa entre ambas variables. Sin embargo, el diagnóstico de los supuestos revela algunos aspectos importantes: los residuos presentan una media cercana a cero, pero la prueba de Shapiro-Wilk indica que no siguen una distribución normal estricta; la prueba de Breusch-Pagan muestra evidencia de heterocedasticidad, lo que sugiere varianza no constante; y la prueba de Durbin-Watson confirma que los errores son independientes. En general, el modelo explica el 47% de la variabilidad en la expectativa de vida femenina y, aunque presenta ligeras desviaciones en los supuestos de normalidad y homocedasticidad, sus resultados pueden considerarse confiables para fines descriptivos y de interpretación general.

Regresion Lineal Multiple

datos <- read.csv("supuestos.csv")
# Paso 1   

# Paso 2 Exploracion de Correlaciones 
library(corrplot)
datos_num <- datos[sapply(datos, is.numeric)]
R <- cor(datos_num, use = "pairwise.complete.obs")
datos <- datos_num
corrplot(R,
         method = "color",        # colores en lugar de números
         type = "lower",          # solo triángulo inferior
         addCoef.col = "black",   # añadir valores en negro
         tl.col = "black",        # etiquetas de variables en negro
         tl.srt = 45,             # rotar etiquetas
         diag = FALSE)            # no mostrar diagonal

En el mapa de correlaciones se observa que la variable tfr (tasa de fertilidad total) tiene una relación negativa fuerte con contracep y con yearSchF. Esto indica que a mayor uso de anticonceptivos y mayor escolaridad femenina, menor es la tasa de fertilidad. Estas variables parecen las más importantes para explicar los cambios en la fertilidad, por lo que se considerarán en el modelo.

# Paso 3 Selección de variables por subconjuntos:
# Creamos el modelo saturado (según las instrucciones)
saturado <- tfr ~ contracep + yearSchF

reg  <- lm(saturado, data = datos) # todos los predictores
summary(reg)
## 
## Call:
## lm(formula = saturado, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.88868 -0.52076  0.06251  0.50355  2.22631 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.950649   0.169315  41.051  < 2e-16 ***
## contracep   -0.042085   0.004648  -9.054 3.25e-15 ***
## yearSchF    -0.194993   0.030539  -6.385 3.44e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7979 on 119 degrees of freedom
##   (72 observations deleted due to missingness)
## Multiple R-squared:  0.8018, Adjusted R-squared:  0.7985 
## F-statistic: 240.7 on 2 and 119 DF,  p-value: < 2.2e-16
library(leaps)
ajuste <- regsubsets(
  saturado, data = datos,
  nvmax = 2,                 # total de predictores disponibles
  method = "exhaustive")     # todas las combinaciones

s <- summary(ajuste)
names(s)
## [1] "which"  "rsq"    "rss"    "adjr2"  "cp"     "bic"    "outmat" "obj"

El modelo lineal muestra que ambas variables (contracep y yearSchF) son significativas y con coeficientes negativos. Esto confirma que cuando aumenta el uso de anticonceptivos o los años de educación femenina, la tasa de fertilidad disminuye. El R² ajustado = 0.7985, lo que significa que el modelo explica cerca del 80% de la variación de la tasa de fertilidad, lo cual representa un ajuste muy bueno.

# Paso 4 Elegir el modelo óptimo:
# Número óptimo de predictores según cada criterio
best_bic  <- which.min(s$bic)
best_r2   <- which.max(s$adjr2)

# Visualización comparativa
par(mfrow = c(1,2))
plot(s$bic, type="b", col="red", pch=19,
     xlab="Número de predictores", ylab="BIC",
     main="Criterio BIC")
points(best_bic, s$bic[best_bic], pch=19, cex=1.5, col="blue")

plot(s$adjr2, type="b", col="darkgreen", pch=19,
     xlab="Número de predictores", ylab="R^2-ajustado",
     main="Criterio R^2-ajustado")
points(best_r2, s$adjr2[best_r2], pch=19, cex=1.5, col="blue")

Al comparar los modelos, ambos criterios (BIC y R² ajustado) indican que el mejor modelo incluye dos predictores: contracep y yearSchF. Esto confirma que estas dos variables son las que mejor explican la tasa de fertilidad sin añadir complejidad innecesaria al modelo.

# Paso 5 Ajustamos el mejor modelo:

# Opción 1
# extraemos las variables del mejor modelo (según BIC)
coef_best <- coef(ajuste, best_bic)
vars_best <- names(coef_best)[-1] # sin intercepto
# Opción 2
# extraemos las variables del mejor modelo (según R^2-ajustado)
coef_best <- coef(ajuste, best_r2)
vars_best <- names(coef_best)[-1] # sin intercepto

# modelo final ajustado
f_final <- as.formula(paste("tfr ~", paste(vars_best, collapse = " + ")))
modelo_final <- lm(f_final, data = datos)
summary(modelo_final)
## 
## Call:
## lm(formula = f_final, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.88868 -0.52076  0.06251  0.50355  2.22631 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.950649   0.169315  41.051  < 2e-16 ***
## contracep   -0.042085   0.004648  -9.054 3.25e-15 ***
## yearSchF    -0.194993   0.030539  -6.385 3.44e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7979 on 119 degrees of freedom
##   (72 observations deleted due to missingness)
## Multiple R-squared:  0.8018, Adjusted R-squared:  0.7985 
## F-statistic: 240.7 on 2 and 119 DF,  p-value: < 2.2e-16
# modelo final ajustado
f_final <- as.formula(paste("tfr ~", paste(vars_best, collapse = " + ")))
modelo_final <- lm(f_final, data = datos)
summary(modelo_final)
## 
## Call:
## lm(formula = f_final, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.88868 -0.52076  0.06251  0.50355  2.22631 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.950649   0.169315  41.051  < 2e-16 ***
## contracep   -0.042085   0.004648  -9.054 3.25e-15 ***
## yearSchF    -0.194993   0.030539  -6.385 3.44e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7979 on 119 degrees of freedom
##   (72 observations deleted due to missingness)
## Multiple R-squared:  0.8018, Adjusted R-squared:  0.7985 
## F-statistic: 240.7 on 2 and 119 DF,  p-value: < 2.2e-16

El modelo final mantiene las mismas variables (contracep y yearSchF), ambas con efectos negativos y significativos. El R² ajustado = 0.7985 confirma un excelente nivel de explicación. En resumen, una mayor educación femenina y un mayor uso de métodos anticonceptivos están asociados con una menor tasa de fertilidad total.

Conclusion:

En general, el modelo demuestra una relación clara y fuerte entre la educación femenina, el uso de anticonceptivos y la reducción de la tasa de fertilidad. Los resultados son coherentes con la teoría demográfica y muestran que mejorar la educación de las mujeres y promover el acceso a métodos anticonceptivos son factores clave para reducir la fertilidad. El modelo tiene un ajuste muy alto (R² ≈ 0.80) y cumple adecuadamente los supuestos estadísticos, por lo que sus resultados son confiables.