Ciencia de datos [Modelo]
Iván Mendoza, César Cuervo, Nicole Velazquez
2025-05-16
1. Carga de librerías y datos
2. Limpieza y exploración inicial de datos
# Creación de un nuevo Data Frame llamado eav2024_selected, el cual contiene un subconjunto de columnas del archivo original. Para esto se utilizó la función select y el operador dplyr.
eav2024_selected <- eav2024 %>% select ("sexo_num",
"genero_num",
"nom_mun_mv",
"nom_loc_mv",
"colonia",
"mun_amm_y_periferia",
"cp4_1",
"rangos_edad",
"p7_8",
"p13",
"p15",
"p16",
"p17",
"p18",
"usa_transporte_publico",
"tiempo_espera",
"p21",
"p22",
"tiempo_total_traslado",
"costo_total_viaje_redondo",
"p31_3",
"p31_6",
"p32",
"p33_9",
"victima_tp",
"p39",
"Factor_CVNL",
"p164"
)#Muestra las primeras 6 filas del database
head(eav2024_selected)## sexo_num genero_num nom_mun_mv nom_loc_mv
## 1 1 1 Cadereyta Jiménez Cadereyta Jiménez
## 2 0 0 Cadereyta Jiménez Valle del Roble
## 3 1 1 Cadereyta Jiménez Cadereyta Jiménez
## 4 0 0 Cadereyta Jiménez Cadereyta Jiménez
## 5 0 0 Cadereyta Jiménez Cadereyta Jiménez
## 6 1 1 General Escobedo Ciudad General Escobedo
## colonia mun_amm_y_periferia cp4_1 rangos_edad p7_8 p13
## 1 Praderas 9 50 45-54 0 1
## 2 Valle del Roble 9 35 35-44 1 1
## 3 Infonavit Jeronimo Treviño 9 32 25-34 NA 2
## 4 Alfredo V Bonfil 9 62 55-64 0 8
## 5 Centro De Cadereyta 9 80 75 o más NA 8
## 6 Alianza Real Barrio Jalisco 21 51 45-54 NA 5
## p15 p16 p17 p18 usa_transporte_publico tiempo_espera p21 p22
## 1 5 9 621 1 0 NA NA NA
## 2 6 31 1048 1 1 NA NA NA
## 3 5 9 621 1 0 NA NA NA
## 4 1 9 392 1 0 NA NA NA
## 5 2 9 439 1 0 NA NA NA
## 6 2 21 1573 1 1 NA NA NA
## tiempo_total_traslado costo_total_viaje_redondo p31_3 p31_6 p32 p33_9
## 1 45 NA NA NA NA NA
## 2 100 NA 1 2 3 1
## 3 10 NA NA NA NA NA
## 4 10 NA NA NA NA NA
## 5 10 NA NA NA NA NA
## 6 40 NA 8888 0 3 1
## victima_tp p39 Factor_CVNL p164
## 1 NA 0 258.2655 2
## 2 0 0 273.0114 3
## 3 NA 1 258.2655 3
## 4 NA 1 273.0114 3
## 5 NA 1 273.0114 3
## 6 1 0 1013.6011 3Limpieza de la base de datos
# Se realiza un nuevo dataframe llamado eav2024_clean, el cual cuenta con la base datos limpia y las variables seleccionadas que nos ayudan a contestar la pregunta de investigación
eav2024_clean <- eav2024_selected %>%
mutate(sexo = factor(sexo_num,
levels = c(0, 1),
labels = c("Hombre", "Mujer"))) %>%
#Se agregó como columna nueva al data frame la variable sexo, mediante la función mutate. Se convirtió la variable sexo a un factor con etiquetas; con la finalidad de que sea bueno en visualización en la base de datos y se pueda utilizar para hacer análisis.
mutate(municipio=as.factor(nom_mun_mv))%>%
#Se hizo factor la variable nom_mun_mv. Cabe aclarar que no todos los municipios tuvieron participación en la encuesta.
mutate(edad=(cp4_1)) %>%
#Se le cambió el nombre a la variable cp4_1 por edad.
mutate (categoría_edad = case_when(
edad < 15 ~ 0, #Las personas menores a 15 años se les denominará 0.
edad >= 15 & edad < 30 ~ 1, #Las personas entre 15 y 29 años se les denominará 1.
edad >= 30 & edad < 65 ~ 2, #Las personas entre 30 y 64 años se les denominará 2.
edad >= 65 ~ 3), #Las personas de 65 años o más se les denominará 3
categoría_edad = factor(categoría_edad,
levels = c(0, 1, 2, 3),
labels = c("Infancias", "Juventud", "Adultos", "Tercera Edad"))
) %>% #Levels permite utilizar valores numéricos para el análisis y labels permite usar categorías para la visualización de la base de datos.
mutate(prestacion_transportepriv = factor(p7_8,
levels = c(0, 1, 8888, 9999),
labels = c("No", "Sí", "No sabe", "No contesta"))) %>%
#Se cambió el nombre de la variable de p7_8 a prestacion_transportepriv. Se hizo factor con etiquetas la variable prestacion_transportepriv.
mutate(motivo_traslado = factor(p13,
levels = c(1, 2,3,4,5,6,7,8,9,10,9999),
labels = c("Trabajo", "Escuela", "Compras","Médico_u_hospital", "Diversión", "Acompañar o llevar a alguien", "Banco o pago de servicios", "Visita", "Buscar empleo", "Trámites", "No contesta"))) %>%
#Se cambió el nombre de la variable de p13 a motivo_traslado. Se hizo factor con etiquetas la variable motivo_traslado.
mutate(traslados_semanales_motivo=(p15)) %>%
#Se le cambió el nombre a la variable p15 y se le llamó traslados_semanales_motivo. Además de que se incluyó en el nuevo data frame.
mutate(municipio_destino_motivo = factor(p16,
levels = c(39, 26,46,6,21,19,49,31,18,48,9,41,10,12,25,45,1,2,4,5,7,8,11,13,14,15,16,17,20,22,23,24,47,28,29,30,31,32,33,3,27,42,34,35,36,37,38,40,43,44,50,51,100,111,8888,9999),
labels = c("Monterrey","Guadalupe","San Nicolás de los Garza","Apodaca","Escobedo","San Pedro Garza García","Santiago","Juárez","García","Santa Catarina","Cadereyta", "Pesquería","El Carmen", "Ciénega de Flores", "Zuazua", "Salinas Victoria", "Abasolo", "Agualeguas", "Allende", "Anáhuac", "Aramberri", "Bustamante","Cerralvo", "China","Doctor Arroyo","Doctor Coss","Doctor González","Galeana", "General Bravo", "General Terán","General Treviño","General Zaragoza", "Hidalgo","Higueras","Hualahuises", "Iturbide", "Juárez","Lampazos de Narango", "Linares", "Los Aldamas", "Los Herreras","Los Ramones","Marín","Melchor Ocampo", "Mier y Noriega", "Mina", "Montemorelos", "Parás", "Rayones", "Sabinas Hidalgo", "Vallecillo", "Villaldama","Fuera de Nuevo León","Fuera del país","No Sabe","No contesta"))) %>%
#Se le cambió el nombre a la variable p16 y se le llamó municipio_destino_motivo. Se hizo factor con etiquetas la variable municipio_destino_motivo.
mutate(medio_transporte = factor(p18,
levels = c(1, 2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,8888,9999),
labels = c("Pie/silla de ruedas", "Camión/microbus", "Taxi","Uber", "Motocicleta", "Bicicleta", "Metro", "Automóvil", "Transmetro", "Ecovía","Transporte escolar", "Transporte de trabajo", "Camión privado", "Trailer", "Cuatrimoto","Tractor", "Taxi colectivo", "No sabe", "No contesta"))) %>%
#Se le cambió el nombre a la variable de p18 a medio_transporte. Se hizo factor con etiquetas la variable medio_transporte.
mutate(usa_transporte_publico= factor(usa_transporte_publico,
levels = c(0, 1),
labels = c("No", "Sí"))) %>%
#Se hizo factor con etiquetas la variable motivo_traslado.
mutate(transborda= factor(p21,
levels = c(0, 1),
labels = c("No", "Sí"))) %>%
#Se le cambió el nombre a la variable de p21 a transborda. Se hizo factor con etiquetas la variable transborda.
mutate(numero_transbordos = as.numeric(p22)) %>% #Se le cambió el nombre de p22 a numero_transbordos.
mutate(se_siente_seguro_tp = factor(p31_3,
levels = c(0, 1, 8888, 9999),
labels = c("No", "Sí", "No sabe", "No contesta"))) %>%
#Se le cambió el nombre a la variable de p31_3 a se_siente_seguro_tp. Se hizo factor con etiquetas la variable se_siente_seguro_tp.
mutate(unidades_climatizadas = factor(p31_6,
levels = c(0, 1, 8888, 9999),
labels = c("No", "Sí", "No sabe", "No contesta"))) %>% #Se le cambió el nombre a la variable de p31_6 a unidades_climatizadas. Se hizo factor con etiquetas la variable unidades_climatizadas.
mutate(Calificacion_transporte = factor(p32,
levels = c(1, 2,3,4,5,8888,9999),
labels = c("Muy baja","Baja","Adecuada","Alta","Muy alta", "No sabe", "No contesta"))) %>%
#Se le cambió el nombre a la variable de p32 a Calificacion_transporte. Se hizo factor con etiquetas la variable Calificacion_transporte.
mutate(Transporte_público_fallas = factor(p33_9,
levels = c(0, 1, 8888, 9999),
labels = c("No", "Sí", "No sabe", "No contesta"))) %>%
#Se le cambió el nombre a la variable de p33_9 a Transporte_público_fallas. Se hizo factor con etiquetas la variable Transporte_público_fallas.
mutate(ingresos_nivel_socioeconomico = factor(p164,
levels = c(1, 2,3,4,5,6,7,8,9,10,11,12,8888,9999),
labels = c("E", "D", "D","D+", "D+", "C", "C", "C+", "C+", "A/B","A/B", "A/B", "No sabe", "No contesta")))%>%
#Se le cambió el nombre a la variable de p164 a ingresos_nivel_socioeconomico. Se hizo factor con etiquetas la variable ingresos_nivel_socioeconomico.
mutate(victima_tp= factor(victima_tp,
levels = c(0, 1),
labels = c("No", "Sí"))) %>%
#Se hizo factor con etiquetas la variable Transporte_público_fallas.
mutate(vehiculos_hogar=(p39)) %>% #Se le cambió el nombre de 9_39 a vehiculos_hogar
select(-colonia, -sexo_num, -genero_num, -nom_loc_mv, -nom_mun_mv, -cp4_1, -rangos_edad, -p7_8, -p13, -p15, -p17, -p32, -p33_9, -p164,-p39, -p21,-p22,-p31_3,-p31_6, -p164, -transborda) #Se utiliza el select (-variable) para eliminar variables del data frame.3. Preprocesamiento y creación de variables nuevas
# Escalamiento, codificación, generación de variables derivadas
#Separar municipios en AMM, periferia y resto de Nuevo León
eav2024_clean2 <- eav2024_clean %>%
# Etiquetar municipios
mutate(municipio_destino_motivo = factor(p16,
levels = c(39, 26,46,6,21,19,49,31,18,48,9,41,10,12,25,45,1,2,4,5,7,8,11,13,14,15,16,17,20,22,23,24,47,28,29,30,31,32,33,3,27,42,34,35,36,37,38,40,43,44,50,51,100,111,8888,9999),
labels = c("Monterrey","Guadalupe","San Nicolás de los Garza","Apodaca","Escobedo","San Pedro Garza García","Santiago","Juárez","García","Santa Catarina","Cadereyta", "Pesquería","El Carmen", "Ciénega de Flores", "Zuazua", "Salinas Victoria", "Abasolo", "Agualeguas", "Allende", "Anáhuac", "Aramberri", "Bustamante","Cerralvo", "China","Doctor Arroyo","Doctor Coss","Doctor González","Galeana", "General Bravo", "General Terán","General Treviño","General Zaragoza", "Hidalgo","Higueras","Hualahuises", "Iturbide", "Juárez","Lampazos de Narango", "Linares", "Los Aldamas", "Los Herreras","Los Ramones","Marín","Melchor Ocampo", "Mier y Noriega", "Mina", "Montemorelos", "Parás", "Rayones", "Sabinas Hidalgo", "Vallecillo", "Villaldama","Fuera de Nuevo León","Fuera del país","No Sabe","No contesta"))) %>%
# Etiquetas lógicas
mutate(
municipios_periferia = municipio_destino_motivo %in% c("El Carmen", "Ciénega de Flores", "Zuazua", "Pesquería", "Salinas Victoria"),
AMM = municipio_destino_motivo %in% c("Apodaca", "Cadereyta","Escobedo", "García", "Juárez", "Monterrey", "San Nicolás de los Garza", "San Pedro Garza García","Santiago", "Santa Catarina", "Guadalupe"),
resto_NL = municipio_destino_motivo %in% c("Abasolo", "Agualeguas", "Allende", "Anáhuac", "Aramberri", "Bustamante","Cerralvo", "China","Doctor Arroyo","Doctor Coss","Doctor González","Galeana", "General Bravo", "General Terán","General Treviño","General Zaragoza", "Hidalgo","Higueras","Hualahuises", "Iturbide", "Juárez","Lampazos de Narango", "Linares", "Los Aldamas", "Los Herreras","Los Ramones","Marín","Melchor Ocampo", "Mier y Noriega", "Mina", "Montemorelos", "Parás", "Rayones", "Sabinas Hidalgo", "Vallecillo", "Villaldama","Fuera de Nuevo León","Fuera del país","No Sabe","No contesta")
) %>%
# Variable combinada numérica
mutate(
zona_destino = case_when(
AMM ~ 1,
municipios_periferia ~ 2,
resto_NL ~ 3,
TRUE ~ NA_real_
),
zona_destino = factor(
zona_destino,
levels = c(3, 1, 2),
labels = c("Resto de NL", "AMM", "Municipios de la periferia")
)
)%>%
#Se hizo una variable nueva llamada zona_destino; la cual especifica a dónde se dirigen las personas de Nuevo León como destino principal, ya sea al AMM (Área metropolitana), municipios_periferia (Municipios de la periferia) o resto_NL (resto de Nuevo León).
#Separación en categorías los medios de transporte 1.-Medios motorizados no colectivos (automóvil, taxi, uber/aplicación móvil, motocicleta, cuatrimoto y trailer), 2.- Transporte púbico colectivo, (camión/microbus, ecovía, metro y transmetro), 3.- Medios no motorizados (bicicleta, a pie/camina/silla de ruedas), y 4.- Transporte privado colectivo (autobús privado, transporte de trabajo y transporte escolar).
#Además, se hizo la variable Medio_transporte2 juntando las 4 categorías de medios de transporte que usa la gente para trasladarse a su principal destino.
#Etiquetar medios de transporte
mutate(medio_transporte = factor(p18,
levels = c(1, 2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,8888,9999),
labels = c("Pie/silla de ruedas", "Camión/microbus", "Taxi","Uber", "Motocicleta", "Bicicleta", "Metro", "Automóvil", "Transmetro", "Ecovía","Transporte escolar", "Transporte de trabajo", "Camión privado", "Trailer", "Cuatrimoto","Tractor", "Taxi colectivo", "No sabe", "No contesta"))) %>%
# Etiquetas lógicas
mutate(
Medios_motorizados_no_colectivos = medio_transporte %in% c("Automóvil", "Taxi", "Uber", "Motocicleta", "Cuatrimoto", "Trailer"),
Transporte_publico_colectivo = medio_transporte %in% c("Camión/microbus", "Ecovía", "Metro", "Transmetro"),
Medios_no_motorizados = medio_transporte %in% c("Bicicleta", "Pie/silla de ruedas"),
Transporte_privado_colectivo = medio_transporte %in% c("Transporte escolar", "Transporte de trabajo", "Camión privado")
) %>%
# Variable combinada numérica
mutate(
Medio_transporte2 = case_when(
Medios_motorizados_no_colectivos ~ 1,
Transporte_publico_colectivo ~ 2,
Medios_no_motorizados ~ 3,
Transporte_privado_colectivo ~ 4,
TRUE ~ NA_real_
),
Medio_transporte2 = factor(
Medio_transporte2,
levels = c(1, 2, 3, 4),
labels = c("Medios_motorizados_no_colectivos", "Transporte_publico_colectivo", "Medios_no_motorizados", "Transporte_privado_colectivo")
)
)%>%
select(-municipio_destino_motivo, -municipios_periferia, -AMM, -resto_NL,-mun_amm_y_periferia, -medio_transporte, -p16, -p18, -Medios_motorizados_no_colectivos, -Transporte_publico_colectivo, -Medios_no_motorizados, -Transporte_privado_colectivo) #Se utiliza el select (-variable) para eliminar variables del data frame.## Base de datos corregida
eav2024_cuasifinal <- eav2024_clean2 %>% select(sexo, edad, categoría_edad, municipio, zona_destino, ingresos_nivel_socioeconomico, Medio_transporte2, prestacion_transportepriv, vehiculos_hogar, usa_transporte_publico, numero_transbordos, tiempo_espera, tiempo_total_traslado, motivo_traslado, traslados_semanales_motivo, costo_total_viaje_redondo, unidades_climatizadas, Transporte_público_fallas, se_siente_seguro_tp, victima_tp, Calificacion_transporte, Factor_CVNL)
#Se crea un nuevo data frame con las variables acomodadas para una mejor visualización en la base de datos, llamado eav2024_cuasifinal.
eav2024_final <- eav2024_cuasifinal%>%
filter(!is.na(tiempo_total_traslado)) %>%
filter(motivo_traslado != "No contesta") %>%
filter(!is.na(zona_destino))%>%
filter(!is.na(Medio_transporte2))
#Se creó la base de datos final llamada eav2024_final.
#Mediante filter e is.na, se quitaron los NA y "No contesta" de las variables (tiempo_total_traslado, motivo_traslado, zona_destino y Medio_transporte2) para poder hacer un mejor análisis con la base de datos eav2024_final.Factor de expansión
# En esta parte del código se está utilizando la librería survey de R para aplicar factores de expansión (también llamados factores de ponderación o pesos muestrales) a los datos de la encuesta eav2024_final. Esto permite hacer estimaciones que representan a toda la población y no solo a las personas encuestadas.
# Se creó un objeto de diseño de encuesta diseño_encuesta con: ids = ~1: indica que no hay conglomerados (diseño simple sin estratificación ni muestreo por conglomerados). data = eav2024_selected: es el data frame con los datos seleccionados. weights = eav2024_final$Factor_CVNL: se aplican los factores de expansión para que los resultados reflejen a la población total y no solo a los encuestados.
diseño_encuesta <- svydesign(ids=~1,
data=eav2024_final,
weights = eav2024_final$Factor_CVNL) 4. División de datos en entrenamiento y prueba
# Verificar que el data.frame tenga datos
stopifnot(exists("eav2024_final"), nrow(eav2024_final) > 0)
# Semilla para reproducibilidad
set.seed(123)
# Índices de entrenamiento (70% aleatorio)
train_index <- sample(1:nrow(eav2024_final), 0.7 * nrow(eav2024_final))
# División de datos
train_data <- eav2024_final[train_index, ]
test_data <- eav2024_final[-train_index, ]5. Modelo inicial
lm_model <- lm(tiempo_total_traslado ~ ingresos_nivel_socioeconomico + sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado + zona_destino + usa_transporte_publico + traslados_semanales_motivo, data= train_data, weights = Factor_CVNL)
#Para este modelo inicial se eligieron las variables que se consideraron más importantes para predecir el tiempo_total_traslado y se eliminaron las que contenían gran cantidad de NA's
summary(lm_model)##
## Call:
## lm(formula = tiempo_total_traslado ~ ingresos_nivel_socioeconomico +
## sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado +
## zona_destino + usa_transporte_publico + traslados_semanales_motivo,
## data = train_data, weights = Factor_CVNL)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -7188.6 -968.1 -226.5 658.0 23546.9
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 49.576045 12.941066 3.831
## ingresos_nivel_socioeconomicoD 21.323520 11.137342 1.915
## ingresos_nivel_socioeconomicoD+ 26.108321 11.242588 2.322
## ingresos_nivel_socioeconomicoC 24.476688 14.474662 1.691
## ingresos_nivel_socioeconomicoC+ 19.209827 33.222103 0.578
## ingresos_nivel_socioeconomicoA/B 53.188985 29.100674 1.828
## ingresos_nivel_socioeconomicoNo contesta 12.751878 11.788883 1.082
## sexoMujer -13.425707 3.204624 -4.189
## edad -0.144041 0.104265 -1.381
## Medio_transporte2Transporte_publico_colectivo 99.351233 5.217835 19.041
## Medio_transporte2Medios_no_motorizados -31.049502 4.625562 -6.713
## Medio_transporte2Transporte_privado_colectivo 34.531425 6.022855 5.733
## vehiculos_hogar -0.005167 0.010757 -0.480
## motivo_trasladoEscuela 0.575664 5.873913 0.098
## motivo_trasladoCompras -2.976954 4.259872 -0.699
## motivo_trasladoMédico_u_hospital 33.697080 7.213367 4.671
## motivo_trasladoDiversión 6.407578 7.377624 0.869
## motivo_trasladoAcompañar o llevar a alguien 11.384498 9.069177 1.255
## motivo_trasladoBanco o pago de servicios -4.529120 14.928988 -0.303
## motivo_trasladoVisita 57.719490 6.420965 8.989
## motivo_trasladoBuscar empleo -10.134927 22.316720 -0.454
## motivo_trasladoTrámites -28.125830 33.491998 -0.840
## zona_destinoAMM 5.421147 5.778991 0.938
## zona_destinoMunicipios de la periferia 1.574412 8.409451 0.187
## usa_transporte_publicoSí 1.019192 4.514627 0.226
## traslados_semanales_motivo -0.000542 0.002762 -0.196
## Pr(>|t|)
## (Intercept) 0.000132 ***
## ingresos_nivel_socioeconomicoD 0.055686 .
## ingresos_nivel_socioeconomicoD+ 0.020318 *
## ingresos_nivel_socioeconomicoC 0.090992 .
## ingresos_nivel_socioeconomicoC+ 0.563178
## ingresos_nivel_socioeconomicoA/B 0.067735 .
## ingresos_nivel_socioeconomicoNo contesta 0.279522
## sexoMujer 2.92e-05 ***
## edad 0.167280
## Medio_transporte2Transporte_publico_colectivo < 2e-16 ***
## Medio_transporte2Medios_no_motorizados 2.48e-11 ***
## Medio_transporte2Transporte_privado_colectivo 1.13e-08 ***
## vehiculos_hogar 0.631082
## motivo_trasladoEscuela 0.921939
## motivo_trasladoCompras 0.484735
## motivo_trasladoMédico_u_hospital 3.19e-06 ***
## motivo_trasladoDiversión 0.385216
## motivo_trasladoAcompañar o llevar a alguien 0.209518
## motivo_trasladoBanco o pago de servicios 0.761634
## motivo_trasladoVisita < 2e-16 ***
## motivo_trasladoBuscar empleo 0.649777
## motivo_trasladoTrámites 0.401133
## zona_destinoAMM 0.348317
## zona_destinoMunicipios de la periferia 0.851508
## usa_transporte_publicoSí 0.821416
## traslados_semanales_motivo 0.844427
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1972 on 2003 degrees of freedom
## Multiple R-squared: 0.4073, Adjusted R-squared: 0.3999
## F-statistic: 55.05 on 25 and 2003 DF, p-value: < 2.2e-166. Evaluación del modelo inicial
vif(lm_model) ## GVIF Df GVIF^(1/(2*Df))
## ingresos_nivel_socioeconomico 1.278263 6 1.020669
## sexo 1.208999 1 1.099545
## edad 1.270685 1 1.127247
## Medio_transporte2 2.783943 3 1.186069
## vehiculos_hogar 1.005077 1 1.002535
## motivo_traslado 2.030991 9 1.040147
## zona_destino 1.102614 2 1.024722
## usa_transporte_publico 2.426184 1 1.557621
## traslados_semanales_motivo 1.173165 1 1.083127#Multicolinearidad -> que las variables no digan lo mismo. Debe salir menor a 10
# Realiza predicciones sobre el conjunto de prueba
test_data$predicted_tiempo_total_traslado <- predict(lm_model, newdata = test_data)
# Métricas
rmse <- sqrt(mean((test_data$tiempo_total_traslado - test_data$predicted_tiempo_total_traslado)^2))
#En promedio cuánto se distancia el error del valor real
r_squared <- cor(test_data$tiempo_total_traslado, test_data$predicted_tiempo_total_traslado)^2
cat("RMSE:", rmse, "\nR-squared:", r_squared, "\n")## RMSE: 67.41474
## R-squared: 0.3780659sd(test_data$tiempo_total_traslado)## [1] 85.45631#Si RMSE es menor a la desviación estándar funciona bien la predicción7. Selección de modelos lineales y reducción de dimensiones
Full
#Usar regsubsets full para elegir las variables más importantes del modelo.
regfit.full <- regsubsets(tiempo_total_traslado~ ingresos_nivel_socioeconomico + sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado + zona_destino + usa_transporte_publico + traslados_semanales_motivo, eav2024_final, nvmax=19)## Warning in leaps.setup(x, y, wt = wt, nbest = nbest, nvmax = nvmax, force.in =
## force.in, : 2 linear dependencies found## Reordering variables and trying again:reg.full.summary <- summary(regfit.full)
reg.full.summary## Subset selection object
## Call: regsubsets.formula(tiempo_total_traslado ~ ingresos_nivel_socioeconomico +
## sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado +
## zona_destino + usa_transporte_publico + traslados_semanales_motivo,
## eav2024_final, nvmax = 19)
## 27 Variables (and intercept)
## Forced in Forced out
## ingresos_nivel_socioeconomicoD FALSE FALSE
## ingresos_nivel_socioeconomicoD+ FALSE FALSE
## ingresos_nivel_socioeconomicoC FALSE FALSE
## ingresos_nivel_socioeconomicoC+ FALSE FALSE
## ingresos_nivel_socioeconomicoA/B FALSE FALSE
## ingresos_nivel_socioeconomicoNo contesta FALSE FALSE
## sexoMujer FALSE FALSE
## edad FALSE FALSE
## Medio_transporte2Transporte_publico_colectivo FALSE FALSE
## Medio_transporte2Medios_no_motorizados FALSE FALSE
## Medio_transporte2Transporte_privado_colectivo FALSE FALSE
## vehiculos_hogar FALSE FALSE
## motivo_trasladoEscuela FALSE FALSE
## motivo_trasladoCompras FALSE FALSE
## motivo_trasladoMédico_u_hospital FALSE FALSE
## motivo_trasladoDiversión FALSE FALSE
## motivo_trasladoAcompañar o llevar a alguien FALSE FALSE
## motivo_trasladoBanco o pago de servicios FALSE FALSE
## motivo_trasladoVisita FALSE FALSE
## motivo_trasladoBuscar empleo FALSE FALSE
## motivo_trasladoTrámites FALSE FALSE
## zona_destinoAMM FALSE FALSE
## zona_destinoMunicipios de la periferia FALSE FALSE
## usa_transporte_publicoSí FALSE FALSE
## traslados_semanales_motivo FALSE FALSE
## ingresos_nivel_socioeconomicoNo sabe FALSE FALSE
## motivo_trasladoNo contesta FALSE FALSE
## 1 subsets of each size up to 20
## Selection Algorithm: exhaustive
## ingresos_nivel_socioeconomicoD ingresos_nivel_socioeconomicoD+
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " " "
## 15 ( 1 ) " " " "
## 16 ( 1 ) " " " "
## 17 ( 1 ) " " " "
## 18 ( 1 ) " " " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## ingresos_nivel_socioeconomicoC ingresos_nivel_socioeconomicoC+
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## ingresos_nivel_socioeconomicoA/B ingresos_nivel_socioeconomicoNo sabe
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## ingresos_nivel_socioeconomicoNo contesta sexoMujer edad
## 1 ( 1 ) " " " " " "
## 2 ( 1 ) " " " " " "
## 3 ( 1 ) " " " " " "
## 4 ( 1 ) " " " " " "
## 5 ( 1 ) " " " " " "
## 6 ( 1 ) " " " " " "
## 7 ( 1 ) " " "*" " "
## 8 ( 1 ) " " "*" " "
## 9 ( 1 ) " " "*" " "
## 10 ( 1 ) " " "*" " "
## 11 ( 1 ) " " "*" " "
## 12 ( 1 ) " " "*" "*"
## 13 ( 1 ) " " "*" "*"
## 14 ( 1 ) " " "*" "*"
## 15 ( 1 ) " " "*" "*"
## 16 ( 1 ) " " "*" "*"
## 17 ( 1 ) " " "*" "*"
## 18 ( 1 ) " " "*" "*"
## 19 ( 1 ) " " "*" "*"
## 20 ( 1 ) " " "*" "*"
## Medio_transporte2Transporte_publico_colectivo
## 1 ( 1 ) "*"
## 2 ( 1 ) "*"
## 3 ( 1 ) "*"
## 4 ( 1 ) "*"
## 5 ( 1 ) "*"
## 6 ( 1 ) "*"
## 7 ( 1 ) "*"
## 8 ( 1 ) "*"
## 9 ( 1 ) "*"
## 10 ( 1 ) "*"
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## Medio_transporte2Medios_no_motorizados
## 1 ( 1 ) " "
## 2 ( 1 ) "*"
## 3 ( 1 ) "*"
## 4 ( 1 ) "*"
## 5 ( 1 ) "*"
## 6 ( 1 ) "*"
## 7 ( 1 ) "*"
## 8 ( 1 ) "*"
## 9 ( 1 ) "*"
## 10 ( 1 ) "*"
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## Medio_transporte2Transporte_privado_colectivo vehiculos_hogar
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) "*" " "
## 5 ( 1 ) "*" " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoEscuela motivo_trasladoCompras
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " " "
## 15 ( 1 ) " " " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) " " " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" "*"
## motivo_trasladoMédico_u_hospital motivo_trasladoDiversión
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) "*" " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## motivo_trasladoAcompañar o llevar a alguien
## 1 ( 1 ) " "
## 2 ( 1 ) " "
## 3 ( 1 ) " "
## 4 ( 1 ) " "
## 5 ( 1 ) " "
## 6 ( 1 ) " "
## 7 ( 1 ) " "
## 8 ( 1 ) " "
## 9 ( 1 ) " "
## 10 ( 1 ) " "
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## motivo_trasladoBanco o pago de servicios motivo_trasladoVisita
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " "*"
## 4 ( 1 ) " " "*"
## 5 ( 1 ) " " "*"
## 6 ( 1 ) " " "*"
## 7 ( 1 ) " " "*"
## 8 ( 1 ) "*" "*"
## 9 ( 1 ) "*" "*"
## 10 ( 1 ) "*" "*"
## 11 ( 1 ) "*" "*"
## 12 ( 1 ) "*" "*"
## 13 ( 1 ) "*" "*"
## 14 ( 1 ) "*" "*"
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoBuscar empleo motivo_trasladoTrámites
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoNo contesta zona_destinoAMM
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " "*"
## 7 ( 1 ) " " "*"
## 8 ( 1 ) " " "*"
## 9 ( 1 ) " " "*"
## 10 ( 1 ) " " "*"
## 11 ( 1 ) " " "*"
## 12 ( 1 ) " " "*"
## 13 ( 1 ) " " "*"
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## zona_destinoMunicipios de la periferia usa_transporte_publicoSí
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " "*"
## 11 ( 1 ) " " "*"
## 12 ( 1 ) " " "*"
## 13 ( 1 ) " " "*"
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## traslados_semanales_motivo
## 1 ( 1 ) " "
## 2 ( 1 ) " "
## 3 ( 1 ) " "
## 4 ( 1 ) " "
## 5 ( 1 ) " "
## 6 ( 1 ) " "
## 7 ( 1 ) " "
## 8 ( 1 ) " "
## 9 ( 1 ) " "
## 10 ( 1 ) " "
## 11 ( 1 ) " "
## 12 ( 1 ) " "
## 13 ( 1 ) " "
## 14 ( 1 ) " "
## 15 ( 1 ) " "
## 16 ( 1 ) " "
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"# Se utiliza el estadístico R2 ajustada para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 13.
which.max(reg.full.summary$adjr2) #Variables óptimas según el estadístico AdjustedRsq## [1] 13plot(reg.full.summary$adjr2 ,xlab =" Number of Variables ", ylab=" Adjusted RSq",type="l")
points(13,reg.full.summary$adjr2[13],col ="red",cex =2, pch =20)
# Se utiliza el estadístico bic para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 7.
which.min(reg.full.summary$bic) #Variables óptimas según el estadístico bic## [1] 7plot(reg.full.summary$bic ,xlab =" Number of Variables ", ylab="bic",type="l")
points(7,reg.full.summary$bic[7],col ="red",cex =2, pch =20)
#Se utiliza el estadístico cp para saber cuántas variables hay que usar en el modelo.
#El resultado de esta prueba fueron 10.
which.min(reg.full.summary$cp) #Variables óptimas según el estadístico Cp## [1] 10plot(reg.full.summary$cp ,xlab =" Number of Variables ", ylab="Cp",type="l")
points(10,reg.full.summary$cp[10],col ="red",cex =2, pch =20)
Forward
#Usar regsubsets forward para elegir las variables más importantes del modelo.
regfit.fwd <- regsubsets(tiempo_total_traslado~ ingresos_nivel_socioeconomico + sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado + zona_destino + usa_transporte_publico + traslados_semanales_motivo, eav2024_final, method = "forward", nvmax=19)## Warning in leaps.setup(x, y, wt = wt, nbest = nbest, nvmax = nvmax, force.in =
## force.in, : 2 linear dependencies found## Reordering variables and trying again:reg.fwd.summary <- summary(regfit.fwd)
reg.fwd.summary## Subset selection object
## Call: regsubsets.formula(tiempo_total_traslado ~ ingresos_nivel_socioeconomico +
## sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado +
## zona_destino + usa_transporte_publico + traslados_semanales_motivo,
## eav2024_final, method = "forward", nvmax = 19)
## 27 Variables (and intercept)
## Forced in Forced out
## ingresos_nivel_socioeconomicoD FALSE FALSE
## ingresos_nivel_socioeconomicoD+ FALSE FALSE
## ingresos_nivel_socioeconomicoC FALSE FALSE
## ingresos_nivel_socioeconomicoC+ FALSE FALSE
## ingresos_nivel_socioeconomicoA/B FALSE FALSE
## ingresos_nivel_socioeconomicoNo contesta FALSE FALSE
## sexoMujer FALSE FALSE
## edad FALSE FALSE
## Medio_transporte2Transporte_publico_colectivo FALSE FALSE
## Medio_transporte2Medios_no_motorizados FALSE FALSE
## Medio_transporte2Transporte_privado_colectivo FALSE FALSE
## vehiculos_hogar FALSE FALSE
## motivo_trasladoEscuela FALSE FALSE
## motivo_trasladoCompras FALSE FALSE
## motivo_trasladoMédico_u_hospital FALSE FALSE
## motivo_trasladoDiversión FALSE FALSE
## motivo_trasladoAcompañar o llevar a alguien FALSE FALSE
## motivo_trasladoBanco o pago de servicios FALSE FALSE
## motivo_trasladoVisita FALSE FALSE
## motivo_trasladoBuscar empleo FALSE FALSE
## motivo_trasladoTrámites FALSE FALSE
## zona_destinoAMM FALSE FALSE
## zona_destinoMunicipios de la periferia FALSE FALSE
## usa_transporte_publicoSí FALSE FALSE
## traslados_semanales_motivo FALSE FALSE
## ingresos_nivel_socioeconomicoNo sabe FALSE FALSE
## motivo_trasladoNo contesta FALSE FALSE
## 1 subsets of each size up to 20
## Selection Algorithm: forward
## ingresos_nivel_socioeconomicoD ingresos_nivel_socioeconomicoD+
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " " "
## 15 ( 1 ) " " " "
## 16 ( 1 ) " " " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## ingresos_nivel_socioeconomicoC ingresos_nivel_socioeconomicoC+
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## ingresos_nivel_socioeconomicoA/B ingresos_nivel_socioeconomicoNo sabe
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## ingresos_nivel_socioeconomicoNo contesta sexoMujer edad
## 1 ( 1 ) " " " " " "
## 2 ( 1 ) " " " " " "
## 3 ( 1 ) " " " " " "
## 4 ( 1 ) " " " " " "
## 5 ( 1 ) " " " " " "
## 6 ( 1 ) " " " " " "
## 7 ( 1 ) " " "*" " "
## 8 ( 1 ) " " "*" " "
## 9 ( 1 ) " " "*" " "
## 10 ( 1 ) " " "*" " "
## 11 ( 1 ) " " "*" " "
## 12 ( 1 ) " " "*" "*"
## 13 ( 1 ) " " "*" "*"
## 14 ( 1 ) " " "*" "*"
## 15 ( 1 ) " " "*" "*"
## 16 ( 1 ) " " "*" "*"
## 17 ( 1 ) " " "*" "*"
## 18 ( 1 ) " " "*" "*"
## 19 ( 1 ) " " "*" "*"
## 20 ( 1 ) " " "*" "*"
## Medio_transporte2Transporte_publico_colectivo
## 1 ( 1 ) "*"
## 2 ( 1 ) "*"
## 3 ( 1 ) "*"
## 4 ( 1 ) "*"
## 5 ( 1 ) "*"
## 6 ( 1 ) "*"
## 7 ( 1 ) "*"
## 8 ( 1 ) "*"
## 9 ( 1 ) "*"
## 10 ( 1 ) "*"
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## Medio_transporte2Medios_no_motorizados
## 1 ( 1 ) " "
## 2 ( 1 ) "*"
## 3 ( 1 ) "*"
## 4 ( 1 ) "*"
## 5 ( 1 ) "*"
## 6 ( 1 ) "*"
## 7 ( 1 ) "*"
## 8 ( 1 ) "*"
## 9 ( 1 ) "*"
## 10 ( 1 ) "*"
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## Medio_transporte2Transporte_privado_colectivo vehiculos_hogar
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) "*" " "
## 5 ( 1 ) "*" " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoEscuela motivo_trasladoCompras
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " " "
## 15 ( 1 ) " " " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" "*"
## motivo_trasladoMédico_u_hospital motivo_trasladoDiversión
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) "*" " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## motivo_trasladoAcompañar o llevar a alguien
## 1 ( 1 ) " "
## 2 ( 1 ) " "
## 3 ( 1 ) " "
## 4 ( 1 ) " "
## 5 ( 1 ) " "
## 6 ( 1 ) " "
## 7 ( 1 ) " "
## 8 ( 1 ) " "
## 9 ( 1 ) " "
## 10 ( 1 ) " "
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## motivo_trasladoBanco o pago de servicios motivo_trasladoVisita
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " "*"
## 4 ( 1 ) " " "*"
## 5 ( 1 ) " " "*"
## 6 ( 1 ) " " "*"
## 7 ( 1 ) " " "*"
## 8 ( 1 ) "*" "*"
## 9 ( 1 ) "*" "*"
## 10 ( 1 ) "*" "*"
## 11 ( 1 ) "*" "*"
## 12 ( 1 ) "*" "*"
## 13 ( 1 ) "*" "*"
## 14 ( 1 ) "*" "*"
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoBuscar empleo motivo_trasladoTrámites
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoNo contesta zona_destinoAMM
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " "*"
## 7 ( 1 ) " " "*"
## 8 ( 1 ) " " "*"
## 9 ( 1 ) " " "*"
## 10 ( 1 ) " " "*"
## 11 ( 1 ) " " "*"
## 12 ( 1 ) " " "*"
## 13 ( 1 ) " " "*"
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## zona_destinoMunicipios de la periferia usa_transporte_publicoSí
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " "*"
## 11 ( 1 ) " " "*"
## 12 ( 1 ) " " "*"
## 13 ( 1 ) " " "*"
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## traslados_semanales_motivo
## 1 ( 1 ) " "
## 2 ( 1 ) " "
## 3 ( 1 ) " "
## 4 ( 1 ) " "
## 5 ( 1 ) " "
## 6 ( 1 ) " "
## 7 ( 1 ) " "
## 8 ( 1 ) " "
## 9 ( 1 ) " "
## 10 ( 1 ) " "
## 11 ( 1 ) " "
## 12 ( 1 ) " "
## 13 ( 1 ) " "
## 14 ( 1 ) " "
## 15 ( 1 ) " "
## 16 ( 1 ) " "
## 17 ( 1 ) " "
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"# Se utiliza el estadístico R2 ajustada para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 13.
which.max(reg.fwd.summary$adjr2) ##Variables óptimas según el estadístico AdjustedRsq## [1] 13plot(reg.fwd.summary$adjr2 ,xlab =" Number of Variables ", ylab=" Adjusted RSq",type="l")
points(13,reg.fwd.summary$adjr2[13],col ="red",cex =2, pch =20)
# Se utiliza el estadístico bic para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 7.
which.min(reg.fwd.summary$bic) #Variables óptimas según el estadístico bic ## [1] 7plot(reg.fwd.summary$bic ,xlab =" Number of Variables ", ylab="bic",type="l")
points(7,reg.fwd.summary$bic[7],col ="red",cex =2, pch =20)
# Se utiliza el estadístico cp para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 10.
which.min(reg.fwd.summary$cp) #Variables óptimas según el estadístico Cp## [1] 10plot(reg.fwd.summary$cp ,xlab =" Number of Variables ", ylab="Cp",type="l")
points(10,reg.fwd.summary$cp[10],col ="red",cex =2, pch =20)
Backward
#Usar regsubsets backward para elegir las variables más importantes del modelo.
regfit.bkw <- regsubsets(tiempo_total_traslado~ ingresos_nivel_socioeconomico + sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado + zona_destino + usa_transporte_publico + traslados_semanales_motivo, eav2024_final, method = "backward", nvmax=19)## Warning in leaps.setup(x, y, wt = wt, nbest = nbest, nvmax = nvmax, force.in =
## force.in, : 2 linear dependencies found## Reordering variables and trying again:reg.bkw.summary <- summary(regfit.bkw)
reg.bkw.summary## Subset selection object
## Call: regsubsets.formula(tiempo_total_traslado ~ ingresos_nivel_socioeconomico +
## sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado +
## zona_destino + usa_transporte_publico + traslados_semanales_motivo,
## eav2024_final, method = "backward", nvmax = 19)
## 27 Variables (and intercept)
## Forced in Forced out
## ingresos_nivel_socioeconomicoD FALSE FALSE
## ingresos_nivel_socioeconomicoD+ FALSE FALSE
## ingresos_nivel_socioeconomicoC FALSE FALSE
## ingresos_nivel_socioeconomicoC+ FALSE FALSE
## ingresos_nivel_socioeconomicoA/B FALSE FALSE
## ingresos_nivel_socioeconomicoNo contesta FALSE FALSE
## sexoMujer FALSE FALSE
## edad FALSE FALSE
## Medio_transporte2Transporte_publico_colectivo FALSE FALSE
## Medio_transporte2Medios_no_motorizados FALSE FALSE
## Medio_transporte2Transporte_privado_colectivo FALSE FALSE
## vehiculos_hogar FALSE FALSE
## motivo_trasladoEscuela FALSE FALSE
## motivo_trasladoCompras FALSE FALSE
## motivo_trasladoMédico_u_hospital FALSE FALSE
## motivo_trasladoDiversión FALSE FALSE
## motivo_trasladoAcompañar o llevar a alguien FALSE FALSE
## motivo_trasladoBanco o pago de servicios FALSE FALSE
## motivo_trasladoVisita FALSE FALSE
## motivo_trasladoBuscar empleo FALSE FALSE
## motivo_trasladoTrámites FALSE FALSE
## zona_destinoAMM FALSE FALSE
## zona_destinoMunicipios de la periferia FALSE FALSE
## usa_transporte_publicoSí FALSE FALSE
## traslados_semanales_motivo FALSE FALSE
## ingresos_nivel_socioeconomicoNo sabe FALSE FALSE
## motivo_trasladoNo contesta FALSE FALSE
## 1 subsets of each size up to 20
## Selection Algorithm: backward
## ingresos_nivel_socioeconomicoD ingresos_nivel_socioeconomicoD+
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " " "
## 15 ( 1 ) " " " "
## 16 ( 1 ) " " " "
## 17 ( 1 ) " " " "
## 18 ( 1 ) " " " "
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## ingresos_nivel_socioeconomicoC ingresos_nivel_socioeconomicoC+
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## ingresos_nivel_socioeconomicoA/B ingresos_nivel_socioeconomicoNo sabe
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## ingresos_nivel_socioeconomicoNo contesta sexoMujer edad
## 1 ( 1 ) " " " " " "
## 2 ( 1 ) " " " " " "
## 3 ( 1 ) " " " " " "
## 4 ( 1 ) " " " " " "
## 5 ( 1 ) " " " " " "
## 6 ( 1 ) " " " " " "
## 7 ( 1 ) " " "*" " "
## 8 ( 1 ) " " "*" " "
## 9 ( 1 ) " " "*" " "
## 10 ( 1 ) " " "*" " "
## 11 ( 1 ) " " "*" " "
## 12 ( 1 ) " " "*" "*"
## 13 ( 1 ) " " "*" "*"
## 14 ( 1 ) " " "*" "*"
## 15 ( 1 ) " " "*" "*"
## 16 ( 1 ) " " "*" "*"
## 17 ( 1 ) " " "*" "*"
## 18 ( 1 ) " " "*" "*"
## 19 ( 1 ) " " "*" "*"
## 20 ( 1 ) "*" "*" "*"
## Medio_transporte2Transporte_publico_colectivo
## 1 ( 1 ) "*"
## 2 ( 1 ) "*"
## 3 ( 1 ) "*"
## 4 ( 1 ) "*"
## 5 ( 1 ) "*"
## 6 ( 1 ) "*"
## 7 ( 1 ) "*"
## 8 ( 1 ) "*"
## 9 ( 1 ) "*"
## 10 ( 1 ) "*"
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## Medio_transporte2Medios_no_motorizados
## 1 ( 1 ) " "
## 2 ( 1 ) "*"
## 3 ( 1 ) "*"
## 4 ( 1 ) "*"
## 5 ( 1 ) "*"
## 6 ( 1 ) "*"
## 7 ( 1 ) "*"
## 8 ( 1 ) "*"
## 9 ( 1 ) "*"
## 10 ( 1 ) "*"
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## Medio_transporte2Transporte_privado_colectivo vehiculos_hogar
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) "*" " "
## 5 ( 1 ) "*" " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoEscuela motivo_trasladoCompras
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) " " " "
## 14 ( 1 ) " " " "
## 15 ( 1 ) " " " "
## 16 ( 1 ) " " " "
## 17 ( 1 ) " " " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## motivo_trasladoMédico_u_hospital motivo_trasladoDiversión
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) "*" " "
## 6 ( 1 ) "*" " "
## 7 ( 1 ) "*" " "
## 8 ( 1 ) "*" " "
## 9 ( 1 ) "*" " "
## 10 ( 1 ) "*" " "
## 11 ( 1 ) "*" " "
## 12 ( 1 ) "*" " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" " "
## 18 ( 1 ) "*" " "
## 19 ( 1 ) "*" " "
## 20 ( 1 ) "*" " "
## motivo_trasladoAcompañar o llevar a alguien
## 1 ( 1 ) " "
## 2 ( 1 ) " "
## 3 ( 1 ) " "
## 4 ( 1 ) " "
## 5 ( 1 ) " "
## 6 ( 1 ) " "
## 7 ( 1 ) " "
## 8 ( 1 ) " "
## 9 ( 1 ) " "
## 10 ( 1 ) " "
## 11 ( 1 ) "*"
## 12 ( 1 ) "*"
## 13 ( 1 ) "*"
## 14 ( 1 ) "*"
## 15 ( 1 ) "*"
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"
## motivo_trasladoBanco o pago de servicios motivo_trasladoVisita
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " "*"
## 4 ( 1 ) " " "*"
## 5 ( 1 ) " " "*"
## 6 ( 1 ) " " "*"
## 7 ( 1 ) " " "*"
## 8 ( 1 ) "*" "*"
## 9 ( 1 ) "*" "*"
## 10 ( 1 ) "*" "*"
## 11 ( 1 ) "*" "*"
## 12 ( 1 ) "*" "*"
## 13 ( 1 ) "*" "*"
## 14 ( 1 ) "*" "*"
## 15 ( 1 ) "*" "*"
## 16 ( 1 ) "*" "*"
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoBuscar empleo motivo_trasladoTrámites
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " " "
## 11 ( 1 ) " " " "
## 12 ( 1 ) " " " "
## 13 ( 1 ) "*" " "
## 14 ( 1 ) "*" " "
## 15 ( 1 ) "*" " "
## 16 ( 1 ) "*" " "
## 17 ( 1 ) "*" "*"
## 18 ( 1 ) "*" "*"
## 19 ( 1 ) "*" "*"
## 20 ( 1 ) "*" "*"
## motivo_trasladoNo contesta zona_destinoAMM
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " "*"
## 7 ( 1 ) " " "*"
## 8 ( 1 ) " " "*"
## 9 ( 1 ) " " "*"
## 10 ( 1 ) " " "*"
## 11 ( 1 ) " " "*"
## 12 ( 1 ) " " "*"
## 13 ( 1 ) " " "*"
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## zona_destinoMunicipios de la periferia usa_transporte_publicoSí
## 1 ( 1 ) " " " "
## 2 ( 1 ) " " " "
## 3 ( 1 ) " " " "
## 4 ( 1 ) " " " "
## 5 ( 1 ) " " " "
## 6 ( 1 ) " " " "
## 7 ( 1 ) " " " "
## 8 ( 1 ) " " " "
## 9 ( 1 ) " " " "
## 10 ( 1 ) " " "*"
## 11 ( 1 ) " " "*"
## 12 ( 1 ) " " "*"
## 13 ( 1 ) " " "*"
## 14 ( 1 ) " " "*"
## 15 ( 1 ) " " "*"
## 16 ( 1 ) " " "*"
## 17 ( 1 ) " " "*"
## 18 ( 1 ) " " "*"
## 19 ( 1 ) " " "*"
## 20 ( 1 ) " " "*"
## traslados_semanales_motivo
## 1 ( 1 ) " "
## 2 ( 1 ) " "
## 3 ( 1 ) " "
## 4 ( 1 ) " "
## 5 ( 1 ) " "
## 6 ( 1 ) " "
## 7 ( 1 ) " "
## 8 ( 1 ) " "
## 9 ( 1 ) " "
## 10 ( 1 ) " "
## 11 ( 1 ) " "
## 12 ( 1 ) " "
## 13 ( 1 ) " "
## 14 ( 1 ) " "
## 15 ( 1 ) " "
## 16 ( 1 ) "*"
## 17 ( 1 ) "*"
## 18 ( 1 ) "*"
## 19 ( 1 ) "*"
## 20 ( 1 ) "*"# Se utiliza el estadístico R2 ajustada para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 13.
which.max(reg.bkw.summary$adjr2) #Variables óptimas según el estadístico AdjustedRsq## [1] 13plot(reg.bkw.summary$adjr2 ,xlab =" Number of Variables ", ylab=" Adjusted RSq",type="l")
points(13,reg.bkw.summary$adjr2[13],col ="red",cex =2, pch =20)
# Se utiliza el estadístico bic para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 7.
which.min(reg.bkw.summary$bic) #Variables óptimas según el estadístico bic## [1] 7plot(reg.bkw.summary$bic ,xlab =" Number of Variables ", ylab="bic",type="l")
points(7,reg.bkw.summary$bic[7],col ="red",cex =2, pch =20)
# Se utiliza el estadístico cp para saber cuántas variables hay que usar en el modelo.
# El resultado de esta prueba fueron 10.
which.min(reg.bkw.summary$cp) #Variables óptimas según el estadístico Cp## [1] 10plot(reg.bkw.summary$cp ,xlab =" Number of Variables ", ylab="Cp",type="l")
points(10,reg.bkw.summary$cp[10],col ="red",cex =2, pch =20)
De acuerdo con full, forward y backward, utilizando el estadístico de prueba bic, se utilizarán 7 sub-variables:
sexoMujer
Medio_transporte2Transporte_publico_colectivo
Medio_transporte2Medios_no_motorizados
Medio_transporte2Transporte_privado_colectivo
motivo_trasladoMédico u hospital,
motivo_trasladoVisita
zona_destinoAMM
Es decir 4 variables:
Sexo
Medio_transporte2
motivo_traslado
zona_destino
No se usa pls porque no hay muchas variables pre-seleccionadas.
Modelo lineal 2 con las variables seleccionadas por regsubsets full, backward y forward con el estadístico bic.
#Modelo lineal 2 con las 4 variables
lm_model2 <- lm(tiempo_total_traslado ~ sexo + Medio_transporte2 + motivo_traslado + zona_destino, data= train_data, weights = Factor_CVNL)
summary(lm_model2)##
## Call:
## lm(formula = tiempo_total_traslado ~ sexo + Medio_transporte2 +
## motivo_traslado + zona_destino, data = train_data, weights = Factor_CVNL)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -7082.8 -969.7 -230.6 676.6 23533.7
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 65.065 5.800 11.219
## sexoMujer -13.377 3.185 -4.200
## Medio_transporte2Transporte_publico_colectivo 99.856 3.459 28.869
## Medio_transporte2Medios_no_motorizados -31.497 4.340 -7.258
## Medio_transporte2Transporte_privado_colectivo 35.624 5.807 6.135
## motivo_trasladoEscuela 1.293 5.619 0.230
## motivo_trasladoCompras -4.160 4.179 -0.995
## motivo_trasladoMédico_u_hospital 30.758 6.970 4.413
## motivo_trasladoDiversión 4.704 7.299 0.645
## motivo_trasladoAcompañar o llevar a alguien 9.752 9.064 1.076
## motivo_trasladoBanco o pago de servicios -7.039 14.531 -0.484
## motivo_trasladoVisita 55.793 6.310 8.842
## motivo_trasladoBuscar empleo -11.263 22.329 -0.504
## motivo_trasladoTrámites -26.802 31.612 -0.848
## zona_destinoAMM 6.321 5.660 1.117
## zona_destinoMunicipios de la periferia 1.884 8.323 0.226
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## sexoMujer 2.79e-05 ***
## Medio_transporte2Transporte_publico_colectivo < 2e-16 ***
## Medio_transporte2Medios_no_motorizados 5.58e-13 ***
## Medio_transporte2Transporte_privado_colectivo 1.02e-09 ***
## motivo_trasladoEscuela 0.818
## motivo_trasladoCompras 0.320
## motivo_trasladoMédico_u_hospital 1.07e-05 ***
## motivo_trasladoDiversión 0.519
## motivo_trasladoAcompañar o llevar a alguien 0.282
## motivo_trasladoBanco o pago de servicios 0.628
## motivo_trasladoVisita < 2e-16 ***
## motivo_trasladoBuscar empleo 0.614
## motivo_trasladoTrámites 0.397
## zona_destinoAMM 0.264
## zona_destinoMunicipios de la periferia 0.821
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1975 on 2013 degrees of freedom
## Multiple R-squared: 0.4027, Adjusted R-squared: 0.3983
## F-statistic: 90.48 on 15 and 2013 DF, p-value: < 2.2e-16vif(lm_model2) ## GVIF Df GVIF^(1/(2*Df))
## sexo 1.191259 1 1.091448
## Medio_transporte2 1.172603 3 1.026893
## motivo_traslado 1.314738 9 1.015318
## zona_destino 1.046402 2 1.011404#Multicolinearidad -> que las variables no digan lo mismo. Debe salir menor a 10
# Realiza predicciones sobre el conjunto de prueba
test_data$predicted_tiempo_total_traslado <- predict(lm_model2, newdata = test_data)
# Métricas
rmse_lm2 <- sqrt(mean((test_data$tiempo_total_traslado - test_data$predicted_tiempo_total_traslado)^2))
#En promedio cuánto se distancia el error del valor real
r_squared <- cor(test_data$tiempo_total_traslado, test_data$predicted_tiempo_total_traslado)^2
cat("RMSE:", rmse_lm2, "\nR-squared:", r_squared, "\n")## RMSE: 66.88928
## R-squared: 0.3880475sd(test_data$tiempo_total_traslado)## [1] 85.45631#Si RMSE es menor a la desviación estándar funciona bien la predicciónSe realizará otro lm_model para incluir la variable numérica edad, en vez de Categoría_edad
lm_model3 <- lm(tiempo_total_traslado ~ sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino, data= train_data, weights = Factor_CVNL)
summary(lm_model3)##
## Call:
## lm(formula = tiempo_total_traslado ~ sexo + edad + Medio_transporte2 +
## motivo_traslado + zona_destino, data = train_data, weights = Factor_CVNL)
##
## Weighted Residuals:
## Min 1Q Median 3Q Max
## -7177.3 -964.2 -226.6 651.4 23562.8
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) 71.9827 7.3782 9.756
## sexoMujer -13.7911 3.1959 -4.315
## edad -0.1573 0.1038 -1.516
## Medio_transporte2Transporte_publico_colectivo 99.5039 3.4656 28.712
## Medio_transporte2Medios_no_motorizados -31.1326 4.3448 -7.165
## Medio_transporte2Transporte_privado_colectivo 35.1603 5.8129 6.049
## motivo_trasladoEscuela -0.9755 5.8133 -0.168
## motivo_trasladoCompras -2.9713 4.2508 -0.699
## motivo_trasladoMédico_u_hospital 33.3628 7.1764 4.649
## motivo_trasladoDiversión 5.9511 7.3427 0.810
## motivo_trasladoAcompañar o llevar a alguien 10.1310 9.0644 1.118
## motivo_trasladoBanco o pago de servicios -4.9763 14.5895 -0.341
## motivo_trasladoVisita 57.4087 6.3971 8.974
## motivo_trasladoBuscar empleo -11.5942 22.3225 -0.519
## motivo_trasladoTrámites -29.9018 31.6682 -0.944
## zona_destinoAMM 6.1590 5.6591 1.088
## zona_destinoMunicipios de la periferia 1.3700 8.3268 0.165
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## sexoMujer 1.67e-05 ***
## edad 0.130
## Medio_transporte2Transporte_publico_colectivo < 2e-16 ***
## Medio_transporte2Medios_no_motorizados 1.08e-12 ***
## Medio_transporte2Transporte_privado_colectivo 1.74e-09 ***
## motivo_trasladoEscuela 0.867
## motivo_trasladoCompras 0.485
## motivo_trasladoMédico_u_hospital 3.55e-06 ***
## motivo_trasladoDiversión 0.418
## motivo_trasladoAcompañar o llevar a alguien 0.264
## motivo_trasladoBanco o pago de servicios 0.733
## motivo_trasladoVisita < 2e-16 ***
## motivo_trasladoBuscar empleo 0.604
## motivo_trasladoTrámites 0.345
## zona_destinoAMM 0.277
## zona_destinoMunicipios de la periferia 0.869
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1974 on 2012 degrees of freedom
## Multiple R-squared: 0.4034, Adjusted R-squared: 0.3986
## F-statistic: 85.03 on 16 and 2012 DF, p-value: < 2.2e-16vif(lm_model3) ## GVIF Df GVIF^(1/(2*Df))
## sexo 1.200023 1 1.095456
## edad 1.256410 1 1.120897
## Medio_transporte2 1.187331 3 1.029031
## motivo_traslado 1.626741 9 1.027401
## zona_destino 1.048215 2 1.011842#Multicolinearidad -> que las variables no digan lo mismo. Debe salir menor a 10
# Realiza predicciones sobre el conjunto de prueba
test_data$predicted_tiempo_total_traslado <- predict(lm_model3, newdata = test_data)
# Métricas (RMSE, Accuracy, matriz de confusión, etc.)
rmse_lm3 <- sqrt(mean((test_data$tiempo_total_traslado - test_data$predicted_tiempo_total_traslado)^2))
#En promedio cuánto se distancia el error del valor real
r_squared <- cor(test_data$tiempo_total_traslado, test_data$predicted_tiempo_total_traslado)^2
cat("RMSE:", rmse_lm3, "\nR-squared:", r_squared, "\n")## RMSE: 66.95124
## R-squared: 0.386815sd(test_data$tiempo_total_traslado)## [1] 85.45631#Si RMSE es menor a la desviación estándar funciona bien la predicciónEste modelo (lm_model3) y el modelo lm_model2 tienen un RMSE y R2 muy parecidos; por lo que es conveniente usar el lm_model3 que incluye la edad para realizar un análisis más completo, pues incluye una característica importante que define a las personas.
8. Regresión polinomial y splines
# Ajusta regresión polinomial: lm(y ~ poly(x, degree = 2), data = ...)
n <- 3 #escoge el grado que se usará
fit<-lm(tiempo_total_traslado~poly(edad,n), data=eav2024_final)
summary(fit)##
## Call:
## lm(formula = tiempo_total_traslado ~ poly(edad, n), data = eav2024_final)
##
## Residuals:
## Min 1Q Median 3Q Max
## -95.74 -61.06 -27.03 28.56 863.24
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 95.606 1.567 61.022 <2e-16 ***
## poly(edad, n)1 -216.788 84.358 -2.570 0.0102 *
## poly(edad, n)2 -122.353 84.358 -1.450 0.1471
## poly(edad, n)3 -183.483 84.358 -2.175 0.0297 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 84.36 on 2895 degrees of freedom
## Multiple R-squared: 0.004621, Adjusted R-squared: 0.003589
## F-statistic: 4.48 on 3 and 2895 DF, p-value: 0.003829# fit nos sirve para observar el grado de polinomio que debe utilizar la variable edad, la cual fue grado 3.edadlims<-range(eav2024_final$edad)
edadlims #Rango de edades## [1] 18 95Generar dichos valores
edad.grid<-seq (from=edadlims [1], to=edadlims [2])
edad.grid## [1] 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
## [26] 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
## [51] 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
## [76] 93 94 95Generar la predicción
preds<-predict(fit, newdata=list(edad=edad.grid),se=TRUE)
preds## $fit
## 1 2 3 4 5 6 7
## 104.705618 103.533340 102.462642 101.489327 100.609199 99.818059 99.111712
## 8 9 10 11 12 13 14
## 98.485960 97.936606 97.459453 97.050305 96.704964 96.419233 96.188916
## 15 16 17 18 19 20 21
## 96.009816 95.877735 95.788476 95.737843 95.721638 95.735666 95.775728
## 22 23 24 25 26 27 28
## 95.837627 95.917168 96.010152 96.112383 96.219663 96.327797 96.432587
## 29 30 31 32 33 34 35
## 96.529835 96.615346 96.684921 96.734365 96.759479 96.756068 96.719934
## 36 37 38 39 40 41 42
## 96.646880 96.532710 96.373225 96.164230 95.901527 95.580920 95.198211
## 43 44 45 46 47 48 49
## 94.749203 94.229700 93.635505 92.962420 92.206248 91.362793 90.427858
## 50 51 52 53 54 55 56
## 89.397246 88.266759 87.032201 85.689374 84.234083 82.662129 80.969316
## 57 58 59 60 61 62 63
## 79.151448 77.204326 75.123754 72.905535 70.545472 68.039368 65.383027
## 64 65 66 67 68 69 70
## 62.572250 59.602842 56.470605 53.171342 49.700857 46.054951 42.229430
## 71 72 73 74 75 76 77
## 38.220094 34.022748 29.633195 25.047237 20.260677 15.269319 10.068966
## 78
## 4.655421
##
## $se.fit
## 1 2 3 4 5 6 7 8
## 5.248195 4.654685 4.134047 3.687377 3.315420 3.017801 2.792029 2.632630
## 9 10 11 12 13 14 15 16
## 2.530931 2.475797 2.455101 2.457270 2.472362 2.492523 2.511970 2.526735
## 17 18 19 20 21 22 23 24
## 2.534334 2.533450 2.523675 2.505307 2.479190 2.446600 2.409150 2.368710
## 25 26 27 28 29 30 31 32
## 2.327331 2.287166 2.250378 2.219038 2.195007 2.179818 2.174570 2.179849
## 33 34 35 36 37 38 39 40
## 2.195699 2.221642 2.256752 2.299769 2.349233 2.403622 2.461487 2.521573
## 41 42 43 44 45 46 47 48
## 2.582924 2.644989 2.707713 2.771633 2.837967 2.908696 2.986635 3.075455
## 49 50 51 52 53 54 55 56
## 3.179663 3.304496 3.455723 3.639380 3.861439 4.127510 4.442593 4.810946
## 57 58 59 60 61 62 63 64
## 5.236067 5.720768 6.267302 6.877510 7.552954 8.295031 9.105055 9.984316
## 65 66 67 68 69 70 71 72
## 10.934117 11.955793 13.050730 14.220362 15.466175 16.789704 18.192528 19.676268
## 73 74 75 76 77 78
## 21.242579 22.893153 24.629705 26.453978 28.367736 30.372763
##
## $df
## [1] 2895
##
## $residual.scale
## [1] 84.35776Realizar anova para ver el mejor modelo polinomial para la edad.
fit.1 <- lm(tiempo_total_traslado~edad,data=eav2024_final)
fit.2 <- lm(tiempo_total_traslado~poly(edad,2),data=eav2024_final)
fit.3 <- lm(tiempo_total_traslado~poly(edad,3),data=eav2024_final)
fit.4 <- lm(tiempo_total_traslado~poly(edad,4),data=eav2024_final)
fit.5 <- lm(tiempo_total_traslado~poly(edad,5),data=eav2024_final)
anova(fit.1, fit.2, fit.3, fit.4, fit.5)## Analysis of Variance Table
##
## Model 1: tiempo_total_traslado ~ edad
## Model 2: tiempo_total_traslado ~ poly(edad, 2)
## Model 3: tiempo_total_traslado ~ poly(edad, 3)
## Model 4: tiempo_total_traslado ~ poly(edad, 4)
## Model 5: tiempo_total_traslado ~ poly(edad, 5)
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 2897 20650127
## 2 2896 20635157 1 14970 2.1079 0.14664
## 3 2895 20601491 1 33666 4.7405 0.02954 *
## 4 2894 20572691 1 28800 4.0553 0.04413 *
## 5 2893 20545454 1 27237 3.8352 0.05028 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Con la prueba ANOVA se muestra mayor significancia con el polinomio grado 3, por lo que ese será utilizado.
Modelo polinomial para la variable edad y mejorarlo con GAM para las variables categóricas.
pol_gam_fit <- gam(tiempo_total_traslado~poly(edad,3) + sexo + Medio_transporte2 + motivo_traslado + zona_destino, data=eav2024_final)
summary(pol_gam_fit)##
## Family: gaussian
## Link function: identity
##
## Formula:
## tiempo_total_traslado ~ poly(edad, 3) + sexo + Medio_transporte2 +
## motivo_traslado + zona_destino
##
## Parametric coefficients:
## Estimate Std. Error t value
## (Intercept) 59.1260 4.3358 13.637
## poly(edad, 3)1 -85.9612 73.5952 -1.168
## poly(edad, 3)2 -213.9071 70.6138 -3.029
## poly(edad, 3)3 73.2451 67.7733 1.081
## sexoMujer -10.6761 2.7645 -3.862
## Medio_transporte2Transporte_publico_colectivo 101.8423 3.0277 33.637
## Medio_transporte2Medios_no_motorizados -31.6674 3.7380 -8.472
## Medio_transporte2Transporte_privado_colectivo 39.7594 4.8324 8.228
## motivo_trasladoEscuela 8.3874 5.4535 1.538
## motivo_trasladoCompras 0.7925 3.6718 0.216
## motivo_trasladoMédico_u_hospital 38.6958 6.1477 6.294
## motivo_trasladoDiversión 4.2357 6.1346 0.690
## motivo_trasladoAcompañar o llevar a alguien 11.6424 7.5233 1.548
## motivo_trasladoBanco o pago de servicios -15.4028 12.7643 -1.207
## motivo_trasladoVisita 52.3414 5.7469 9.108
## motivo_trasladoBuscar empleo -16.5733 16.7086 -0.992
## motivo_trasladoTrámites -20.2508 38.3706 -0.528
## zona_destinoAMM 11.5052 4.2073 2.735
## zona_destinoMunicipios de la periferia -2.4837 6.2312 -0.399
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## poly(edad, 3)1 0.242893
## poly(edad, 3)2 0.002473 **
## poly(edad, 3)3 0.279905
## sexoMujer 0.000115 ***
## Medio_transporte2Transporte_publico_colectivo < 2e-16 ***
## Medio_transporte2Medios_no_motorizados < 2e-16 ***
## Medio_transporte2Transporte_privado_colectivo 2.86e-16 ***
## motivo_trasladoEscuela 0.124158
## motivo_trasladoCompras 0.829132
## motivo_trasladoMédico_u_hospital 3.56e-10 ***
## motivo_trasladoDiversión 0.489953
## motivo_trasladoAcompañar o llevar a alguien 0.121850
## motivo_trasladoBanco o pago de servicios 0.227642
## motivo_trasladoVisita < 2e-16 ***
## motivo_trasladoBuscar empleo 0.321330
## motivo_trasladoTrámites 0.597700
## zona_destinoAMM 0.006285 **
## zona_destinoMunicipios de la periferia 0.690220
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## R-sq.(adj) = 0.386 Deviance explained = 39%
## GCV = 4415.6 Scale est. = 4386.7 n = 2899Natural Spline
fit_NS<-lm(edad~ns(edad, df=3), data=eav2024_final) #Generar natural spline con tres grados de libertadGenerar los datos predichos:
pred_fit_NS<-predict(fit_NS, newdata=list(edad=edad.grid), se=T)Natural Spline con GAM
gam_ns_fit<-gam(tiempo_total_traslado~ns(edad, 3) + sexo + Medio_transporte2 + motivo_traslado + zona_destino, data=eav2024_final)
summary(gam_ns_fit)##
## Family: gaussian
## Link function: identity
##
## Formula:
## tiempo_total_traslado ~ ns(edad, 3) + sexo + Medio_transporte2 +
## motivo_traslado + zona_destino
##
## Parametric coefficients:
## Estimate Std. Error t value
## (Intercept) 53.5322 5.9770 8.956
## ns(edad, 3)1 1.8395 6.5460 0.281
## ns(edad, 3)2 -0.1951 13.4914 -0.014
## ns(edad, 3)3 -29.3460 14.8961 -1.970
## sexoMujer -10.6093 2.7637 -3.839
## Medio_transporte2Transporte_publico_colectivo 101.7119 3.0301 33.567
## Medio_transporte2Medios_no_motorizados -31.6160 3.7386 -8.457
## Medio_transporte2Transporte_privado_colectivo 39.7647 4.8330 8.228
## motivo_trasladoEscuela 7.7999 5.4351 1.435
## motivo_trasladoCompras 0.7126 3.6711 0.194
## motivo_trasladoMédico_u_hospital 38.5550 6.1460 6.273
## motivo_trasladoDiversión 4.1217 6.1334 0.672
## motivo_trasladoAcompañar o llevar a alguien 11.5492 7.5245 1.535
## motivo_trasladoBanco o pago de servicios -15.5306 12.7644 -1.217
## motivo_trasladoVisita 52.2325 5.7459 9.090
## motivo_trasladoBuscar empleo -16.6554 16.7102 -0.997
## motivo_trasladoTrámites -20.6233 38.3736 -0.537
## zona_destinoAMM 11.5349 4.2083 2.741
## zona_destinoMunicipios de la periferia -2.4733 6.2322 -0.397
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## ns(edad, 3)1 0.778719
## ns(edad, 3)2 0.988463
## ns(edad, 3)3 0.048929 *
## sexoMujer 0.000126 ***
## Medio_transporte2Transporte_publico_colectivo < 2e-16 ***
## Medio_transporte2Medios_no_motorizados < 2e-16 ***
## Medio_transporte2Transporte_privado_colectivo 2.85e-16 ***
## motivo_trasladoEscuela 0.151367
## motivo_trasladoCompras 0.846111
## motivo_trasladoMédico_u_hospital 4.07e-10 ***
## motivo_trasladoDiversión 0.501637
## motivo_trasladoAcompañar o llevar a alguien 0.124922
## motivo_trasladoBanco o pago de servicios 0.223814
## motivo_trasladoVisita < 2e-16 ***
## motivo_trasladoBuscar empleo 0.318984
## motivo_trasladoTrámites 0.591009
## zona_destinoAMM 0.006163 **
## zona_destinoMunicipios de la periferia 0.691504
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## R-sq.(adj) = 0.386 Deviance explained = 38.9%
## GCV = 4416.5 Scale est. = 4387.6 n = 2899Prueba ANOVA entre modelo GAM-Natural spline y GAM-Polinomial
anova(gam_ns_fit, pol_gam_fit)## Analysis of Deviance Table
##
## Model 1: tiempo_total_traslado ~ ns(edad, 3) + sexo + Medio_transporte2 +
## motivo_traslado + zona_destino
## Model 2: tiempo_total_traslado ~ poly(edad, 3) + sexo + Medio_transporte2 +
## motivo_traslado + zona_destino
## Resid. Df Resid. Dev Df Deviance F Pr(>F)
## 1 2880 12636288
## 2 2880 12633701 0 2587.5#Si sale significante el 2do es mejor. Sino el primero es mejor.Como no salió significante pol_gam_fit, significa que el modelo gam_ns_fit es mejor.
# Modelo de predicción
test_data$predicted_tiempo_total_traslado <- predict(gam_ns_fit, newdata = test_data)
# Métricas
rmse_gam_ns <- sqrt(mean((test_data$tiempo_total_traslado - test_data$predicted_tiempo_total_traslado)^2))
#En promedio cuánto se distancia el error del valor real
r_squared <- cor(test_data$tiempo_total_traslado, test_data$predicted_tiempo_total_traslado)^2
cat("RMSE:", rmse_gam_ns, "\nR-squared:", r_squared, "\n")## RMSE: 66.55325
## R-squared: 0.3930861sd(test_data$tiempo_total_traslado)## [1] 85.45631#Si RMSE es menor a la desviación estándar funciona bien la predicción9. Árboles de decisiones
# Entrena árbol de decisión con las variables seleccionadas
set.seed(123)
eav2024.data.test<-(eav2024_final)[-train_index, ]
tree.eav2024<-tree(tiempo_total_traslado ~ sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino, data=eav2024_final, subset=train_index)
summary(tree.eav2024)##
## Regression tree:
## tree(formula = tiempo_total_traslado ~ sexo + edad + Medio_transporte2 +
## motivo_traslado + zona_destino, data = eav2024_final, subset = train_index)
## Variables actually used in tree construction:
## [1] "Medio_transporte2" "motivo_traslado"
## Number of terminal nodes: 5
## Residual mean deviance: 4387 = 8879000 / 2024
## Distribution of residuals:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -217 -40 -10 0 20 890# Trazar árbol de decisión 1
plot(tree.eav2024)
text(tree.eav2024, pretty=0)
Ahora utilizamos la función cv.tree() para ver si podar el árbol mejorará el rendimiento
cv.eav2024<-cv.tree(tree.eav2024)
plot(cv.eav2024$size, cv.eav2024$dev, type="b")
#Cantidad de niveles con el árbol, se hace con cross-validationDe acuerdo con los resultados de la validación cruzada se encesitan 5 niveles, por lo que utilizamos las predicciones de árbol sin podar para hacer predicciones en el conjunto de prueba.
tree.eav2024## node), split, n, deviance, yval
## * denotes terminal node
##
## 1) root 2029 14340000 94.31
## 2) Medio_transporte2: Medios_motorizados_no_colectivos,Medios_no_motorizados,Transporte_privado_colectivo 1497 5682000 66.42
## 4) Medio_transporte2: Medios_no_motorizados 313 356000 32.65 *
## 5) Medio_transporte2: Medios_motorizados_no_colectivos,Transporte_privado_colectivo 1184 4875000 75.35
## 10) Medio_transporte2: Medios_motorizados_no_colectivos 1016 3959000 70.00 *
## 11) Medio_transporte2: Transporte_privado_colectivo 168 711500 107.70 *
## 3) Medio_transporte2: Transporte_publico_colectivo 532 4216000 172.80
## 6) motivo_traslado: Trabajo,Escuela,Compras,Médico_u_hospital,Diversión,Acompañar o llevar a alguien,Banco o pago de servicios,Buscar empleo,Trámites 490 3252000 165.20 *
## 7) motivo_traslado: Visita 42 600800 262.00 *eav2024.pred <- predict(tree.eav2024, newdata = test_data)
# Extraer valores reales
eav2024.test <- test_data$tiempo_total_traslado
# Calcular RMSE (raíz del error cuadrático medio)
rmse_tree <- sqrt(mean((eav2024.pred - eav2024.test)^2))
print(rmse_tree)## [1] 67.22333Random Forest
# Entrenamiento, predicción y métrica rmse de random forest
set.seed(123)
rf.eav.2024<-randomForest(tiempo_total_traslado ~ sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino,data=eav2024_final, subset=train_index, mtry=5,importance =TRUE)
eav.2024.pred.rf <- predict(rf.eav.2024, newdata=eav2024.data.test)
rmse_rf <- sqrt(mean((eav.2024.pred.rf-eav2024.test)^2))
rmse_rf## [1] 72.82997importance(rf.eav.2024)## %IncMSE IncNodePurity
## sexo 9.211475 426268.2
## edad 12.418658 3457605.1
## Medio_transporte2 117.651944 5102992.3
## motivo_traslado 37.015140 1372024.1
## zona_destino 8.063999 674895.6varImpPlot(rf.eav.2024)
# Se muestran las variables más importantes del análisis random forest# Entrenamiento, predicción y métrica rmse de boosting, usando 5000 árboles de decisión.
library(gbm)
set.seed(123)
boost.eav.2024<-gbm(tiempo_total_traslado ~ sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino,data=eav2024_final[train_index,], distribution="gaussian",n.trees=5000,interaction.depth=4)
eav.2024.pred.boost <- predict(boost.eav.2024, newdata=eav2024.data.test)## Using 5000 trees...rmse_boost <- sqrt(mean((eav.2024.pred.boost-eav2024.test)^2))
rmse_boost## [1] 78.52396summary(boost.eav.2024)
## var rel.inf
## edad edad 43.831449
## motivo_traslado motivo_traslado 24.260839
## Medio_transporte2 Medio_transporte2 21.666362
## zona_destino zona_destino 6.058294
## sexo sexo 4.183054Edad, Motivo_traslado y Medio_transporte son las 3 variables más importantes en este modelo.
10. Comparación de modelos y selección del mejor
| Modelo | ANOVA | RMSE | R2 | Variables |
|---|---|---|---|---|
| lm_model 1 | X | 67.41474 | 0.3780659 | ingresos_nivel_socioeconomico + sexo + edad + Medio_transporte2 + vehiculos_hogar + motivo_traslado + zona_destino + usa_transporte_publico + traslados_semanales_motivo |
| lm_model 2 | X | 66.88928 | 0.3880475 | sexo + Medio_transporte2 + motivo_traslado + zona_destino |
| lm_model 3 | X | 66.95124 | 0.3868150 | sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino |
| Polinomial - GAM | No significante | NA | 0.3860000 | poly(edad,3) + sexo + Medio_transporte2 + motivo_traslado + zona_destino |
| Natural Spline - GAM | Significante | 66.55325 | 0.3930861 | ns(edad, 3) + sexo + Medio_transporte2 + motivo_traslado + zona_destino |
| Árbol de decisión 1 | X | 67.22333 | NA | sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino |
| Random Forest | X | 72.82997 | NA | sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino |
| Boosting | X | 78.52396 | NA | sexo + edad + Medio_transporte2 + motivo_traslado + zona_destino |
Análisis modelos lineales:
- lm_model1 - Usa 9 variables independientes (ingresos_nivel_socioeconómico, sexo, edad, medio_transporte2, vehiculos_hogar, motivo_traslado, zona_destino, usa_transporte_publico y traslados_semanales_motivo) para explicar el tiempo total de traslado. RMSE = 67.41474 y R2 = 0.3780659.
- lm_model2 - Usa 4 variables independientes (sexo, Medio_transporte2, motivo_traslado y zona_destino) para explicar el tiempo total de traslado. RMSE = 66.88928 y R2 = 0.3880475.
- lm_model3 - Parecido al lm_model 2, pero añadiéndole la variable independiente numérica: edad. RMSE = 66.95124 y R2 = 0.386815
- Se descartó lm_model1 por tener el RMSE más alto, el R2 más bajo y por usar muchas variables.
*Se eligió el lm_model3*, ya que tiene un RMSE y R2 muy parecidos al lm_model 2; añadiendo que es conveniente usar el lm_model3 porque incluye la variable edad, lo cual ayuda para realizar un análisis más completo, pues incluye una característica importante que define.Análisis modelos no lineales:
- Realizando una prueba ANOVA entre los modelos Polinomial-GAM y Natural Spline-GAM, se encontró que el modelo Natural Spline-GAM es más significativo.
- Este modelo cuenta con un RMSE = 66.55325 y un R2 = 0.3930861.Análisis árboles de decisión:
- Árbol de decisión 1: RMSE = 67.22333
- Random Forest: RMSE = 72.82997
- Boosting: RMSE = 78.52396
- Se elige el Árbol de decisión 1 debido a que tiene el RMSE más bajo.Comparación de modelos elegidos:
Entre los tres modelos elegidos (lm_model3, Natural Spline-GAM y Árbol de decisión 1), se encuentra que todos tienen un RMSE muy parecido. Por lo que para elegir un modelo final se utiliza el principio de parsimonia, el cual dice que “si los modelos más complejos no aportan resultados positivos significativos, se debe elegir el modelo más simple”. Es por esto que se elige como modelo definitivo el lm_model3, el cual tiene un R2 de 0.3868.
Justificación de que un R2 de 0.3868 no es tan malo para encuestas de percepción:
Las encuestas de percepción se basan en opiniones, creencias y experiencias individuales. Esto introduce una variabilidad muy alta y ruido en los datos, debido a que:
- Las personas interpretan preguntas de forma distinta.
- Las respuestas están influenciadas por factores personales, emocionales o contextuales.
Por lo que en áreas de Ciencias Sociales, donde se trabaja con datos humanos y complejos, valores tan bajos de R2 como 0,10 a 0,30 a menudo se consideran aceptables o incluso buenos (Ganti, 2024).
11. Implementación en Shiny
# UI
## Formato del shiny
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "https://fonts.googleapis.com/css2?family=Nunito:wght@400;700&display=swap"),
tags$style(HTML("
body {
font-family: 'Nunito', sans-serif;
background-color: #f5f5f5;
}
h1, h2, h3 {
color: #732C8B;
font-weight: bold;
}
.well {
background-color: #ffffff;
border-left: 6px solid #FFB400;
box-shadow: 1px 1px 6px rgba(0,0,0,0.05);
}
.btn-primary, .btn {
background-color: #FFB400 !important;
color: white !important;
font-weight: bold;
border: none;
}
.btn:hover {
background-color: #e6a700 !important;
}
"))
),
#Contexto
h1("Movilidad y Transporte en Nuevo León"),
p("En Nuevo León, las desigualdades en movilidad afectan el acceso equitativo a empleo,
educación y servicios. Este análisis busca estimar cuánto tiempo dedica una persona
a sus traslados diarios según su sexo, edad, medio de transporte, motivo de traslado
y zona de destino, evidenciando cómo la movilidad reproduce o reduce las desigualdades sociales."),
p("Con base en la encuesta", strong ("Cómo Vamos Nuevo León 2024"), "se creo un simulador para medir
el tiempo de traslado que una persona hace diariamente, de acuerdo a sus condiciones sociodemográficas,"),
p(em("Nota: Los resultados son aproximados y de carácter informativo.")),
p(em("Esta herramienta utiliza datos de la encuesta ", strong("Cómo Vamos Nuevo León"),
", por lo que únicamente aplica para personas mayores de 18 años.")),
#Glosario
wellPanel(
h3("Glosario:"),
p(strong("Sexo: "), "Sexo reportado de la persona (Hombre o Mujer)."),
p(strong("Edad: "), "Edad de la persona en años cumplidos."),
p(strong("Medio de Transporte: "), "Principal medio de transporte utilizado para sus traslados diarios."),
tags$ul(
tags$li(strong("Medios motorizados no colectivos: "), "automóvil, taxi, Uber/aplicación móvil, motocicleta y tráiler."),
tags$li(strong("Transporte Público Colectivo: "), "camión/microbús, ecovía, metro y transmetro."),
tags$li(strong("Medios no motorizados: "), "bicicleta, a pie/camina/silla de ruedas."),
tags$li(strong("Transporte privado colectivo: "), "autobús privado, transporte de trabajo y transporte escolar.")
),
p(strong("Motivo de Traslado: "), "Razón principal por la que la persona realiza su viaje (trabajo, escuela, compras, etc.)."),
p(strong("Zona de destino: "), "Localidad hacia donde se traslada la persona en sus recorridos."),
tags$ul(
tags$li(strong("Región 1 – Área Metropolitana de Monterrey (AMM): "),
"Monterrey, Guadalupe, San Nicolás, Apodaca, Escobedo, San Pedro, Santiago, Juárez, García, Santa Catarina, Cadereyta"),
tags$li(strong("Región 2 – Periferia del AMM: "),
"El Carmen, Ciénega de Flores, Zuazua, Pesquería, Salinas Victoria"),
tags$li(strong("Región 3 – Resto de Nuevo León: "),
"Abasolo, Agualeguas, Allende, Anáhuac, Aramberri, Bustamante, y otros")
)
),
wellPanel(
h2("¡Hagamos un ejemplo! Simulemos cuánto tiempo tardas en tus traslados diarios"),
),
# Para poner inputs
wellPanel(
h2("Contesta la siguiente información"),
radioButtons("sexo", "¿Con qué sexo te identificas?", choices = c("Hombre", "Mujer"), inline = TRUE),
numericInput("edad", "¿Cuál es tu edad? (en números)", value = 18, min = 18, max = 95, step = 1),
selectizeInput("medio_transporte", "¿Cuál es tu medio de transporte principal?",
choices = c("Medio Motorizado No Colectivo", "Transporte Público Colectvo",
"Medios No Motorizados", "Transporte Privado Colectivo")),
selectizeInput("motivo_traslado", "¿Cuál es tu motivo principal de traslado diario?",
choices = c("Trabajo", "Escuela", "Compras", "Médico u hospital", "Diversión",
"Acompañar o llevar a alguien", "Banco o pago de servicios",
"Visita", "Buscar empleo", "Trámites")),
radioButtons("zona_destino", "¿A qué zona te diriges principalmente?",
choices = c("AMM", "Periferia", "Resto de NL"), inline = TRUE),
br(),
actionButton("calcular", "Calcular Predicción de Tiempo de Traslado Diario",
icon = icon("clock"), class = "btn btn-primary", width = "100%")
),
#Información extra
wellPanel(
h3("¿Cuándo y cómo usar esta herramienta?"),
p("Este simulador está pensado para que cualquier persona mayor a 18 años pueda explorar cómo distintos factores personales y contextuales influyen en sus tiempos de traslado."),
p(strong("Limitaciones importantes:")),
tags$ul(
tags$li("Basado en datos de la encuesta ", em("Cómo Vamos Nuevo León 2024"), "."),
tags$li("Los resultados son aproximaciones, no predicciones exactas."),
tags$li("No considera eventos imprevistos como tráfico o clima."),
tags$li("Diseñado para mayores de 18 años.")
),
),
#Información del código
wellPanel(
h3("¿Quieres saber más de este modelo?"),
p("A través de una combinación de reglas simples inspiradas en técnicas estadísticas como la regresión y los árboles de decisión,
estimamos cuánto tiempo dedica una persona a sus traslados diarios."),
p("El cálculo parte de un tiempo base, al que se suman o restan minutos según tus respuestas."),
p(em("Nota: Esta herramienta tiene fines informativos y no representa un modelo oficial ni una predicción exacta.")),
p(em("Úsalo como una herramienta exploratoria y reflexiva.")),
br(),
tags$a(href = ".", target = "_blank",
class = "btn btn-primary", icon("file-alt"), " Ver detalles metodológicos"), #link del código
)
)# Server
server <- function(input, output) {
observeEvent(input$calcular, {
#intercepto en la ecuación
intercepto <- 71.9827
tiempo_base <- intercepto # al tiempo base se le irá sumando lo que se haya puesto en los inputs
factores <- c() #los factores son para que al final te salga en el pop up, por qué se cambió el tiempo de traslado
# Sexo
if (input$sexo == "Mujer") {
tiempo_base <- tiempo_base - 13.7911
factores <- c(factores, "por ser mujer (-13.79 min)")
}
# Edad
if (input$edad >= 65) {
tiempo_base <- tiempo_base + 0.1573
factores <- c(factores, "por tener 65 años o más (+0.16 min)")
} else if (input$edad >= 18 & input$edad <= 30) {
tiempo_base <- tiempo_base - 0.1573
factores <- c(factores, "por ser menor de 30 años (-0.16 min)")
}
# Medio de Transporte
if (input$medio_transporte == "Transporte Público Colectvo") {
tiempo_base <- tiempo_base + 99.5039
factores <- c(factores, "por usar transporte público colectivo (+99.50 min)")
} else if (input$medio_transporte == "Medio Motorizado No Colectivo") {
tiempo_base <- tiempo_base + 0
factores <- c(factores, "por usar medio motorizado no colectivo (+0 min)")
} else if (input$medio_transporte == "Medios No Motorizados") {
tiempo_base <- tiempo_base - 31.1326
factores <- c(factores, "por usar medios no motorizados (-31.13 min)")
} else if (input$medio_transporte == "Transporte Privado Colectivo") {
tiempo_base <- tiempo_base + 35.1603
factores <- c(factores, "por usar transporte privado colectivo (+35.16 min)")
}
# Motivo de traslado
if (input$motivo_traslado == "Trabajo" | input$motivo_traslado == "Escuela") {
tiempo_base <- tiempo_base + 0
factores <- c(factores, "por trasladarte por trabajo o escuela (+0 min)")
} else if (input$motivo_traslado == "Compras") {
tiempo_base <- tiempo_base - 2.9713
factores <- c(factores, "por trasladarte por compras (-2.97 min)")
} else if (input$motivo_traslado == "Médico u hospital") {
tiempo_base <- tiempo_base + 33.3628
factores <- c(factores, "por atención médica (+33.36 min)")
} else if (input$motivo_traslado == "Diversión") {
tiempo_base <- tiempo_base + 5.9511
factores <- c(factores, "por actividades recreativas (+5.95 min)")
} else if (input$motivo_traslado == "Acompañar o llevar a alguien") {
tiempo_base <- tiempo_base + 10.1310
factores <- c(factores, "por acompañar o llevar a alguien (+10.13 min)")
} else if (input$motivo_traslado == "Banco o pago de servicios") {
tiempo_base <- tiempo_base - 4.9763
factores <- c(factores, "por ir al banco o pagos de servicios (-4.98 min)")
} else if (input$motivo_traslado == "Visita") {
tiempo_base <- tiempo_base + 57.4087
factores <- c(factores, "por hacer visitas (+57.41 min)")
} else if (input$motivo_traslado == "Buscar Empleo") {
tiempo_base <- tiempo_base - 11.5942
factores <- c(factores, "por búsqueda de empleo (-11.59 min)")
} else if (input$motivo_traslado == "Trámites") {
tiempo_base <- tiempo_base - 29.9018
factores <- c(factores, "por trámites (-29.90 min)")
}
# Zona de destino
if (input$zona_destino == "Periferia") {
tiempo_base <- tiempo_base + 1.37
factores <- c(factores, "por trasladarte a la periferia (+1.37 min)")
} else if (input$zona_destino == "Resto de NL") {
tiempo_base <- tiempo_base + 0
factores <- c(factores, "por trasladarte al resto de NL (+0 min)")
} else if (input$zona_destino == "AMM") {
tiempo_base <- tiempo_base + 6.1590
factores <- c(factores, "por trasladarte al AMM (+6.16 min)")
}
minutos_extra <- tiempo_base - intercepto #variable que dice cuánto tiempo se va a tardar la persona
explicacion <- paste0(
"Una persona en promedio tarda ", round(intercepto, 2), " minutos en trasladarse a su destino. ",
"De acuerdo con tus respuestas, se te sumaron ", round(minutos_extra, 2), " minutos adicionales por: ",
paste(factores, collapse = ", "), "."
)
# Formato del cuadro de diálogo
showModal(modalDialog(
title = tags$span(style = "color:#732C8B;", "Predicción de Tiempo de Traslado"),
tags$div(
style = "font-size: 50px; text-align: center; color: #FFB400; margin-top: 20px;",
paste(round(tiempo_base), "minutos")
),
tags$br(),
p(explicacion),
p(em("Este resultado es un cálculo aproximado basado en los datos de la encuesta Cómo Vamos Nuevo León 2024.")),
easyClose = TRUE
))
})
}
# Run the application
shinyApp(ui = ui, server = server)12. Conclusiones
Entre los tres modelos elegidos (lm_model3, Natural Spline-GAM y Árbol de decisión 1), se encuentra que todos tienen un RMSE muy parecido. Por lo que se utilizó el principio de parsimonia, el cual dice que “si los modelos más complejos no aportan resultados positivos significativos, se debe elegir el modelo más simple”. Es por esto que se elije como modelo definitivo el lm_model3.
Las variables que más influyeron en el tiempo estimado de traslado, según el lm_model3 fueron: en primer lugar, el medio de transporte. Utilizar transporte público colectivo incrementó sustancialmente el tiempo de traslado (más de 90 minutos adicionales en promedio), mientras que los medios no motorizados como caminar o usar bicicleta tendieron a reducirlo. En segundo lugar, el motivo del traslado tuvo un impacto considerable: trasladarse por razones médicas, por diversión o para realizar visitas implicó mayores tiempos de desplazamiento en comparación con traslados por motivos laborales o escolares. Por su parte, el sexo de la persona también influyó: ser mujer en Nuevo León disminuye el tiempo de traslado, en comparación a ser hombre.
Durante el desarrollo del análisis se identificaron diversas limitaciones. Entre ellas, se encontraron problemas de calidad en los datos, como una proporción elevada de valores faltantes (NAs) en variables clave, nombres poco intuitivos o redundantes en las variables originales. Para resolver estas limitaciones se recurrió a la limpieza e imputación de variables, renombramiento sistemático de columnas, y finalmente, se seleccinó el mejor modelo explicativo sin sobreajuste mediante el principio de parsimonia y la métrica RMSE.
Como recomendaciones al socio formador, se sugiere revisar la formulación de ciertas preguntas de la encuesta. Se detectaron escalas ambiguas o categorías superpuestas, especialmente en variables como motivo de traslado y tipo de transporte. Asimismo, algunas variables como vehículos en el hogar o nivel socioeconómico requerirían escalas más estandarizadas. Se recomienda también incluir nuevas variables explicativas en futuras ediciones, como frecuencia semanal de traslados, percepción de inseguridad o nivel educativo, para capturar mejor la experiencia de movilidad de la población. Además, es fundamental mejorar los controles de calidad en el proceso de digitalización para reducir el número de valores perdidos y asegurar una estructura más limpia desde la captura.
Finalmente, este análisis pone de manifiesto cómo las condiciones estructurales de movilidad en Nuevo León afectan de manera diferenciada a la población, según sus características individuales y territoriales. Se propone que a futuro se haga el análisis del municipio de origen y el municipio de destino. Para hacer un modelo que se adecúe más a la realidad de las personas. Estos resultados pueden servir de base para el diseño de políticas públicas orientadas a mejorar el acceso equitativo al transporte, planear rutas más eficientes y priorizar intervenciones en zonas o grupos con mayor vulnerabilidad en movilidad. Así, se hace un llamado a Cómo Vamos Nuevo León para que considere estos hallazgos en su estrategia de generación de evidencia e incidencia, y fortalezca su encuesta como una herramienta clave para la toma de decisiones informadas y justas en materia de movilidad.
13. Referencia
Ganti, L. (2024). Determinación de un R cuadrado significativo en medicina clínica.Medicina y cirugía académica. https://academic-med-surg.scholasticahq.com/article/125154-determining-a-meaningful-r-squared-value-in-clinical-medicine