Tarea 1 Regresion Lineal
Felipe Salinas Pereda, Felipe Maceiras Vera
2026-05-28
Preparación y Construcción de Datos
# ==============================================================================
# TAREA 1 - REGRESION Felipe Salinas Pereda , Felipe Maceiras Vera
# ==============================================================================
# Carga de librerías
library(arrow) # Consultar y gestionar bases de datos grandes
library(tidyverse) # Manipulación de datos (filtrar, seleccionar, unir)
library(janitor) # Tablas de frecuencias y redondeos
library(leaps) # Selección de subconjuntos y Cp de Mallows
library(olsrr) # Herramientas adicionales para regresión
library(car) # Análisis de multicolinealidad (VIF)
library(glmnet) # Regularización Ridge y LASSO
library(lmtest) # Test de heterocedasticidad (Breusch-Pagan)
# 1. Carga de datos Censo 2024
personas_censo <- arrow::open_dataset("C:/Users/Francisca/Desktop/Tarea 1 Regresion/personas_censo2024.parquet")
viviendas_censo <- arrow::open_dataset("C:/Users/Francisca/Desktop/Tarea 1 Regresion/viviendas_censo2024.parquet")
hogares_censo <- arrow::open_dataset("C:/Users/Francisca/Desktop/Tarea 1 Regresion/hogares_censo2024.parquet")
# 2. Construcción de datos areales por comuna (Regiones 8, 9 y 16)
base_modelo <- personas_censo %>%
filter(region %in% c(8, 9, 16)) %>%
filter(tipo_operativo == 2) %>%
left_join(viviendas_censo, by = "id_vivienda") %>%
left_join(hogares_censo, by = c("id_vivienda", "id_hogar")) %>%
# Creación de variables
mutate(
esc_valida = if_else(escolaridad >= 0, escolaridad, NA_real_),
ind_internet = if_else(p15d_serv_internet_fija == 1, 1, if_else(p15d_serv_internet_fija == 2, 0, NA_real_)),
ind_computador = if_else(p15b_serv_compu == 1, 1, if_else(p15b_serv_compu == 2, 0, NA_real_)),
ind_migrante = if_else(p27_nacionalidad == 3, 1, if_else(p27_nacionalidad %in% c(1, 2), 0, NA_real_)),
edad_valida = if_else(edad >= 0, edad, NA_real_),
ind_hacinamiento = if_else(indice_hacinamiento %in% c(2, 3), 1, if_else(indice_hacinamiento == 1, 0, NA_real_)),
ind_indigena = if_else(p28_autoid_pueblo == 1, 1, if_else(p28_autoid_pueblo == 2, 0, NA_real_)),
ind_desocupacion = if_else(sit_fuerza_trabajo == 2, 1, if_else(sit_fuerza_trabajo == 1, 0, NA_real_)),
ind_discapacidad = if_else(discapacidad == 1, 1, if_else(discapacidad == 2, 0, NA_real_)),
ind_urbano = if_else(area == 1, 1, if_else(area == 2, 0, NA_real_))
) %>%
# comuna como unidad de análisis
group_by(comuna) %>%
summarise(
n_personas = n(),
Y_escolaridad = mean(esc_valida, na.rm = TRUE),
X1_internet = mean(ind_internet, na.rm = TRUE) * 100,
X2_computador = mean(ind_computador, na.rm = TRUE) * 100,
X3_migrante = mean(ind_migrante, na.rm = TRUE) * 100,
X4_edad_prom = mean(edad_valida, na.rm = TRUE),
X5_hacinamiento = mean(ind_hacinamiento, na.rm = TRUE) * 100,
X6_indigena = mean(ind_indigena, na.rm = TRUE) * 100,
X7_desocupacion = mean(ind_desocupacion, na.rm = TRUE) * 100,
X8_discapacidad = mean(ind_discapacidad, na.rm = TRUE) * 100,
pct_urbano_interno = mean(ind_urbano, na.rm = TRUE) * 100,
.groups = "drop"
) %>%
collect() %>%
# Formato final de variables (Factores y redondeo)
mutate(
X9_territorio = factor(if_else(pct_urbano_interno >= 50, "Urbana", "Rural"))
) %>%
mutate(across(where(is.numeric), ~ round_half_up(.x , 2))) %>%
select(-pct_urbano_interno)Ítem 1: Ajuste del Modelo de Regresión Inicial
# ==============================================================================
# ÍTEM 1: AJUSTE DEL MODELO DE REGRESIÓN INICIAL
# ==============================================================================
modelo_inicial <- lm(Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
X4_edad_prom + X5_hacinamiento + X6_indigena +
X7_desocupacion + X8_discapacidad + X9_territorio,
data = base_modelo)
summary(modelo_inicial)##
## Call:
## lm(formula = Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
## X4_edad_prom + X5_hacinamiento + X6_indigena + X7_desocupacion +
## X8_discapacidad + X9_territorio, data = base_modelo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.39286 -0.13362 0.00424 0.11099 0.34075
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.702099 0.855278 4.329 5.05e-05 ***
## X1_internet 0.004308 0.002625 1.641 0.105336
## X2_computador 0.052033 0.007071 7.359 3.19e-10 ***
## X3_migrante 0.237138 0.037296 6.358 1.99e-08 ***
## X4_edad_prom 0.080010 0.016988 4.710 1.27e-05 ***
## X5_hacinamiento -0.041273 0.016631 -2.482 0.015554 *
## X6_indigena 0.006257 0.001612 3.882 0.000237 ***
## X7_desocupacion 0.011048 0.010640 1.038 0.302753
## X8_discapacidad -0.040684 0.015675 -2.595 0.011564 *
## X9_territorioUrbana 0.089026 0.065923 1.350 0.181346
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1767 on 68 degrees of freedom
## (8 observations deleted due to missingness)
## Multiple R-squared: 0.9585, Adjusted R-squared: 0.953
## F-statistic: 174.6 on 9 and 68 DF, p-value: < 2.2e-16El modelo de regresion lineal logra un R2-ajustado de 0.9530, con una significancia alta, lo cual confirma que las variables predicen la respuesta. Al analizar cada variable, se observa que la presencia de computadores, porcentaje de poblacion migrante, edad promedio y poblacion indigena tiene un impacto positivo y altamente significativo al momento de predecir, por otro lado, el hacinamiento y discapacidad muestran un efecto negativo y significativo. mientras que variables como acceso a internet fijo, tasa de desocupacion y el tipo de territorio (urbano/rural) no resultaron ser estadisticamente significativos, lo que sugiere la presencia de ruido, multicolinealidad o sobreajuste.
Ítem 2 y 3: Selección de Variables por Stepwise
# ==============================================================================
# ÍTEM 2 Y 3: SELECCIÓN DE VARIABLES POR STEPWISE
# ==============================================================================
modelo_ajustado <- step(modelo_inicial, direction = "both")## Start: AIC=-261.13
## Y_escolaridad ~ X1_internet + X2_computador + X3_migrante + X4_edad_prom +
## X5_hacinamiento + X6_indigena + X7_desocupacion + X8_discapacidad +
## X9_territorio
##
## Df Sum of Sq RSS AIC
## - X7_desocupacion 1 0.03365 2.1559 -261.90
## <none> 2.1222 -261.13
## - X9_territorio 1 0.05692 2.1791 -261.07
## - X1_internet 1 0.08408 2.2063 -260.10
## - X5_hacinamiento 1 0.19221 2.3144 -256.37
## - X8_discapacidad 1 0.21024 2.3325 -255.76
## - X6_indigena 1 0.47034 2.5926 -247.52
## - X4_edad_prom 1 0.69233 2.8146 -241.11
## - X3_migrante 1 1.26172 3.3839 -226.74
## - X2_computador 1 1.69019 3.8124 -217.44
##
## Step: AIC=-261.9
## Y_escolaridad ~ X1_internet + X2_computador + X3_migrante + X4_edad_prom +
## X5_hacinamiento + X6_indigena + X8_discapacidad + X9_territorio
##
## Df Sum of Sq RSS AIC
## <none> 2.1559 -261.90
## - X9_territorio 1 0.06360 2.2195 -261.64
## + X7_desocupacion 1 0.03365 2.1222 -261.13
## - X1_internet 1 0.09533 2.2512 -260.53
## - X5_hacinamiento 1 0.17273 2.3286 -257.89
## - X8_discapacidad 1 0.26622 2.4221 -254.82
## - X6_indigena 1 0.43908 2.5950 -249.44
## - X4_edad_prom 1 0.67326 2.8291 -242.71
## - X3_migrante 1 1.25094 3.4068 -228.21
## - X2_computador 1 1.66621 3.8221 -219.24summary(modelo_ajustado)##
## Call:
## lm(formula = Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
## X4_edad_prom + X5_hacinamiento + X6_indigena + X8_discapacidad +
## X9_territorio, data = base_modelo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.42901 -0.12432 0.00840 0.09992 0.35348
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.935632 0.825649 4.767 1.00e-05 ***
## X1_internet 0.004567 0.002614 1.747 0.085135 .
## X2_computador 0.051551 0.007059 7.303 3.75e-10 ***
## X3_migrante 0.225826 0.035690 6.327 2.15e-08 ***
## X4_edad_prom 0.078674 0.016948 4.642 1.60e-05 ***
## X5_hacinamiento -0.038684 0.016453 -2.351 0.021572 *
## X6_indigena 0.005926 0.001581 3.749 0.000366 ***
## X8_discapacidad -0.044503 0.015246 -2.919 0.004739 **
## X9_territorioUrbana 0.093874 0.065795 1.427 0.158157
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1768 on 69 degrees of freedom
## (8 observations deleted due to missingness)
## Multiple R-squared: 0.9579, Adjusted R-squared: 0.953
## F-statistic: 196.1 on 8 and 69 DF, p-value: < 2.2e-16Al aplicar el metodo Stepwise en ambas direcciones, se determino que la eliminacion de la variable (X7_desocupacion) optimiza el modelo, reduciendo el AIC de -261.13 a -261.90. Invocando el principio de parsimonia, eta desicion resulta ser completamente justificada, ya que se obtiene un modelo menos complejo manteniendo su capacidad explicativa, conservando un R2-ajustado de 0.9530. Ademas, la eliminacion de esta variable aumento la significancia global del modelo, aumento el estadistico F desde 174.6 hasta 196.1. Cabe recalcar que. aun que las variables como acceso a internet fijo y el tipo de territorio mantienen los valores p individuales superiores a 0.05 en el nuevo ajuste, el algoritmo Stepwise decide mantenerlos debido a que su eliminacion empeoraria el AIC.
Ítem 4 y 5: Selección de Variables por Cp de Mallows
# ==============================================================================
# ÍTEM 4 Y 5: SELECCIÓN DE VARIABLES POR Cp DE MALLOWS
# ==============================================================================
subsets_cp <- regsubsets(
Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
X4_edad_prom + X5_hacinamiento + X6_indigena +
X7_desocupacion + X8_discapacidad + X9_territorio,
data = base_modelo,
nvmax = 9,
method = "exhaustive"
)
resumen_subsets <- summary(subsets_cp)
print(resumen_subsets$cp)## [1] 79.947678 39.553522 31.312442 22.129281 17.615247 12.577382 9.116286
## [8] 9.078317 10.000000print(resumen_subsets$which[7,])## (Intercept) X1_internet X2_computador X3_migrante
## TRUE TRUE TRUE TRUE
## X4_edad_prom X5_hacinamiento X6_indigena X7_desocupacion
## TRUE TRUE TRUE FALSE
## X8_discapacidad X9_territorioUrbana
## TRUE FALSE# Ajuste del modelo por Cp de Mallows
modelo_cp <- lm(Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
X4_edad_prom + X5_hacinamiento + X6_indigena +
X8_discapacidad,
data = base_modelo)
summary(modelo_cp)##
## Call:
## lm(formula = Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
## X4_edad_prom + X5_hacinamiento + X6_indigena + X8_discapacidad,
## data = base_modelo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.38564 -0.14740 0.02928 0.10999 0.38717
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.071229 0.826206 4.928 5.37e-06 ***
## X1_internet 0.006488 0.002257 2.875 0.005355 **
## X2_computador 0.050442 0.007068 7.137 7.04e-10 ***
## X3_migrante 0.218073 0.035534 6.137 4.48e-08 ***
## X4_edad_prom 0.077010 0.017033 4.521 2.44e-05 ***
## X5_hacinamiento -0.038424 0.016573 -2.318 0.023349 *
## X6_indigena 0.005550 0.001570 3.535 0.000729 ***
## X8_discapacidad -0.045996 0.015322 -3.002 0.003717 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1781 on 70 degrees of freedom
## (8 observations deleted due to missingness)
## Multiple R-squared: 0.9566, Adjusted R-squared: 0.9523
## F-statistic: 220.5 on 7 and 70 DF, p-value: < 2.2e-16El criterio del Cp de Mallows nos indica que el modelo optimo es aquel formado por 7 variables explicativas, ya que su Cp = 9.11 resulta ser el mas cercano al numero total de parametros estimables (p = 8, con intercepto), lo cual garantiza un nivel bajo de sesgo y una varianza de prediccion controlada. Al comparar este resultado con el modelo ajustado por Stepwaise, el enfoque via Cp de Mallows logra un modelo aun mas parsimonioso al poder eliminar justificadamente una variable adicional (X9_territorioUrbana). Aun que, el R2-ajustado decrece levemente de 0.9530 a 0.9523, el estadistico F aumenta a 220.5, mas aun ahora todas las variables de este modelo son significativas con un valor p menos a 0.001. Por lo tanto, apoyandonos en el principio de parsimonia, se elige el modelo reducido a 7 variables.
Ítem 6 y 7: Validación de Supuestos y Multicolinealidad
# ==============================================================================
# ÍTEM 6 Y 7: VALIDACIÓN DE SUPUESTOS Y MULTICOLINEALIDAD DEL MEJOR MODELO
# ==============================================================================
# Análisis gráfico de residuos
par(mfrow=c(2,2))
plot(modelo_cp)
# Análisis de multicolinealidad
vif(modelo_cp)## X1_internet X2_computador X3_migrante X4_edad_prom X5_hacinamiento
## 5.780776 11.496080 3.046471 2.244437 2.875665
## X6_indigena X8_discapacidad
## 3.095305 2.211411Mediante un analisis grafico de residuos, se confirma que el modelo seleccionado por Cp de Mallows cumple de forma satisfactoria con los supuestos fundamentales de regresion. El grafico normal Q-Q muestra una alineacion de los puntos sobre la diagonal, validando la normalidad de los errores, mientras que el grafico “Residuales vs Fitted” muestran una dispersion aleatoria, respaldando la homocedasticidad, luego no se evidencian observaciones atipicas con distancias de Cook altamente influyentes. Sin embargo, al evaluar el VIF, se detecta un problema de multicolinealidad donde el porcentaje de hogares con computador alcanza un VIF de 11.5 y acceso a internet fijo un VIF de 5.78. Esto demuestra una fuerte correlacion y redundancia de la informacion entre ambas variables. Lo cual es esperado ya que normalmente la presencia de internet fijo implica la presencia de computador y viceversa. Debido a esto se infla artificialmente al varianza de los estimadores OLS.
Ítem 8 y 9: Mínimos Cuadrados Ponderados (WLS)
# ==============================================================================
# ÍTEM 8 Y 9: MÍNIMOS CUADRADOS PONDERADOS (WLS)
# ==============================================================================
base_modelo_limpia <- base_modelo %>%
drop_na(Y_escolaridad, X1_internet, X2_computador, X3_migrante,
X4_edad_prom, X5_hacinamiento, X6_indigena, X7_desocupacion,
X8_discapacidad, X9_territorio, n_personas)
modelo_wls <- lm(Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
X4_edad_prom + X5_hacinamiento + X6_indigena + X7_desocupacion +
X8_discapacidad + X9_territorio,
data = base_modelo_limpia,
weights = n_personas)
summary(modelo_wls)##
## Call:
## lm(formula = Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
## X4_edad_prom + X5_hacinamiento + X6_indigena + X7_desocupacion +
## X8_discapacidad + X9_territorio, data = base_modelo_limpia,
## weights = n_personas)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -72.697 -22.735 -4.195 11.865 134.346
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.011889 0.827461 3.640 0.000527 ***
## X1_internet 0.002248 0.003468 0.648 0.518986
## X2_computador 0.060979 0.008349 7.304 4.01e-10 ***
## X3_migrante 0.185441 0.028334 6.545 9.28e-09 ***
## X4_edad_prom 0.093892 0.019137 4.906 6.08e-06 ***
## X5_hacinamiento -0.078082 0.023112 -3.379 0.001210 **
## X6_indigena 0.010915 0.001879 5.810 1.82e-07 ***
## X7_desocupacion 0.010148 0.013675 0.742 0.460615
## X8_discapacidad -0.040357 0.019929 -2.025 0.046791 *
## X9_territorioUrbana 0.221832 0.086031 2.579 0.012092 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 33.76 on 68 degrees of freedom
## Multiple R-squared: 0.9752, Adjusted R-squared: 0.9719
## F-statistic: 297 on 9 and 68 DF, p-value: < 2.2e-16# Comparacion de heterocedasticidad
bptest(modelo_inicial)##
## studentized Breusch-Pagan test
##
## data: modelo_inicial
## BP = 4.9609, df = 9, p-value = 0.8377bptest(modelo_cp)##
## studentized Breusch-Pagan test
##
## data: modelo_cp
## BP = 3.7751, df = 7, p-value = 0.8053bptest(modelo_wls)##
## studentized Breusch-Pagan test
##
## data: modelo_wls
## BP = 3078118, df = 9, p-value < 2.2e-16Al intentar ajustar el WLS utilizando la cantidad de habitantes por comuna como factor de ponderacion, se observa un efecto contraproducente en la validez del ajuste. Las pruebas de Breusch-Pagan demuestran que los modelos previos (Inicial y Cp de Mallows) ya cumplian con los supuetos de homocedasticidad con valores p de 0.837 y 0.805 respectivamente, por lo cual no requerian correcion de varianza. Al hacer esta poderacion, las comunas con poblacion mayor se adjudicaron una influencia desproporcionada, afectando el ajuste original. Esto provoco de forma artifical una heterocedasticidad en el modelo WLS. desplomando el valor p del test de Breusch-Pagan. Por lo tanto, aun que el R2 parezca aumentar a un 0.9750, esto solo es provocado por los altos pesos poblaciones, por lo tanto se concluye que el WLS es inadecuado para este conjunto de datos areales.
Ítem 10 y 11: Regularización Ridge y LASSO
# ==============================================================================
# ÍTEM 10 Y 11: REGULARIZACIÓN RIDGE Y LASSO
# ==============================================================================
# Creación de matriz de diseño (Requisito glmnet)
base_glmnet <- base_modelo %>%
drop_na(Y_escolaridad, X1_internet, X2_computador, X3_migrante,
X4_edad_prom, X5_hacinamiento, X6_indigena,
X7_desocupacion, X8_discapacidad, X9_territorio)
X <- model.matrix(Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
X4_edad_prom + X5_hacinamiento + X6_indigena +
X7_desocupacion + X8_discapacidad + X9_territorio,
data = base_glmnet)[, -1]
Y <- base_glmnet$Y_escolaridad
# --- Ridge (Ítem 10) ---
set.seed(2026)
cv_ridge <- cv.glmnet(X, Y, alpha = 0, standardize = TRUE)
mejor_lambda_ridge <- cv_ridge$lambda.min
modelo_ridge <- glmnet(X, Y, alpha = 0, lambda = mejor_lambda_ridge, standardize = TRUE)
coef(modelo_ridge)## 10 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 5.841775323
## X1_internet 0.007455456
## X2_computador 0.033918276
## X3_migrante 0.248279987
## X4_edad_prom 0.054873616
## X5_hacinamiento -0.046635939
## X6_indigena 0.002660404
## X7_desocupacion 0.001781819
## X8_discapacidad -0.054161457
## X9_territorioUrbana 0.081553442# --- LASSO (Ítem 11) ---
set.seed(2026)
cv_lasso <- cv.glmnet(X, Y, alpha = 1, standardize = TRUE)
coef_lasso_1se <- cv_lasso$lambda.1se
modelo_lasso <- glmnet(X, Y, alpha = 1, lambda = coef_lasso_1se, standardize = TRUE)
coef(modelo_lasso)## 10 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 5.266725053
## X1_internet 0.003643210
## X2_computador 0.049862996
## X3_migrante 0.217610919
## X4_edad_prom 0.044552922
## X5_hacinamiento -0.021793336
## X6_indigena 0.001568446
## X7_desocupacion .
## X8_discapacidad -0.035090597
## X9_territorioUrbana 0.037885315Debido a la severa multicolinealidad detectada, se ajustaron los modelos de regularizacion mediante una validacion cruzada para encontrar los paramentros de penalizacion optimos.. En el caso de la regresion Ridge, el algoritmo encogio todos los coeficientes casi hasta cero para reducir la varianza y estabilizar el modelo, pero mantuvo las 9 variables explicativas originales. Por otro lado, la regresion LASSO al ulizar un criterio conservador de un error estandar para escoger el lambda, el modelo no solo contrajo los estimadores, si no que realizo una seleccion de variables, forzando al coeficiente de la tasa de desocupacion a ser exactamente cero, expulsando esta variable del modelo. Este resultado concuerda con la decision tomada por el algoritmo Stepwise, confirmando que la desocupacion no aporta un valor predictivo significativo al modelo en presencia de las demas variables.
Ítem 12: Comparación de Varianzas de Predicción (X0)
# ==============================================================================
# ÍTEM 12: COMPARACIÓN DE VARIANZAS DE PREDICCIÓN (X0)
# ==============================================================================
# 1. Definición de x0: Comuna atipica (alejada de la media)
X_full <- model.matrix(Y_escolaridad ~ X1_internet + X2_computador + X3_migrante +
X4_edad_prom + X5_hacinamiento + X6_indigena +
X7_desocupacion + X8_discapacidad + X9_territorio,
data = base_glmnet)
desviaciones <- apply(X_full, 2, sd)
x0_full <- colMeans(X_full) + desviaciones
x0_full["(Intercept)"] <- 1
x0_full["X9_territorioUrbana"] <- 1
# Estimación de Varianza del error
n <- nrow(X_full)
p <- ncol(X_full)
sigma2_hat <- sum(resid(modelo_inicial)^2) / (n - p)
# A. Varianza Modelo Mallows Cp (OLS reducido)
vars_cp <- c("(Intercept)", "X1_internet", "X2_computador", "X3_migrante",
"X4_edad_prom", "X5_hacinamiento", "X6_indigena", "X8_discapacidad")
X_cp <- X_full[, vars_cp]
x0_cp <- x0_full[vars_cp]
var_pred_cp <- as.numeric(sigma2_hat * t(x0_cp) %*% solve(t(X_cp) %*% X_cp) %*% x0_cp)
# B. Varianza Modelo Ridge
lambda_ridge_adj <- mejor_lambda_ridge * n
D_ridge <- diag(c(0, rep(1, ncol(X_full) - 1))) * lambda_ridge_adj
inv_ridge <- solve(t(X_full) %*% X_full + D_ridge)
var_mat_ridge <- sigma2_hat * (inv_ridge %*% (t(X_full) %*% X_full) %*% inv_ridge)
var_pred_ridge <- as.numeric(t(x0_full) %*% var_mat_ridge %*% x0_full)
# C. Varianza Modelo LASSO
vars_lasso <- c("(Intercept)", "X1_internet", "X2_computador", "X3_migrante",
"X4_edad_prom", "X5_hacinamiento", "X6_indigena",
"X8_discapacidad", "X9_territorioUrbana")
X_lasso <- X_full[, vars_lasso]
x0_lasso <- x0_full[vars_lasso]
var_pred_lasso <- as.numeric(sigma2_hat * t(x0_lasso) %*% solve(t(X_lasso) %*% X_lasso) %*% x0_lasso)
# Tabla de Resultados
resultados_varianza <- data.frame(
Modelo = c("Mallows Cp (OLS)", "Regresión Ridge", "Regresión LASSO"),
Varianza_Prediccion_en_x0 = c(var_pred_cp, var_pred_ridge, var_pred_lasso)
)
print(resultados_varianza)## Modelo Varianza_Prediccion_en_x0
## 1 Mallows Cp (OLS) 0.01027803
## 2 Regresión Ridge 0.01128445
## 3 Regresión LASSO 0.01054691Al evaluar la varianza de prediccion para un perfil de comuna atipico, se observa que el modelo ajustado por el Cp de Mallows presenta una mayor estabilidad predictiva, con la varianza mas baja de 0.01020, superando a las regresion penalizadas por Ridge y LASSO. Notar que teoricamente se esperaba que la regularizacion simpre redujera la viaranza frente a la presencia de multicolinealidad, sin embargo en este caso se logro una menor varianza por principio de parsimonia, El modelo de Mallows elimino 2 variables ruidosas, lo cual redujo la incertidumbre al momento de predecir. Por el contrario, la regresion Ridge mantuvo todas las variables originales contraidas, acumulando una mayor varianza al evaluar un punto extremo, mientras que LASSO elimino solo una variable predictora. En conclusion, el modelo de 7 variables sugerido por Mallows, ofrece un ajuste sobresaliente, cumpliendo con los supuestos de regresion y la prediccion mas estable.
Referencias
- Instituto Nacional de Estadisticas (INE). (2024).Base de microdatos - Viviendas, hogares, personas Censo 2024 (parquet). https://censo2024.ine.gob.cl/
- Lagos,B.(2026) Presentaciones Clases. Curso de Regresion, Universidad de Concepcion