Evidencia 1. Producto de Ciencia de Datos
2024-06-16
Entrega de Jairo Acuña Retana - A00835392#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-0. 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.1524759 0.1521353
##
## $seed
## [1] 10403 1 -855016871 1503756907 947644378 -1180170084
## [7] 1184336543 -1965774603 1888416140 649526370 -281572291 1053998775
## [13] -1873453730 -287095656 657108987 789902745 -572586456 710491862
## [19] 1908202321 -72385021 -1730453102 68435748 -875056665 449257021
## [25] 1563805876 2068455194 -1458088859 -1635476225 -1301213818 326615824
## [31] 580720563 -1862435759 1755389952 92098782 373615401 -1424042277
## [37] -2078423574 311987596 -2071857 -1459691899 298630460 1968439314
## [43] -244044019 956943431 923467310 1148749704 -429485429 2058970217
## [49] 712296504 -748076826 -1257830271 -29364205 810006466 160190580
## [55] -105077129 1414117229 -653465596 -404077782 1869396117 -1441765585
## [61] 1027788342 821156448 -1788827485 2558913 -796932176 -1033735474
## [67] 1952043065 -351861173 1094192122 -81185028 -193078465 -653044715
## [73] 1947848492 -455973886 -2118334755 1646425559 -297779010 -917343496
## [79] -723363621 1240984377 -1990533496 136890934 1587675761 -35145565
## [85] 1324143090 -1889812156 935746055 1458825181 454770900 -850075654
## [91] -1157736635 -164785249 -635471578 906299824 -1548697005 1186540913
## [97] 472677536 -742564802 -812149943 -159669765 795641290 -396047572
## [103] 1046733615 1761565157 -1486060388 -951848718 778979693 1790551719
## [109] -888764210 1042728488 661311019 -588626871 -1100712616 2043046918
## [115] -492270111 887895923 -486960158 626391892 171660887 -811356595
## [121] -27131420 1650613194 -1286889931 -1146231665 -1246573162 1999712576
## [127] -1515140093 1031515681 -51930864 86906606 15788697 1523909419
## [133] 233106970 452461788 1134467295 -863078731 -1568624564 1177840802
## [139] 1351195645 -1035081481 1015197214 775217368 -681950149 148860377
## [145] -1975051416 1763743382 1033818129 1548579267 -1362706990 -291015580
## [151] 1164551079 1659211005 -1017222924 597704666 -1717857499 -1879735745
## [157] -815896122 1319108176 -23776653 -401684847 -338084160 -1417033570
## [163] 405496937 -1185230693 -1819323990 1767041484 1139606671 -311649083
## [169] 1622690940 -278757166 -695771059 2087729415 943533294 1949500872
## [175] -1740805429 -478538967 -1826245768 -1511544666 -1654361407 1778516819
## [181] -1117057022 -1586791116 -460507465 -671036755 -674427964 1171788778
## [187] -426959787 -1816591889 1940179446 347082528 932282595 369030529
## [193] -19573776 51059342 1155608057 -1480831093 845925306 -1890241860
## [199] 1082960383 877131605 -1128624020 1277019330 208318237 -1907104361
## [205] -1898507010 -1545732424 571957403 -75624711 -1651244984 -1623141514
## [211] 1439876785 -199555357 439121330 -1345495548 -959589049 1621413917
## [217] 442447508 -1543602630 -1162932091 -9120417 357531110 991171696
## [223] -1825945709 34574385 879484640 -1184327810 331058697 1065739835
## [229] 459356170 1760664764 246482738 -1255531968 -669196108 -1974416824
## [235] -60256838 -295984624 315234028 1010840916 440218898 1087560096
## [241] -812599604 -1587982752 624032706 185969448 2106391468 -1643888836
## [247] -1348723342 1836551984 1929229604 1306166072 2076491482 -1144525936
## [253] 846060284 1876149140 -450650046 348619008 1672977468 -1785146032
## [259] -1858899806 -1003346616 1325255436 -688641316 -1937600174 1917143168
## [265] 646032468 1180222440 -2028053254 -1222377648 1402468140 499498356
## [271] 933265298 -1579574176 1798440332 1445360480 1988384226 -1452031064
## [277] -184366900 1849660412 -531414606 -83923472 1831698372 345704792
## [283] 436600186 1559570352 -676545092 -1271303084 -1973938238 -1662973920
## [289] 2112749756 1997764176 347928546 565106792 -245467060 -1286707972
## [295] -1658771470 -1245127424 -401209996 1068974088 -726457414 -363608624
## [301] -892059668 1359267220 219578834 1184389472 -1392534708 658284832
## [307] 1904478082 1422360296 1172269292 -490289092 -1991397518 -253768080
## [313] -313824220 -481927368 1801809050 -1007365424 -1461497668 914140820
## [319] -122868094 1624842432 1640441660 1808797840 420982306 -73815032
## [325] -1346466548 125775004 -1237208558 -2096499840 -889727468 -1561760216
## [331] 750214458 615386576 -181147540 -624474828 388295314 1913098080
## [337] 598536012 -347912224 -931169374 1757600680 2111863180 1820425404
## [343] 1134272882 1754466544 150075460 -1329748648 -1181889990 1172164464
## [349] 2126982204 634233620 -68041278 880733920 1403153276 1667773136
## [355] 1722420386 1800265768 61733132 -1018180676 1404116274 -333446720
## [361] 1635310132 -1963298872 -1565696838 517108112 874070508 -280422828
## [367] -190622574 -56040672 201302476 427283936 78792386 989415464
## [373] 2105702060 -2002984772 1361862130 1710353712 -715111260 -254092616
## [379] 1203394906 2070432144 1033668476 1144350996 -99410110 1803464448
## [385] 870359996 1932702544 -807428318 1865704776 -488526324 -45983652
## [391] -496332590 867683840 69636436 -770048536 -1508803590 -964715312
## [397] -1375004372 401598196 574979474 -930226080 929969420 485219040
## [403] -759317150 623272616 -2063750580 310965628 150001970 1335061616
## [409] -678606012 537444824 -965340038 1134421552 208749244 411620180
## [415] -426430398 -298128992 918697660 -224903728 1569152354 943663080
## [421] 1381380044 -982490372 -493472270 -287945600 -1299392268 -1691723128
## [427] 1994640186 347547472 1179425388 -1765295980 -231800494 1002018528
## [433] -1829370164 -279443296 -2029074558 1855661800 -1099452692 -458223556
## [439] -1633442190 -172739472 -794801628 2008799288 974868506 -407410992
## [445] -135709636 614960276 -179566462 -51564608 843315516 367203984
## [451] 1788411938 -661243896 -127480692 -441461732 593177234 -1189154688
## [457] 1089253188 -1723366795 -355978273 750991160 -952061674 582266147
## [463] -829800731 -2113239294 476294512 -1603588839 1256629515 94340604
## [469] -2080498134 -1285536161 371971561 -1296562434 -171706644 1217955389
## [475] 1425159687 -1203693072 90704270 -1334419525 -52475491 -1167849654
## [481] 1909439336 2076622161 204705347 -708398268 -994111502 362646983
## [487] -102034543 -1838707946 -882999436 1759657477 667346511 -424975800
## [493] 428487654 1010703635 -1759735179 -1293615022 720745120 -1665745015
## [499] -1090036805 -497181684 523438490 -1210005233 -1872513191 1359256046
## [505] 643679356 904552685 -1159010409 -947142560 473702974 -713383157
## [511] 522344845 227680954 -158160648 1775294113 -859885997 -315813516
## [517] 1732691714 -767135849 1745576289 896887206 -1230820444 1598133845
## [523] -837019905 853343128 1366555830 543512899 -1082027899 1858349346
## [529] 37329424 -1315110471 581169771 58043740 689003658 -2032962433
## [535] 377355721 -135039394 -177310452 279965917 -1452982809 954820112
## [541] -1469613266 -1910972453 -1653235523 51300906 2022618824 986952689
## [547] 1266283875 -930558620 143913106 -811375257 -1672872143 2146677878
## [553] 959253908 1529928101 -769101137 1064153960 -1627877562 -779225357
## [559] 104355925 1174692914 -571424256 -291196183 403745115 -1122909268
## [565] -354443334 1217927535 1812624121 -1972274290 1049069148 -542681907
## [571] 1062403127 -981510464 -1376661090 1818815083 2130686445 -1100627878
## [577] 1964412696 775132289 435614259 -1226698668 1744196706 -1687946505
## [583] 782820673 -978197562 -653590268 -660602699 -1785344097 -134184968
## [589] -719572522 1744504931 1933909029 -1919157310 -213675856 1770028249
## [595] -627713461 -1498711876 1350164202 -597512417 1967108009 -956094146
## [601] -1384779732 -1976729987 1418158279 1668599216 -762329138 -1330676485
## [607] 2024729437 -1682575222 1214676648 1298211345 1436635907 -540809724
## [613] 908326450 1651222151 2019273425 977542230 -562883532 1084315461
## [619] 1282047375 -954716920 -1703424218 884535251 -442629835 966178962
## [625] 1196275808 -1647742879# 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/