Evidencia 1. Producto de Ciencia de Datos
2024-06-16
Entrega de Gonzalo Mendoza Olloqui - A01235319#Tecnologico de Monterrey #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
Links a RPUBS
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 y arboles de decision, con la intencion de conocer que variables son las que afectan la decision previamente mencionada de los neoloneneses; y, de manera mas precisa, en que medida afectan estas variables a su decision. Al conseguir los datos duros de como estas variables afectan la decision de transporte de la ciudadania y en que medida, proveeremos informacion que puede ser de gran utilidad para los tomadores de decisiones en temas de movilidad y transporte en Nuevo Leon.
##DEFINICION DE LA PROBLEMATICA
Como inicio de la investigación presente, se identificó una problemática creciente en el estado de Nuevo León: la movilidad, o bien, la ausencia de movilidad. Desde nuestra experiencia propia, comentamos que es difícil moverse en Nuevo León, desde el hecho de que no hay banquetas, el transporte público es escaso, hasta las horas pico con altos niveles de tráfico. Observamos además que, por parte de los tomadores de decisiones, hay poco interés en solucionar este problema de manera efectiva, e incluso cuando se habla de soluciones para el tráfico, se plantea la opción de más carriles y calles, las cuales, además de ser una solución de corto plazo, benefician solamente a aquellos que cuentan con transporte privado.
De acuerdo a la última encuesta de Cómo Vamos Nuevo León; Así Vamos 2023, en Nuevo León, los tiempos de traslado incrementaron en promedio 15 minutos al compararlos con 2022, pasando de 68 a 83 minutos invertidos, superando el promedio de años anteriores. Además de esto, aquellas personas que se mueven en transporte público enfrentan aún más dificultades al transportarse de un punto a otro, ya que los usuarios de camión invierten dos horas y 21 minutos en su viaje redondo, mientras que quienes se mueven en automóvil tardan menos de la mitad (una hora con siete minutos).
Ahora bien, aquellas personas que no utilizan transporte dan múltiples razones por las cuales no utilizan transporte público, como se muestra en la gráfica a continuación:
Sys.setlocale("LC_ALL", "en_US.UTF-8")## [1] "LC_COLLATE=en_US.UTF-8;LC_CTYPE=en_US.UTF-8;LC_MONETARY=en_US.UTF-8;LC_NUMERIC=C;LC_TIME=en_US.UTF-8"# Instala y carga las librerías necesarias
library(ggplot2)
# Crea el conjunto de datos con codificación UTF-8
data <- data.frame(
Reason = c("Comodidad", "Se tarda más tiempo\nque el transporte privado/\nEs más rápido en auto",
"No hay una ruta que\nme lleve a mi destino",
"El transporte no me deja\ncerca de mi destino",
"El transporte\nsiempre va lleno",
"El transporte\nestá feo/sucio",
"El transporte es inseguro/\nda miedo usarlo",
"La parada está lejos",
"El pasaje es muy caro",
"Otro",
"Mal servicio\n(choferes poco amables\no que juegan carreras)",
"No es accesible para\npersonas con discapacidad"),
Percentage = c(45.8, 17.8, 10.9, 8.3, 3.7, 3.2, 3, 2.7, 1.7, 1.3, 1.1, 0.6),
stringsAsFactors = FALSE
)
# Convertir los factores a UTF-8
data$Reason <- iconv(data$Reason, from = "latin1", to = "UTF-8")
# Ordena las razones por porcentaje
data$Reason <- factor(data$Reason, levels = data$Reason[order(data$Percentage, decreasing = TRUE)])
# Crea la gráfica de barras
ggplot(data, aes(x = Reason, y = Percentage)) +
geom_bar(stat = "identity", fill = "#00C19F") +
geom_text(aes(label = paste0(Percentage, "%")), vjust = -0.5, color = "#00C19F", size = 3.5) +
labs(title = iconv("Razon otorgada de no utilizar el transporte publico", from = "latin1", to = "UTF-8"),
x = "",
y = "",
caption = "") +
theme_minimal(base_size = 14) +
theme(axis.text.x = element_text(angle = 45, hjust = 1, color = "#7300a6", size = 10),
axis.text.y = element_text(color = "#00C19F"),
plot.title = element_text(size = 18, face = "bold", color = "#7300a6"),
plot.subtitle = element_text(size = 14, color = "#7300a6"))
Es aquí donde nos encontramos con la pregunta de investigación. Al observar esta problemática, como equipo de investigación, nos preguntamos, más allá de las razones dadas por aquellos que no utilizan transporte público, ¿qué variables socioeconómicas y etnográficas afectan el que una persona use o no transporte público?
A continuación, se establece la pregunta de investigación de manera concisa:
##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?”
A continuación, se presenta el análisis estadístico elaborado para responder esta pregunta establecida.
Cabe mencionar que el código elaborado ha sido separado por pasos, donde después de cada “chunk” de código, se puede encontrar la pregunta “¿Qué hicimos en este chunk?”, seguida de una descripción del código elaborado y, en dado caso de haber resultados, se ofrece también una interpretación de los mismos bajo la pregunta “¿Qué observamos en los resultados?”
##LIBRERIAS Y BASES DE DATOS
options(repos = c(CRAN = "https://cran.rstudio.com/"))
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, unionlibrary(boot)
library(caret)## Loading required package: lattice##
## Attaching package: 'lattice'## The following object is masked from 'package:boot':
##
## melanomalibrary(glmnet)## Loading required package: Matrix## Loaded glmnet 4.1-8library(rpart)
library(splines)
library(rpart.plot)
library(mgcv)## Loading required package: nlme##
## Attaching package: 'nlme'## The following object is masked from 'package:dplyr':
##
## collapse## This is mgcv 1.9-1. For overview type 'help("mgcv-package")'.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, Factor_CVNL)
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
## Factor_CVNL
## 1 1359.894
## 2 1428.555
## 3 1359.894
## 4 1428.555
## 5 1359.894
## 6 1428.555
## 7 1359.894
## 8 1359.894
## 9 1359.894
## 10 1428.555eav23_limpio<-na.omit(eav23_limpio)¿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
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', 'Maestria',
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') %>%
mutate(Factor_CVNL == as.numeric(Factor_CVNL))%>%
select(transporte, edad, ingreso.maximo, inseguridad, genero, municipio, tiempo_translado, inseguridad_en_transporte, mala_calidad_aire, estudios, actividad_laboral, Factor_CVNL)
# 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)
df$estudios <- factor(df$estudios)¿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 con todas las variables.
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
## estudiosMaestria -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
## estudiosMaestria 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
## estudiosMaestria -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
## estudiosMaestria 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.
¿Qué observamos en los resultados? En los resultados de la regresión logística, las variables tiempo de traslado, inseguridad en el transporte, mala calidad del aire y estudios de bachillerato tecnológico son las más relevantes para determinar el uso del transporte público. El tiempo de traslado (p < 2e-16) y la inseguridad en el transporte (p < 0.001) son altamente significativos, indicando que mayor tiempo de traslado y percepción de inseguridad en el transporte disminuyen la probabilidad de utilizar transporte público. Asimismo, la mala calidad del aire (p < 0.05) tiene un efecto negativo, mientras que tener estudios de bachillerato tecnológico (p < 0.01) aumenta la probabilidad de usar transporte público. El resto de las variables no resultaron ser significativas en este 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.
¿Qué observamos en los resultados?
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
Se crea un modelo excluyendo la variable 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
## estudiosMaestria -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
## estudiosMaestria 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
## estudiosMaestria -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
## estudiosMaestria 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.
¿Qué observamos en los resultados? El segundo modelo parece ser más conciso y significativo, con un foco más claro en las variables más relevantes como el tiempo de traslado, la inseguridad en el transporte y la mala calidad del aire, eliminando la complejidad innecesaria de las variables de municipio. En ambos modelos, el tiempo de traslado es altamente significativo (p < 2e-16), al igual que la inseguridad en el transporte, la cual tiene una mayor significancia en el segundo modelo (p < 5.73e-06). La mala calidad del aire también es significativa en ambos modelos, con una significancia mayor en el segundo (p = 0.00239).
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.
¿Qué observamos en los resultados? Se observan resultados similares a la regresion anterior, con una ligera mejora en la significancia de los predictores de inseguridad en el transporte y mala calidad de aire.
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.
¿Qué observamos en los resultados?
En estos resultados, a diferencia de los pasados, la inseguridad es la única variable significativa (p = 0.00258), indicando que tiene un impacto importante en la probabilidad de no utilizar transporte público. El ingreso máximo y el intercepto no son significativos, lo que sugiere que no tienen un efecto notable 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.logistica1.4 <- glm(transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire + actividad_laboral, family = "binomial", data = df)
summary(regresion.logistica1.4)##
## 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.logistica1.4, 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¿Qué hicimos en este chunk?
Se ajustó un nuevo modelo de regresión logística (regresion.logistica1.4) 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.
¿Qué observamos en los resultados? En comparación con los resultados anteriores, estos muestran que las variables tiempo de traslado (p < 2e-16), inseguridad en el transporte (p < 0.001) y mala calidad del aire (p < 0.01) siguen siendo altamente significativas. Además, se incluye la variable de género y varias categorías de actividad laboral, aunque ninguna de estas resulta significativa. La bondad de ajuste del modelo ha mejorado, con una reducción en la devianza residual (861.16) y un AIC ligeramente mayor (889.16). La precisión del modelo es de aproximadamente 79.9%.
COMPARACIÓN DE MODELOS CON ANOVA
# Realizar ANOVA con test de Chi-cuadrado para comparar los modelos regresion.logistica1.1, 1.2 y 1.4
anova_resultado <- anova(regresion.logistica1.1, regresion.logistica1.2, regresion.logistica1.4, test = "Chisq")
# Mostrar resultados
anova_resultado## Analysis of Deviance Table
##
## Model 1: transporte ~ genero + inseguridad + ingreso.maximo + municipio +
## edad + tiempo_translado + inseguridad_en_transporte + mala_calidad_aire +
## estudios + actividad_laboral
## Model 2: transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado +
## inseguridad_en_transporte + mala_calidad_aire + estudios +
## actividad_laboral
## Model 3: transporte ~ genero + inseguridad + ingreso.maximo + edad + tiempo_translado +
## inseguridad_en_transporte + mala_calidad_aire + actividad_laboral
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 878 785.51
## 2 903 844.72 -25 -59.213 0.0001341 ***
## 3 915 861.16 -12 -16.445 0.1716996
## ---
## 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.
¿Qué observamos en los resultados?
Los resultados del ANOVA con test de Chi-cuadrado comparan tres modelos de regresión logística. El primer modelo, que incluye todas las variables (incluyendo municipio), tiene la devianza residual más baja (785.51) y sirve como referencia. El segundo modelo, que elimina la variable municipio, muestra una disminución significativa en la devianza residual (p = 0.0001341), indicando que la simplificación del modelo al quitar la variable municipio mejora su ajuste. El tercer modelo, que además elimina la variable estudios, no muestra una mejora significativa (p = 0.1717). Por lo tanto, el segundo modelo (regresion.logistica1.2, sin la variable municipio) es el mejor, ya que mantiene un buen ajuste mientras reduce la complejidad del modelo.
VALIDACION CRUZADA
cv_result <- cv.glm(data = df, glmfit = regresion.logistica1.4, K = 10)
print(cv_result)## $call
## cv.glm(data = df, glmfit = regresion.logistica1.4, K = 10)
##
## $K
## [1] 10
##
## $delta
## [1] 0.1523764 0.1520344
##
## $seed
## [1] 10403 1 1848931894 865677920 -1322979165 -2143321151
## [7] 99602352 1019583182 -100333511 1165168203 611750906 1064754940
## [13] 1526215487 908835861 -1426262228 -1993565182 -2055102755 726093271
## [19] 942196926 -1319200008 -1020034853 854352697 747554440 517411382
## [25] -995538319 -1408364381 -770409998 -720209596 1857876487 1102127069
## [31] -1975891756 -1619724294 1016606533 -398115937 1523700006 758202800
## [37] 191830611 -1376705167 -1056291680 24511550 1607879497 509311483
## [43] 1355488714 -657583316 -1762567377 635576805 1975356572 -1124824846
## [49] 1662124397 1851518631 1009320142 187338280 1592825387 1638906953
## [55] -201040552 1289954310 -1517337119 1460113267 309660642 -1907530924
## [61] 1832119895 -1827310003 -1417737756 1575904202 -805812683 1631792271
## [67] 1044333974 -1065281216 2143720451 -2029279711 2089791760 1484439278
## [73] -2080709991 -1652745429 -1996331494 -2028090148 -481574689 1691266741
## [79] 1266395212 -574622558 1360274429 -1177493257 1331832350 646781144
## [85] 994741307 -263645735 328299368 1980382870 -1406486511 1368349123
## [91] 381887954 40143972 -1648600153 -1834306307 677318900 432637914
## [97] 1414593317 -676918721 221221318 -207337904 -1119741325 1108631185
## [103] -1610266944 860696734 -2060805015 -1619335013 -937678422 633344460
## [109] -1328595825 -1325288251 15422588 -1713354542 -1263327155 1644617991
## [115] 583644398 1313955272 -261758261 1387735849 -1235514504 -155111258
## [121] -649647423 -1411335341 -1266972670 -655989452 315223735 968176301
## [127] -1013054524 77057002 -170412971 -87193105 425415158 1085982496
## [133] -1763485469 -446616191 -469677072 1174909582 1725228537 -959563893
## [139] -36584518 -1075963204 1555821055 -101818539 82802796 652414146
## [145] -966383843 -1685660265 409386238 -586193224 -897697637 -1435093255
## [151] 358094920 -498988170 -547844431 259596003 615304626 1434580484
## [157] -994046649 -1264236515 2101399188 -1607563718 -768391035 -1273184929
## [163] -2095720986 1412811888 1968017299 323119153 154658528 28692350
## [169] -101464567 1597943355 -719368182 -1167101972 -727415697 -621077595
## [175] -2097087652 -1252268238 -1838533075 291372263 -2133488114 108426216
## [181] -808243733 39220873 1601160728 -1387328186 -1168446559 2062698035
## [187] 1068080034 1898532500 -1731408617 -858203379 -649958876 -1329262070
## [193] 368282485 1864994511 -1955462698 1105997184 -1523014205 1662485345
## [199] 928053712 -1123856082 -1914963751 -2097876245 -2118574246 -2116237028
## [205] -71909345 -923554699 -444925684 1970328802 -1817248323 -1831720393
## [211] 1721899230 1217909784 -1845138565 1494874905 -1648973912 -1189714090
## [217] -1970651183 119839619 -1420894702 -156747356 -1952211609 1536516797
## [223] 917381684 1940068762 1078773221 1704591743 1289218310 -951635312
## [229] 1004098355 -148338656 1419108540 385500752 -1243596830 -1467254680
## [235] 18946124 236102908 386029554 -1653465856 2020472180 -1097908216
## [241] 1979749306 1883526608 -31371284 21685652 972054994 -1798309536
## [247] -368673972 1366151456 1841940354 -1967448344 1978206444 1062430780
## [253] -1941086350 467226224 -1468474332 -912781512 1459510426 1729659600
## [259] -1234571076 -915145068 -145371518 -1308974912 1436182332 -353808240
## [265] -356573662 368659464 1914588428 -1179460452 1895445010 -634506368
## [271] -1138424300 1517436456 1431084346 -1260999216 -616097684 -2082839244
## [277] 1893755538 -1019920544 1377546060 -1953105952 2030914466 336501672
## [283] 1909172620 716483772 1797996914 -1893353232 -130770876 -129596072
## [289] -740922822 324104048 1185451068 922964756 1422620098 -2093834528
## [295] -889631876 -166935856 -255394654 -1844830168 1356781836 1983773628
## [301] -895857358 1773330880 -850847180 1367519176 648760506 -395521648
## [307] -1408019988 -118503852 -1703406446 -2123152608 1138958796 -377518624
## [313] -341838142 -584124376 829122220 1200263356 683490802 -815125200
## [319] 847094948 2000915128 -1669711526 -1332852336 802404220 -1789974252
## [325] -905322686 -277713152 -708570180 287794000 607997730 1332852040
## [331] 1191833100 1697089628 -927625006 60595712 1661231444 1012559336
## [337] -996332550 -668771120 -255502036 187487988 109944210 -1369812896
## [343] 179139852 498060000 1748651362 417628840 -1655354804 725734780
## [349] -1476351694 550345840 -867022012 -489324072 762750074 1015612976
## [355] 1549075132 1834324820 -413278142 -335771232 1291187900 1566592464
## [361] -1303622302 53274600 82976716 -99204356 -81033742 161512576
## [367] -1602488076 -483878264 -915363014 -1413114032 1588320876 1149642900
## [373] -1310080686 -44366112 -1345743156 1619982496 -2031831166 -1357953304
## [379] -1020264724 1450197052 1102628466 -59853712 288815652 60483640
## [385] -11702246 -274970928 -1740489668 632470676 -1255823230 749920192
## [391] 637872444 -27441520 652484642 -1076037624 383196300 1914860572
## [397] 1082698386 1806741632 -1442167788 2107373864 -1522271686 1445524688
## [403] -1441262484 994127540 1426204690 1784661984 1506599884 1728110048
## [409] 1306804770 -714298072 -606681844 1942584892 1754394866 -431812880
## [415] 665096004 99597912 -548230598 513388272 -796847940 -2118888940
## [421] 899503298 2039018592 1109220732 1612730576 1900561442 -1253327192
## [427] -683998324 1765617084 -1707566030 882861888 -1951234892 1666434888
## [433] -1647981894 1524997904 1093844204 1780630612 -709128430 -846481504
## [439] 978637772 510317408 2124514498 1772721704 -136997460 716753724
## [445] 175454066 258398000 -1609796060 464913464 727916762 -1755318896
## [451] 47692540 -1285721196 664123202 -1127457280 -1539578308 -1262556592
## [457] -754100653 -259217036 483946242 1848559511 -499152543 -335359578
## [463] 2067784612 -1489797547 -1810784513 -150543464 -1644202826 -414334653
## [469] 1054660741 461537570 159822352 -479258183 -1967220117 919606620
## [475] 854959242 -1065833345 -1901287991 -633127330 943054092 216492253
## [481] 1420748263 324173328 -357395666 -522913829 843917501 1993294378
## [487] -1580405048 1265482737 -163697309 -1918147228 -249231214 1219181927
## [493] 1224918833 -307258250 -1749236332 -664407643 -1063122257 2135792488
## [499] 881551174 -1394532621 -835837867 670153778 -1223157248 -1233036567
## [505] -2137136805 -1800475732 -1890146374 -338685585 357530361 -1824484466
## [511] 1274306140 -770429747 -813755337 823484096 -1160287842 779645547
## [517] 734255597 -1459681190 380073752 -1483555711 -2093659597 1394006100
## [523] -1343349662 929239799 -282714815 -1323111482 2118203652 1997650101
## [529] 89024415 187222008 2123069910 -8519581 -1678150619 955188162
## [535] -947996496 1252562137 -1940278709 -235188036 -24181014 1474115359
## [541] -2005735511 -809758402 1427478572 -1259559299 -176068409 -845249104
## [547] 1167400910 898639099 -1520659619 -15099766 -950589784 1456228881
## [553] -1698047229 263908868 70704690 -1107206521 1369617105 -1275493290
## [559] 1757596724 415510341 1218246031 -94915320 1838663462 1136240595
## [565] -1118271179 170262674 1661567072 -27593271 -1197880069 -711556404
## [571] 90425178 -1260285361 236386073 1636745518 1420632892 1586129069
## [577] 2092493655 756981408 -1880025090 -1402192181 564859085 -1557531654
## [583] 424886328 1808439777 -1672437101 -1413584716 1768208834 1999282647
## [589] 945229345 -1961310746 -2019173148 131589141 1833145407 2137086936
## [595] -1202172426 1538518531 -1468888763 -1550037662 1743531728 1822231033
## [601] -546973397 1262527132 2039417034 1338040767 -845175543 928949790
## [607] 1441201100 -610281059 -1809058777 -869156272 1128072942 439672731
## [613] -351261187 1884983530 1391383432 1508408625 370664867 -341552732
## [619] -1925856174 -2080759897 -311550991 -1122853066 1064418260 -453865115
## [625] 2067942767 -1659863281# 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.logistica1.4). 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.
¿Qué observamos en los resultados? Los resultados de la validación cruzada con 10 pliegues para el modelo de regresión logística muestran que el error de validación cruzada bruto es 0.1514 y el error ajustado es 0.1511. Estos valores indican que el modelo tiene un buen desempeño predictivo con una baja tasa de error. La diferencia mínima entre el error bruto y el ajustado sugiere que el modelo es estable y no está sobreajustado a los datos de entrenamiento.
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.logistica1.4))
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.
¿Qué observamos en los resultados?
Los resultados del bootstrap no paramétrico ordinario muestran las estimaciones originales, los sesgos y los errores estándar para los coeficientes del modelo. La mayoría de los coeficientes tienen sesgos pequeños, lo que indica que las estimaciones originales son razonablemente precisas. Sin embargo, algunos coeficientes, como t9, t10, t11, t12, t13* y t14*, tienen errores estándar relativamente grandes, lo que sugiere una mayor variabilidad
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).
¿Qué observamos en los resultados? Los resultados del modelo LASSO muestran que, tras aplicar la penalización, solo algunas variables resultaron ser significativas en la predicción del uso del transporte público. Las variables que permanecen en el modelo incluyen inseguridad, tiempo de traslado, inseguridad en el transporte, mala calidad del aire, tener un negocio propio, no estudiar, no trabajar ni buscar empleo, y trabajo doméstico no remunerado. Esto indica que estas son las variables más relevantes, mientras que otras como género, ingreso máximo, edad y varias categorías de actividad laboral no contribuyen significativamente al modelo y fueron excluidas.
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.
¿Qué observamos en los resultados?
Los resultados de la regresión logística indican que las variables tiempo de traslado (p < 2e-16), inseguridad en el transporte (p < 0.001) y mala calidad del aire (p < 0.01) son altamente significativas y afectan de manera importante la probabilidad de utilizar transporte público. El tiempo de traslado tiene un efecto positivo, mientras que la inseguridad en el transporte y la mala calidad del aire tienen efectos negativos. Otras variables como género, ingreso máximo, edad y varias categorías de actividad laboral no resultaron significativas, lo que sugiere que no tienen un impacto considerable en la decisión de usar transporte público.
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.
¿Qué observamos en los resultados? Los resultados del modelo spline de regresión logística muestran que las variables tiempo de traslado (p < 2e-16), inseguridad en el transporte (p < 0.001) y mala calidad del aire (p < 0.01) son altamente significativas y afectan significativamente la probabilidad de utilizar transporte público. El tiempo de traslado tiene un efecto positivo, mientras que la inseguridad en el transporte y la mala calidad del aire tienen efectos negativos. Otras variables como género, ingreso máximo, edad y varias categorías de actividad laboral no resultaron significativas, lo que sugiere que no tienen un impacto considerable en la decisión de usar transporte público. El modelo tiene una devianza residual de 861.16 y un AIC de 889.16, indicando un ajuste razonable.
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
ARBOL DE DECISION
# 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.
PODA DE 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= 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.
¿Qué observamos en los resultados? Al pasar del primer arbol elaborado al segundo obtenemos los siguientes resultados:
En el árbol podado, se eliminan algunas variables menos significativas y se concentran las divisiones en las variables más importantes, como el tiempo de traslado, la actividad laboral, la edad y la mala calidad del aire. Esto hace que el modelo sea más interpretable y manejable sin perder demasiada precisión en la predicción de si una persona utiliza transporte público o privado. La poda ayuda a evitar el sobreajuste, asegurando que el modelo generalice mejor a nuevos datos.
RANDOM FOREST
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:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## margin# 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.
¿Qué observamos en los resultados? El modelo Random Forest de clasificación con 500 árboles y 8 variables probadas en cada división muestra un error estimado del 24.62%. La matriz de confusión revela que el modelo predice correctamente 102 casos de “privado” y 388 casos de “público”. Sin embargo, tiene una tasa de error del 49.25% para “privado” y del 13.59% para “público”, indicando que el modelo tiene más dificultades para predecir correctamente los casos de “privado” en comparación con los de “público”.
# 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.
¿Qué observamos en los resultados?
La gráfica de “Predicciones vs Valores Reales” muestra cómo el modelo Random Forest clasifica las observaciones en “privado” y “público”. Se observa que hay una considerable cantidad de casos de “privado” que fueron clasificados incorrectamente como “público” (área clara en el cuadrante “privado”), mientras que la mayoría de los casos de “público” fueron clasificados correctamente (área oscura en el cuadrante “público”). Esto indica que el modelo tiene un buen desempeño en predecir “público” pero tiene dificultades para predecir correctamente “privado”, lo cual es consistente con la tasa de error más alta para “privado” observada en la matriz de confusión.
# 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.
¿Qué observamos en los resultados?
La gráfica de importancia de variables del modelo Random Forest muestra que el “tiempo de traslado” es, con diferencia, la variable más importante tanto en términos de la disminución de la precisión media (Mean Decrease Accuracy) como de la disminución del índice Gini (Mean Decrease Gini), lo que indica su fuerte influencia en la predicción del uso de transporte público. Otras variables importantes incluyen la “actividad laboral”, la “edad” y la “mala calidad del aire”. En contraste, variables como “género” e “inseguridad” tienen un impacto mucho menor en las predicciones del modelo. Esto sugiere que factores relacionados con el tiempo y la situación laboral son más determinantes en la decisión de usar transporte público en comparación con otros factores demográficos y de percepción.
COMPARATIVA Y SELECCION FINAL DEL MODELO
A lo largo de la evaluación de distintos modelos para predecir el uso del transporte público, hemos examinado una variedad de técnicas, incluyendo la regresión logística, el modelo LASSO, árboles de decisión, y Random Forest. El primer modelo de regresión logística mostró que las variables tiempo de traslado, inseguridad en el transporte, y mala calidad del aire eran altamente significativas. Sin embargo, otras variables como género, ingreso máximo, edad, y varias categorías de actividad laboral no resultaron significativas. Este modelo inicial tuvo un AIC de 889.16, indicando un ajuste razonable pero con áreas para mejorar.
El modelo LASSO refinó este enfoque al penalizar y eliminar variables menos importantes, destacando de nuevo el tiempo de traslado, inseguridad en el transporte, y mala calidad del aire, entre otras. Los árboles de decisión simplificaron aún más la interpretación del modelo, revelando claras reglas de decisión basadas en las mismas variables clave. La poda del árbol mejoró la interpretabilidad sin sacrificar demasiado la precisión. El modelo Random Forest, que es más robusto y complejo, mostró una mejora significativa en la predicción con un error OOB del 24.62% y destacó nuevamente la importancia del tiempo de traslado como la variable más influyente, seguido por la actividad laboral y la edad.
En conclusión, aunque todos los modelos ofrecen perspectivas valiosas, recomiendo el modelo Random Forest para su uso final. Este modelo no solo mantiene la precisión predictiva más alta, sino que también identifica claramente las variables más influyentes, lo que es crucial para la toma de decisiones. La combinación de un bajo error de predicción y la robustez en la selección de variables hace que Random Forest sea la opción más sólida para predecir el uso del transporte público.
CONCLUSIONES
La comparación de diversos métodos estadísticos, desde regresiones logísticas y modelos LASSO hasta árboles de decisión y Random Forest, resalta la importancia de utilizar múltiples enfoques para obtener una visión integral y precisa de los factores que influyen en el uso del transporte público. Cada método ofrece sus propias ventajas: la regresión logística proporciona interpretaciones claras de la significancia de las variables, LASSO simplifica el modelo penalizando variables irrelevantes, mientras que los árboles de decisión y Random Forest no solo mejoran la precisión predictiva sino que también facilitan la visualización de decisiones complejas. Para los tomadores de decisiones, estas herramientas son esenciales no solo para entender qué factores impactan más significativamente, sino también para desarrollar políticas efectivas basadas en datos sólidos y interpretables.
Como ultimo comentario, considero que mas que todo estos modelos elaborados nos permitieron observar que si desde un principio es poca la probabilidad de utilizar transporte publico, los largos tiempos de espera y recorridos, mas el sentido de inseguridad que provoca el uso de los mismos y la mala calidad del aire son problematicas que SI pueden ser resueltas por los tomadores de decisiones con politicas publicas adecuadas. Considero que el uso de estos ejercicios son vitales ya que permitiran precisamente a los tomadores de decisiones observar que precisamente son estas las problematicas a resilver y asi mismo se vean incentivados a resolverlas.
RECOMENDACIONES A SOCIO FORMADOR
Debido a la poca experiencia trabajando con bases de datos, se considera que nuestras observaciones acerca de como mejorar la base de datos son pocas, o bien nulas. Sin embargo, recomendamos a la encuestadora que, para futuras recolecciones de datos, considere incluir preguntas que capturen más detalles sobre variables críticas identificadas, como el tiempo de traslado, la percepción de inseguridad en el transporte y la calidad del aire, con la intencion de continuar la investigacion y encontrar hallazgos mas precisos.
De igual manera, se batallo un poco multiples veces el descargar la base de datos, creemos que es posible mejorar el diseño de la platafomra para que esto sea mas sencillo.
##REFERENCIAS CVNL | Inicio. (s. f.). https://comovamosnl.org/