pacman::p_load(readr, readxl,knitr, kableExtra, MASS, ggcorrplot)

Cargamos bases de datos

dibas = "D:/Centro_geo/C02_SIG/proyecto_final/"

# Cargar la base de datos principal
bd <- read_csv(paste0(dibas,"c01_exploracion_datos/analisis_r/bd_ent_socioeconomico_2020.csv"),show_col_types = FALSE)

# Cargar el diccionario de variables
dic_bd <- read_csv(paste0(dibas,"c01_exploracion_datos/analisis_r/diccionario_bd.csv"),show_col_types = FALSE)
# Mostrar la tabla de la base de datos principal
kable(head(bd), format = "html", table.attr = "style='width:100%;'") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F) %>%
  scroll_box(width = "100%", height = "400px")
aa_cen aa_cve_ent aa_pobtot20 al_caal al_paal cs_cgin cs_ring cv_ccvi cv_pcvi cv_vhac ga_plm5 ga_porb pz_cpbr i_cpex i_cpmo i_crze i_inma pz_inmn i_irsl i_pnnv pz_pobr pz_ppbr i_ppex ip_pvin ie_nesc ip_pism ip_inc ip_int ip_pibc ip_pibe re_p15a re_p15b re_p15m re_p6ae re_pana re_pse re_psp re_ptot sb_csbv sb_psbv sb_pvae sb_pvdd sb_pvdi sb_pvdl sb_pvdr sb_pvdt sb_pvee sb_pves sb_pvpt se_c1cs se_c3cs se_cass ss_casa se_cvcs se_p1cs se_p3cs ss_pasa se_pass ss_psds se_pvcl se_pvcs se_pvdc ie_pcom ie_pint ie_pele ie_pagu ie_psan ed_phind ed_pasi ed_crean ed_esex ed_desp
AGU 1 1425607 2.1 17.4 0.4 0.8 2.6 4.0 13.1 21.3 0.17 1.8 3.3 1.7 2.2 22.2 0.8 0.2 33.4 392042 27.5 2.7 9.4 2302 58.5 3.028 4316774 142703 204726 2.1 23.5 1059395 5.0 21833 68530 159005 249368 3.1 2.1 0.6 0.6 38.9 13.0 5.4 4.0 0.3 0.6 0.8 1.7 3.2 1.9 2.4 1.6 57.3 9.1 20.2 42.7 18.4 54.1 29.7 6.8 64.025 74.025 74.425 72.400 70.400 0.0 73.60 0.40 1.900 5.733333
BCN 2 3769020 2.2 12.7 0.4 0.5 2.4 6.8 14.6 8.5 0.73 1.9 3.4 1.8 2.2 21.4 0.8 0.4 31.7 870644 23.1 1.7 6.4 4554 73.6 2.323 8755674 152317 553650 1.8 24.6 2949750 6.5 52736 199904 470015 722655 2.7 5.0 2.1 3.5 30.1 17.3 5.1 6.4 0.8 0.7 2.0 1.8 3.3 1.9 2.4 1.7 61.9 10.0 24.0 46.9 22.2 49.6 38.8 5.6 73.200 73.700 73.775 67.575 65.400 1.3 74.32 -0.78 1.925 5.366667
BCS 3 798447 2.2 22.7 0.4 0.9 2.7 11.4 18.6 10.3 9.05 2.1 3.6 1.9 2.4 21.5 0.8 0.4 31.8 218774 27.4 3.5 7.0 1336 45.5 2.257 1802259 151590 121986 2.3 23.9 618726 4.2 14089 41905 90080 146074 3.0 9.4 5.0 2.6 37.9 31.5 8.2 10.5 1.2 1.3 4.7 1.9 3.4 2.1 2.6 1.7 61.2 13.1 17.4 40.4 16.2 54.5 33.9 5.4 65.850 67.800 73.075 68.450 63.400 0.1 77.40 0.18 1.650 5.333333
CAM 4 928363 2.9 24.5 0.5 6.0 3.3 13.5 30.0 29.9 1.72 2.5 3.5 2.1 3.0 17.8 0.7 0.9 20.0 450256 48.5 11.9 6.3 2274 70.0 2.514 2334258 481697 481995 5.9 29.7 694979 6.4 39910 66664 100167 206741 2.9 33.5 4.0 5.1 56.2 22.7 16.0 13.1 1.4 3.6 2.7 2.3 3.4 2.5 2.9 1.9 73.7 28.0 21.0 58.4 21.9 66.3 25.2 16.1 49.875 44.850 73.550 67.925 64.425 2.9 76.16 -1.16 2.525 6.166667
COA 5 3146771 2.1 15.2 0.4 0.9 2.5 2.8 13.5 10.0 0.90 1.9 3.3 1.8 2.0 22.5 0.8 0.2 38.5 742638 23.6 2.3 11.3 5513 60.0 4.011 12621481 166389 535558 1.7 21.3 2359455 5.0 38298 124955 351877 515130 2.8 3.2 1.0 1.2 42.3 13.4 3.3 4.1 0.3 0.7 0.8 1.8 3.3 2.0 2.4 1.6 50.2 8.4 21.6 34.0 19.0 59.1 26.6 8.4 56.800 56.050 73.450 60.500 45.750 0.0 74.92 0.08 2.325 5.200000
COL 6 731391 2.3 16.6 0.4 0.7 2.7 7.4 15.3 13.5 0.31 2.0 3.5 1.8 2.3 21.5 0.8 0.5 31.0 203327 27.8 2.7 6.5 1480 59.7 1.953 1428050 128953 101248 3.4 27.7 567729 6.0 18792 49976 89670 158438 2.9 7.9 0.7 0.5 41.5 24.8 6.6 8.7 0.5 0.8 2.5 1.8 3.4 2.0 2.5 1.7 62.5 11.6 19.0 47.0 16.8 60.2 34.7 8.7 63.200 67.075 73.325 72.775 68.100 0.1 77.32 -0.20 4.450 5.433333 
# Mostrar la tabla del diccionario de variables
kable(head(dic_bd), format = "html", table.attr = "style='width:100%;'") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F) %>%
  scroll_box(width = "100%", height = "400px")
aspectos criterio variable descripcion
derechos sociales alimentacion al_caal Carencias promedio en carencia por acceso a la alimentación
derechos sociales alimentacion al_paal Porcentaje de poblacion en carencia por acceso a la alimentación
derechos sociales calidad y espacios vivienda cv_ccvi Carencias promedio en carencia por calidad y espacios de la vivienda
derechos sociales calidad y espacios vivienda cv_pcvi Porcentaje de poblacion carencia por calidad y espacios de la vivienda
derechos sociales calidad y espacios vivienda cv_vhac % Viviendas particulares con hacinamiento
clave clave aa_cen Clave 3 letras de entidad

Objetivo 1:

Aqui se genera una matriz de correlacion por CRITERIO, primero definimos dentro de las variables de la variable de rezago educativo, cual es la mas viable, adicionalmente como ya corrimos el stepwise seleccionamos para representar el rezago la varible re_ptot = Poblacion con rezago eduactivo.

# Filtrar las variables del diccionario por criterio
var_rezg <- dic_bd$variable[dic_bd$criterio %in% c("rezago educativo")]

# Crear una base de datos filtrada con estas variables
bd_rezg <- bd[, var_rezg]

# Calcular la matriz de correlacion
mc_rezg <- cor(bd_rezg, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_rezg, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Rezago Educativo",
           colors = c("blue", "white", "red"))

Una vez seleccionada esta variable, se corre la matriz para cada criterio y se selecciona dentro de cada criterio la variable con mayor correlacion a re_ptot.

# Filtrar las variables por criterio
variables_alimentacion <- dic_bd$variable[dic_bd$criterio == "alimentacion"]

# Crear una base de datos filtrada con las variables de alimentacion y re_ptot
bd_filtro <- bd[, c(variables_alimentacion, "re_ptot")]

# Calcular la matriz de correlacion
matriz_correlacion <- cor(bd_filtro, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(matriz_correlacion, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Alimentacion vs re_ptot",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_espacios <- dic_bd$variable[dic_bd$criterio == "calidad y espacios vivienda"]

# Crear una base de datos filtrada con las variables de alimentacion y re_ptot
bd_cev <- bd[, c(var_espacios, "re_ptot")]

# Calcular la matriz de correlacion
mc_cev <- cor(bd_cev, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_cev, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Calidad y vivienda y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_cs <- dic_bd$variable[dic_bd$criterio == "cohesion social"]

# Crear una base de datos filtrada con estas variables
bd_cs <- bd[, c(var_cs, "re_ptot")]

# Calcular la matriz de correlacion
mc_cs <- cor(bd_cs, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_cs, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Cohesion social y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_gdcap <- dic_bd$variable[dic_bd$criterio == "grado accesibilidad"]

# Crear una base de datos filtrada con estas variables
bd_gd <- bd[, c(var_gdcap, "re_ptot")]

# Calcular la matriz de correlacion
mc_gd <- cor(bd_gd, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_gd, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Grado accesibilidad y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_inper <- dic_bd$variable[dic_bd$criterio == "ingreso per capita"]

# Crear una base de datos filtrada con estas variables
bd_inper <- bd[, c(var_inper, "re_ptot")]

# Calcular la matriz de correlacion
mc_inper <- cor(bd_inper, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_inper, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Ingreso y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_pbrz <- dic_bd$variable[dic_bd$criterio == "pobreza"]

# Crear una base de datos filtrada con estas variables
bd_pbrz <- bd[, c(var_pbrz, "re_ptot")]

# Calcular la matriz de correlacion
mc_pbrz <- cor(bd_pbrz, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_pbrz, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Pobreza y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_seg <- dic_bd$variable[dic_bd$criterio == "seguridad social"]

# Crear una base de datos filtrada con estas variables
bd_seg <- bd[, c(var_seg, "re_ptot")]

# Calcular la matriz de correlacion
mc_seg <- cor(bd_seg, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_seg, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Seguridad social y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_sv <- dic_bd$variable[dic_bd$criterio == "servicios basicos vivienda"]

# Crear una base de datos filtrada con estas variables
bd_sv <- bd[, c(var_sv, "re_ptot")]

# Calcular la matriz de correlacion
mc_sv <- cor(bd_sv, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_sv, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Servicios basicos vivienda y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_sal <- dic_bd$variable[dic_bd$criterio == "servicios de salud"]

# Crear una base de datos filtrada con estas variables
bd_sal <- bd[, c(var_sal, "re_ptot")]

# Calcular la matriz de correlacion
mc_sal <- cor(bd_sal, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_sal, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Servicios salud y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_infra <- dic_bd$variable[dic_bd$criterio == "infraestructura educativa"]

# Crear una base de datos filtrada con estas variables
bd_infra <- bd[, c(var_infra, "re_ptot")]

# Calcular la matriz de correlacion
mc_infra <- cor(bd_infra, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_infra, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Infraestructura y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Filtrar las variables
var_edu <- dic_bd$variable[dic_bd$criterio == "educativo"]

# Crear una base de datos filtrada con estas variables
bd_edu <- bd[, c(var_edu, "re_ptot")]

# Calcular la matriz de correlacion
mc_edu <- cor(bd_edu, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(mc_edu, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma: Eduacion y Rezago Educativo",
           colors = c("blue", "white", "red"))

# Seleccionar las variables especificas
variables_correlacion <- c("re_ptot", "al_caal", "cv_ccvi", "cs_ring", 
                           "ga_porb", "ip_pibe", "pz_pobr", 
                           "se_pvcs", "sb_pvdr", "ss_pasa", "ie_nesc", "ed_phind")

# Filtrar las variables de interes en la base de datos
bd_filtro <- bd[, variables_correlacion]

# Calcular la matriz de correlacion
matriz_correlacion <- cor(bd_filtro, use = "pairwise.complete.obs")

# Generar el correlograma
ggcorrplot(matriz_correlacion, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma variables socioeconomicas vs rezago educativo",
           colors = c("red", "white", "blue"))

Objetivo 2

Una vez que se tienen las variables por criterio con mayor correlacion para predecir el rezago educativo, entonces se identifica cual es la significancia estadistica en terminos de valor de p mediante el stepwise. El stepwise es una tecnica para la seleccion de variables en modelos de regresion. Su objetivo es encontrar un conjunto optimo de variables predictoras, eliminando aquellas que no aportan significativamente al modelo. El valor de p indica la probabilidad de obtener los resultados observados si la variable realmente no tuviera ningun efecto (es decir, si la hipotesis nula fuera verdadera).

# Preparar el modelo inicial (modelo nulo) y completo
modelo_nulo <- lm(re_ptot  ~ 1, data = bd) 

# Ajustar el modelo completo de regresian lineal
modelo_completo <- lm(re_ptot ~ 
                        al_caal  + cv_ccvi + cs_ring + 
                        ga_porb  + ip_pibe + se_pvcs + 
                        sb_pvdr  + ss_pasa + ie_nesc + 
                        ed_phind, data = bd)

# Mostrar un resumen del modelo
summary(modelo_completo)
## 
## Call:
## lm(formula = re_ptot ~ al_caal + cv_ccvi + cs_ring + ga_porb + 
##     ip_pibe + se_pvcs + sb_pvdr + ss_pasa + ie_nesc + ed_phind, 
##     data = bd)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -184997  -61440   -3848   64573  252361 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -8.700e+04  3.491e+05  -0.249   0.8056    
## al_caal     -6.050e+04  2.025e+05  -0.299   0.7681    
## cv_ccvi     -1.087e+05  1.703e+05  -0.638   0.5301    
## cs_ring      1.801e+03  7.292e+03   0.247   0.8073    
## ga_porb     -1.471e+04  1.015e+04  -1.449   0.1621    
## ip_pibe      1.271e-01  6.007e-02   2.115   0.0465 *  
## se_pvcs      5.973e+03  7.166e+03   0.834   0.4139    
## sb_pvdr      1.322e+04  7.671e+03   1.724   0.0994 .  
## ss_pasa      8.415e+03  7.669e+03   1.097   0.2849    
## ie_nesc      1.223e+02  7.405e+00  16.513 1.66e-13 ***
## ed_phind    -1.888e+04  1.171e+04  -1.613   0.1218    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 129800 on 21 degrees of freedom
## Multiple R-squared:  0.9787, Adjusted R-squared:  0.9686 
## F-statistic: 96.58 on 10 and 21 DF,  p-value: 3.011e-15
# Aplicar la seleccion stepwise
modelo_stepwise <- step(modelo_nulo, 
                        scope = list(lower = modelo_nulo, upper = modelo_completo), 
                        direction = "both")  # "both" para hacia adelante y hacia atras
## Start:  AIC=865.23
## re_ptot ~ 1
## 
##            Df  Sum of Sq        RSS    AIC
## + ie_nesc   1 1.5182e+13 1.4383e+12 788.92
## + ss_pasa   1 7.3925e+12 9.2277e+12 848.40
## + ip_pibe   1 4.2704e+12 1.2350e+13 857.73
## + se_pvcs   1 3.1704e+12 1.3450e+13 860.46
## + al_caal   1 2.9619e+12 1.3658e+13 860.95
## + sb_pvdr   1 1.8782e+12 1.4742e+13 863.39
## + cs_ring   1 1.8499e+12 1.4770e+13 863.45
## + ed_phind  1 1.5620e+12 1.5058e+13 864.07
## + cv_ccvi   1 1.3578e+12 1.5262e+13 864.50
## + ga_porb   1 1.1573e+12 1.5463e+13 864.92
## <none>                   1.6620e+13 865.23
## 
## Step:  AIC=788.92
## re_ptot ~ ie_nesc
## 
##            Df  Sum of Sq        RSS    AIC
## + ga_porb   1 8.7721e+11 5.6106e+11 760.80
## + ed_phind  1 7.7809e+11 6.6018e+11 766.00
## + ip_pibe   1 5.4821e+11 8.9006e+11 775.56
## + cs_ring   1 4.9271e+11 9.4557e+11 777.50
## + cv_ccvi   1 4.3672e+11 1.0016e+12 779.34
## + al_caal   1 4.2478e+11 1.0135e+12 779.72
## + sb_pvdr   1 2.9451e+11 1.1438e+12 783.59
## <none>                   1.4383e+12 788.92
## + se_pvcs   1 1.0465e+10 1.4278e+12 790.69
## + ss_pasa   1 4.6936e+09 1.4336e+12 790.81
## - ie_nesc   1 1.5182e+13 1.6620e+13 865.23
## 
## Step:  AIC=760.8
## re_ptot ~ ie_nesc + ga_porb
## 
##            Df  Sum of Sq        RSS    AIC
## + ip_pibe   1 7.8316e+10 4.8274e+11 757.98
## <none>                   5.6106e+11 760.80
## + ed_phind  1 2.6788e+10 5.3427e+11 761.23
## + cv_ccvi   1 2.6257e+10 5.3480e+11 761.26
## + al_caal   1 1.7521e+10 5.4354e+11 761.78
## + ss_pasa   1 1.1140e+10 5.4992e+11 762.15
## + cs_ring   1 6.8602e+09 5.5420e+11 762.40
## + se_pvcs   1 1.9339e+09 5.5913e+11 762.69
## + sb_pvdr   1 4.8505e+07 5.6101e+11 762.79
## - ga_porb   1 8.7721e+11 1.4383e+12 788.92
## - ie_nesc   1 1.4902e+13 1.5463e+13 864.92
## 
## Step:  AIC=757.98
## re_ptot ~ ie_nesc + ga_porb + ip_pibe
## 
##            Df  Sum of Sq        RSS    AIC
## <none>                   4.8274e+11 757.98
## + ss_pasa   1 1.9983e+10 4.6276e+11 758.63
## + ed_phind  1 1.8241e+10 4.6450e+11 758.75
## + sb_pvdr   1 6.3197e+09 4.7643e+11 759.56
## + cv_ccvi   1 5.8839e+09 4.7686e+11 759.59
## + al_caal   1 4.0742e+09 4.7867e+11 759.71
## + se_pvcs   1 2.1856e+09 4.8056e+11 759.84
## + cs_ring   1 1.9469e+09 4.8080e+11 759.86
## - ip_pibe   1 7.8316e+10 5.6106e+11 760.80
## - ga_porb   1 4.0732e+11 8.9006e+11 775.56
## - ie_nesc   1 8.9948e+12 9.4775e+12 851.25
# Resumen del modelo stepwise
summary(modelo_stepwise)
## 
## Call:
## lm(formula = re_ptot ~ ie_nesc + ga_porb + ip_pibe, data = bd)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -228316  -89529   -9312   72305  304714 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -5.782e+04  4.367e+04  -1.324    0.196    
## ie_nesc      1.246e+02  5.454e+00  22.841  < 2e-16 ***
## ga_porb     -2.826e+04  5.814e+03  -4.861 4.06e-05 ***
## ip_pibe      1.176e-01  5.517e-02   2.131    0.042 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 131300 on 28 degrees of freedom
## Multiple R-squared:  0.971,  Adjusted R-squared:  0.9678 
## F-statistic:   312 on 3 and 28 DF,  p-value: < 2.2e-16
# Variables seleccionadas
modelo_stepwise$coefficients
##   (Intercept)       ie_nesc       ga_porb       ip_pibe 
## -5.781537e+04  1.245739e+02 -2.825792e+04  1.175775e-01
# Extraer los nombres de las variables seleccionadas en el modelo stepwise
variables_seleccionadas <- names(coef(modelo_stepwise))[-1]  # Excluye el intercepto

# Filtrar las descripciones correspondientes en dic_bd
descripciones <- dic_bd[dic_bd$variable %in% variables_seleccionadas, c("variable", "descripcion")]

# Mostrar la tabla en un formato mas legible
kable(descripciones, format = "html", table.attr = "style='width:100%;'") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F) %>%
  scroll_box(width = "100%", height = "300px")
variable descripcion
ga_porb Porcentaje de población con GACP bajo o muy bajo
ie_nesc Numero de escuelas por estado
ip_pibe Producto interno bruto por estado 
# Generar predicciones del modelo
predicciones <- predict(modelo_stepwise)

# Crear el grafico: valores reales vs predicciones
plot(bd$re_ptot, predicciones, 
     main = "Prediccion vs Valores Observados", 
     xlab = "Valores Observados (re_ptot)", 
     ylab = "Valores Predichos", 
     col = "blue", 
     pch = 20)
abline(0, 1, col = "red")  # Linea de referencia

# Filtrar la base de datos para incluir solo las variables seleccionadas
var_sel <- bd[, variables_seleccionadas]

# Calcular la matriz de correlacion
mc_rez <- round(cor(var_sel, use = "pairwise.complete.obs"),2)

# Generar el correlograma
ggcorrplot(mc_rez, 
           type = "lower", 
           lab = TRUE, 
           title = "Correlograma variables signficativas vs rezago educativo",
           colors = c("red", "white", "blue"))

# Guardar la matriz en un archivo para futuras consultas
#write.csv(mc_rez, paste0(dibas, "rezago_matriz_correlacion.csv"))