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?”
#Actividad. ##Ciencia de datos para la toma de decisiones I
##Dr. Victor Manuel Espinoza Juarez #Alumnos: Sabina Martín Rodríguez - A00831896 Jairo Acuña Retana - A00835392 Gonzalo Mendoza Olloqui - A01235319
##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.
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(boot)
library(ggplot2)
library(caret)
## Loading required package: lattice
##
## Attaching package: 'lattice'
## The following object is masked from 'package:boot':
##
## melanoma
library(glmnet)
## Loading required package: Matrix
## Loaded glmnet 4.1-8
library(rpart)
library(splines)
library(rpart.plot)
eav23 <- read.csv("eav23.csv")
eav23_limpio <- eav23 %>%
select(P16, CP3_1, P93, P144, NOM_MUN_MV, CP4_1, tiempo_total_traslado, P27_3, P53, CP8_1, P3)
head(eav23_limpio, 10)
## P16 CP3_1 P93 P144 NOM_MUN_MV CP4_1 tiempo_total_traslado P27_3 P53 CP8_1 P3
## 1 NA 1 3 4 Apodaca 45 NA 1 3 3 5
## 2 NA 0 1 4 Apodaca 68 NA NA 1 2 7
## 3 1 1 2 4 Apodaca 35 35 NA 3 4 5
## 4 12 0 4 4 Apodaca 35 50 NA 3 4 1
## 5 8 1 4 5 Apodaca 57 70 NA 2 3 5
## 6 NA 0 1 5 Apodaca 25 NA NA 2 4 8
## 7 NA 1 4 3 Apodaca 35 NA NA 3 3 5
## 8 NA 1 2 4 Apodaca 42 NA NA 4 4 5
## 9 NA 1 2 3 Apodaca 69 NA 1 3 2 8
## 10 NA 0 2 3 Apodaca 77 NA NA 3 2 7
eav23_limpio<-na.omit(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
df <- eav23_limpio %>%
mutate(municipio = as.factor(NOM_MUN_MV)) %>%
mutate(genero = as.factor(CP3_1),
genero = ifelse(CP3_1 == '0', 'Hombre', ifelse(CP3_1 == '1', 'Mujer', 'NA'))) %>%
filter(genero != 'NA') %>%
mutate(inseguridad = as.numeric(P93)) %>%
filter(inseguridad != c(8888, 9999)) %>%
filter(inseguridad != 'NA') %>%
mutate(ingreso.maximo = ifelse(P144 == '1', 0,
ifelse(P144 == '2', 6233,
ifelse(P144 == '3', 12446,
ifelse(P144 == '4', 18670,
ifelse(P144 == '5', 24893,
ifelse(P144 == '6', 31116,
ifelse(P144 == '7', 37339,
ifelse(P144 == '8', 43562,
ifelse(P144 == '9', 49786,
ifelse(P144 == '10', 56009,
ifelse(P144 == '11', 62232,
ifelse(P144 == '12', 62233, NA))))))))))))) %>%
filter(ingreso.maximo != 'NA') %>%
mutate(edad = as.numeric(CP4_1)) %>%
mutate(transporte = as.factor(P16),
transporte = ifelse(P16 == '2', 'publico',
ifelse(P16 == '7', 'publico',
ifelse(P16 == '9', 'publico',
ifelse(P16 == '10', 'publico',
ifelse(P16 == '1', 'privado',
ifelse(P16 == '3', 'privado',
ifelse(P16 == '4', 'privado',
ifelse(P16 == '5', 'privado',
ifelse(P16 == '6', 'privado',
ifelse(P16 == '8', 'privado',
ifelse(P16 == '11', 'privado',
ifelse(P16 == '12', 'privado',
ifelse(P16 == '13', 'privado',
ifelse(P16 == '14', 'privado',
ifelse(P16 == '15', 'privado', 'NA')))))))))))))))) %>%
filter(transporte != 'NA') %>%
mutate(tiempo_translado = as.numeric(tiempo_total_traslado)) %>%
mutate(inseguridad_en_transporte = ifelse(P27_3 == '0', 'Sí', ifelse(P27_3 == '1', 'No', 'NA'))) %>%
filter(inseguridad_en_transporte != 'NA') %>%
mutate(mala_calidad_aire = ifelse(P53 %in% c(8888, 9999), NA, as.numeric(P53))) %>%
filter(!is.na(mala_calidad_aire)) %>%
mutate(estudios = as.factor(CP8_1),
estudios = ifelse(CP8_1 == '0', 'Ninguno',
ifelse(CP8_1 == '1', 'Preescolar',
ifelse(CP8_1 == '2', 'Primaria',
ifelse(CP8_1 == '3', 'Secundaria',
ifelse(CP8_1 == '4', 'Bachillerato general',
ifelse(CP8_1 == '5', 'Bachillerato tecnológico',
ifelse(CP8_1 == '6', 'Estudios técnicos o comerciales con primaria terminada',
ifelse(CP8_1 == '7', 'Estudios técnicos o comerciales con secundaria terminada',
ifelse(CP8_1 == '8', 'Estudios técnicos o comerciales con preparatoria terminada',
ifelse(CP8_1 == '9', 'Normal con primaria o secundaria terminada',
ifelse(CP8_1 == '10', 'Normal de licenciatura',
ifelse(CP8_1 == '11', 'Licenciatura',
ifelse(CP8_1 == '12', 'Especialidad',
ifelse(CP8_1 == '13', 'Maestría',
ifelse(CP8_1 == '14', 'Doctorado', 'NA')))))))))))))))) %>%
filter(estudios != 'NA') %>%
mutate(actividad_laboral = as.factor(P3),
actividad_laboral = ifelse(P3 == '1', 'Empleado(a)',
ifelse(P3 == '2', 'Buscando empleo',
ifelse(P3 == '3', 'Estudiante',
ifelse(P3 == '4', 'Negocio propio',
ifelse(P3 == '5', 'Trabajo doméstico no remunerado',
ifelse(P3 == '6', 'Trabajo doméstico remunerado',
ifelse(P3 == '7', 'Jubilado',
ifelse(P3 == '8', 'Ni estudia, ni trabaja, ni busca empleo', 'NA'))))))))) %>%
filter(actividad_laboral != 'NA') %>%
select(transporte, edad, ingreso.maximo, inseguridad, genero, municipio, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, estudios, actividad_laboral)
# Corregir factores y tipos que deben ser numéricos
df$transporte <- as.factor(df$transporte)
df$ingreso.maximo <- as.numeric(df$ingreso.maximo)
df$edad <- as.numeric(df$edad)
df$inseguridad <- as.numeric(df$inseguridad)
df$genero <- as.factor(df$genero)
df$municipio <- as.factor(df$municipio)
df$tiempo_translado <- as.numeric(df$tiempo_translado)
df$inseguridad_en_transporte <- as.factor(df$inseguridad_en_transporte)
df$mala_calidad_aire <- as.numeric(df$mala_calidad_aire)
df$estudios <- as.factor(df$estudios)
df$actividad_laboral <- as.factor(df$actividad_laboral)
##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.
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
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))
#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.
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
# 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))
## Se observan resultados similares a la regresion anterior, con una
ligera mejora en la significancia de los predictores de percepcion de
inseguridad.
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
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.7987083
Observamos una precision del 0.79%, la cual es alta.
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.1531531 0.1527728
##
## $seed
## [1] 10403 1 -99799845 428060473 104434312 1484123702
## [7] -536174991 -922829661 644806130 -322980540 775845383 -1091619875
## [13] 1229429972 641762298 -289279163 11020191 1941368102 -807488080
## [19] 1808821843 -884577935 -1708228448 1208766526 -1202063543 -181117445
## [25] -1779203638 2009706284 912690991 -2458139 1805533340 1579967730
## [31] 2032115053 1848732327 -1401289522 1318365736 -1098876373 1835520073
## [37] 559321432 1615874054 261568993 -463846541 1474140130 1964228436
## [43] 556823127 -953867699 2068694500 1406181322 -309222859 -1851447153
## [49] -577414762 492365120 1563326467 821750305 592178448 -787799314
## [55] -2116141415 -42041557 -1830159846 -359470884 -1337514785 1885119157
## [61] 732984396 1156237474 -236222467 1199699191 -1134353890 986717400
## [67] 1978982459 52931033 -2106831000 1288667798 287558673 1162026435
## [73] 1209704914 1277110372 1218578343 658606333 414670068 -1120289830
## [79] -1674932443 1132713535 1445633478 818592336 -999311757 1303755409
## [85] 1537934016 1516872862 1527089257 1757078683 -1269211734 1524731340
## [91] 1661640847 1205067973 -1537240964 1006513362 -1060387763 20043015
## [97] 566737134 1231100360 -2133197109 1121775401 1748563832 1471466662
## [103] 1076567745 -165226669 869274626 37564724 1412078263 2036713133
## [109] -434124860 -2024296470 -1689948075 526765551 -524462602 -1295682784
## [115] -270160669 1531292033 -156164112 1105215118 -407600647 508922763
## [121] -1029912646 756811452 1882398207 -878126251 494849132 -1425200958
## [127] -422544611 -1391595113 2008721662 2014689976 -978549605 -1475181831
## [133] -1516714936 -762992778 1824678577 1227420387 -462327374 1753924100
## [139] -1737344697 1668203549 -2011137388 1821045306 1954774149 -1484349089
## [145] 1968108006 -1307533200 1791419283 -784292815 1440819936 769305470
## [151] -2049039863 1276586555 -487771126 1942195180 1692491887 -422871131
## [157] 1750075228 704056114 -563678675 1861705959 -1003515378 258846696
## [163] -354987541 -1368022391 1940167192 -108998330 171138977 416813619
## [169] 1096380322 -1271502188 -406314729 2060697357 -1316997596 -1350689270
## [175] 617883509 -1495813425 2015757782 2131544448 -1577516605 -1557588127
## [181] -846287408 -1336337106 358591705 -1569560853 1388807002 583456028
## [187] 1895932959 408283253 -746212084 1826986210 -1336667715 1792284215
## [193] 1810566366 -692316136 2021934971 -764754151 84401064 -1595684010
## [199] 1762415569 1402435459 1459905042 463304100 -901009049 643604157
## [205] -2084673996 1837768090 798026213 -1431775873 528669958 -776272240
## [211] 65277747 -2132243247 1839879808 1583611742 -343515991 -1940172965
## [217] 1729570154 -346298356 218153039 -1810417403 731525564 -699558766
## [223] -310833267 1787123655 1368550574 1838447880 527588107 1775728105
## [229] -255401288 1368869152 269461378 -713144600 1607069932 655222844
## [235] -289976462 -1593008528 -2001904604 -177731784 -1988815718 -1846009136
## [241] 1551042748 861296276 472661634 -1902786368 -1922212036 -983617392
## [247] -968100318 1198849032 2133531916 1472666780 -1054559726 828162944
## [253] 783152660 -1468697048 -1565991622 -180103728 1611100268 -314661580
## [259] 1082573458 295950176 264130380 1709903840 312249250 -478106712
## [265] 1211685260 -1439365956 -283168398 -1313705744 1746370628 -896365224
## [271] -1889197510 -1174921360 1821371452 2026916628 -1142401598 137025248
## [277] 570159996 -388820272 1711559842 -1569888216 -89241332 1560630204
## [283] -141130446 1086177728 -1113394636 881117128 1921475770 -1952212592
## [289] 2135745004 898973268 1492577426 845888288 1692000716 -1609433632
## [295] 1510403778 1278849064 246210220 -1722634052 1058936306 -284615376
## [301] 731530404 -2001247560 289339738 -809135728 -217247876 119875860
## [307] 289812290 -2137846016 1097311164 918403920 981061410 -993729208
## [313] 1844332044 -1024532388 165279954 1279768064 1742747988 -1625078296
## [319] 85419002 135359696 1012840748 1089959668 1411020178 -1285349280
## [325] 911799564 1727906528 1679107426 -1474852184 552383052 -702927492
## [331] -1774558926 -931570576 742343492 -1491633704 1824636026 383598128
## [337] -1031216452 1515817812 77348930 1493227936 -1820817732 1457489360
## [343] 1862757730 769892328 647663564 926841596 1499389426 375723136
## [349] 2102993140 -643636600 -925891782 -2025353392 -414485908 1044887700
## [355] -1242779310 -1277311264 666046156 414732448 -925735038 1460303592
## [361] -327786772 -210804676 641240690 2120342640 2020446756 1494630456
## [367] 1033230362 983566032 1996606524 -215534444 -160262014 -317075520
## [373] -1328477892 -1070121328 -429062110 -510961656 871595148 62759964
## [379] 1568309906 351019136 1067836436 -330919640 -141575622 -1495079728
## [385] 1614052460 1922703028 1465161746 700510176 1062337484 929486304
## [391] -895010270 -308034264 -1621025524 -1253984708 1193036018 -607607056
## [397] -761893052 713074264 186444346 1461358320 -182806340 -1177449964
## [403] -535409470 -1604146080 2141781372 937068752 -1301267422 1113265832
## [409] -1541911668 -1408399940 -26971086 -1531695296 1075266740 -2736312
## [415] 102867642 1597402896 2057729260 1513233492 648797970 -1169404000
## [421] -1051012148 -2039346336 -1533008702 -1913979352 -1305592404 -881353924
## [427] 592652146 -665919696 1610999332 526949432 1966192858 1702309264
## [433] 236796668 -1561795692 -121237694 -1197689344 -320168388 -1926282672
## [439] -109457758 -930616504 1175376396 2055379164 -993273262 -1233233792
## [445] -777428140 -995263000 -683385094 -1132217520 -1950471124 1631267188
## [451] 1174791826 -1778479520 1577477772 -728541344 1772270306 163094696
## [457] 770912394 -1186326401 -1277027895 -1108567458 1966149900 454362333
## [463] -835972633 575752720 -1691932882 1785621467 -1023480643 -434082262
## [469] 1675854536 -1264896015 -1036764829 485697892 -1979290478 1870627175
## [475] 2031997745 -1493559178 636633492 1599137189 1332928175 -936212632
## [481] -896816314 795052787 -1880005547 -55629774 -1156258304 -1308948759
## [487] 1077712219 -1550387284 381311930 -967367313 -1470615815 -1857505394
## [493] -926141860 1445843149 -410525641 -1558627648 -1926562402 727699051
## [499] -714226195 -550480806 1886167832 502958209 1165880883 -1384287148
## [505] -1688014750 -1347717385 -1991866047 240660422 16995588 729582773
## [511] 1944955807 1937851384 1226153430 -1567005597 -712880091 -2075793470
## [517] 2098101424 -2006943527 1383624267 -34765636 -1118733590 -106956001
## [523] 2101179305 -711232194 -2056520660 -1455211907 -1863240505 -817835600
## [529] -1706525746 -868341509 -958238883 1908526218 1853356712 -677476847
## [535] -454158589 -1308069372 1621064242 -596006265 -2036314415 -972302250
## [541] -1019320268 -2088514747 1631713679 -783388408 -2064356570 -1151261741
## [547] 1271436597 -998984558 153513056 -1739781687 -184737541 -1887887668
## [553] 1394856794 -966183345 -994405607 -747074258 -1267525828 1867134125
## [559] -2117269673 -66909536 -1369938946 -417803573 236192973 1470121978
## [565] 909777976 -1404547615 2044679827 1980658868 193494466 -1726788137
## [571] 276566561 -1085111834 339646692 -182573035 1308547135 -1246349352
## [577] -664880650 316676611 -1717514939 1104951650 821064400 72510969
## [583] -103381717 -1610996068 1450026186 586337727 207089929 80990750
## [589] -1130651700 -2028986979 1222113319 -714103216 1623339758 -1353204837
## [595] 723880445 -244544278 -1292105848 2118545713 -1705815645 1190618532
## [601] -2050312110 234584999 -1109139471 -1133622474 918468564 -347222683
## [607] 28361071 -1838916696 -429231866 1677250611 -826849643 -1322664206
## [613] 1889619776 -792580951 652734747 -1682389268 951253754 1908900655
## [619] -234763463 1541705038 -1073140836 -422338291 -1417600137 1739593600
## [625] 1664845278 -283980664
# 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("")
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:
Barras:
Interpretación:
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.
# 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 variables
ggplot(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")
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 .
#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.
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
##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.
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
##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
# 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
##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, ]
# 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)
# Resumen del árbol
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= 279
##
## CP nsplit rel error xerror xstd
## 1 0.52631579 0 1.0000000 1.0000000 0.08331918
## 2 0.02105263 1 0.4736842 0.5368421 0.06795584
## 3 0.01578947 3 0.4315789 0.5894737 0.07042401
## 4 0.01000000 5 0.4000000 0.5684211 0.06946442
##
## Variable importance
## tiempo_translado inseguridad_en_transporte actividad_laboral
## 85 6 4
## edad inseguridad mala_calidad_aire
## 3 1 1
##
## Node number 1: 279 observations, complexity param=0.5263158
## predicted class=publico expected loss=0.3405018 P(node) =1
## class counts: 95 184
## probabilities: 0.341 0.659
## left son=2 (78 obs) right son=3 (201 obs)
## Primary splits:
## tiempo_translado < 57.5 to the left, improve=49.892490, (0 missing)
## actividad_laboral splits as LRLRRLR, improve= 6.830849, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve= 1.982924, (0 missing)
## inseguridad < 3.5 to the left, improve= 1.563733, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 1.125916, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LRRRRLR, agree=0.731, adj=0.038, (0 split)
##
## Node number 2: 78 observations, complexity param=0.02105263
## predicted class=privado expected loss=0.1794872 P(node) =0.2795699
## class counts: 64 14
## probabilities: 0.821 0.179
## left son=4 (56 obs) right son=5 (22 obs)
## Primary splits:
## tiempo_translado < 37.5 to the left, improve=4.6366970, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=1.3128210, (0 missing)
## actividad_laboral splits as LRLLRLR, improve=1.2918190, (0 missing)
## edad < 32.5 to the right, improve=0.9333242, (0 missing)
## inseguridad < 2.5 to the left, improve=0.8575398, (0 missing)
## Surrogate splits:
## inseguridad < 3.5 to the left, agree=0.744, adj=0.091, (0 split)
## actividad_laboral splits as LLLLRLL, agree=0.744, adj=0.091, (0 split)
##
## Node number 3: 201 observations, complexity param=0.01578947
## predicted class=publico expected loss=0.1542289 P(node) =0.7204301
## class counts: 31 170
## probabilities: 0.154 0.846
## left son=6 (92 obs) right son=7 (109 obs)
## Primary splits:
## tiempo_translado < 120.5 to the left, improve=3.8586330, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.3852620, (0 missing)
## actividad_laboral splits as RLLRRLL, improve=0.8539726, (0 missing)
## mala_calidad_aire < 3.5 to the left, improve=0.7038928, (0 missing)
## inseguridad < 2.5 to the right, improve=0.7015014, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LRRRRLL, agree=0.582, adj=0.087, (0 split)
## edad < 56.5 to the right, agree=0.562, adj=0.043, (0 split)
## ingreso.maximo < 21781.5 to the right, agree=0.557, adj=0.033, (0 split)
## inseguridad < 3.5 to the right, agree=0.552, adj=0.022, (0 split)
## mala_calidad_aire < 4.5 to the right, agree=0.552, adj=0.022, (0 split)
##
## Node number 4: 56 observations
## predicted class=privado expected loss=0.07142857 P(node) =0.2007168
## class counts: 52 4
## probabilities: 0.929 0.071
##
## Node number 5: 22 observations, complexity param=0.02105263
## predicted class=privado expected loss=0.4545455 P(node) =0.07885305
## class counts: 12 10
## probabilities: 0.545 0.455
## left son=10 (14 obs) right son=11 (8 obs)
## Primary splits:
## edad < 34.5 to the right, improve=2.19480500, (0 missing)
## inseguridad < 2.5 to the left, improve=0.87575760, (0 missing)
## genero splits as RL, improve=0.15909090, (0 missing)
## tiempo_translado < 47.5 to the right, improve=0.10909090, (0 missing)
## ingreso.maximo < 15558 to the left, improve=0.07575758, (0 missing)
## Surrogate splits:
## tiempo_translado < 42 to the left, agree=0.682, adj=0.125, (0 split)
## mala_calidad_aire < 1.5 to the right, agree=0.682, adj=0.125, (0 split)
##
## Node number 6: 92 observations, complexity param=0.01578947
## predicted class=publico expected loss=0.2608696 P(node) =0.3297491
## class counts: 24 68
## probabilities: 0.261 0.739
## left son=12 (17 obs) right son=13 (75 obs)
## Primary splits:
## inseguridad_en_transporte splits as RL, improve=4.4696330, (0 missing)
## actividad_laboral splits as RLLLRLL, improve=1.1925470, (0 missing)
## mala_calidad_aire < 3.5 to the left, improve=0.9711384, (0 missing)
## tiempo_translado < 66 to the left, improve=0.6746788, (0 missing)
## edad < 25 to the left, improve=0.6723706, (0 missing)
##
## Node number 7: 109 observations
## predicted class=publico expected loss=0.06422018 P(node) =0.390681
## class counts: 7 102
## probabilities: 0.064 0.936
##
## Node number 10: 14 observations
## predicted class=privado expected loss=0.2857143 P(node) =0.05017921
## class counts: 10 4
## probabilities: 0.714 0.286
##
## Node number 11: 8 observations
## predicted class=publico expected loss=0.25 P(node) =0.02867384
## class counts: 2 6
## probabilities: 0.250 0.750
##
## Node number 12: 17 observations
## predicted class=privado expected loss=0.4117647 P(node) =0.0609319
## class counts: 10 7
## probabilities: 0.588 0.412
##
## Node number 13: 75 observations
## predicted class=publico expected loss=0.1866667 P(node) =0.2688172
## class counts: 14 61
## probabilities: 0.187 0.813
# 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= 279
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 279 95 publico (0.34050179 0.65949821)
## 2) tiempo_translado< 57.5 78 14 privado (0.82051282 0.17948718)
## 4) tiempo_translado< 37.5 56 4 privado (0.92857143 0.07142857) *
## 5) tiempo_translado>=37.5 22 10 privado (0.54545455 0.45454545)
## 10) edad>=34.5 14 4 privado (0.71428571 0.28571429) *
## 11) edad< 34.5 8 2 publico (0.25000000 0.75000000) *
## 3) tiempo_translado>=57.5 201 31 publico (0.15422886 0.84577114)
## 6) tiempo_translado< 120.5 92 24 publico (0.26086957 0.73913043)
## 12) inseguridad_en_transporte=Sí 17 7 privado (0.58823529 0.41176471) *
## 13) inseguridad_en_transporte=No 75 14 publico (0.18666667 0.81333333) *
## 7) tiempo_translado>=120.5 109 7 publico (0.06422018 0.93577982) *
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= 279
##
## CP nsplit rel error xerror xstd
## 1 0.52631579 0 1.0000000 1.0000000 0.08331918
## 2 0.02105263 1 0.4736842 0.5368421 0.06795584
## 3 0.01578947 3 0.4315789 0.5894737 0.07042401
## 4 0.01000000 5 0.4000000 0.5684211 0.06946442
##
## Variable importance
## tiempo_translado inseguridad_en_transporte actividad_laboral
## 85 6 4
## edad inseguridad mala_calidad_aire
## 3 1 1
##
## Node number 1: 279 observations, complexity param=0.5263158
## predicted class=publico expected loss=0.3405018 P(node) =1
## class counts: 95 184
## probabilities: 0.341 0.659
## left son=2 (78 obs) right son=3 (201 obs)
## Primary splits:
## tiempo_translado < 57.5 to the left, improve=49.892490, (0 missing)
## actividad_laboral splits as LRLRRLR, improve= 6.830849, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve= 1.982924, (0 missing)
## inseguridad < 3.5 to the left, improve= 1.563733, (0 missing)
## inseguridad_en_transporte splits as RL, improve= 1.125916, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LRRRRLR, agree=0.731, adj=0.038, (0 split)
##
## Node number 2: 78 observations, complexity param=0.02105263
## predicted class=privado expected loss=0.1794872 P(node) =0.2795699
## class counts: 64 14
## probabilities: 0.821 0.179
## left son=4 (56 obs) right son=5 (22 obs)
## Primary splits:
## tiempo_translado < 37.5 to the left, improve=4.6366970, (0 missing)
## mala_calidad_aire < 2.5 to the right, improve=1.3128210, (0 missing)
## actividad_laboral splits as LRLLRLR, improve=1.2918190, (0 missing)
## edad < 32.5 to the right, improve=0.9333242, (0 missing)
## inseguridad < 2.5 to the left, improve=0.8575398, (0 missing)
## Surrogate splits:
## inseguridad < 3.5 to the left, agree=0.744, adj=0.091, (0 split)
## actividad_laboral splits as LLLLRLL, agree=0.744, adj=0.091, (0 split)
##
## Node number 3: 201 observations, complexity param=0.01578947
## predicted class=publico expected loss=0.1542289 P(node) =0.7204301
## class counts: 31 170
## probabilities: 0.154 0.846
## left son=6 (92 obs) right son=7 (109 obs)
## Primary splits:
## tiempo_translado < 120.5 to the left, improve=3.8586330, (0 missing)
## inseguridad_en_transporte splits as RL, improve=1.3852620, (0 missing)
## actividad_laboral splits as RLLRRLL, improve=0.8539726, (0 missing)
## mala_calidad_aire < 3.5 to the left, improve=0.7038928, (0 missing)
## inseguridad < 2.5 to the right, improve=0.7015014, (0 missing)
## Surrogate splits:
## actividad_laboral splits as LRRRRLL, agree=0.582, adj=0.087, (0 split)
## edad < 56.5 to the right, agree=0.562, adj=0.043, (0 split)
## ingreso.maximo < 21781.5 to the right, agree=0.557, adj=0.033, (0 split)
## inseguridad < 3.5 to the right, agree=0.552, adj=0.022, (0 split)
## mala_calidad_aire < 4.5 to the right, agree=0.552, adj=0.022, (0 split)
##
## Node number 4: 56 observations
## predicted class=privado expected loss=0.07142857 P(node) =0.2007168
## class counts: 52 4
## probabilities: 0.929 0.071
##
## Node number 5: 22 observations, complexity param=0.02105263
## predicted class=privado expected loss=0.4545455 P(node) =0.07885305
## class counts: 12 10
## probabilities: 0.545 0.455
## left son=10 (14 obs) right son=11 (8 obs)
## Primary splits:
## edad < 34.5 to the right, improve=2.19480500, (0 missing)
## inseguridad < 2.5 to the left, improve=0.87575760, (0 missing)
## genero splits as RL, improve=0.15909090, (0 missing)
## tiempo_translado < 47.5 to the right, improve=0.10909090, (0 missing)
## ingreso.maximo < 15558 to the left, improve=0.07575758, (0 missing)
## Surrogate splits:
## tiempo_translado < 42 to the left, agree=0.682, adj=0.125, (0 split)
## mala_calidad_aire < 1.5 to the right, agree=0.682, adj=0.125, (0 split)
##
## Node number 6: 92 observations, complexity param=0.01578947
## predicted class=publico expected loss=0.2608696 P(node) =0.3297491
## class counts: 24 68
## probabilities: 0.261 0.739
## left son=12 (17 obs) right son=13 (75 obs)
## Primary splits:
## inseguridad_en_transporte splits as RL, improve=4.4696330, (0 missing)
## actividad_laboral splits as RLLLRLL, improve=1.1925470, (0 missing)
## mala_calidad_aire < 3.5 to the left, improve=0.9711384, (0 missing)
## tiempo_translado < 66 to the left, improve=0.6746788, (0 missing)
## edad < 25 to the left, improve=0.6723706, (0 missing)
##
## Node number 7: 109 observations
## predicted class=publico expected loss=0.06422018 P(node) =0.390681
## class counts: 7 102
## probabilities: 0.064 0.936
##
## Node number 10: 14 observations
## predicted class=privado expected loss=0.2857143 P(node) =0.05017921
## class counts: 10 4
## probabilities: 0.714 0.286
##
## Node number 11: 8 observations
## predicted class=publico expected loss=0.25 P(node) =0.02867384
## class counts: 2 6
## probabilities: 0.250 0.750
##
## Node number 12: 17 observations
## predicted class=privado expected loss=0.4117647 P(node) =0.0609319
## class counts: 10 7
## probabilities: 0.588 0.412
##
## Node number 13: 75 observations
## predicted class=publico expected loss=0.1866667 P(node) =0.2688172
## class counts: 14 61
## probabilities: 0.187 0.813
# 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 133 68
## publico 80 369
# Calcula la tasa de error de prueba
test_error_rate <- 1 - mean(predictions == test_data$transporte)
test_error_rate
## [1] 0.2276923
# 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] edad inseguridad_en_transporte
## [3] tiempo_translado
##
## Root node error: 95/279 = 0.3405
##
## n= 279
##
## CP nsplit rel error xerror xstd
## 1 0.526316 0 1.00000 1.00000 0.083319
## 2 0.021053 1 0.47368 0.53684 0.067956
## 3 0.015789 3 0.43158 0.58947 0.070424
## 4 0.010000 5 0.40000 0.56842 0.069464
# 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] 2
# 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] 2
# 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
)
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.
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