Reto CVNL
2024-05-03
Ciencia de datos para la toma de decisiones I
Dr. Victor Manuel Espinoza Juarez
Sabina Martín Rodríguez - A00831896
Jairo Acuña Retana - A00835392
Gonzalo Mendoza Olloqui - A01235319
#Link a la publicacion Rpubs:
Modelo Predictivo del Reto - CÓMO VAMOS NUEVO LEÓN (CVNL)
Pregunta de investigación: “¿Cómo impactan las variables socioeconómicas y demográficas en la decisión de la ciudadanía neolonesa de utilizar transporte público o privado en su día a día?”
INTRODUCCION
Este reporte marca el inicio de una investigación sobre cómo la ciudadania en Nuevo León elige entre transporte público y privado. Nos interesa saber cómo influyen variables socioeconómicas y demográficas como el género, la percepción de seguridad, el nivel de ingreso, la edad de la persona y el municipio de residencia en esta decisión. Utilizamos datos de la encuesta “Así Vamos Nuevo León 2023”, la cual es una organizacion que atraves de encuestas evalúa cómo la ciudadania neolonense califica las condiciones de servicios publicos, inseguridad, urbanismo, etc. En este trabajo, se realizan una serie de procedimientos estadisticos; desde regresiones lineales hasta la utilizacion de metodos mas avanzados como Bootstrap, con la intencion de contestar la pregunta de investigacion y conseguir datos duros de como estas variables afectan la decision de transporte de la ciudadania, informacion que puede ser de gran utilidad para los tomadores de decisiones en temas de movilidad y transporte.
INVESTIGACION INICIAL
La iniciativa “Cómo Vamos Nuevo León” se destaca como una herramienta clave para recopilar datos que fomenta activamente la participación ciudadana a través de la transparencia. Su objetivo es identificar las necesidades y resaltar las áreas de oportunidad en diversos aspectos del desarrollo. El programa se compromete a evaluar periódicamente y presentar resultados para abogar constantemente por mejorar la calidad de vida de los ciudadanos. Utiliza indicadores, objetivos y la recopilación de datos para este fin. “Cómo Vamos Nuevo León” realiza un enfoque en la inclusión y la participación ciudadana. Promueve y busca activamente el diálogo entre gobierno, sociedad civil y sector privado para impulsar políticas públicas que respondan a las necesidades reales de la población (Cómo Vamos, 2023).
La encuesta “Así Vamos Nuevo León” aborda una amplia gama de temas críticos que reflejan los intereses y necesidades de los ciudadanos, incluyendo economía y trabajo, educación, salud, medio ambiente, movilidad, desarrollo urbano, seguridad y gobierno.
Despues de realizar un analisis de los temas que contiene la encuesta, se encontro un interes un tema en especifico; Movilidad.
Movilidad: Este tema representa un significativo reto en la percepción pública, donde los usuarios de autobuses reportan jornadas de viaje de hasta 2 horas y 21 minutos en su desplazamiento principal. En contraste, quienes cuentan con un automóvil invierten menos de la mitad de ese tiempo, aproximándose a 1 hora y 7 minutos (Cómo Vamos, 2023).
Al identificar los temas en los cuales nos enfocaremos e identificando la relevancia de estos en la agenda de interés público de las diferentes regiones del estado, se formula la pregunta de investigación que guiará las siguientes etapas del proyecto de investigación.
DEFINICION DE LA PREGUNTA DE INVESTIGACION
“¿Cómo impacta el género, la edad de las personas, la percepción de inseguridad, el municipio de residencia y el nivel de ingreso a la decision de utilizar transporte publico o privado de los ciudadanos neolonenses?”
LIBRERIAS Y BASES DE DATOS
Se cargan las librerias a utilizar y se crea una base de datos con las variables que seran utilizadas en los modelos.
¿Qué hicimos en este chunk? Se cargaron las librerías necesarias para la manipulación de datos, visualización, validación de modelos, y entrenamiento de modelos de regresión y árboles de decisión. Se leyó el archivo CSV eav23.csv y se almacenó en el dataframe eav23. Se seleccionaron las variables de interés y se creó un nuevo dataframe eav23_limpio con esas variables. Se mostraron las primeras 10 filas del dataframe eav23_limpio para verificar la selección de variables. Se eliminaron las filas con valores nulos en el dataframe eav23_limpio.
VARIABLES
Se presenta a continuacion las variables utilizadas, la pregunta dentro del cuestionario a la cual corresponden y las posibles respuestas dentro del mismo:
P16 - Medio de transporte mas utilizado Durante el día de ayer: ¿Cuál de los siguientes modos de transporte usted utilizó para llegar a su destino? (Si utilizó más de uno, seleccionar en el que pasó más tiempo) Transporte publico - 2. Camión, microbús, 7. Metro, 9. Transmetro, 10. Ecovía Transporte privado - 1. Pie/camina/en silla de ruedas, 3. Taxi, 4. Uber u otra aplicación móvil similar, 5. Motocicleta, 6. Bicicleta, 8. Automóvil/acompañante de automóvil, 11. Transporte escolar, 12. Transporte de trabajo, 13. Autobús privado (tipo Senda), 14. Triciclo, 15. Taxi colectivo 8888. No sabe, 9999. No contesta
CP3_1 - Género Género. A encuestadores: preguntar género (no asumirlo) 0. Hombre, 1. Mujer, 2. Persona no binaria, 9999. No contesta
P93 - Inseguridad ¿Qué tan seguro se siente en su municipio? 1. Muy seguro, 2. Seguro, 3. Inseguro, 4. Muy inseguro, 8888. No sabe, 9999. No contesta
P144 - Ingreso ¿Cuál es el ingreso mensual total del hogar? 1. Sin ingreso, 2. Menos de 1 SM ($1 - $6,223), 3. 1-2 SM ($6,223 - $12,446), 4. 2-3 SM ($12,446 - $18,670), 5. 3-4 SM ($18,670 - $24,893), 6. 4-5 SM ($24,893 - $31,116), 7. 5-6 SM ($31,116 - $37,339), 8. 6-7 SM ($37,339 - $43,562), 9. 7-8 SM ($43,562 - $49,786), 10. 8-9 SM ($49,786 - $56,009), 11. 9-10 SM ($56,009 - $62,232), 12. 10 o más SM ($62,232 o más), 12. 10 o más SM ($62,232 o más)
NOM_MUN_MV - Municipio Municipio ya designado por encuestador al llegar a la vivienda.
CP4_1 - Edad ¿Cuántos años cumplidos tiene? Responde edad. 8888. No sabe, 9999. No contesta
tiempo_total_traslado - Tiempo Translado Tiempo total en minutos que tardó en el medio que lo transportó a su destino principal (viaje redondo; ida y regreso)
P27_3 - Seguridad en Transporte Publico ¿Se siente seguro viajando en el transporte público? 0. No, 1. Sí, 8888. No sabe, 9999. No contesta
P53 - Calidad de Aire Considera que la calidad del aire en su municipio es: 1. Pésima, 2. Mala, 3. Regular, 4. Buena, 5. Excelente, 8888. No sabe, 9999. No contesta
CP8_1 - Nivel de Estudios ¿Cuál es el nivel máximo de estudios terminado? 0. Ninguno, 1. Preescolar, 2. Primaria, 3. Secundaria, 4. Preparatoria o bachillerato general, 5. Bachillerato tecnológico, 6. Estudios técnicos o comerciales con primaria terminada, 7. Estudios técnicos o comerciales con secundaria terminada, 8. Estudios técnicos o comerciales con preparatoria terminada, 9. Normal con primaria o secundaria terminada, 10. Normal de licenciatura, 11. Licenciatura, 12. Especialidad, 13. Maestría, 14. Doctorado, 8888. No sabe, 9999. No contesta
P3 - Actividad laboral Durante la semana pasada, ¿cuál fue su principal actividad laboral? (Seleccione una) 1. Empleado(a), 2. Buscando empleo, 3. Estudiante, 4. Negocio propio / independiente, 5. Trabajo doméstico no remunerado (limpieza y cuidados), 6. Trabajo doméstico remunerado (limpieza de otros hogares), 7. Jubilado/Pensionado, 8. Ni estudia, ni trabaja, ni busca empleo, 9.Otro. Especificar, 9999. No contesta
LIMPIEZA DE DATOS
Se realiza la limpieza de los datos, al igual que se establecen las variables numericas y factores.
Variables numericas: Ingreso - P144 Edad - CP4_1 Tiempo Translado - tiempo_total_traslado
Factores: Medio de transporte mas utilizado - P16 inseguridad - P93 Género - CP3_1 Municipio - NOM_MUN_MV Seguridad en Transporte Publico - P27_3 Calidad de Aire - P53 Nivel de Estudios - CP8_1 Actividad laboral - P3
¿Qué hicimos en este chunk?
Se creó un nuevo dataframe df a partir de eav23_limpio mediante varias transformaciones:
Conversión de variables: Se convirtieron ciertas variables a factores (municipio, genero, transporte, estudios, actividad_laboral) y otras a numéricas (inseguridad, edad, tiempo_translado, mala_calidad_aire). Reetiquetado de variables: Se reasignaron etiquetas para genero y transporte. Filtrado de datos: Se eliminaron filas con valores no válidos o ‘NA’ en genero, inseguridad, ingreso.maximo, transporte, inseguridad_en_transporte, mala_calidad_aire, y estudios. Transformaciones adicionales: Se crearon nuevas variables como ingreso.maximo y se ajustaron categorías de respuesta para P144, P16, P27_3, P53, CP8_1, y P3. Se seleccionaron las variables finales para el análisis y se almacenaron en el dataframe df.
Se corrigieron los tipos de datos de las variables en el dataframe df para asegurar que las variables estuvieran en los formatos correctos (factores o numéricas según correspondiera).
REGRESION LINEAL
Como parte de nuestro analisis, decidimos comenzar realizando una regresion lineal, sin embargo, debido a que la variable dependiente es categorica (Transporte), no es posible realizar una regresion lineal. No es posible hacer una regresión lineal cuando la variable dependiente es categórica porque la regresión lineal está diseñada para predecir valores continuos, no categorías discretas.
REGRESION LOGISTICA MODELO 1.1
Se realiza el primer modelo logistico.
regresion.logistica1.1 <- glm(transporte ~ genero + inseguridad + ingreso.maximo + municipio + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + estudios + actividad_laboral, family = "binomial", data = df)
summary(regresion.logistica1.1)##
## Call:
## glm(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## municipio + edad + tiempo_translado + inseguridad_en_transporte +
## mala_calidad_aire + estudios + actividad_laboral, family = "binomial",
## data = df)
##
## Coefficients:
## Estimate
## (Intercept) 1.471e+01
## generoMujer -1.469e-01
## inseguridad 9.898e-02
## ingreso.maximo -4.649e-06
## municipioAllende 8.333e-01
## municipioAnáhuac -1.365e+01
## municipioApodaca -1.460e+01
## municipioCadereyta Jiménez -1.483e+01
## municipioChina -3.234e+01
## municipioCiénega de Flores -1.585e+01
## municipioEl Carmen -1.475e+01
## municipioGarcía -1.503e+01
## municipioGeneral Escobedo -1.519e+01
## municipioGeneral Treviño 1.889e+00
## municipioGeneral Zuazua -1.553e+01
## municipioGuadalupe -1.399e+01
## municipioHidalgo -1.721e+01
## municipioJuárez -1.420e+01
## municipioLinares -1.187e+01
## municipioMina -2.948e+01
## municipioMontemorelos -1.325e+01
## municipioMonterrey -1.444e+01
## municipioPesquería -1.442e+01
## municipioSabinas Hidalgo -1.530e+01
## municipioSalinas Victoria -1.533e+01
## municipioSan Nicolás de los Garza -1.445e+01
## municipioSan Pedro Garza García -1.536e+01
## municipioSanta Catarina -1.393e+01
## municipioSantiago -1.463e+01
## edad -6.596e-03
## tiempo_translado 2.191e-02
## inseguridad_en_transporteSí -9.666e-01
## mala_calidad_aire -2.740e-01
## estudiosBachillerato tecnológico 1.565e+00
## estudiosEspecialidad -1.910e-01
## estudiosEstudios técnicos o comerciales con preparatoria terminada -8.131e-01
## estudiosEstudios técnicos o comerciales con primaria terminada 1.525e+00
## estudiosEstudios técnicos o comerciales con secundaria terminada 2.092e-01
## estudiosLicenciatura -5.667e-01
## estudiosMaestría -1.519e+01
## estudiosNinguno 1.076e+01
## estudiosNormal de licenciatura 1.599e+01
## estudiosPreescolar 1.200e+01
## estudiosPrimaria 3.652e-01
## estudiosSecundaria 3.763e-01
## actividad_laboralEmpleado(a) -3.547e-01
## actividad_laboralJubilado -4.188e-01
## actividad_laboralNegocio propio -8.886e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 7.829e-01
## actividad_laboralTrabajo doméstico no remunerado -5.786e-01
## actividad_laboralTrabajo doméstico remunerado -3.475e-01
## Std. Error
## (Intercept) 1.455e+03
## generoMujer 2.354e-01
## inseguridad 1.558e-01
## ingreso.maximo 1.950e-05
## municipioAllende 1.671e+03
## municipioAnáhuac 1.455e+03
## municipioApodaca 1.455e+03
## municipioCadereyta Jiménez 1.455e+03
## municipioChina 2.058e+03
## municipioCiénega de Flores 1.455e+03
## municipioEl Carmen 1.455e+03
## municipioGarcía 1.455e+03
## municipioGeneral Escobedo 1.455e+03
## municipioGeneral Treviño 2.058e+03
## municipioGeneral Zuazua 1.455e+03
## municipioGuadalupe 1.455e+03
## municipioHidalgo 1.455e+03
## municipioJuárez 1.455e+03
## municipioLinares 1.455e+03
## municipioMina 2.058e+03
## municipioMontemorelos 1.455e+03
## municipioMonterrey 1.455e+03
## municipioPesquería 1.455e+03
## municipioSabinas Hidalgo 1.455e+03
## municipioSalinas Victoria 1.455e+03
## municipioSan Nicolás de los Garza 1.455e+03
## municipioSan Pedro Garza García 1.455e+03
## municipioSanta Catarina 1.455e+03
## municipioSantiago 1.455e+03
## edad 8.117e-03
## tiempo_translado 1.890e-03
## inseguridad_en_transporteSí 2.374e-01
## mala_calidad_aire 1.140e-01
## estudiosBachillerato tecnológico 5.729e-01
## estudiosEspecialidad 1.657e+00
## estudiosEstudios técnicos o comerciales con preparatoria terminada 6.413e-01
## estudiosEstudios técnicos o comerciales con primaria terminada 1.063e+00
## estudiosEstudios técnicos o comerciales con secundaria terminada 6.331e-01
## estudiosLicenciatura 4.830e-01
## estudiosMaestría 1.455e+03
## estudiosNinguno 1.455e+03
## estudiosNormal de licenciatura 1.455e+03
## estudiosPreescolar 1.455e+03
## estudiosPrimaria 3.523e-01
## estudiosSecundaria 2.373e-01
## actividad_laboralEmpleado(a) 7.319e-01
## actividad_laboralJubilado 8.434e-01
## actividad_laboralNegocio propio 7.937e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 8.490e-01
## actividad_laboralTrabajo doméstico no remunerado 7.763e-01
## actividad_laboralTrabajo doméstico remunerado 9.502e-01
## z value
## (Intercept) 0.010
## generoMujer -0.624
## inseguridad 0.635
## ingreso.maximo -0.238
## municipioAllende 0.000
## municipioAnáhuac -0.009
## municipioApodaca -0.010
## municipioCadereyta Jiménez -0.010
## municipioChina -0.016
## municipioCiénega de Flores -0.011
## municipioEl Carmen -0.010
## municipioGarcía -0.010
## municipioGeneral Escobedo -0.010
## municipioGeneral Treviño 0.001
## municipioGeneral Zuazua -0.011
## municipioGuadalupe -0.010
## municipioHidalgo -0.012
## municipioJuárez -0.010
## municipioLinares -0.008
## municipioMina -0.014
## municipioMontemorelos -0.009
## municipioMonterrey -0.010
## municipioPesquería -0.010
## municipioSabinas Hidalgo -0.011
## municipioSalinas Victoria -0.011
## municipioSan Nicolás de los Garza -0.010
## municipioSan Pedro Garza García -0.011
## municipioSanta Catarina -0.010
## municipioSantiago -0.010
## edad -0.813
## tiempo_translado 11.594
## inseguridad_en_transporteSí -4.071
## mala_calidad_aire -2.403
## estudiosBachillerato tecnológico 2.731
## estudiosEspecialidad -0.115
## estudiosEstudios técnicos o comerciales con preparatoria terminada -1.268
## estudiosEstudios técnicos o comerciales con primaria terminada 1.435
## estudiosEstudios técnicos o comerciales con secundaria terminada 0.330
## estudiosLicenciatura -1.173
## estudiosMaestría -0.010
## estudiosNinguno 0.007
## estudiosNormal de licenciatura 0.011
## estudiosPreescolar 0.008
## estudiosPrimaria 1.037
## estudiosSecundaria 1.586
## actividad_laboralEmpleado(a) -0.485
## actividad_laboralJubilado -0.497
## actividad_laboralNegocio propio -1.120
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.922
## actividad_laboralTrabajo doméstico no remunerado -0.745
## actividad_laboralTrabajo doméstico remunerado -0.366
## Pr(>|z|)
## (Intercept) 0.99194
## generoMujer 0.53266
## inseguridad 0.52512
## ingreso.maximo 0.81159
## municipioAllende 0.99960
## municipioAnáhuac 0.99252
## municipioApodaca 0.99200
## municipioCadereyta Jiménez 0.99187
## municipioChina 0.98746
## municipioCiénega de Flores 0.99131
## municipioEl Carmen 0.99191
## municipioGarcía 0.99176
## municipioGeneral Escobedo 0.99167
## municipioGeneral Treviño 0.99927
## municipioGeneral Zuazua 0.99149
## municipioGuadalupe 0.99233
## municipioHidalgo 0.99056
## municipioJuárez 0.99222
## municipioLinares 0.99349
## municipioMina 0.98857
## municipioMontemorelos 0.99273
## municipioMonterrey 0.99209
## municipioPesquería 0.99209
## municipioSabinas Hidalgo 0.99161
## municipioSalinas Victoria 0.99160
## municipioSan Nicolás de los Garza 0.99208
## municipioSan Pedro Garza García 0.99158
## municipioSanta Catarina 0.99237
## municipioSantiago 0.99198
## edad 0.41647
## tiempo_translado < 2e-16 ***
## inseguridad_en_transporteSí 4.68e-05 ***
## mala_calidad_aire 0.01626 *
## estudiosBachillerato tecnológico 0.00632 **
## estudiosEspecialidad 0.90825
## estudiosEstudios técnicos o comerciales con preparatoria terminada 0.20487
## estudiosEstudios técnicos o comerciales con primaria terminada 0.15122
## estudiosEstudios técnicos o comerciales con secundaria terminada 0.74109
## estudiosLicenciatura 0.24074
## estudiosMaestría 0.99167
## estudiosNinguno 0.99410
## estudiosNormal de licenciatura 0.99124
## estudiosPreescolar 0.99342
## estudiosPrimaria 0.29988
## estudiosSecundaria 0.11271
## actividad_laboralEmpleado(a) 0.62801
## actividad_laboralJubilado 0.61951
## actividad_laboralNegocio propio 0.26287
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.35650
## actividad_laboralTrabajo doméstico no remunerado 0.45610
## actividad_laboralTrabajo doméstico remunerado 0.71457
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1162.79 on 928 degrees of freedom
## Residual deviance: 785.51 on 878 degrees of freedom
## AIC: 887.51
##
## Number of Fisher Scoring iterations: 14¿Qué hicimos en este chunk?
Se ajustó un modelo de regresión logística para predecir el tipo de transporte (transporte) utilizando como variables predictoras: genero, inseguridad, ingreso.maximo, municipio, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, estudios, y actividad_laboral. La familia de distribución utilizada es “binomial”. Se generó un resumen del modelo de regresión logística, mostrando estadísticas clave como los coeficientes de las variables predictoras, errores estándar, valores z, y valores p para evaluar la significancia de cada predictor en el modelo.
RESULTADOS MODELO 1.1
Se presentan los resultados y se crea una tabla para observar los coeficientes obtenido de todos los determinantes.
# Asumiendo que regresion.logistica es tu modelo ajustado
coef_df <- as.data.frame(summary(regresion.logistica1.1)$coefficients)
# Agregar los nombres de las variables como una columna
coef_df$Variables <- rownames(coef_df)
ggplot(coef_df, aes(x = Variables, y = Estimate, fill = Estimate > 0)) +
geom_col(show.legend = FALSE) +
coord_flip() + # Invetir los ejes para mejor visualización de gráfica
theme_minimal() +
labs(title = "Coeficientes de la Regresión Logística",
x = "Variables",
y = "Estimación de Coeficientes") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
¿Qué hicimos en este chunk?
Se creó un dataframe coef_df a partir de los coeficientes del modelo de regresión logística regresion.logistica1.1, incluyendo las estimaciones de los coeficientes y los nombres de las variables. Se generó una gráfica de barras utilizando ggplot2 para visualizar los coeficientes del modelo de regresión logística. Las barras representan las estimaciones de los coeficientes, con el color indicando si el coeficiente es positivo o negativo. Se invirtieron los ejes (coord_flip()) para una mejor visualización. Se aplicó un tema minimalista (theme_minimal()) para un diseño limpio. Se añadieron etiquetas y un título descriptivo a la gráfica. Se ajustó el ángulo del texto de los ejes para mejorar la legibilidad.
Las Barras Azules representan un aumento en la probabilidad logarítmica de la variable dependiente (posiblemente el uso de transporte público) asociado con la variable respectiva. Esto es típico para los municipios donde el transporte público es probablemente más accesible o preferido.
Las Barras Rojas indican una disminución en la probabilidad logarítmica asociada con la variable respectiva. Al momento de que el variable tiene un coeficiente negativo, lo que podría interpretarse como que a mayor ingreso, menor es la probabilidad de optar por el transporte público, prefiriendo posiblemente el transporte privado.
Sin embargo, debido a la poca significancia de las variables se decide realizar otros modelos excluyendo otras variables.
REGRESION MODELO 1.2
Sin municipio
regresion.logistica1.2 <- glm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + estudios + actividad_laboral, family = "binomial", data = df)
summary(regresion.logistica1.2)##
## Call:
## glm(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## estudios + actividad_laboral, family = "binomial", data = df)
##
## Coefficients:
## Estimate
## (Intercept) 2.603e-01
## generoMujer -7.836e-02
## inseguridad 8.177e-02
## ingreso.maximo -3.167e-07
## edad -7.095e-03
## tiempo_translado 1.925e-02
## inseguridad_en_transporteSí -9.780e-01
## mala_calidad_aire -3.100e-01
## estudiosBachillerato tecnológico 1.410e+00
## estudiosEspecialidad -3.849e-01
## estudiosEstudios técnicos o comerciales con preparatoria terminada -4.220e-01
## estudiosEstudios técnicos o comerciales con primaria terminada 1.629e+00
## estudiosEstudios técnicos o comerciales con secundaria terminada 3.935e-01
## estudiosLicenciatura -5.031e-01
## estudiosMaestría -1.357e+01
## estudiosNinguno 1.052e+01
## estudiosNormal de licenciatura 1.485e+01
## estudiosPreescolar 1.141e+01
## estudiosPrimaria 1.825e-01
## estudiosSecundaria 3.114e-01
## actividad_laboralEmpleado(a) -1.733e-01
## actividad_laboralJubilado 4.252e-02
## actividad_laboralNegocio propio -7.846e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 7.567e-01
## actividad_laboralTrabajo doméstico no remunerado -6.222e-01
## actividad_laboralTrabajo doméstico remunerado 4.735e-02
## Std. Error
## (Intercept) 9.233e-01
## generoMujer 2.192e-01
## inseguridad 1.433e-01
## ingreso.maximo 1.746e-05
## edad 7.566e-03
## tiempo_translado 1.672e-03
## inseguridad_en_transporteSí 2.156e-01
## mala_calidad_aire 1.021e-01
## estudiosBachillerato tecnológico 5.517e-01
## estudiosEspecialidad 1.568e+00
## estudiosEstudios técnicos o comerciales con preparatoria terminada 6.440e-01
## estudiosEstudios técnicos o comerciales con primaria terminada 9.927e-01
## estudiosEstudios técnicos o comerciales con secundaria terminada 6.054e-01
## estudiosLicenciatura 4.536e-01
## estudiosMaestría 8.827e+02
## estudiosNinguno 8.827e+02
## estudiosNormal de licenciatura 8.827e+02
## estudiosPreescolar 8.827e+02
## estudiosPrimaria 3.353e-01
## estudiosSecundaria 2.230e-01
## actividad_laboralEmpleado(a) 6.829e-01
## actividad_laboralJubilado 7.917e-01
## actividad_laboralNegocio propio 7.443e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 7.927e-01
## actividad_laboralTrabajo doméstico no remunerado 7.266e-01
## actividad_laboralTrabajo doméstico remunerado 9.096e-01
## z value
## (Intercept) 0.282
## generoMujer -0.357
## inseguridad 0.571
## ingreso.maximo -0.018
## edad -0.938
## tiempo_translado 11.517
## inseguridad_en_transporteSí -4.536
## mala_calidad_aire -3.037
## estudiosBachillerato tecnológico 2.556
## estudiosEspecialidad -0.245
## estudiosEstudios técnicos o comerciales con preparatoria terminada -0.655
## estudiosEstudios técnicos o comerciales con primaria terminada 1.641
## estudiosEstudios técnicos o comerciales con secundaria terminada 0.650
## estudiosLicenciatura -1.109
## estudiosMaestría -0.015
## estudiosNinguno 0.012
## estudiosNormal de licenciatura 0.017
## estudiosPreescolar 0.013
## estudiosPrimaria 0.544
## estudiosSecundaria 1.396
## actividad_laboralEmpleado(a) -0.254
## actividad_laboralJubilado 0.054
## actividad_laboralNegocio propio -1.054
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.955
## actividad_laboralTrabajo doméstico no remunerado -0.856
## actividad_laboralTrabajo doméstico remunerado 0.052
## Pr(>|z|)
## (Intercept) 0.77800
## generoMujer 0.72072
## inseguridad 0.56826
## ingreso.maximo 0.98553
## edad 0.34835
## tiempo_translado < 2e-16 ***
## inseguridad_en_transporteSí 5.73e-06 ***
## mala_calidad_aire 0.00239 **
## estudiosBachillerato tecnológico 0.01058 *
## estudiosEspecialidad 0.80608
## estudiosEstudios técnicos o comerciales con preparatoria terminada 0.51231
## estudiosEstudios técnicos o comerciales con primaria terminada 0.10082
## estudiosEstudios técnicos o comerciales con secundaria terminada 0.51576
## estudiosLicenciatura 0.26734
## estudiosMaestría 0.98773
## estudiosNinguno 0.99049
## estudiosNormal de licenciatura 0.98658
## estudiosPreescolar 0.98968
## estudiosPrimaria 0.58622
## estudiosSecundaria 0.16268
## actividad_laboralEmpleado(a) 0.79964
## actividad_laboralJubilado 0.95717
## actividad_laboralNegocio propio 0.29184
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.33980
## actividad_laboralTrabajo doméstico no remunerado 0.39183
## actividad_laboralTrabajo doméstico remunerado 0.95848
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1162.79 on 928 degrees of freedom
## Residual deviance: 844.72 on 903 degrees of freedom
## AIC: 896.72
##
## Number of Fisher Scoring iterations: 13¿Qué hicimos en este chunk?
Se ajustó un nuevo modelo de regresión logística (regresion.logistica1.2) para predecir el tipo de transporte (transporte), utilizando las mismas variables predictoras que el modelo anterior, pero excluyendo municipio. Las variables predictoras incluyen: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, estudios, y actividad_laboral. La familia de distribución utilizada es “binomial”. Se generó un resumen del nuevo modelo de regresión logística, mostrando estadísticas clave como los coeficientes de las variables predictoras, errores estándar, valores z, y valores p para evaluar la significancia de cada predictor en el modelo.
RESULTADOS MODELO 1.2
# Asumiendo que regresion.logistica es tu modelo ajustado
coef_df <- as.data.frame(summary(regresion.logistica1.2)$coefficients)
# Agregar los nombres de las variables como una columna
coef_df$Variables <- rownames(coef_df)
ggplot(coef_df, aes(x = Variables, y = Estimate, fill = Estimate > 0)) +
geom_col(show.legend = FALSE) +
coord_flip() + # Invetir los ejes para mejor visualización de gráfica
theme_minimal() +
labs(title = "Coeficientes de la Regresión Logística 1.2",
x = "Variables",
y = "Estimación de Coeficientes") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
¿Qué hicimos en este chunk?
Se creó un dataframe coef_df a partir de los coeficientes del nuevo modelo de regresión logística regresion.logistica1.2, incluyendo las estimaciones de los coeficientes y los nombres de las variables. Se generó una gráfica de barras utilizando ggplot2 para visualizar los coeficientes del nuevo modelo de regresión logística. Las barras representan las estimaciones de los coeficientes, con el color indicando si el coeficiente es positivo o negativo. Se invirtieron los ejes (coord_flip()) para una mejor visualización. Se aplicó un tema minimalista (theme_minimal()) para un diseño limpio. Se añadieron etiquetas y un título descriptivo a la gráfica. Se ajustó el ángulo del texto de los ejes para mejorar la legibilidad.
Se observan resultados similares a la regresion anterior, con una ligera mejora en la significancia de los predictores de percepcion de inseguridad.
REGRESION MODELO 1.3
Se realiza un modelo solametne con inseguridad e ingreso con interes de observar resultados de coeficientes.
regresion.logistica1.3 <- glm(transporte ~ inseguridad + ingreso.maximo, family = "binomial", data = df)
summary(regresion.logistica1.3)##
## Call:
## glm(formula = transporte ~ inseguridad + ingreso.maximo, family = "binomial",
## data = df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.716e-02 3.487e-01 -0.221 0.82490
## inseguridad 3.242e-01 1.076e-01 3.014 0.00258 **
## ingreso.maximo 2.594e-06 1.361e-05 0.191 0.84882
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1162.8 on 928 degrees of freedom
## Residual deviance: 1153.4 on 926 degrees of freedom
## AIC: 1159.4
##
## Number of Fisher Scoring iterations: 4¿Qué hicimos en este chunk?
Se ajustó un tercer modelo de regresión logística (regresion.logistica1.3) para predecir el tipo de transporte (transporte), utilizando solo dos variables predictoras: inseguridad e ingreso.maximo. La familia de distribución utilizada es “binomial”. Se generó un resumen del tercer modelo de regresión logística, mostrando estadísticas clave como los coeficientes de las variables predictoras, errores estándar, valores z, y valores p para evaluar la significancia de cada predictor en el modelo.
REGRESION MODELO 1.4
Se realiza un modelo excluyendo las variables municipio y estudios.
# Ajustar el modelo sin la variable 'municipio'
regresion.logistica_sin_municipio <- glm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, family = "binomial", data = df)
summary(regresion.logistica_sin_municipio)##
## Call:
## glm(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## actividad_laboral, family = "binomial", data = df)
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.629e-01 9.023e-01
## generoMujer -5.199e-02 2.168e-01
## inseguridad 9.012e-02 1.416e-01
## ingreso.maximo -7.439e-06 1.626e-05
## edad -2.994e-03 6.826e-03
## tiempo_translado 1.869e-02 1.622e-03
## inseguridad_en_transporteSí -9.457e-01 2.110e-01
## mala_calidad_aire -3.099e-01 1.008e-01
## actividad_laboralEmpleado(a) -3.187e-01 6.787e-01
## actividad_laboralJubilado -1.311e-01 7.810e-01
## actividad_laboralNegocio propio -9.939e-01 7.345e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 6.215e-01 7.838e-01
## actividad_laboralTrabajo doméstico no remunerado -7.445e-01 7.231e-01
## actividad_laboralTrabajo doméstico remunerado -1.697e-01 9.054e-01
## z value Pr(>|z|)
## (Intercept) 0.624 0.53275
## generoMujer -0.240 0.81046
## inseguridad 0.636 0.52458
## ingreso.maximo -0.458 0.64724
## edad -0.439 0.66092
## tiempo_translado 11.529 < 2e-16 ***
## inseguridad_en_transporteSí -4.481 7.43e-06 ***
## mala_calidad_aire -3.074 0.00211 **
## actividad_laboralEmpleado(a) -0.470 0.63871
## actividad_laboralJubilado -0.168 0.86672
## actividad_laboralNegocio propio -1.353 0.17601
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.793 0.42779
## actividad_laboralTrabajo doméstico no remunerado -1.030 0.30320
## actividad_laboralTrabajo doméstico remunerado -0.187 0.85134
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1162.79 on 928 degrees of freedom
## Residual deviance: 861.16 on 915 degrees of freedom
## AIC: 889.16
##
## Number of Fisher Scoring iterations: 5# Hacer predicciones
predicciones <- predict(regresion.logistica_sin_municipio, type = "response")
# Convertir las probabilidades en categorías binarias ('publico' o 'privado')
df$prediccion <- ifelse(predicciones > 0.5, "publico", "privado")
# Crear la matriz de confusión
tabla <- table(Observado = df$transporte, Predicho = df$prediccion)
tabla## Predicho
## Observado privado publico
## privado 180 116
## publico 71 562# Calcular la precisión
precision <- sum(diag(tabla)) / sum(tabla)
precision## [1] 0.7987083Observamos una precision del 0.79%, la cual es alta.
¿Qué hicimos en este chunk?
Se ajustó un nuevo modelo de regresión logística (regresion.logistica_sin_municipio) para predecir el tipo de transporte (transporte), excluyendo la variable municipio. Las variables predictoras utilizadas fueron: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, y actividad_laboral. La familia de distribución utilizada es “binomial”. Se generó un resumen del nuevo modelo de regresión logística, mostrando estadísticas clave como los coeficientes de las variables predictoras, errores estándar, valores z, y valores p. Se realizaron predicciones utilizando el modelo ajustado, obteniendo probabilidades de que el tipo de transporte sea publico. Se convirtieron las probabilidades en categorías binarias (publico o privado), con un umbral de 0.5. Se creó una matriz de confusión para comparar las predicciones del modelo con los valores observados de transporte. Se calculó la precisión del modelo sumando los valores correctamente clasificados y dividiéndolos por el total de observaciones.
COMPARACIÓN DE MODELOS CON ANOVA
# Realizar ANOVA con test de Chi-cuadrado para comparar los modelos regresion.logistica1.1 y regresion.logistica1.2
anova_resultado <- anova(regresion.logistica1.2, regresion.logistica1.1, test = "Chisq")
# Mostrar resultados
anova_resultado## Analysis of Deviance Table
##
## Model 1: transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado +
## inseguridad_en_transporte + mala_calidad_aire + estudios +
## actividad_laboral
## Model 2: transporte ~ genero + inseguridad + ingreso.maximo + municipio +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## estudios + actividad_laboral
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 903 844.72
## 2 878 785.51 25 59.213 0.0001341 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1¿Qué hicimos en este chunk?
Se compararon dos modelos de regresión logística previamente
definidos: - regresion.logistica1.2: Modelo sin la variable
municipio. - regresion.logistica1.1: Modelo
con todas las variables.
Se utilizó la función anova() para comparar estos dos
modelos usando un test de Chi-cuadrado (test = "Chisq"). Se
mostraron los resultados del ANOVA para evaluar si el modelo más
complejo proporciona una mejora significativa en el ajuste con respecto
al modelo más simple.
Interpretación del ANOVA
El resultado del ANOVA muestra que el modelo complejo proporciona un ajuste significativamente mejor en comparación con el modelo simple. Esto se evidencia por los siguientes puntos:
- Grados de Libertad Residuales
(
Resid. Df):Modelo simple:Modelo complejo:- La diferencia en los grados de libertad es , correspondiente al número de predictores adicionales en el modelo más complejo.
- Deviance Residual (
Resid. Dev):Modelo simple:Modelo complejo:- La deviance del modelo más complejo es menor, indicando un mejor ajuste.
- Deviance:
- La diferencia en la deviance entre los dos modelos es , lo cual es significativo.
- Pr(>Chi):
- El valor p (X.XXXe-XX) es muy pequeño (menor a 0.001), indicando que los predictores adicionales en el modelo complejo mejoran significativamente el ajuste del modelo.
Conclusión
El modelo complejo proporciona un ajuste significativamente mejor
comparado con el modelo simple, como se evidencia por el test de
Chi-cuadrado con un valor p altamente significativo. Esto sugiere que
las variables adicionales (inseguridad_en_transporte,
mala_calidad_aire, y actividad_laboral)
aportan información significativa al modelo.
VALIDACION CRUZADA
cv_result <- cv.glm(data = df, glmfit = regresion.logistica_sin_municipio, K = 10)
print(cv_result)## $call
## cv.glm(data = df, glmfit = regresion.logistica_sin_municipio,
## K = 10)
##
## $K
## [1] 10
##
## $delta
## [1] 0.1535092 0.1531093
##
## $seed
## [1] 10403 1 1400771387 1196676313 -256141208 -2008027754
## [7] -786254575 490403523 2024658642 921444 874312359 -873653251
## [13] 1235881460 -954938662 686902309 2084233535 1199888070 -740279472
## [19] 1589732211 -1831430767 463288256 73728414 -2028180631 993386395
## [25] 2140989098 -605450036 -1096740465 -1070537275 -219371140 303094226
## [31] -1265285811 -467183609 -1742374930 645168840 -1927548469 762381353
## [37] 545714808 1019871142 -2143667775 -1767748013 -646691582 -1627872204
## [43] -473107017 -1954981459 -180847932 655892202 -2114293419 -98736401
## [49] 1272698102 603448352 -991455773 572655233 1242673392 -171561074
## [55] -1741872903 495831691 1872612026 -1882577476 -104788225 -1295678891
## [61] 1589425516 -1112228414 1226063389 -2019834217 -883601410 1223195576
## [67] -386025573 2144861689 1705622856 -1267435402 -385661519 231984099
## [73] -1150805838 87602436 -2106321337 1206698269 1087655828 2081207098
## [79] 1804926853 1530399839 1041876710 289107312 -1952917869 1525894961
## [85] 1530009056 1928671870 -1976254199 -277535941 -142025974 326693612
## [91] 2116300655 1774252197 384711260 1173912114 -1143885523 -805226521
## [97] -573399282 1327386856 1296712427 810978185 -927205608 -1028720058
## [103] -121636191 1984396595 574465186 -43922540 -2055278057 676132365
## [109] 745034532 2069229322 966763125 1642242511 407038678 -722514304
## [115] -2053476157 1876602465 1253517008 2069241902 -1287453223 -1015375381
## [121] -669512614 -93383140 -1868327137 1547561845 -1970064884 1632289762
## [127] -1703898947 -1803845833 -691951650 810530072 -1690969989 -1069490663
## [133] -1653459288 747443286 -1602146095 -1814344573 1013165842 -1866433884
## [139] -944208281 1302697917 1920026932 930163354 -1723438875 1466751615
## [145] -1086274554 -878405744 -1535944141 2046677457 780129152 -1796403618
## [151] -1801095767 1003033691 -267178902 -1993657076 1708414799 743130117
## [157] 1213545148 1765428114 -1289090931 -860057913 1080281006 -1079782904
## [163] 1419925003 235118313 1002371512 -1249659290 -1450749183 -1176283757
## [169] 202976834 329273844 -34264073 1698861037 -1785366396 -992485718
## [175] 1893749781 426411183 -1227011402 427116768 -649759709 828844865
## [181] -425380304 -2011282354 -2013311815 -1755412277 -1791912582 -1306744708
## [187] -1925251905 -1019594347 805540268 -1186618494 1748879709 1570687063
## [193] 368770878 1035265912 -717566885 537934777 -1865168376 -1723608906
## [199] -775944207 536564259 -13198734 -757980988 87074439 -721707427
## [205] -1567440812 191996538 -1304102459 2109754143 466839206 -1466992592
## [211] 1177217747 -1138376463 -69063648 -821183810 1846595273 373607547
## [217] 1438704202 -457075028 -1653583441 836401509 -1944590564 -1068831886
## [223] 836437997 1829152807 798797902 -1957874520 1855306411 -1793896503
## [229] -250731560 -1000977440 1668633282 74508840 -1861509460 550384316
## [235] 1345929714 -1294120656 552565924 -700566856 -1298429094 -917246576
## [241] -553229956 -727114476 1662413122 -1667710208 -807126084 -1545245872
## [247] -454565598 -1615917752 1868281868 338548828 602952914 -820484096
## [253] -1190728876 2030899688 -1750890502 346408656 1302107436 501053684
## [259] -597510254 1307421792 1085205772 509478624 1494191458 -2045148504
## [265] 1570564684 1828732 -1182225614 1478258288 -704029372 370879448
## [271] -1119731590 1800033840 877714108 2137085780 -55903678 -2105975904
## [277] 519026876 1480405456 185943394 -2138053656 -1997854772 1335453436
## [283] 20484082 -2118271872 -1955837708 2060686472 -1761430214 -1837956272
## [289] -282514324 -1436684140 -1079457454 975724256 163750092 102733984
## [295] 1865603458 -1301120792 -1514641172 1573972028 999678066 1402529904
## [301] 1511186980 688439864 857602586 -1175559984 1179420220 -1346532204
## [307] 368166018 -1195939904 1239743804 120983184 679666722 -1745727480
## [313] 1768070284 678891548 -1637206894 792915072 1132708884 -155122904
## [319] 1628591162 -1471255344 968774764 1613948596 -1460899822 776290272
## [325] 1249749964 -1950999072 124836898 576824616 -621045492 1409420860
## [331] 1286010098 -546436880 -1533589692 1249368 1554514490 -627722000
## [337] 1131483836 -1264551404 143502530 -1611774368 -1347758724 121074896
## [343] 1836450850 -2137839448 612142476 669774268 -1829398478 1432732480
## [349] -1556689228 1009787208 1329349306 1683554064 1945690348 604235860
## [355] -1141119214 1712431520 171853772 190144352 -884015934 814255656
## [361] 336599468 620389180 -934038670 -1529991376 -1258102748 664669752
## [367] 382194394 -605603952 961688828 2036227476 434090818 1829251584
## [373] -309139396 548409936 155816098 -563535032 -1568732660 752507612
## [379] 72880210 558247040 -1408932012 -834498584 1357579002 -407943344
## [385] 188163116 1225759092 -632975726 -740957600 -1562177396 -1259695776
## [391] 409671906 -1539658584 -104028468 526195196 -986981454 -1125915664
## [397] 2002440644 1907789144 385327482 110571952 -1749988932 -1140720044
## [403] 633887170 1589846816 1223390140 1616441424 1211325410 1565851496
## [409] -1368918196 779783932 -1779460366 145636608 -1007154060 541429256
## [415] -524270150 -1390807600 -1245595668 -32601196 771508434 -216079264
## [421] 1560841548 2118898464 689027714 1126433256 -1705722900 491142716
## [427] 1456957042 761342832 -489153244 -418383304 -1143852646 1771023824
## [433] 2120926652 967929492 176759426 -350724672 -2081966276 -1151389040
## [439] -2088962270 418444808 -964689140 -1517960292 2118097938 -1292506240
## [445] -701932780 552596776 2089168954 2128659408 -1979123092 -1976071116
## [451] 1875882130 -9766560 -425861812 -1047341600 -1380557918 983784360
## [457] -420194838 -283151841 894376105 705007678 898883884 -1170125955
## [463] -673807929 -176376656 -1605131570 488347643 -1042227107 451717002
## [469] -2094323800 -1860285167 -686402557 53583620 -207654094 1082904967
## [475] -606824495 -834758314 1166743348 -1870874043 -1408645489 1234915336
## [481] 276722726 1036700883 1335692853 -1559911022 1052195168 127205577
## [487] 754095099 -1031957556 1489317466 -737397937 -308917735 -1131288530
## [493] 427468348 1693555629 180032599 1685463456 1720859390 1083005387
## [499] 1805754317 -313003270 280439096 1413018337 -1900423789 -864387660
## [505] 433585858 -1769976105 -256762079 362886886 571723748 -1282957547
## [511] -1260710081 2009842392 882345718 1039872259 -556887483 325165666
## [517] -1138130480 1893949177 504650795 -1036543076 1722880970 -1568772929
## [523] -959066615 1506215710 1800433356 -802460003 147860263 -1919122096
## [529] 999369710 -169651045 -871235843 -1985821206 -1410591096 -1195466703
## [535] -1358136669 -1906589020 2109592402 -1416676697 -591649039 -1330461130
## [541] 1953974996 1288592997 367373423 -1381935448 -2078206970 -841547469
## [547] -1741873771 -586034702 837393984 1530724265 662856219 -1055777812
## [553] -214017030 -1464788945 1836193849 327838286 1227205276 -720064499
## [559] -682251145 1044081792 1642007262 -839861845 -647023955 -1451415782
## [565] -1367345192 -1132006335 -123469069 1982137620 1782460578 -1188483657
## [571] -1146478207 -1506257018 1335367108 1612522741 444247391 1491058616
## [577] 1531138710 -1107231581 1097766501 -1819135102 847818992 1531517081
## [583] 1503457419 -247277188 545327018 1745950687 869750121 -1606596226
## [589] 1463351660 2141233597 -335400313 1789347440 1591061774 -740421061
## [595] -686835427 -731984950 372376808 -753010735 1899112899 1693627076
## [601] 46076274 -602858425 -1243574255 1976474006 2022382836 -1231186299
## [607] 341647311 784322248 -597121178 -1849942637 -135446795 -1926078766
## [613] 310348064 2057857289 -896778693 1114289036 -623619558 -87420273
## [619] -2078097959 1566417518 1239446012 1742152557 -1901736681 -282187552
## [625] 2079461054 -432007112# Crear un data frame para graficar
cv_data <- data.frame(
Error_Type = c("Raw CV Error", "Adjusted CV Error"),
Error = cv_result$delta
)
# Graficar usando ggplot2
ggplot(cv_data, aes(x = Error_Type, y = Error, fill = Error_Type)) +
geom_col() +
theme_minimal() +
ggtitle("Cross-Validation Error of Logistic Regression Model") +
ylab("Cross-Validation Error") +
xlab("")
¿Qué hicimos en este chunk?
Se realizó una validación cruzada de 10 pliegues (K = 10) para evaluar el rendimiento del modelo de regresión logística (regresion.logistica_sin_municipio). Se utilizó la función cv.glm para este propósito. Se imprimieron los resultados de la validación cruzada, incluyendo los errores de validación cruda y ajustada (cv_result$delta). Se creó un dataframe cv_data para almacenar los errores de validación cruzada (tanto el crudo como el ajustado). Se generó una gráfica de barras utilizando ggplot2 para visualizar los errores de validación cruzada. La gráfica incluye: Barras que representan los errores de validación cruda y ajustada. Un tema minimalista (theme_minimal()) para un diseño limpio. Un título descriptivo, etiquetas de los ejes y ajuste del ángulo del texto para mejorar la legibilidad.
La gráfica muestra el error de validación cruzada de un modelo de regresión logística. Aquí tienes una explicación de cada elemento de la gráfica:
Título: “Cross-Validation Error of Logistic Regression Model”. Este título indica que la gráfica muestra el error de validación cruzada para un modelo de regresión logística.
Ejes:
- Eje Y: Muestra los valores del error de validación cruzada. Los valores parecen estar en una escala de 0 a 0.20.
- Eje X: No tiene etiqueta específica, pero categoriza dos tipos de errores, uno para cada barra.
Barras:
- Barra Roja: Representa el “Adjusted CV Error”, que es el error ajustado de la validación cruzada.
- Barra Azul: Muestra el “Raw CV Error”, que es el error crudo de la validación cruzada. Este es el error directamente calculado sin ajustes.
Interpretación:
- Las barras indican la magnitud del error para cada tipo. La barra roja parece tener un valor ligeramente mayor que la barra azul, lo cual podría indicar que después de hacer ajustes para compensar factores como el sobreajuste o sesgo en el modelo, el error estimado es un poco más alto. Queda dentro de una estimación de 0.20.
INTERPRETACION
- Mayor Error Ajustado: El hecho de que el error ajustado sea mayor que el crudo puede indicar que el modelo tiene un cierto grado de sobreajuste o sesgo que los ajustes de la validación cruzada están tratando de compensar.
- Implicaciones: Un error mayor en la validación cruzada ajustada sugiere que el modelo podría no generalizar tan bien como indica el error crudo cuando se enfrenta a nuevos datos.
Obtenemos ademas un valor de delta de 0.1979759 0.1979161, lo cual, al estar entre el rango de 0-1 es positivo para el modelo elaborado.
BOOTSTRAP
# Función para obtener los coeficientes del modelo
boot_coef <- function(data, indices) {
d <- data[indices, ] # Re-muestrear los datos
fit <- glm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, family = "binomial", data = d)
return(coef(fit)) # Devolver los coeficientes del modelo
}
# Realizar el bootstrap con 1000 réplicas
set.seed(123) # Para evidenciar la reproducibilidad del modelo
boot_results <- boot(data = df, statistic = boot_coef, R = 1000)
print(boot_results)##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = df, statistic = boot_coef, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 5.628521e-01 2.352571e-01 1.933490e+00
## t2* -5.198734e-02 -1.866226e-02 2.143216e-01
## t3* 9.011906e-02 5.110886e-04 1.527993e-01
## t4* -7.438768e-06 3.744148e-09 1.659878e-05
## t5* -2.994057e-03 -1.859373e-04 6.845525e-03
## t6* 1.869469e-02 3.216495e-04 2.289033e-03
## t7* -9.456890e-01 -7.068180e-03 2.248144e-01
## t8* -3.099464e-01 -1.494530e-04 1.016504e-01
## t9* -3.186687e-01 -2.417947e-01 1.855463e+00
## t10* -1.310721e-01 -2.173324e-01 1.872300e+00
## t11* -9.938534e-01 -2.447569e-01 1.872376e+00
## t12* 6.215375e-01 -1.828489e-01 1.892777e+00
## t13* -7.444684e-01 -2.266246e-01 1.868591e+00
## t14* -1.696680e-01 -3.089759e-02 2.441668e+00# Graficar los resultados del bootstrap
boot_coefs <- boot_results$t
colnames(boot_coefs) <- names(coef(regresion.logistica_sin_municipio))
df_boot <- as.data.frame(boot_coefs)
df_boot_long <- reshape2::melt(df_boot)## No id variables; using all as measure variablesggplot(df_boot_long, aes(x = value)) +
geom_histogram(bins = 30, fill = "purple", alpha = 0.7) +
facet_wrap(~variable, scales = "free_x") +
theme_minimal() +
labs(title = "Bootstrap Distribution of Coefficients",
x = "Coefficient Value",
y = "Frequency")
¿Qué hicimos en este chunk?
Se definió una función boot_coef para obtener los coeficientes del modelo de regresión logística, utilizando remuestreo de los datos. Se realizó un análisis de bootstrap con 1000 réplicas para estimar la distribución de los coeficientes del modelo. Se utilizó la función boot para este propósito y se fijó una semilla (set.seed(123) para garantizar la reproducibilidad de los resultados. Se imprimieron los resultados del análisis de bootstrap (boot_results). Se prepararon los resultados del bootstrap para graficarlos: Se extrajeron los coeficientes del bootstrap (boot_coefs) y se asignaron nombres de columnas correspondientes a los coeficientes del modelo. Se convirtió el dataframe df_boot a un formato largo (df_boot_long) utilizando reshape2::melt. Se generó una gráfica de histogramas utilizando ggplot2 para visualizar la distribución de los coeficientes del modelo a partir del análisis de bootstrap. La gráfica incluye: Histogramas de la distribución de los valores de cada coeficiente. Un tema minimalista (theme_minimal()) para un diseño limpio. Un título descriptivo y etiquetas de los ejes.
LASSO
x <- model.matrix(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, data = df)[,-1]
y <- df$transporte
lasso_model <- cv.glmnet(x, y, alpha = 1, family = "binomial")
plot(lasso_model)
print(coef(lasso_model, s = "lambda.min"))## 14 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 0.01743372
## generoMujer .
## inseguridad 0.02688480
## ingreso.maximo .
## edad .
## tiempo_translado 0.01699375
## inseguridad_en_transporteSí -0.76765492
## mala_calidad_aire -0.23340360
## actividad_laboralEmpleado(a) .
## actividad_laboralJubilado .
## actividad_laboralNegocio propio -0.48924077
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.62525070
## actividad_laboralTrabajo doméstico no remunerado -0.37607760
## actividad_laboralTrabajo doméstico remunerado .¿Qué hicimos en este chunk?
Se prepararon las matrices de diseño para el modelo Lasso:
Se creó la matriz x de variables predictoras a partir del dataframe df, excluyendo la columna de intercepto. Se extrajo la variable respuesta y (transporte) del dataframe df. Se ajustó un modelo de regresión logística con regularización Lasso utilizando la función cv.glmnet:
El parámetro alpha = 1 indica que se utiliza Lasso (L1 regularization). Se especificó que la familia de distribución es “binomial” adecuada para modelos de regresión logística. Se generó y mostró una gráfica del proceso de validación cruzada para seleccionar el valor óptimo del parámetro de regularización (lambda).
Se imprimieron los coeficientes del modelo Lasso ajustado para el valor de lambda que minimiza el error de validación cruzada (lambda.min).
INTERPRETACION
El modelo LASSO ha identificado que la percepción de inseguridad, el ingreso máximo y el municipio de residencia son variables clave que afectan la decisión de utilizar transporte público o privado en Nuevo León. La percepción de inseguridad tiene un impacto significativo y diferenciado, mientras que el ingreso máximo y la edad también influyen en la preferencia por el transporte. La residencia en ciertos municipios puede aumentar o disminuir significativamente la probabilidad de elegir transporte público, reflejando las diferencias en accesibilidad y preferencia por el transporte en diferentes áreas.
Percepción de Inseguridad
inseguridadMuy Inseguro: 4.210224e-01
Sentirse muy inseguro aumenta la probabilidad logarítmica de elegir transporte público en 0.421 unidades, lo que sugiere que las personas que se sienten muy inseguras son más propensas a usar el transporte público.
inseguridadMuy Seguro: -1.674855e-01
Sentirse muy seguro disminuye la probabilidad logarítmica de elegir transporte público en 0.167 unidades, lo que indica que las personas que se sienten muy seguras tienden a preferir el transporte privado.
inseguridadSeguro: -1.102324e-01
Sentirse seguro también disminuye la probabilidad logarítmica de elegir transporte público en 0.110 unidades, aunque este efecto es menos pronunciado que sentirse muy seguro.
Ingreso Máximo
ingreso.maximo: -6.534692e-05 A mayor ingreso máximo, menor es la probabilidad logarítmica de optar por el transporte público. Este coeficiente es muy pequeño, pero sigue indicando una tendencia de que las personas con ingresos más altos prefieren el transporte privado.
Regresión polinomial
polynomial_model <- glm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, family = "binomial", data = df)
summary(polynomial_model)##
## Call:
## glm(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## actividad_laboral, family = "binomial", data = df)
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.629e-01 9.023e-01
## generoMujer -5.199e-02 2.168e-01
## inseguridad 9.012e-02 1.416e-01
## ingreso.maximo -7.439e-06 1.626e-05
## edad -2.994e-03 6.826e-03
## tiempo_translado 1.869e-02 1.622e-03
## inseguridad_en_transporteSí -9.457e-01 2.110e-01
## mala_calidad_aire -3.099e-01 1.008e-01
## actividad_laboralEmpleado(a) -3.187e-01 6.787e-01
## actividad_laboralJubilado -1.311e-01 7.810e-01
## actividad_laboralNegocio propio -9.939e-01 7.345e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 6.215e-01 7.838e-01
## actividad_laboralTrabajo doméstico no remunerado -7.445e-01 7.231e-01
## actividad_laboralTrabajo doméstico remunerado -1.697e-01 9.054e-01
## z value Pr(>|z|)
## (Intercept) 0.624 0.53275
## generoMujer -0.240 0.81046
## inseguridad 0.636 0.52458
## ingreso.maximo -0.458 0.64724
## edad -0.439 0.66092
## tiempo_translado 11.529 < 2e-16 ***
## inseguridad_en_transporteSí -4.481 7.43e-06 ***
## mala_calidad_aire -3.074 0.00211 **
## actividad_laboralEmpleado(a) -0.470 0.63871
## actividad_laboralJubilado -0.168 0.86672
## actividad_laboralNegocio propio -1.353 0.17601
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.793 0.42779
## actividad_laboralTrabajo doméstico no remunerado -1.030 0.30320
## actividad_laboralTrabajo doméstico remunerado -0.187 0.85134
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1162.79 on 928 degrees of freedom
## Residual deviance: 861.16 on 915 degrees of freedom
## AIC: 889.16
##
## Number of Fisher Scoring iterations: 5¿Qué hicimos en este chunk?
Se ajustó un modelo de regresión logística (polynomial_model) para predecir el tipo de transporte (transporte), utilizando como variables predictoras: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, y actividad_laboral. La familia de distribución utilizada es “binomial”. Se generó un resumen del modelo de regresión logística, mostrando estadísticas clave como los coeficientes de las variables predictoras, errores estándar, valores z, y valores p para evaluar la significancia de cada predictor en el modelo.
#####INTERPRETACION Percepción de Inseguridad La percepción de inseguridad es un factor significativo en la decisión de transporte, con sentirse muy inseguro aumentando la probabilidad de usar transporte público.
Ingreso Máximo Un mayor ingreso máximo está asociado con una menor probabilidad de usar transporte público, lo que es consistente con la hipótesis de que las personas con mayores ingresos prefieren el transporte privado.
Edad y Género En este modelo, la edad (considerando un polinomio de grado 2) y el género no tienen un impacto significativo en la decisión de transporte. Municipios: La mayoría de los municipios no muestran un impacto significativo en la elección de transporte público o privado en este modelo.
SPLINES
spline_model <- glm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, family = "binomial", data = df)
summary(spline_model)##
## Call:
## glm(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## actividad_laboral, family = "binomial", data = df)
##
## Coefficients:
## Estimate Std. Error
## (Intercept) 5.629e-01 9.023e-01
## generoMujer -5.199e-02 2.168e-01
## inseguridad 9.012e-02 1.416e-01
## ingreso.maximo -7.439e-06 1.626e-05
## edad -2.994e-03 6.826e-03
## tiempo_translado 1.869e-02 1.622e-03
## inseguridad_en_transporteSí -9.457e-01 2.110e-01
## mala_calidad_aire -3.099e-01 1.008e-01
## actividad_laboralEmpleado(a) -3.187e-01 6.787e-01
## actividad_laboralJubilado -1.311e-01 7.810e-01
## actividad_laboralNegocio propio -9.939e-01 7.345e-01
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 6.215e-01 7.838e-01
## actividad_laboralTrabajo doméstico no remunerado -7.445e-01 7.231e-01
## actividad_laboralTrabajo doméstico remunerado -1.697e-01 9.054e-01
## z value Pr(>|z|)
## (Intercept) 0.624 0.53275
## generoMujer -0.240 0.81046
## inseguridad 0.636 0.52458
## ingreso.maximo -0.458 0.64724
## edad -0.439 0.66092
## tiempo_translado 11.529 < 2e-16 ***
## inseguridad_en_transporteSí -4.481 7.43e-06 ***
## mala_calidad_aire -3.074 0.00211 **
## actividad_laboralEmpleado(a) -0.470 0.63871
## actividad_laboralJubilado -0.168 0.86672
## actividad_laboralNegocio propio -1.353 0.17601
## actividad_laboralNi estudia, ni trabaja, ni busca empleo 0.793 0.42779
## actividad_laboralTrabajo doméstico no remunerado -1.030 0.30320
## actividad_laboralTrabajo doméstico remunerado -0.187 0.85134
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1162.79 on 928 degrees of freedom
## Residual deviance: 861.16 on 915 degrees of freedom
## AIC: 889.16
##
## Number of Fisher Scoring iterations: 5¿Qué hicimos en este chunk?
Se ajustó un modelo de regresión logística (spline_model) para predecir el tipo de transporte (transporte), utilizando como variables predictoras: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, y actividad_laboral. La familia de distribución utilizada es “binomial”. Se generó un resumen del modelo de regresión logística, mostrando estadísticas clave como los coeficientes de las variables predictoras, errores estándar, valores z, y valores p para evaluar la significancia de cada predictor en el modelo.
INTERPRETACION
Este modelo, de forma similar a los anteriores, demuestra resultados consistentes con respecto a la significancia de los predictores.
Percepción de Inseguridad Sentirse muy inseguro tiene un impacto significativo positivo en la probabilidad de usar transporte público.
Ingreso Máximo Un mayor ingreso máximo está asociado con una menor probabilidad de usar transporte público, consistente con la hipótesis de que las personas con mayores ingresos prefieren el transporte privado.
#Cabe mencionar que el uso de splines con 4 grados de libertad para modelar la edad muestra que hay componentes significativos que afectan la probabilidad de usar transporte público. Los coeficientes significativos negativos sugieren que hay mayor edad hay una menor probabilidad de decidir por usar transporte publico
Árboles de decisión
# Crear el modelo de árbol de decisión
arbol_modelo <- rpart(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, data = df, method = "class")
# Plotear el árbol de decisión usando prp para mejorar la visualización
prp(arbol_modelo,
faclen = 0, # Longitud de las etiquetas de las categorías (0 para no truncar)
cex = 0.8, # Tamaño del texto
extra = 104, # Añadir detalles adicionales
under = TRUE, # Mostrar información de predicción debajo de los nodos
varlen = 0, # Longitud de las etiquetas de las variables (0 para no truncar)
compress = TRUE, # Comprimir el árbol horizontalmente
box.palette = "auto", # Paleta de colores para los nodos
branch.col = "blue", # Color de las ramas
shadow.col = "gray" # Color de la sombra
)
# Imprimir resumen del modelo
print(arbol_modelo)## n= 929
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 929 296 publico (0.31862217 0.68137783)
## 2) tiempo_translado< 56.5 267 86 privado (0.67790262 0.32209738)
## 4) tiempo_translado< 23 106 13 privado (0.87735849 0.12264151) *
## 5) tiempo_translado>=23 161 73 privado (0.54658385 0.45341615)
## 10) actividad_laboral=Negocio propio,Trabajo doméstico no remunerado 46 11 privado (0.76086957 0.23913043) *
## 11) actividad_laboral=Buscando empleo,Empleado(a),Jubilado,Ni estudia, ni trabaja, ni busca empleo,Trabajo doméstico remunerado 115 53 publico (0.46086957 0.53913043)
## 22) edad>=44.5 55 21 privado (0.61818182 0.38181818)
## 44) actividad_laboral=Empleado(a),Trabajo doméstico remunerado 37 10 privado (0.72972973 0.27027027) *
## 45) actividad_laboral=Buscando empleo,Jubilado,Ni estudia, ni trabaja, ni busca empleo 18 7 publico (0.38888889 0.61111111) *
## 23) edad< 44.5 60 19 publico (0.31666667 0.68333333) *
## 3) tiempo_translado>=56.5 662 115 publico (0.17371601 0.82628399)
## 6) tiempo_translado< 120.5 317 87 publico (0.27444795 0.72555205)
## 12) inseguridad_en_transporte=Sí 61 28 privado (0.54098361 0.45901639)
## 24) mala_calidad_aire>=2.5 43 16 privado (0.62790698 0.37209302) *
## 25) mala_calidad_aire< 2.5 18 6 publico (0.33333333 0.66666667) *
## 13) inseguridad_en_transporte=No 256 54 publico (0.21093750 0.78906250) *
## 7) tiempo_translado>=120.5 345 28 publico (0.08115942 0.91884058) *summary(arbol_modelo)## Call:
## rpart(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## actividad_laboral, data = df, method = "class")
## n= 929
##
## CP nsplit rel error xerror xstd
## 1 0.32094595 0 1.0000000 1.0000000 0.04797866
## 2 0.02477477 1 0.6790541 0.6959459 0.04277630
## 3 0.01351351 4 0.6047297 0.6554054 0.04185477
## 4 0.01238739 5 0.5912162 0.6655405 0.04209098
## 5 0.01000000 8 0.5540541 0.6655405 0.04209098
##
## Variable importance
## tiempo_translado actividad_laboral inseguridad_en_transporte
## 77 8 7
## edad mala_calidad_aire ingreso.maximo
## 5 2 1
##
## Node number 1: 929 observations, complexity param=0.3209459
## predicted class=publico expected loss=0.3186222 P(node) =1
## class counts: 296 633
## probabilities: 0.319 0.681
## left son=2 (267 obs) right son=3 (662 obs)
## Primary splits:
## tiempo_translado < 56.5 to the left, improve=96.731100, (0 missing)
## actividad_laboral splits as RRRLRLR, improve=13.269320, (0 missing)
## inseguridad < 3.5 to the left, improve= 7.557998, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve= 7.407076, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 4.577043, (0 missing)
##
## Node number 2: 267 observations, complexity param=0.02477477
## predicted class=privado expected loss=0.3220974 P(node) =0.2874058
## class counts: 181 86
## probabilities: 0.678 0.322
## left son=4 (106 obs) right son=5 (161 obs)
## Primary splits:
## tiempo_translado < 23 to the left, improve=13.986690, (0 missing)
## actividad_laboral splits as LRRLRLR, improve=13.426640, (0 missing)
## ingreso.maximo < 9339.5 to the left, improve= 1.684749, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 1.645003, (0 missing)
## inseguridad < 3.5 to the left, improve= 1.604698, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LRRRRLR, agree=0.633, adj=0.075, (0 split)
## ingreso.maximo < 3116.5 to the left, agree=0.610, adj=0.019, (0 split)
## edad < 18.5 to the left, agree=0.610, adj=0.019, (0 split)
## inseguridad < 1.5 to the left, agree=0.607, adj=0.009, (0 split)
## mala_calidad_aire < 4.5 to the right, agree=0.607, adj=0.009, (0 split)
##
## Node number 3: 662 observations, complexity param=0.01238739
## predicted class=publico expected loss=0.173716 P(node) =0.7125942
## class counts: 115 547
## probabilities: 0.174 0.826
## left son=6 (317 obs) right son=7 (345 obs)
## Primary splits:
## tiempo_translado < 120.5 to the left, improve=12.344190, (0 missing)
## actividad_laboral splits as RLLRRLL, improve= 3.404377, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve= 3.026143, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 2.879828, (0 missing)
## inseguridad < 3.5 to the left, improve= 1.485726, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LLRRRLR, agree=0.557, adj=0.076, (0 split)
## edad < 31.5 to the left, agree=0.547, adj=0.054, (0 split)
## ingreso.maximo < 21781.5 to the right, agree=0.541, adj=0.041, (0 split)
## mala_calidad_aire < 3.5 to the right, agree=0.538, adj=0.035, (0 split)
## inseguridad < 2.5 to the left, agree=0.536, adj=0.032, (0 split)
##
## Node number 4: 106 observations
## predicted class=privado expected loss=0.1226415 P(node) =0.1141012
## class counts: 93 13
## probabilities: 0.877 0.123
##
## Node number 5: 161 observations, complexity param=0.02477477
## predicted class=privado expected loss=0.4534161 P(node) =0.1733046
## class counts: 88 73
## probabilities: 0.547 0.453
## left son=10 (46 obs) right son=11 (115 obs)
## Primary splits:
## actividad_laboral splits as RRRLRLR, improve=5.914286, (0 missing)
## edad < 41 to the right, improve=3.190079, (0 missing)
## tiempo_translado < 35.5 to the left, improve=2.004141, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.378885, (0 missing)
## mala_calidad_aire < 1.5 to the right, improve=1.100562, (0 missing)
##
## Node number 6: 317 observations, complexity param=0.01238739
## predicted class=publico expected loss=0.2744479 P(node) =0.3412271
## class counts: 87 230
## probabilities: 0.274 0.726
## left son=12 (61 obs) right son=13 (256 obs)
## Primary splits:
## inseguridad_en_transporte splits as RL, improve=10.732220, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve= 3.363877, (0 missing)
## actividad_laboral splits as RLLLRLL, improve= 2.814032, (0 missing)
## tiempo_translado < 92.5 to the left, improve= 1.560478, (0 missing)
## ingreso.maximo < 28004.5 to the right, improve= 1.262647, (0 missing)
## Surrogate splits:
## ingreso.maximo < 34227.5 to the right, agree=0.811, adj=0.016, (0 split)
## edad < 18.5 to the left, agree=0.811, adj=0.016, (0 split)
##
## Node number 7: 345 observations
## predicted class=publico expected loss=0.08115942 P(node) =0.3713671
## class counts: 28 317
## probabilities: 0.081 0.919
##
## Node number 10: 46 observations
## predicted class=privado expected loss=0.2391304 P(node) =0.04951561
## class counts: 35 11
## probabilities: 0.761 0.239
##
## Node number 11: 115 observations, complexity param=0.02477477
## predicted class=publico expected loss=0.4608696 P(node) =0.123789
## class counts: 53 62
## probabilities: 0.461 0.539
## left son=22 (55 obs) right son=23 (60 obs)
## Primary splits:
## edad < 44.5 to the right, improve=5.217523, (0 missing)
## actividad_laboral splits as RLL-R-R, improve=2.030179, (0 missing)
## mala_calidad_aire < 1.5 to the right, improve=1.894330, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.285617, (0 missing)
## ingreso.maximo < 9339.5 to the left, improve=1.134881, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LRL-R-R, agree=0.635, adj=0.236, (0 split)
## ingreso.maximo < 15558 to the right, agree=0.583, adj=0.127, (0 split)
## tiempo_translado < 34 to the left, agree=0.583, adj=0.127, (0 split)
## genero splits as RL, agree=0.539, adj=0.036, (0 split)
## mala_calidad_aire < 1.5 to the right, agree=0.539, adj=0.036, (0 split)
##
## Node number 12: 61 observations, complexity param=0.01238739
## predicted class=privado expected loss=0.4590164 P(node) =0.065662
## class counts: 33 28
## probabilities: 0.541 0.459
## left son=24 (43 obs) right son=25 (18 obs)
## Primary splits:
## mala_calidad_aire < 2.5 to the right, improve=2.2020590, (0 missing)
## tiempo_translado < 87.5 to the right, improve=1.5303760, (0 missing)
## edad < 55.5 to the right, improve=1.1839710, (0 missing)
## actividad_laboral splits as RLLRRR-, improve=0.7907341, (0 missing)
## ingreso.maximo < 21781.5 to the right, improve=0.4749761, (0 missing)
## Surrogate splits:
## edad < 18.5 to the right, agree=0.738, adj=0.111, (0 split)
## actividad_laboral splits as RLLLRL-, agree=0.738, adj=0.111, (0 split)
##
## Node number 13: 256 observations
## predicted class=publico expected loss=0.2109375 P(node) =0.2755651
## class counts: 54 202
## probabilities: 0.211 0.789
##
## Node number 22: 55 observations, complexity param=0.01351351
## predicted class=privado expected loss=0.3818182 P(node) =0.05920344
## class counts: 34 21
## probabilities: 0.618 0.382
## left son=44 (37 obs) right son=45 (18 obs)
## Primary splits:
## actividad_laboral splits as RLR-R-L, improve=2.8134860, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.9414140, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=1.7818180, (0 missing)
## edad < 50.5 to the left, improve=1.0542290, (0 missing)
## ingreso.maximo < 15558 to the right, improve=0.8727273, (0 missing)
## Surrogate splits:
## edad < 59.5 to the left, agree=0.873, adj=0.611, (0 split)
## mala_calidad_aire < 1.5 to the right, agree=0.709, adj=0.111, (0 split)
##
## Node number 23: 60 observations
## predicted class=publico expected loss=0.3166667 P(node) =0.06458558
## class counts: 19 41
## probabilities: 0.317 0.683
##
## Node number 24: 43 observations
## predicted class=privado expected loss=0.372093 P(node) =0.04628633
## class counts: 27 16
## probabilities: 0.628 0.372
##
## Node number 25: 18 observations
## predicted class=publico expected loss=0.3333333 P(node) =0.01937567
## class counts: 6 12
## probabilities: 0.333 0.667
##
## Node number 44: 37 observations
## predicted class=privado expected loss=0.2702703 P(node) =0.03982777
## class counts: 27 10
## probabilities: 0.730 0.270
##
## Node number 45: 18 observations
## predicted class=publico expected loss=0.3888889 P(node) =0.01937567
## class counts: 7 11
## probabilities: 0.389 0.611¿Qué hicimos en este chunk?
Se creó un modelo de árbol de decisión (arbol_modelo) para predecir el tipo de transporte (transporte), utilizando como variables predictoras: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, y actividad_laboral. El método utilizado es “class” para clasificación. Se generó una visualización del árbol de decisión utilizando la función prp con varias configuraciones para mejorar la legibilidad: faclen = 0: No truncar las etiquetas de las categorías. cex = 0.8: Ajustar el tamaño del texto. extra = 104: Añadir detalles adicionales en los nodos. under = TRUE: Mostrar información de predicción debajo de los nodos. varlen = 0: No truncar las etiquetas de las variables. compress = TRUE: Comprimir el árbol horizontalmente. box.palette = “auto”: Utilizar una paleta de colores automática para los nodos. branch.col = “blue”: Color azul para las ramas. shadow.col = “gray”: Color gris para las sombras. Se imprimió y resumió el modelo del árbol de decisión, mostrando las reglas y estadísticas clave del árbol.
Podar el arbol
# Proporción deseada para el conjunto de prueba (30%)
prop_prueba <- 0.3
set.seed(123)
# Crear el índice para el muestreo aleatorio
indice_muestreo <- sample(1:nrow(df), size = round(prop_prueba * nrow(df)))
# Conjunto de entrenamiento
train_data <- df[-indice_muestreo, ]
# Conjunto de pruebas
test_data <- df[indice_muestreo, ]¿Qué hicimos en este chunk?
Se definió la proporción deseada para el conjunto de prueba (prop_prueba) como el 30% del total de datos. Se estableció una semilla (set.seed(123)) para garantizar la reproducibilidad del muestreo aleatorio. Se creó un índice de muestreo aleatorio (indice_muestreo) seleccionando el 30% de las filas del dataframe df. Se dividieron los datos en dos conjuntos: train_data: Conjunto de entrenamiento, que incluye el 70% de los datos no seleccionados en el índice de muestreo. test_data: Conjunto de prueba, que incluye el 30% de los datos seleccionados en el índice de muestreo.
# Ajusta un árbol a los datos de entrenamiento
library(tree)
arbol_modelo2 <- rpart(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, data = train_data)# Plotear el árbol de decisión usando prp para mejorar la visualización
prp(arbol_modelo2,
faclen = 0, # Longitud de las etiquetas de las categorías (0 para no truncar)
cex = 0.8, # Tamaño del texto
extra = 104, # Añadir detalles adicionales
under = TRUE, # Mostrar información de predicción debajo de los nodos
varlen = 0, # Longitud de las etiquetas de las variables (0 para no truncar)
compress = TRUE, # Comprimir el árbol horizontalmente
box.palette = "auto", # Paleta de colores para los nodos
branch.col = "blue", # Color de las ramas
shadow.col = "gray" # Color de la sombra
)
# Imprimir resumen del modelo
print(arbol_modelo2)## n= 650
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 650 201 publico (0.30923077 0.69076923)
## 2) tiempo_translado< 56.5 189 72 privado (0.61904762 0.38095238)
## 4) actividad_laboral=Negocio propio,Trabajo doméstico no remunerado 62 8 privado (0.87096774 0.12903226) *
## 5) actividad_laboral=Buscando empleo,Empleado(a),Jubilado,Ni estudia, ni trabaja, ni busca empleo,Trabajo doméstico remunerado 127 63 publico (0.49606299 0.50393701)
## 10) tiempo_translado< 22 37 12 privado (0.67567568 0.32432432) *
## 11) tiempo_translado>=22 90 38 publico (0.42222222 0.57777778)
## 22) edad>=41 50 23 privado (0.54000000 0.46000000)
## 44) actividad_laboral=Empleado(a),Jubilado,Trabajo doméstico remunerado 43 17 privado (0.60465116 0.39534884)
## 88) mala_calidad_aire>=2.5 34 11 privado (0.67647059 0.32352941) *
## 89) mala_calidad_aire< 2.5 9 3 publico (0.33333333 0.66666667) *
## 45) actividad_laboral=Buscando empleo,Ni estudia, ni trabaja, ni busca empleo 7 1 publico (0.14285714 0.85714286) *
## 23) edad< 41 40 11 publico (0.27500000 0.72500000) *
## 3) tiempo_translado>=56.5 461 84 publico (0.18221258 0.81778742)
## 6) tiempo_translado< 142.5 244 67 publico (0.27459016 0.72540984)
## 12) inseguridad_en_transporte=Sí 46 23 privado (0.50000000 0.50000000)
## 24) mala_calidad_aire>=2.5 30 11 privado (0.63333333 0.36666667) *
## 25) mala_calidad_aire< 2.5 16 4 publico (0.25000000 0.75000000) *
## 13) inseguridad_en_transporte=No 198 44 publico (0.22222222 0.77777778) *
## 7) tiempo_translado>=142.5 217 17 publico (0.07834101 0.92165899) *summary(arbol_modelo2)## Call:
## rpart(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## actividad_laboral, data = train_data)
## n= 650
##
## CP nsplit rel error xerror xstd
## 1 0.22388060 0 1.0000000 1.0000000 0.05862306
## 2 0.03482587 1 0.7761194 0.8109453 0.05498010
## 3 0.02238806 3 0.7064677 0.8606965 0.05605696
## 4 0.01492537 5 0.6616915 0.8457711 0.05574326
## 5 0.01326700 6 0.6467662 0.8009950 0.05475385
## 6 0.01000000 9 0.6069652 0.8109453 0.05498010
##
## Variable importance
## tiempo_translado actividad_laboral inseguridad_en_transporte
## 65 16 7
## mala_calidad_aire edad inseguridad
## 5 5 1
## ingreso.maximo
## 1
##
## Node number 1: 650 observations, complexity param=0.2238806
## predicted class=publico expected loss=0.3092308 P(node) =1
## class counts: 201 449
## probabilities: 0.309 0.691
## left son=2 (189 obs) right son=3 (461 obs)
## Primary splits:
## tiempo_translado < 56.5 to the left, improve=51.158090, (0 missing)
## actividad_laboral splits as RRRLRLR, improve= 8.446512, (0 missing)
## inseguridad < 3.5 to the left, improve= 5.867009, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve= 5.276860, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 3.390035, (0 missing)
## Surrogate splits:
## edad < 75.5 to the right, agree=0.711, adj=0.005, (0 split)
##
## Node number 2: 189 observations, complexity param=0.03482587
## predicted class=privado expected loss=0.3809524 P(node) =0.2907692
## class counts: 117 72
## probabilities: 0.619 0.381
## left son=4 (62 obs) right son=5 (127 obs)
## Primary splits:
## actividad_laboral splits as RRRLRLR, improve=11.7113100, (0 missing)
## tiempo_translado < 23 to the left, improve= 9.3167700, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 2.2040820, (0 missing)
## ingreso.maximo < 9339.5 to the left, improve= 0.9428571, (0 missing)
## genero splits as RL, improve= 0.9230769, (0 missing)
## Surrogate splits:
## inseguridad_en_transporte splits as RL, agree=0.683, adj=0.032, (0 split)
## tiempo_translado < 13 to the left, agree=0.677, adj=0.016, (0 split)
##
## Node number 3: 461 observations, complexity param=0.013267
## predicted class=publico expected loss=0.1822126 P(node) =0.7092308
## class counts: 84 377
## probabilities: 0.182 0.818
## left son=6 (244 obs) right son=7 (217 obs)
## Primary splits:
## tiempo_translado < 142.5 to the left, improve=8.846963, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=3.203978, (0 missing)
## actividad_laboral splits as RLLRRRL, improve=2.660085, (0 missing)
## inseguridad < 3.5 to the left, improve=2.184274, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.609198, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LLRRRLR, agree=0.594, adj=0.138, (0 split)
## edad < 59.5 to the left, agree=0.566, adj=0.078, (0 split)
## inseguridad < 3.5 to the left, agree=0.557, adj=0.060, (0 split)
## inseguridad_en_transporte splits as LR, agree=0.555, adj=0.055, (0 split)
## ingreso.maximo < 9339.5 to the right, agree=0.549, adj=0.041, (0 split)
##
## Node number 4: 62 observations
## predicted class=privado expected loss=0.1290323 P(node) =0.09538462
## class counts: 54 8
## probabilities: 0.871 0.129
##
## Node number 5: 127 observations, complexity param=0.03482587
## predicted class=publico expected loss=0.496063 P(node) =0.1953846
## class counts: 63 64
## probabilities: 0.496 0.504
## left son=10 (37 obs) right son=11 (90 obs)
## Primary splits:
## tiempo_translado < 22 to the left, improve=3.3687360, (0 missing)
## ingreso.maximo < 9339.5 to the left, improve=2.1613800, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=1.2343570, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.1250350, (0 missing)
## edad < 41 to the right, improve=0.6704296, (0 missing)
## Surrogate splits:
## inseguridad < 1.5 to the left, agree=0.724, adj=0.054, (0 split)
## actividad_laboral splits as LRR-R-R, agree=0.717, adj=0.027, (0 split)
##
## Node number 6: 244 observations, complexity param=0.013267
## predicted class=publico expected loss=0.2745902 P(node) =0.3753846
## class counts: 67 177
## probabilities: 0.275 0.725
## left son=12 (46 obs) right son=13 (198 obs)
## Primary splits:
## inseguridad_en_transporte splits as RL, improve=5.760474, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=2.429918, (0 missing)
## actividad_laboral splits as RLLRRLL, improve=1.927933, (0 missing)
## inseguridad < 3.5 to the left, improve=1.631617, (0 missing)
## tiempo_translado < 92.5 to the left, improve=1.110755, (0 missing)
## Surrogate splits:
## ingreso.maximo < 28004.5 to the right, agree=0.816, adj=0.022, (0 split)
##
## Node number 7: 217 observations
## predicted class=publico expected loss=0.07834101 P(node) =0.3338462
## class counts: 17 200
## probabilities: 0.078 0.922
##
## Node number 10: 37 observations
## predicted class=privado expected loss=0.3243243 P(node) =0.05692308
## class counts: 25 12
## probabilities: 0.676 0.324
##
## Node number 11: 90 observations, complexity param=0.02238806
## predicted class=publico expected loss=0.4222222 P(node) =0.1384615
## class counts: 38 52
## probabilities: 0.422 0.578
## left son=22 (50 obs) right son=23 (40 obs)
## Primary splits:
## edad < 41 to the right, improve=3.1211110, (0 missing)
## actividad_laboral splits as RLL-R-L, improve=1.8085470, (0 missing)
## ingreso.maximo < 9339.5 to the left, improve=1.7361110, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.1552690, (0 missing)
## mala_calidad_aire < 1.5 to the right, improve=0.5208672, (0 missing)
## Surrogate splits:
## mala_calidad_aire < 1.5 to the right, agree=0.622, adj=0.150, (0 split)
## ingreso.maximo < 21781.5 to the left, agree=0.578, adj=0.050, (0 split)
## tiempo_translado < 51.5 to the left, agree=0.578, adj=0.050, (0 split)
## inseguridad < 3.5 to the left, agree=0.567, adj=0.025, (0 split)
## actividad_laboral splits as LLL-L-R, agree=0.567, adj=0.025, (0 split)
##
## Node number 12: 46 observations, complexity param=0.013267
## predicted class=privado expected loss=0.5 P(node) =0.07076923
## class counts: 23 23
## probabilities: 0.500 0.500
## left son=24 (30 obs) right son=25 (16 obs)
## Primary splits:
## mala_calidad_aire < 2.5 to the right, improve=3.0666670, (0 missing)
## edad < 50 to the right, improve=0.9019608, (0 missing)
## inseguridad < 2.5 to the left, improve=0.6969697, (0 missing)
## tiempo_translado < 87.5 to the right, improve=0.6969697, (0 missing)
## actividad_laboral splits as RRLRRL-, improve=0.2555556, (0 missing)
## Surrogate splits:
## edad < 20.5 to the right, agree=0.717, adj=0.187, (0 split)
## tiempo_translado < 130 to the left, agree=0.696, adj=0.125, (0 split)
## actividad_laboral splits as RLLLRL-, agree=0.696, adj=0.125, (0 split)
##
## Node number 13: 198 observations
## predicted class=publico expected loss=0.2222222 P(node) =0.3046154
## class counts: 44 154
## probabilities: 0.222 0.778
##
## Node number 22: 50 observations, complexity param=0.02238806
## predicted class=privado expected loss=0.46 P(node) =0.07692308
## class counts: 27 23
## probabilities: 0.540 0.460
## left son=44 (43 obs) right son=45 (7 obs)
## Primary splits:
## actividad_laboral splits as RLL-R-L, improve=2.5675750, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=1.4400000, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.2410840, (0 missing)
## edad < 52.5 to the left, improve=0.6669231, (0 missing)
## tiempo_translado < 31.5 to the right, improve=0.2948440, (0 missing)
##
## Node number 23: 40 observations
## predicted class=publico expected loss=0.275 P(node) =0.06153846
## class counts: 11 29
## probabilities: 0.275 0.725
##
## Node number 24: 30 observations
## predicted class=privado expected loss=0.3666667 P(node) =0.04615385
## class counts: 19 11
## probabilities: 0.633 0.367
##
## Node number 25: 16 observations
## predicted class=publico expected loss=0.25 P(node) =0.02461538
## class counts: 4 12
## probabilities: 0.250 0.750
##
## Node number 44: 43 observations, complexity param=0.01492537
## predicted class=privado expected loss=0.3953488 P(node) =0.06615385
## class counts: 26 17
## probabilities: 0.605 0.395
## left son=88 (34 obs) right son=89 (9 obs)
## Primary splits:
## mala_calidad_aire < 2.5 to the right, improve=1.6757870, (0 missing)
## genero splits as RL, improve=1.3610950, (0 missing)
## inseguridad_en_transporte splits as RL, improve=0.6823225, (0 missing)
## edad < 63 to the left, improve=0.5842833, (0 missing)
## actividad_laboral splits as -LR---L, improve=0.5842833, (0 missing)
## Surrogate splits:
## edad < 67.5 to the left, agree=0.814, adj=0.111, (0 split)
##
## Node number 45: 7 observations
## predicted class=publico expected loss=0.1428571 P(node) =0.01076923
## class counts: 1 6
## probabilities: 0.143 0.857
##
## Node number 88: 34 observations
## predicted class=privado expected loss=0.3235294 P(node) =0.05230769
## class counts: 23 11
## probabilities: 0.676 0.324
##
## Node number 89: 9 observations
## predicted class=publico expected loss=0.3333333 P(node) =0.01384615
## class counts: 3 6
## probabilities: 0.333 0.667# Predice la respuesta en los datos de prueba
predictions <- predict(arbol_modelo2, newdata = test_data, type = "class")
# Calcula la matriz de confusión
confusion_matrix <- table(test_data$transporte, predictions)
# Muestra la matriz de confusión
confusion_matrix## predictions
## privado publico
## privado 66 29
## publico 12 172# Calcula la tasa de error de prueba
test_error_rate <- 1 - mean(predictions == test_data$transporte)
test_error_rate## [1] 0.1469534# Realiza la validación cruzada y muestra la tabla de CP
cv_model <- printcp(arbol_modelo2)##
## Classification tree:
## rpart(formula = transporte ~ genero + inseguridad + ingreso.maximo +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## actividad_laboral, data = train_data)
##
## Variables actually used in tree construction:
## [1] actividad_laboral edad
## [3] inseguridad_en_transporte mala_calidad_aire
## [5] tiempo_translado
##
## Root node error: 201/650 = 0.30923
##
## n= 650
##
## CP nsplit rel error xerror xstd
## 1 0.223881 0 1.00000 1.00000 0.058623
## 2 0.034826 1 0.77612 0.81095 0.054980
## 3 0.022388 3 0.70647 0.86070 0.056057
## 4 0.014925 5 0.66169 0.84577 0.055743
## 5 0.013267 6 0.64677 0.80100 0.054754
## 6 0.010000 9 0.60697 0.81095 0.054980# Encuentra el valor de CP con el menor error de validación cruzada (xerror)
optimal_cp <- arbol_modelo2$cptable[which.min(arbol_modelo2$cptable[,"xerror"]), "CP"]
# Tamaño óptimo del árbol (el número de terminales después de la poda)
optimal_size <- arbol_modelo2$cptable[which.min(arbol_modelo2$cptable[,"xerror"]), "nsplit"] + 1
optimal_size## [1] 7# Produce un gráfico con el tamaño del árbol en el eje x y la tasa de error de clasificación cruzada en el eje y
plot(arbol_modelo2$cptable[, "nsplit"] + 1, arbol_modelo2$cptable[, "xerror"], type = "b",
xlab = "Tamaño del Árbol", ylab = "Tasa de Error de Clasificación Cruzada",
main = "Validación Cruzada para Árbol de Decisión")
min_error <- min(arbol_modelo2$cptable[, "xerror"])
# Encuentra el tamaño óptimo del árbol (número de divisiones + 1)
optimal_size <- arbol_modelo2$cptable[arbol_modelo2$cptable[, "xerror"] == min_error, "nsplit"] + 1
optimal_size## [1] 7# Encuentra el valor de CP con el menor error de validación cruzada (xerror)
optimal_cp <- arbol_modelo2$cptable[which.min(arbol_modelo2$cptable[,"xerror"]), "CP"]
# Podar el árbol usando el CP óptimo
arbol_podado <- prune(arbol_modelo2, cp = optimal_cp)
# Visualizar el árbol podado
prp(arbol_podado,
faclen = 0, # Longitud de las etiquetas de las categorías (0 para no truncar)
cex = 0.8, # Tamaño del texto
extra = 104, # Añadir detalles adicionales
under = TRUE, # Mostrar información de predicción debajo de los nodos
varlen = 0, # Longitud de las etiquetas de las variables (0 para no truncar)
compress = TRUE, # Comprimir el árbol horizontalmente
box.palette = "auto", # Paleta de colores para los nodos
branch.col = "blue", # Color de las ramas
shadow.col = "gray" # Color de la sombra
)
¿Qué hicimos en este chunk?
Ajuste del Modelo de Árbol de Decisión:
Se ajustó un árbol de decisión a los datos de entrenamiento utilizando rpart y se generó un resumen del modelo. Visualización del Árbol de Decisión:
Se ploteó el árbol de decisión utilizando prp para mejorar la visualización, añadiendo detalles adicionales y configurando el tamaño del texto, colores y compresión del árbol. Predicción y Evaluación del Modelo:
Se realizaron predicciones en los datos de prueba utilizando el modelo de árbol de decisión. Se creó una matriz de confusión para comparar las predicciones con los valores reales. Se calculó la tasa de error de prueba del modelo. Validación Cruzada del Árbol de Decisión:
Se realizó una validación cruzada del modelo de árbol de decisión y se mostró la tabla de complejidad de poda (CP). Se identificó el valor de CP con el menor error de validación cruzada y se determinó el tamaño óptimo del árbol. Visualización de la Validación Cruzada:
Se produjo un gráfico mostrando la tasa de error de clasificación cruzada en función del tamaño del árbol. Poda del Árbol de Decisión:
Se podó el árbol de decisión utilizando el valor óptimo de CP y se visualizó el árbol podado con prp.
# Cargar librerías necesarias
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## margin## The following object is masked from 'package:dplyr':
##
## combine# Establecer la semilla para reproducibilidad
set.seed(123)
# Crear el modelo Random Forest para la variable objetivo 'transporte'
random_forest_model <- randomForest(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral,
data = train_data,
mtry = 8, # Ajustar mtry según el número de predictores
importance = TRUE)
# Mostrar el modelo
random_forest_model##
## Call:
## randomForest(formula = transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, data = train_data, mtry = 8, importance = TRUE)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 8
##
## OOB estimate of error rate: 24.62%
## Confusion matrix:
## privado publico class.error
## privado 102 99 0.4925373
## publico 61 388 0.1358575¿Qué hicimos en este chunk?
Instalación y Carga de Librerías:
Se instaló y cargó la librería randomForest necesaria para ajustar modelos de Random Forest. Establecimiento de Semilla:
Se estableció una semilla (set.seed(123)) para garantizar la reproducibilidad de los resultados. Creación del Modelo Random Forest:
Se ajustó un modelo Random Forest para predecir la variable objetivo transporte utilizando las variables predictoras: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, y actividad_laboral. Se configuró el parámetro mtry (número de predictores a considerar en cada división) a 8 y se habilitó la opción importance para evaluar la importancia de las variables. Visualización del Modelo:
Se mostró la salida del modelo Random Forest ajustado para revisar los detalles del modelo.
# Predecir usando el modelo Random Forest en los datos de prueba
transporte.pred.rf <- predict(random_forest_model, newdata = test_data)
# Asumiendo que la variable objetivo en test_data se llama 'transporte'
actual <- test_data$transporte
# Plotear las predicciones contra los valores reales
plot(transporte.pred.rf, actual, main = "Predicciones vs Valores Reales", xlab = "Predicciones", ylab = "Valores Reales")
abline(0, 1)
# Calcular el error cuadrático medio
mean((transporte.pred.rf != actual)^2)## [1] 0.2043011# Calcular la matriz de confusión
confusion_matrix <- table(Predicted = transporte.pred.rf, Actual = actual)
print(confusion_matrix)## Actual
## Predicted privado publico
## privado 55 17
## publico 40 167# Calcular la precisión
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
print(paste("Precisión:", accuracy))## [1] "Precisión: 0.795698924731183"¿Qué hicimos en este chunk?
Predicciones con el Modelo Random Forest:
Se utilizaron los datos de prueba para realizar predicciones con el modelo Random Forest ajustado. Comparación de Predicciones y Valores Reales:
Se extrajo la variable objetivo transporte de los datos de prueba (actual). Se graficaron las predicciones contra los valores reales y se añadió una línea de identidad (abline(0, 1)) para facilitar la comparación visual. Cálculo del Error Cuadrático Medio:
Se calculó el error cuadrático medio para evaluar el rendimiento del modelo. Matriz de Confusión:
Se creó una matriz de confusión para comparar las predicciones del modelo con los valores reales. Se imprimió la matriz de confusión para revisar los detalles. Cálculo de la Precisión:
Se calculó la precisión del modelo como la proporción de predicciones correctas sobre el total de predicciones. Se imprimió la precisión del modelo.
# Mostrar la importancia de las variables
importance(random_forest_model)## privado publico MeanDecreaseAccuracy
## genero 0.7145869 2.422610 2.421973
## inseguridad -2.5480645 9.398224 6.639789
## ingreso.maximo 5.1648346 5.434485 7.540406
## edad 3.1115121 13.129732 12.442874
## tiempo_translado 63.4126124 40.318247 65.905513
## inseguridad_en_transporte 4.3548930 10.321984 10.885380
## mala_calidad_aire 5.9417076 6.856080 8.959113
## actividad_laboral 20.7377996 16.417281 25.624512
## MeanDecreaseGini
## genero 8.078085
## inseguridad 15.467508
## ingreso.maximo 20.757454
## edad 69.953743
## tiempo_translado 106.713509
## inseguridad_en_transporte 9.870492
## mala_calidad_aire 19.561739
## actividad_laboral 26.865568# Graficar la importancia de las variables
varImpPlot(random_forest_model)
¿Qué hicimos en este chunk?
Mostrar la Importancia de las Variables:
Se utilizó la función importance para mostrar la importancia de cada variable predictora en el modelo Random Forest. Graficar la Importancia de las Variables:
Se utilizó la función varImpPlot para generar una gráfica que visualiza la importancia de las variables en el modelo Random Forest. Esta gráfica ayuda a identificar cuáles variables tienen mayor influencia en las predicciones del modelo.
#Cargar librerías necesarias
library(gbm)## Loaded gbm 2.1.9## This version of gbm is no longer under development. Consider transitioning to gbm3, https://github.com/gbm-developers/gbm3# Convertir la variable 'transporte' a binaria si es necesario
train_data$transporte <- ifelse(train_data$transporte == "publico", 1, 0)
test_data$transporte <- ifelse(test_data$transporte == "publico", 1, 0)
# Establecer la semilla para reproducibilidad
set.seed(123)
# Crear el modelo de Gradient Boosting para la variable objetivo 'transporte'
boost_model <- gbm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral,
data = train_data,
distribution = "bernoulli", # Cambiar a 'bernoulli' para clasificación binaria
n.trees = 5000,
interaction.depth = 4)
# Mostrar el modelo
summary(boost_model)
## var rel.inf
## tiempo_translado tiempo_translado 34.592253
## edad edad 31.514892
## actividad_laboral actividad_laboral 14.249199
## mala_calidad_aire mala_calidad_aire 5.565821
## ingreso.maximo ingreso.maximo 5.491403
## inseguridad inseguridad 3.595807
## inseguridad_en_transporte inseguridad_en_transporte 2.554968
## genero genero 2.435657¿Qué hicimos en este chunk?
Instalación y Carga de Librerías:
Se verificó si la librería gbm está instalada, y en caso contrario, se instaló y cargó. Conversión de la Variable Objetivo:
Se convirtió la variable objetivo transporte a una variable binaria: 1 para publico y 0 para privado tanto en los datos de entrenamiento como en los datos de prueba. Establecimiento de Semilla:
Se estableció una semilla (set.seed(123)) para garantizar la reproducibilidad de los resultados. Creación del Modelo de Gradient Boosting:
Se ajustó un modelo de Gradient Boosting para predecir la variable objetivo transporte utilizando las variables predictoras: genero, inseguridad, ingreso.maximo, edad, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, y actividad_laboral. Se configuraron los parámetros del modelo: distribution se estableció en “bernoulli” para clasificación binaria, n.trees en 5000 para el número de árboles a construir, e interaction.depth en 4 para la profundidad máxima de cada árbol. Visualización del Modelo:
Se mostró un resumen del modelo de Gradient Boosting ajustado para revisar la importancia de las variables y otros detalles del modelo.
# Ajustar la disposición de la gráfica para mostrar dos gráficos lado a lado
par(mfrow = c(1, 2))
# Graficar la importancia de las variables en el modelo de Gradient Boosting
plot(boost_model, i = "genero")
plot(boost_model, i = "edad")
¿Qué hicimos en este chunk?
Ajuste de la Disposición de la Gráfica:
Se ajustó la disposición de la gráfica para mostrar dos gráficos lado a lado utilizando par(mfrow = c(1, 2)). Visualización de la Importancia de las Variables en el Modelo de Gradient Boosting:
Se generaron gráficos para visualizar la influencia de las variables genero y edad en el modelo de Gradient Boosting. Estos gráficos muestran cómo varía la predicción del modelo con respecto a los diferentes valores de estas variables.
INTERPRETACION FINAL DEL MODELO
La presencia de coeficientes tanto positivos como negativos para las variables de inseguridad sugiere que la percepción de seguridad puede tener un impacto significativo y diferenciado en la decisión de transporte. Aquellos que se sienten muy inseguros pueden optar más por el transporte público, posiblemente porque lo ven como una opción más segura deido a la alta demanda y utlización o debido a la falta de medios para opciones de transporte privado, mencionado previamente. Los costos de los medios de transporte privado fungen como uno de los principales retractores para optar por movibilidad privada y resulta relevante como esto es un aspecto a tomar a consideración en la consulta de medios de parte de la encuesta.
El ingreso máximo tiene un efecto negativo claro, lo cual es consistente con la idea de que individuos con mayores ingresos tienden a preferir opciones de transporte privadas, presumiblemente debido a la mayor disponibilidad de recursos.
SUSTENTO TEÓRICO
Genero: La influencia del género en elección de transporte ha sido señalada como significativa, esto por las distintas necesidades de los distintos géneros, preferencias, e inquietudes ante la percepción de seguridad que afectan la elección en el modo de transporte. Se ha señalado en estudios que las diferencias de genero pueden tener influencia en la percepción de seguridad, costo del tiempo de transporte, y preferencias por modos específicos de transporte como lo son el público y el transporte privado “Las diferencias de género son evidentes en las elecciones de modo de transporte, lo cual podría atribuirse a las variadas necesidades y percepciones relacionadas con la seguridad personal y la comodidad entre hombres y mujeres” (DesarrolloEconomico, 1989).
Percepción de Seguridad: La percepción que se tenga de seguridad impacta en la decisión entre transporte público y privado. El sentimiento de seguridad o vulnerabilidad de los individuos puede ser influenciado por varios factores, incluyendo el tipo de transporte, hora del día, y experiencias previas. Existen investigaciones que indican que mejorando la percepción de seguridad se aumenta el uso de transporte público, “La percepción de seguridad influye significativamente en las elecciones de transporte, destacando la necesidad de medidas políticas que mejoren las percepciones de seguridad pública para promover el uso del transporte público” (Márquez, 2016), esto debido a que los individuos tienden a escoger modos de transporte que consideran más seguros.
Ingreso: Los niveles de ingreso de un individuo afectan directamente su elección de modo de transporte, con individuos de más alto ingreso es más probable que utilicen transporte privado debido a la asequibilidad y valor percibido de tiempo. Mientras que los individuos de bajo ingreso puede que prefieran el transporte público como una opción económica. Al incorporar los efectos del ingreso en los modos de transporte elegidos se puede predecir fielmente la elección que se tiene “La metodología […] confirma cuantitativamente análisis cualitativos previos y muestra empíricamente la necesidad de emplear modelos de elección de modo sensibles al ingreso” (Jara-Díaz & Videla, 1989), y se pueden entender las barreras económicas que se presentan frente a ciertos tipos de transporte.
Municipio: Los niveles significativos de esta variable depende directamente de una percepción hacia la elección de medio de transporte sesgada por las condiciones actuales de la planificación urbana y el obstáculo de desarrollo que representa en la vialidad y la necesidad de tomar alternativas ante la falta de opciones. Esto se sustenta por medio de la investigación de la opinión pública de la situación de traslados que se simula como desfavorable y la elección de transporte rutinario de los ciudadanos por región del estado que no necesariamente coincide con la realidad a falta de alternativas efectivas.Néchet, F. L. (2012).
Edad: Resulta relevante como factor como factor sociodemográfico para la perfilación de respuestas, pero ante la situación de la planificación de vialidades disponibles ante traslados y sus temporalidades estimadas que limitan los medios de transportes disponibles por región; optamos por utilizar este aspecto como punto de referencia para las interpretaciones de percepción de la ciudadanía basadas en edad sin que implique una mayor afectación en los resultados o predicciones para las subsecuentes etapas de investgiación Villena‐Sanchez, J., Boschmann, E. E., & Ávila-Forcada, S. (2022).
REFERENCIAS
CVNL | Inicio. (s. f.). https://comovamosnl.org/
García, Pablo Marcelo. (2005). Una aproximación microeconométrica a los determinantes de la elección del modo de transporte. Revista Latinoamericana de Desarrollo Económico, (4), 11-40. Recuperado en 26 de abril de 2024, de http://www.scielo.org.bo/scielo.php?script=sci_arttext&pid=S2074-47062005000100002&lng=es&tlng=es.
Leon, A. D., Díaz, S., & Márquez, L. (2022). Análisis de la percepción de inseguridad con enfoque de género en la elección del transporte público. Estudio de caso Tunja, Colombia. EURE, 49(147), 1-29. https://doi.org/10.7764/eure.49.147.02
Yeganeh, A. J., Hall, R. P., Pearce, A. R., & Hankey, S. (2018). A social equity analysis of the U.S. public transportation system based on job accessibility. Journal Of Transport And Land Use, 11(1). https://doi.org/10.5198/jtlu.2018.1370
Jara-Dı́Az, S., & Videla, J. (1989). Detection of income effect in mode choice: Theory and application. Transportation Research. Part B: Methodological/Transportation Research. Part B, Methodological, 23(6), 393-400. https://doi.org/10.1016/0191-2615(89)90040-4
Márquez, L. (2016). Safety perception in transportation choices: progress and research lines. Ingeniería y Competitividad, 18(2), 11-24. https://dialnet.unirioja.es/descarga/articulo/6059330.pdf
Fan, Y., Guthrie, A., & Levinson, D. (2016). Waiting time perceptions at transit stops and stations: Effects of basic amenities, gender, and security. Transportation Research. Part A, Policy And Practice, 88, 251-264. https://doi.org/10.1016/j.tra.2016.04.012
García, Pablo Marcelo. (2005). Una aproximación microeconométrica a los determinantes de la elección del modo de transporte. Revista Latinoamericana de Desarrollo Económico, (4), 11-40. Recuperado en 26 de abril de 2024, de http://www.scielo.org.bo/scielo.php?script=sci_arttext&pid=S2074-47062005000100002&lng=es&tlng=es.
Gareth James, Witten, D., Hastie, T., & Tibshirani, R. (2020). An introduction to statistical learning (01 ed.). Springer. https://experiencia21.tec.mx/courses/463306/pages/recursos-de-aprendizaje
http://data4.mx. (s. f.). Cómo Vamos Nuevo León: Plataforma de visualización. Como Vamos Nuevo León. http://datos.comovamosnl.org/#/home
Instituto mexicano para la competitividad. (2024, 29 abril). Inicio - IMCO. IMCO. https://imco.org.mx/
Jara-Dı́Az, S., & Videla, J. (1989). Detection of income effect in mode choice: Theory and application. Transportation Research. Part B: Methodological/Transportation Research. Part B, Methodological, 23(6), 393-400. https://doi.org/10.1016/0191-2615(89)90040-4
Leon, A. D., Díaz, S., & Márquez, L. (2022). Análisis de la percepción de inseguridad con enfoque de género en la elección del transporte público. Estudio de caso Tunja, Colombia. EURE, 49(147), 1-29. https://doi.org/10.7764/eure.49.147.02
Néchet, F. L. (2012). Urban spatial structure, daily mobility and energy consumption: a study of 34 European cities. Cybergeo. https://doi.org/10.4000/cybergeo.24966
Villena‐Sanchez, J., Boschmann, E. E., & Ávila-Forcada, S. (2022). Daily travel behaviors and transport mode choice of older adults in Mexico City. Journal Of Transport Geography, 104, 103445. https://doi.org/10.1016/j.jtrangeo.2022.103445
Yeganeh, A. J., Hall, R. P., Pearce, A. R., & Hankey, S. (2018). A social equity analysis of the U.S. public transportation system based on job accessibility. Journal Of Transport And Land Use, 11(1). https://doi.org/10.5198/jtlu.2018.1370
Zhang, J., & Van Acker, V. (2017). Life-oriented travel behavior research: An overview. Transportation Research. Part A, Policy And Practice, 104, 167-178. https://doi.org/10.1016/j.tra.2017.06.004