Tarea 3
Ángel Serrano, Isabela Puga
2025-09-18
Modelos BIC y R^2 ajustado
library(readr)
data_rlm <- read_csv("data_rlm.csv")## Rows: 78 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): municipio
## dbl (6): ing_pc, bach_pct, desem_pct, banda_pct, pobreza_pct, tam_hogar
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.library(leaps)
paso_log <- data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$desem_pct + data_rlm$banda_pct + data_rlm$pobreza_pct + data_rlm$tam_hogar
data_num= data_rlm[,-1]
ajuste <- regsubsets(
paso_log, data = data_num,
nvmax = 5,
method = "exhaustive")
s <- summary(ajuste)
names(s)## [1] "which" "rsq" "rss" "adjr2" "cp" "bic" "outmat" "obj"Escoger las mejores variables
best_bic <- which.min(s$bic)
best_r2 <- which.max(s$adjr2)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")
Selección de las mejores variables para BIC
coef_best <- coef(ajuste, best_bic)
vars_best <- names(coef_best)[-1]Modelo Final
f_final <- as.formula(paste("ing_pc ~", paste(vars_best, collapse = " + ")))
modelo_final <- lm(f_final, data = data_num)
summary(modelo_final)##
## Call:
## lm(formula = f_final, data = data_num)
##
## 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 *
## data_rlm$bach_pct 270.45 67.62 3.999 0.000149 ***
## data_rlm$banda_pct 119.54 44.32 2.697 0.008657 **
## data_rlm$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-16Selección de las mejores variables para R^2
coef_best <- coef(ajuste, best_r2)
vars_best <- names(coef_best)[-1]
f_final2 <- as.formula(paste("ing_pc ~", paste(vars_best, collapse = " + ")))
modelo_final2 <- lm(f_final2, data = data_num)
summary(modelo_final2)##
## Call:
## lm(formula = f_final2, data = data_num)
##
## 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
## data_rlm$bach_pct 267.16 67.36 3.966 0.000169 ***
## data_rlm$banda_pct 123.03 44.21 2.783 0.006848 **
## data_rlm$pobreza_pct -209.38 47.15 -4.441 3.12e-05 ***
## data_rlm$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-16Gráficas
library(corrplot)## corrplot 0.95 loadedRlog <- cor(data_num, use = "pairwise.complete.obs")
corrplot(Rlog,
method = "color",
type = "lower",
addCoef.col = "black",
tl.col = "black",
tl.srt = 45,
diag = FALSE)
paso_log <- data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$desem_pct + data_rlm$banda_pct + data_rlm$pobreza_pct + data_rlm$tam_hogarModelo Nulo y Saturado
m0_log= lm(data_rlm$ing_pc~ 1 , data=data_num)
mF_log= lm(paso_log,data=data_num)Hacia Adelante
m1_foward <- step(m0_log,
scope = list(lower = ~1, upper = formula(mF_log)),
direction = "forward",
k = log(nrow(data_num)),
trace = TRUE)## Start: AIC=1328.25
## data_rlm$ing_pc ~ 1
##
## Df Sum of Sq RSS AIC
## + data_rlm$bach_pct 1 1438089133 395800604 1213.0
## + data_rlm$pobreza_pct 1 1331610382 502279355 1231.6
## + data_rlm$banda_pct 1 1121735582 712154155 1258.8
## <none> 1833889736 1328.2
## + data_rlm$desem_pct 1 8354792 1825534944 1332.2
## + data_rlm$tam_hogar 1 5821235 1828068502 1332.4
##
## Step: AIC=1213.01
## data_rlm$ing_pc ~ data_rlm$bach_pct
##
## Df Sum of Sq RSS AIC
## + data_rlm$pobreza_pct 1 77610119 318190485 1200.3
## + data_rlm$banda_pct 1 29535087 366265517 1211.3
## <none> 395800604 1213.0
## + data_rlm$tam_hogar 1 4923053 390877551 1216.4
## + data_rlm$desem_pct 1 2817657 392982947 1216.8
##
## Step: AIC=1200.34
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$pobreza_pct
##
## Df Sum of Sq RSS AIC
## + data_rlm$banda_pct 1 28478762 289711723 1197.4
## <none> 318190485 1200.3
## + data_rlm$tam_hogar 1 4915101 313275383 1203.5
## + data_rlm$desem_pct 1 672748 317517737 1204.5
##
## Step: AIC=1197.39
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$pobreza_pct +
## data_rlm$banda_pct
##
## Df Sum of Sq RSS AIC
## <none> 289711723 1197.4
## + data_rlm$tam_hogar 1 6489907 283221816 1200.0
## + data_rlm$desem_pct 1 17073 289694650 1201.7Hacia Atrás
M2_back =step(mF_log ,direction = "backward" , k = log(nrow(data_num)), trace = TRUE)## Start: AIC=1204.26
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$desem_pct + data_rlm$banda_pct +
## data_rlm$pobreza_pct + data_rlm$tam_hogar
##
## Df Sum of Sq RSS AIC
## - data_rlm$desem_pct 1 282063 283221816 1200.0
## - data_rlm$tam_hogar 1 6754897 289694650 1201.7
## <none> 282939753 1204.3
## - data_rlm$banda_pct 1 30072895 313012647 1207.8
## - data_rlm$bach_pct 1 58048450 340988202 1214.5
## - data_rlm$pobreza_pct 1 76685336 359625088 1218.6
##
## Step: AIC=1199.98
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$banda_pct + data_rlm$pobreza_pct +
## data_rlm$tam_hogar
##
## Df Sum of Sq RSS AIC
## - data_rlm$tam_hogar 1 6489907 289711723 1197.4
## <none> 283221816 1200.0
## - data_rlm$banda_pct 1 30053567 313275383 1203.5
## - data_rlm$bach_pct 1 61021640 344243456 1210.8
## - data_rlm$pobreza_pct 1 76514196 359736013 1214.3
##
## Step: AIC=1197.39
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$banda_pct + data_rlm$pobreza_pct
##
## Df Sum of Sq RSS AIC
## <none> 289711723 1197.4
## - data_rlm$banda_pct 1 28478762 318190485 1200.3
## - data_rlm$bach_pct 1 62624091 352335814 1208.3
## - data_rlm$pobreza_pct 1 76553794 366265517 1211.3Híbrido
M3_both =step(m0_log,scope=list(lower= ~1, upper = formula(mF_log)),direction = "both" , k = log(nrow(data_num)), trace = TRUE)## Start: AIC=1328.25
## data_rlm$ing_pc ~ 1
##
## Df Sum of Sq RSS AIC
## + data_rlm$bach_pct 1 1438089133 395800604 1213.0
## + data_rlm$pobreza_pct 1 1331610382 502279355 1231.6
## + data_rlm$banda_pct 1 1121735582 712154155 1258.8
## <none> 1833889736 1328.2
## + data_rlm$desem_pct 1 8354792 1825534944 1332.2
## + data_rlm$tam_hogar 1 5821235 1828068502 1332.4
##
## Step: AIC=1213.01
## data_rlm$ing_pc ~ data_rlm$bach_pct
##
## Df Sum of Sq RSS AIC
## + data_rlm$pobreza_pct 1 77610119 318190485 1200.3
## + data_rlm$banda_pct 1 29535087 366265517 1211.3
## <none> 395800604 1213.0
## + data_rlm$tam_hogar 1 4923053 390877551 1216.4
## + data_rlm$desem_pct 1 2817657 392982947 1216.8
## - data_rlm$bach_pct 1 1438089133 1833889736 1328.2
##
## Step: AIC=1200.34
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$pobreza_pct
##
## Df Sum of Sq RSS AIC
## + data_rlm$banda_pct 1 28478762 289711723 1197.4
## <none> 318190485 1200.3
## + data_rlm$tam_hogar 1 4915101 313275383 1203.5
## + data_rlm$desem_pct 1 672748 317517737 1204.5
## - data_rlm$pobreza_pct 1 77610119 395800604 1213.0
## - data_rlm$bach_pct 1 184088870 502279355 1231.6
##
## Step: AIC=1197.39
## data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$pobreza_pct +
## data_rlm$banda_pct
##
## Df Sum of Sq RSS AIC
## <none> 289711723 1197.4
## + data_rlm$tam_hogar 1 6489907 283221816 1200.0
## - data_rlm$banda_pct 1 28478762 318190485 1200.3
## + data_rlm$desem_pct 1 17073 289694650 1201.7
## - data_rlm$bach_pct 1 62624091 352335814 1208.3
## - data_rlm$pobreza_pct 1 76553794 366265517 1211.3Paso a Paso : Resumen
summary(m1_foward)##
## Call:
## lm(formula = data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$pobreza_pct +
## data_rlm$banda_pct, data = data_num)
##
## 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 *
## data_rlm$bach_pct 270.45 67.62 3.999 0.000149 ***
## data_rlm$pobreza_pct -209.43 47.36 -4.422 3.3e-05 ***
## data_rlm$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-16summary(M2_back)##
## Call:
## lm(formula = data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$banda_pct +
## data_rlm$pobreza_pct, data = data_num)
##
## 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 *
## data_rlm$bach_pct 270.45 67.62 3.999 0.000149 ***
## data_rlm$banda_pct 119.54 44.32 2.697 0.008657 **
## data_rlm$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-16summary(M3_both)##
## Call:
## lm(formula = data_rlm$ing_pc ~ data_rlm$bach_pct + data_rlm$pobreza_pct +
## data_rlm$banda_pct, data = data_num)
##
## 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 *
## data_rlm$bach_pct 270.45 67.62 3.999 0.000149 ***
## data_rlm$pobreza_pct -209.43 47.36 -4.422 3.3e-05 ***
## data_rlm$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¿Qué modelo es mejor y por qué?
En términos de ajuste estadístico, el modelo por subgrupos presenta un mejor desempeño para los datos estudiados, dado a que tiene un R² ajustado ligeramente superior cuando se utiliza este indicador como criterio principal de evaluación.Sin embargo, desde una perspectiva práctica, el modelo paso a paso demuestra mayor eficiencia operativa debido a su proceso más simplificado y directo. Cabe mencionar que la diferencia fue mínima, y ambos modelos determinaron que las variables de desempleo y tamaño del hogar son insignificantes para medir el ingreso per cápita.
Intepretación de los coeficientes del modelo final
Los coeficientes del modelo R^2 ajustado se pueden interpretar de la siguiente manera: Intercepto: El promedio del ingreso sin tomar en consideración las variables respuesta es $4,047.29. Por cada bachillerato adicional en el porcentaje de las casas de Puerto Rico, el ingreso per cápita aumenta $267.16. Por cada casa con banda ancha, por porcentaje, en Puerto Rico, el ingreso per cápita aumenta $123.03. Por el nivel de pobreza en cada casa en porcentaje en Puerto Rico, el ingreso per cápita disminuye $209.38. No se toma en consideración la data del tamaño en los hogares porque no es significante (el p valor>0.05).
Los coeficientes del modelo BIC se pueden interpretar de la siguiente manera:
Basado en el modelo estadístico paso a paso desarrollado, se identificaron patrones significativos en los factores que influyen en el ingreso per cápita de los municipios de Puerto Rico. El modelo establece un ingreso per cápita promedio de $6,481.30 para los municipios estudiados.Cada punto porcentual adicional de población con bachillerato o más se asocia con un incremento de $270.45 en el ingreso per cápita. El acceso a internet de banda ancha también muestra un impacto positivo, con un aumento de $119.54 por cada punto porcentual de hogares conectados.Cada punto porcentual adicional de población bajo el nivel de pobreza resulta en una disminución de $209.43 en el ingreso per cápita
Conclusión general
El análisis revela que la educación representa el factor más influyente en el aumento del ingreso per cápita municipal. Por el contrario, la pobreza emerge como el principal factor limitante, que incluso presenta una correlación negativa fuerte con el nivel educativo y el acceso limitado a internet de banda ancha. En conclusión, el modelo demuestra que la educación actúa como el principal motor de crecimiento económico municipal en Puerto Rico, mientras que la pobreza representa la barrera más significativa. Esta dinámica sugiere que las políticas públicas enfocadas en mejorar el acceso y la calidad educativa podrían tener efectos multiplicadores positivos en la calidad de vida y el desarrollo económico de los municipios.