Contexto del Problema

El ingreso per cápita varía entre municipios de Puerto Rico. Factores como educación, desempleo, acceso a internet, pobreza y tamaño del hogar pueden ayudar a explicar estas diferencias. El objetivo es aplicar Regresión Lineal Múltiple (RLM) y técnicas de selección de variables para identificar los predictores más relevantes.

Variables incluidas en el modelo:

  • ing_pc: Ingreso per cápita.

  • bach_pct: % con bachillerato o más.

  • desem_pct: Tasa de desempleo.

  • banda_pct: % de hogares con internet de banda ancha.

  • pobreza_pct: % de población bajo pobreza.

  • tam_hogar: Tamaño promedio del hogar.

Datos:

Los datos que se utilizarán para realizar este análisis viene de la página del Censo de Puerto Rico

library(readr)
data_censo <- read.csv("data_censo.csv")
municipio <-data_censo$municipio
ing_pc <- data_censo$ing_pc
bach_pct <- data_censo$bach_pct
desem_pct <- data_censo$desem_pct 
banda_pct <- data_censo$banda_pct
pobreza_pct <- data_censo$pobreza_pct
tam_hogar <- data_censo$tam_hogar
datos <- data.frame(
  municipio, ing_pc, bach_pct, desem_pct, banda_pct, pobreza_pct, tam_hogar)

Correlación:

Para poder analizar la correlación se usará un mapa de correlaciones para detectar relaciones fuertes y posibles colinealidades entre predictores antes de seleccionar.

vars <- data_censo[, c("ing_pc", "bach_pct", "desem_pct", "banda_pct", "pobreza_pct", "tam_hogar")]


R <- cor(vars, use = "pairwise.complete.obs")


library(corrplot)
corrplot(R,
  method = "color",
  type = "lower",
  addCoef.col = "black",
  tl.col = "black",
  tl.srt = 45,
  diag = FALSE)

Observación:

Basado en este mapa, se puede observar una correlación positiva entre el ingreso per cápita y el % de personas con bachillerato, así como también el % de hogares con acceso a internet de banda ancha. Esto puede significar que los municipios con mayores niveles de educación y un buen acceso a internet tienden a presentar mejores niveles de ingreso per cápita.

Por el otro lado, el ingreso per cápita se puede observa una correlación negativa fuerte con el % de la población bajo pobreza. Que es evidente decir que cuando aumenta el nivel de pobreza en un municipio, el ingreso per cápita tiende a disminuir.

Selección de variables por subconjuntos

Paso 1: Función regsubsets Ahora se creará el modelo saturado con todas las variables disponibles para ver cuan significativas son las variables respecto al Ingreso per Cápita.

saturado <- ing_pc ~ bach_pct + desem_pct + banda_pct + pobreza_pct + tam_hogar

reg <- lm(saturado, data = data_censo)

summary(reg)
## 
## Call:
## lm(formula = saturado, data = data_censo)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4585.2 -1168.6  -125.4  1208.2  5224.9 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3757.23    3338.95   1.125 0.264211    
## bach_pct      264.14      68.73   3.843 0.000259 ***
## desem_pct      20.05      74.85   0.268 0.789533    
## banda_pct     125.32      45.30   2.766 0.007198 ** 
## pobreza_pct  -210.64      47.68  -4.417 3.45e-05 ***
## tam_hogar     816.67     622.90   1.311 0.193997    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1982 on 72 degrees of freedom
## Multiple R-squared:  0.8457, Adjusted R-squared:  0.835 
## F-statistic: 78.93 on 5 and 72 DF,  p-value: < 2.2e-16

Paso 2: leaps

library(leaps)

ajuste <- regsubsets(
  saturado, data = datos,
  nvmax = 6,                
  method = "exhaustive")    
s <- summary(ajuste)

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

Ahora, se estará analizando para escoger el mejor número y correlación de variables. Para poder llegar a estas conclusiones usaré el ajuste del modelo BIC o ajustando modelos comparando el BIC y el B^2 ajustado.

Eligiendo Modelo Optimo

Obeservación

En estos dos modelos se puede observar desigualdad notable entre ambas. Esto se debe a que BIC normalmente propone un modelo más pequeño porque penaliza mucho la complejidad, mientras que R^2-ajustado suele elegir un modelo más grande.

Se ajusta el mejor modelo:

Ahora podré hacer un modelo ajustado final, sacando las variables de cada método o modelo

BIC

coef_best <- coef(ajuste, best_bic)
vars_best <- names(coef_best)[-1] 

f_final <- as.formula(paste("ing_pc ~", 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 
## -4644.3  -995.6   -35.5  1360.0  5031.6 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6481.30    2522.94   2.569 0.012215 *  
## bach_pct      270.45      67.62   3.999 0.000149 ***
## banda_pct     119.54      44.32   2.697 0.008657 ** 
## pobreza_pct  -209.43      47.36  -4.422  3.3e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1979 on 74 degrees of freedom
## Multiple R-squared:  0.842,  Adjusted R-squared:  0.8356 
## F-statistic: 131.5 on 3 and 74 DF,  p-value: < 2.2e-16

Observación Al observar este modelo, se puede concluir que las variables (nivel de educación, acceso al internet y nivel de pobreza) tienen relación significativa con el ingreso per Cápita de los municipios. Cuando vemos el R^2 vemos que el modelo explica un 84.2% de la variabilidad del ingreso por Cápita, aún así cuando vemos el R^2 ajustado es un 83.6% vemos que sige siendo alto, siendo un indicador de un buen ajuste.

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("ing_pc ~", 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 
## -4630.0 -1129.5   -83.4  1182.5  5207.2 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4047.29    3138.40   1.290 0.201259    
## bach_pct      267.16      67.36   3.966 0.000169 ***
## banda_pct     123.03      44.21   2.783 0.006848 ** 
## pobreza_pct  -209.38      47.15  -4.441 3.12e-05 ***
## tam_hogar     790.86     611.48   1.293 0.199967    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1970 on 73 degrees of freedom
## Multiple R-squared:  0.8456, Adjusted R-squared:  0.8371 
## F-statistic: 99.92 on 4 and 73 DF,  p-value: < 2.2e-16

Observación Al igual que el modelo anterior, este modelo final del R^2 ajustado muestra que las variables tienen una relación significativa con el ingreso per Cápita por municipio. Se observa que el ingreso per Cápita en los municipios es de $4047 cuando las demas variables son 0. Las hipoteses de las variables del % en educación y el % de pobreza en la población con confiables. Y si comparamos las R^2 ajustadas vemos que la diferencia entre modelos no es tan significativa donde podemos concluir que el modelo con 3 variables que es el de BIC lo debemos seleccionar porque nos podemos quedar con el nivel de internet, educcación, y nivel de pobresa como variables principales y no yendonos por un modelo más complejo. Con este modelo se puede ofrece un mejor sentido explicativo y simple de la relación de las variables con el intercepto.

Ajusta modelos paso a paso usando BIC

También para escoger la mejor combinación de variables se puede utilizar el método de Paso a Paso:

Paso a Paso foward

saturado <- ing_pc ~ bach_pct + desem_pct + banda_pct + pobreza_pct +
  tam_hogar 
# Modelos de nulo y saturado
m0_log <- lm(ing_pc ~ 1, data = data_censo)   # sin predictores
mF_log <- lm(saturado, data = data_censo)        # todos los predictores

# Hacia adelante 
m1_step_log <- step(m0_log,
  scope     = list(lower = ~1, upper = formula(mF_log)),
  direction = "forward",
  k         = log(nrow(data_censo)),
  trace     = TRUE)
## Start:  AIC=1328.25
## ing_pc ~ 1
## 
##               Df  Sum of Sq        RSS    AIC
## + bach_pct     1 1438089133  395800604 1213.0
## + pobreza_pct  1 1331610382  502279355 1231.6
## + banda_pct    1 1121735582  712154155 1258.8
## <none>                      1833889736 1328.2
## + desem_pct    1    8354792 1825534944 1332.2
## + tam_hogar    1    5821235 1828068502 1332.4
## 
## Step:  AIC=1213.01
## ing_pc ~ bach_pct
## 
##               Df Sum of Sq       RSS    AIC
## + pobreza_pct  1  77610119 318190485 1200.3
## + banda_pct    1  29535087 366265517 1211.3
## <none>                     395800604 1213.0
## + tam_hogar    1   4923053 390877551 1216.4
## + desem_pct    1   2817657 392982947 1216.8
## 
## Step:  AIC=1200.34
## ing_pc ~ bach_pct + pobreza_pct
## 
##             Df Sum of Sq       RSS    AIC
## + banda_pct  1  28478762 289711723 1197.4
## <none>                   318190485 1200.3
## + tam_hogar  1   4915101 313275383 1203.5
## + desem_pct  1    672748 317517737 1204.5
## 
## Step:  AIC=1197.39
## ing_pc ~ bach_pct + pobreza_pct + banda_pct
## 
##             Df Sum of Sq       RSS    AIC
## <none>                   289711723 1197.4
## + tam_hogar  1   6489907 283221816 1200.0
## + desem_pct  1     17073 289694650 1201.7

Paso a Paso backwards

# Hacia atras 
m2_step_log <- step(mF_log,
                    direction = "backward",
                    k         = log(nrow(data_censo)),
                    trace     = TRUE)
## Start:  AIC=1204.26
## ing_pc ~ bach_pct + desem_pct + banda_pct + pobreza_pct + tam_hogar
## 
##               Df Sum of Sq       RSS    AIC
## - desem_pct    1    282063 283221816 1200.0
## - tam_hogar    1   6754897 289694650 1201.7
## <none>                     282939753 1204.3
## - banda_pct    1  30072895 313012647 1207.8
## - bach_pct     1  58048450 340988202 1214.5
## - pobreza_pct  1  76685336 359625088 1218.6
## 
## Step:  AIC=1199.98
## ing_pc ~ bach_pct + banda_pct + pobreza_pct + tam_hogar
## 
##               Df Sum of Sq       RSS    AIC
## - tam_hogar    1   6489907 289711723 1197.4
## <none>                     283221816 1200.0
## - banda_pct    1  30053567 313275383 1203.5
## - bach_pct     1  61021640 344243456 1210.8
## - pobreza_pct  1  76514196 359736013 1214.3
## 
## Step:  AIC=1197.39
## ing_pc ~ bach_pct + banda_pct + pobreza_pct
## 
##               Df Sum of Sq       RSS    AIC
## <none>                     289711723 1197.4
## - banda_pct    1  28478762 318190485 1200.3
## - bach_pct     1  62624091 352335814 1208.3
## - pobreza_pct  1  76553794 366265517 1211.3

Paso a Paso both

# híbrido 
m3_step_log <- step(m0_log,
  scope     = list(lower = ~1, upper = formula(mF_log)),
  direction = "both",
  k         = log(nrow(data_censo)),
  trace     = TRUE)
## Start:  AIC=1328.25
## ing_pc ~ 1
## 
##               Df  Sum of Sq        RSS    AIC
## + bach_pct     1 1438089133  395800604 1213.0
## + pobreza_pct  1 1331610382  502279355 1231.6
## + banda_pct    1 1121735582  712154155 1258.8
## <none>                      1833889736 1328.2
## + desem_pct    1    8354792 1825534944 1332.2
## + tam_hogar    1    5821235 1828068502 1332.4
## 
## Step:  AIC=1213.01
## ing_pc ~ bach_pct
## 
##               Df  Sum of Sq        RSS    AIC
## + pobreza_pct  1   77610119  318190485 1200.3
## + banda_pct    1   29535087  366265517 1211.3
## <none>                       395800604 1213.0
## + tam_hogar    1    4923053  390877551 1216.4
## + desem_pct    1    2817657  392982947 1216.8
## - bach_pct     1 1438089133 1833889736 1328.2
## 
## Step:  AIC=1200.34
## ing_pc ~ bach_pct + pobreza_pct
## 
##               Df Sum of Sq       RSS    AIC
## + banda_pct    1  28478762 289711723 1197.4
## <none>                     318190485 1200.3
## + tam_hogar    1   4915101 313275383 1203.5
## + desem_pct    1    672748 317517737 1204.5
## - pobreza_pct  1  77610119 395800604 1213.0
## - bach_pct     1 184088870 502279355 1231.6
## 
## Step:  AIC=1197.39
## ing_pc ~ bach_pct + pobreza_pct + banda_pct
## 
##               Df Sum of Sq       RSS    AIC
## <none>                     289711723 1197.4
## + tam_hogar    1   6489907 283221816 1200.0
## - banda_pct    1  28478762 318190485 1200.3
## + desem_pct    1     17073 289694650 1201.7
## - bach_pct     1  62624091 352335814 1208.3
## - pobreza_pct  1  76553794 366265517 1211.3

Obervación: Al analizar los tres “Paso a Paso” decidiré utilizar el metodo híbrido, porque es el más detallado o complejo para ayudar en este ejercicio.

Coeficientes del modelo final y Conclusión

summary(m3_step_log)
## 
## Call:
## lm(formula = ing_pc ~ bach_pct + pobreza_pct + banda_pct, data = data_censo)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4644.3  -995.6   -35.5  1360.0  5031.6 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6481.30    2522.94   2.569 0.012215 *  
## bach_pct      270.45      67.62   3.999 0.000149 ***
## pobreza_pct  -209.43      47.36  -4.422  3.3e-05 ***
## banda_pct     119.54      44.32   2.697 0.008657 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1979 on 74 degrees of freedom
## Multiple R-squared:  0.842,  Adjusted R-squared:  0.8356 
## F-statistic: 131.5 on 3 and 74 DF,  p-value: < 2.2e-16

Conclusión

Basado en los coefficientes del modelo final es evidente decir que el ingreso per cápita de los habitantes de los municipios está significativamente relacionado de manera (+) al % de personas con bachillerator o alta educación, al igual que el % de personas con acceso al internet. Por el otro lado, de manera (-) pero significativamente relacionado el % de nivel de pobreza. Se puede decir que es importante para los habitantes de Puerto Rico poder recibir una buena educación, un buen acceso al internet y calidad de vida para poder aumentar su ingreso a lo largo del tiempo.