| title: “AsiVamos” |
| author: “Manuel Enriquez” |
| date: “2024-04-19” |
| output: html_document |
library(readxl)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(sandwich)
library (boot)
##
## Attaching package: 'boot'
## The following object is masked from 'package:car':
##
## logit
library (leaps)
library(glmnet)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
## Loaded glmnet 4.1-8
library(pls)
##
## Attaching package: 'pls'
## The following object is masked from 'package:stats':
##
## loadings
library(ISLR)
library(tree)
library(splines)
library(tibble)
library(gam)
## Loading required package: foreach
## Loaded gam 1.22-3
library(DiagrammeR)
library(rpart)
library(rpart.plot)
library(rattle)
## Loading required package: bitops
##
## Attaching package: 'bitops'
## The following object is masked from 'package:Matrix':
##
## %&%
## Rattle: A free graphical interface for data science with R.
## Version 5.5.1 Copyright (c) 2006-2021 Togaware Pty Ltd.
## Type 'rattle()' to shake, rattle, and roll your data.
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:rattle':
##
## importance
## The following object is masked from 'package:dplyr':
##
## combine
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
La salud mental en Nuevo León es un problema severo de acuerdo al gobierno del estado, el cual, en base a datos de la Encuesta Nacional de Salud y Nutrición ENSANUT 2023, llamó a la población que considera que puede tener algún problema de salud mental a atenderse en las clínicas estatales. Los datos publicados en la ENSANUT resultaron alarmantes para el gobierno del estado ya que demostraron que el 17.7% de los adultos en Nuevo León tienen síntomas de depresión. A pesar de esto, solo el 2.3% de las consultas médicas a adultos en el estado que fueron registradas estaban relacionados al padecimiento o síntomas de algún problema de salud mental. Estos datos subrayan la necesidad urgente de que los ciudadanos presten mayor atención a su salud mental y utilicen los servicios médicos disponibles para abordar estos problemas. (Gobierno del Estado de Nuevo León, 2023)
Como parte del plan del Gobierno del Estado de Nuevo León para atender la salud mental en el estado, se invirtieron 55 millones de pesos para crear el nuevo Hospital de Especialidades en Salud Mental el cual planea reemplazar Hospital psiquiátrico, el cual según el mismo gobierno no había recibido muchas modificaciones desde que se abrió al público hace 64 años. Alma Rosa Marroquín, secretaria de salud de Nuevo León dio a conocer en la apertura del hospital que este cuenta con 124 camas de hospitalización y se estima que al año pueda haber alrededor de 30 mil consultas. De igual manera, se planea que el antiguo hospital psiquiátrico siga en funcionamiento como centro para la salud mental con especialidades distintas y que de esta manera aumente la cantidad de personas que pueden atenderse en el estado y las condiciones que el gobierno ofrece para ello. (Santamaría, 2023)
Como equipo se decidió que este tema era de vital importancia debido a que a pesar de que en años pasados a raíz de la pandemia se ha hecho más mención al tema de la salud mental y lo importante que es atenderla, no muchas personas considerarían al momento de pensar en los problemas con los que contamos en el estado (Hernández et al, 2017). Esto puede verse reflejado en la misma encuesta de Cómo Vamos Nuevo León, en donde vemos que a pesar de que se pregunta si las personas han sufrido anteriormente un problema de salud mental antes, no se incluyen más preguntas o especificaciones acerca de cuál enfermedad tuvo, si la persona tomó alguna medicación para mejorar, si alguna vez consultó con un profesional de la salud ya sea en una clínica o privada o pública, si la persona sigue actualmente lidiando con ese problema, si hubo algún detonador que haya contribuido a que se presentará su problema mental, entre otras cosas que se podrían preguntar para saber más información acerca de la salud mental de las personas de Nuevo León.
Tomando esto en cuenta, la problemática específica a investigar a profundidad en este proyecto son específicamente la depresión, ansiedad e insomnio, que son los problemas mentales que considera la encuesta de Cómo Vamos Nuevo León cuando se le pregunta a la gente si ha sufrido algún problema mental antes.
Tomando en cuenta la creciente tendencia de estudios buscando los determinantes sociales de las enfermedades de salud mental, y la disponibilidad de datos se generó la siguiente pregunta de investigación: ¿Cuáles son los determinantes de las enfermedades de salud mental para las personas en Nuevo León?
Paso 1: Lee el archivo
bd_comovamos.xlsx y guarda los datos en
eav_23. Selecciona las columnas específicas del dataframe
eav_23 y guárdalas en df_eav23. Se escogieron
las preguntas generales, en las que no existen muchos NAs en los datos,
que ocurren por ser subpreguntas sujetas a la condición de respuesta de
una anterior.
Paso 2: Utiliza la función rename del paquete
dplyr para cambiar los nombres de las columnas en
df_eav23 según una correspondencia predefinida entre las
columnas originales y los nuevos nombres. Impresión de una tabla para
observar la sustitución de variables, se puede utilizar para comparar
nuestras variables con el diccionario de Cómo Vamos NL.
Paso 3: Cambia las observaciones de la columna
actividad_laboral según una regla definida: si la
observación está en el conjunto [1 (Empleado), 2 (Buscando
Empleo), 4 (Negocio Propio/Independiente), 5 (Trabajo
Doméstico No Remunerado), 6 (Trabajo Doméstico
Remunerado)], se cambia a “Económicamente Activa”; de lo contrario,
si está en [3 (Estudiante), 7 (Jubilado/Pensionado), 8
(Ni estudia, ni trabaja), 9 (Otro)], se cambia a
“Económicamente Inactiva”.
Paso 4: Cambia las observaciones de la columna
motivo_traslado según otra regla definida: si la
observación está en el conjunto [1 (Trabajo), 2
(Escuela), 3 (Compras), 4 (Médico/Hospital),
7 (Banco o Pago de Servicios), 10 (Buscar trabajo), 12
(Trámites), 13 (Funeral)], se cambia a “Rutinarias”;
de lo contrario, si está en [5 (Diversión), 6 (Acompañar o Llevar a
Alguien), 8 (Visita), 9 (Sin Viaje), 11 (Iglesia)], se cambia a
“Ocio”.
Paso 5: Cambia las observaciones de la columna
tema_agua de acuerdo con una nueva regla: los valores 1
(Sí, disminución de la presión del agua), 2 (Sí, cortes de
agua), 3 (Sí, cortes de agua y disminución de la presión del
agua), y 4 (No ha tenido ningún problema) se reemplazan
por 2, 3, 4, y 1 respectivamente; siendo que quedan en el ordén (1)
Ningún Problema, (2) Disminución de la Presión, (3) Cortes de Agua y (4)
Cortes de Agua y Disminución.
Paso 6: Utiliza mutate y
case_when para cambiar las observaciones de la columna
frecuencia_parques invirtiendo los valores donde 8 equivale
a visitar los parques todos los días y 1 no visitarlos.
Paso 7: Utiliza mutate_at y
case_when para invertir los valores de las observaciones de
varias columnas (siteconomica_pasado,
siteconomica_presente, siteconomica_futuro y
seguro_municipio) simultáneamente para que los valores 4
siempre indiquen un mejor valor y 1 siempre un peor valor.
Paso 8: Modifica las observaciones de
df_eav23 para que aquellas donde
problema_salud tiene valores 0 o 2 se conviertan en 0, y se
mantenga el 1 de ser el caso. Es decir, solo considere enfermedades
crónicas (diabetes, hipertensión, cáncer, etc.) y considerar las agudas
(COVID-19, resfriados, etc.) como que no se tiene un problema de
salud.
Paso 9: Utiliza mutate_at y
case_when para cambiar las observaciones de varias columnas
relacionadas con problemas de salud (ansiedad, depresión, insomnio) para
que sea solamente Sí o No, considerando cualquier signo de manifestación
del malestar.
Paso 10: Utiliza mutate_at y
case_when para cambiar las observaciones de las siguientes
columnas: internet, transporte_publico,
abandonadas, viaje_bicicleta,
aire_acondicionado, calefacción,
obesidad, problema_salud,
victima_delita, al_menos_un_problema_mental
relacionadas con respuestas Sí/No para que sea esto lo que aparezca en
la base de datos y no 1 y 0.
Paso 11: Utiliza mutate_at para cambiar
las observaciones de varias columnas (actividad_laboral,
motivo_traslado, vehiculos_motor,
tema_agua, calidad_aire,
ing_mensual,problema_salud) donde se
encuentran ciertos valores específicos (9999, 8888) por NA, pues el
No Contesto o el No Sabe.
Paso 12: Utiliza complete.cases para
mantener solo las filas completas (sin valores NA) en el dataframe
df_eav23.
Paso 13: Convierte algunas columnas seleccionadas
(municipio, sexo, internet,
motivo_traslado, transporte_publico,
viaje_bicicleta, obesidad,
problema_salud, ansiedad,
depresion, insomnio,
al_menos_un_problema_mental, victima_delita)
en factores y/o numéricas pues son variables categóricas
no-ordinarias.
Paso 14: Convierte las columnas seleccionadas
(quehaceres_hogar, cuidado_personas,
total_min_trabajo_rem_y_norem,
vehiculos_motor, tema_agua,
frecuencia_parques, calidad_aire,
siteconomica_pasado, siteconomica_futuro,
siteconomica_presente, num_discriminaciones,
ing_mensual, seguro_municipio) a tipo
numérico, pues estas son variables numéricas o categóricas
ordinales.
# Paso 1
eav_23 <- read_excel("~/Desktop/DataScience/bases de datos/bd_comovamos.xlsx")
## Warning: Expecting logical in DY1685 / R1685C129: got '9'
## Warning: Expecting logical in DY2424 / R2424C129: got '6'
## Warning: Expecting logical in DY4287 / R4287C129: got '9'
## Warning: Expecting logical in DY4737 / R4737C129: got '9'
df_eav23 <- eav_23[, c("NOM_MUN_MV","Sex_Persona_Entrevistada_MV","P2","P3","quehaceres_hogar","cuidado_personas","total_min_trabajo_rem_y_norem","P10","P26","P34","P36","P41","P49","P51","P53","P59","P60","P63","P64","P65","num_discriminaciones","P74","P75","P91_1","P91_2","P91_3","al_menos_un_problema_mental","P93","P95","P144","Factor_CVNL")]
# Paso 2
df_eav23 <- df_eav23 %>%
rename(
municipio = NOM_MUN_MV,
sexo = Sex_Persona_Entrevistada_MV,
internet = P2,
actividad_laboral = P3,
quehaceres_hogar = quehaceres_hogar,
cuidado_personas = cuidado_personas,
total_min_trabajo_rem_y_norem = total_min_trabajo_rem_y_norem,
motivo_traslado = P10,
transporte_publico = P26,
viaje_bicicleta = P34,
vehiculos_motor = P36,
abandonadas = P41,
tema_agua = P49,
frecuencia_parques = P51,
calidad_aire = P53,
aire_acondicionado = P59,
calefaccion = P60,
siteconomica_pasado = P63,
siteconomica_futuro = P64,
siteconomica_presente = P65,
num_discriminaciones = num_discriminaciones,
obesidad = P74,
problema_salud = P75,
depresion = P91_1,
ansiedad = P91_2,
insomnio = P91_3,
al_menos_un_problema_mental = al_menos_un_problema_mental,
seguro_municipio = P93,
victima_delita = P95,
ing_mensual = P144,
factor = Factor_CVNL
)
tibble(
`Variable Original` = c(
"NOM_MUN_MV","Sex_Persona_Entrevistada_MV","P2","P3","quehaceres_hogar","cuidado_personas","total_min_trabajo_rem_y_norem","P10","P26","P34","P36","P41","P49","P51","P53","P59","P60","P63","P64","P65","num_discriminaciones", "P74","P75","P91_1","P91_2","P91_3","al_menos_un_problema_mental","P93","P95","P144"
),
`Nuevo Nombre` = c(
"municipio","sexo","internet","actividad_laboral","quehaceres_hogar","cuidado_personas","total_min_trabajo_rem_y_norem","motivo_traslado","transporte_publico","viaje_bicicleta","vehiculos_motor","abandonadas","tema_agua","frecuencia_parques","calidad_aire","aire_acondicionado","calefaccion","siteconomica_pasado", "siteconomica_futuro","siteconomica_presente", "num_discriminaciones", "obesidad","problema_salud","depresion","ansiedad","insomnio","al_menos_un_problema_mental","seguro_municipio","victima_delita","ing_mensual"
),
`Pregunta en CVNL` = c("¿En qué municipio vives?","Sexo de la Persona Entrevistada","Hogar tiene Conexión a Internet","Principal actividad laboral","Tiempo total en minutos en quehaceres del hogar","Tiempo total en minutos que destina al cuidado no remunerado de personas","Total de minutos que destina al trabajo remunerado y no remunerado","Principal motivo para trasladarse fuera de su casa","¿Utiliza el transporte público como medio de transporte?","¿Utiliza la bicicleta como medio de transporte?", "¿Cuántos vehículos de motor hay en el hogar?","¿Considera que en su colonia existe un problema de viviendas abandonadas?","¿Ha tenido algún problema relacionado con el tema del agua?","¿Con qué frecuencia visita los parques de su municipio?","¿Cómo es la calidad de aire en su municipio?","¿En su casa tiene aires acondicionados y abanicos?","¿En su casa tiene medios suficientes como calentadores o calefacción?","¿Cómo describiría usted la situación económica de se hogar comparada con la de hace 12 meses?","¿Cómo será la situación económica de se hogar dentro de 12 meses?","¿Cómo vive con el ingreso actual en su hogar?","Número de razones por las que cree que en Nuevo León se discrimina a la gente","¿Considera que tiene sobrepeso u obesidad?","¿Tuvo algún problema de salud?","Se ha sentido decaído/a, deprimido/a","¿Se ha sentido nervioso/a, ansioso/a o muy alterado/a?","¿Ha tardado más de 30 minutos en poder dormir, o se despierta durante la noche o madrugada?","Ha sufrido al menos un problema de salud mental","¿Qué tan seguro se siente en su municipio?","¿Ha sido víctima de algún delito?","¿Cuál es el ingreso mensual total del hogar?")
)
## # A tibble: 30 × 3
## `Variable Original` `Nuevo Nombre` `Pregunta en CVNL`
## <chr> <chr> <chr>
## 1 NOM_MUN_MV municipio ¿En qué municipio…
## 2 Sex_Persona_Entrevistada_MV sexo Sexo de la Person…
## 3 P2 internet Hogar tiene Conex…
## 4 P3 actividad_laboral Principal activid…
## 5 quehaceres_hogar quehaceres_hogar Tiempo total en m…
## 6 cuidado_personas cuidado_personas Tiempo total en m…
## 7 total_min_trabajo_rem_y_norem total_min_trabajo_rem_y_nor… Total de minutos …
## 8 P10 motivo_traslado Principal motivo …
## 9 P26 transporte_publico ¿Utiliza el trans…
## 10 P34 viaje_bicicleta ¿Utiliza la bicic…
## # ℹ 20 more rows
# Paso 3
df_eav23$actividad_laboral <- ifelse(df_eav23$actividad_laboral %in% c(1, 2, 4, 5, 6), "Económicamente Activa",ifelse(df_eav23$actividad_laboral %in% c(3, 7, 8, 9), "Económicamente Inactiva",df_eav23$actividad_laboral))
# Paso 4
df_eav23$motivo_traslado <- ifelse(df_eav23$motivo_traslado %in% c(1, 2, 3, 4, 7, 10, 12, 13), "Rutinarias",ifelse(df_eav23$motivo_traslado %in% c(5, 6, 8, 9, 11), "Ocio",df_eav23$motivo_traslado))
# Paso 5
df_eav23$tema_agua <- ifelse(df_eav23$tema_agua == 1, 2,ifelse(df_eav23$tema_agua == 2, 3,ifelse(df_eav23$tema_agua == 3, 4,ifelse(df_eav23$tema_agua == 4, 1,df_eav23$tema_agua))))
# Paso 6
df_eav23 <- df_eav23 %>%
mutate(
frecuencia_parques = case_when(
frecuencia_parques == 1 ~ 8,
frecuencia_parques == 2 ~ 7,
frecuencia_parques == 3 ~ 6,
frecuencia_parques == 4 ~ 5,
frecuencia_parques == 5 ~ 4,
frecuencia_parques == 6 ~ 3,
frecuencia_parques == 7 ~ 2,
frecuencia_parques == 8 ~ 1,
)
)
# Paso 7
df_eav23 <- df_eav23 %>%
mutate_at(vars(siteconomica_pasado,siteconomica_presente,siteconomica_futuro,seguro_municipio),
funs(case_when(
. == 1 ~ 4,
. == 2 ~ 3,
. == 3 ~ 2,
. == 4 ~ 1,
)))
## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Paso 8
df_eav23 <- df_eav23 %>%
mutate(
problema_salud = case_when(
problema_salud == 0 ~ 0,
problema_salud == 1 ~ 1,
problema_salud == 2 ~ 0,
)
)
df_eav23 <- df_eav23 %>%
filter(problema_salud %in% c(0, 1))
# Paso 9
df_eav23 <- df_eav23 %>%
mutate_at(vars(ansiedad, depresion, insomnio),
funs(case_when(
. %in% c(1, 2, 3) ~ "Sí",
. == 4 ~ "No",)))
## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Paso 10
df_eav23 <- df_eav23 %>%
mutate_at(vars(internet, transporte_publico, abandonadas,viaje_bicicleta,aire_acondicionado,calefaccion,obesidad,problema_salud,victima_delita,al_menos_un_problema_mental),
funs(case_when(
. == 1 ~ "Sí",
. == 0 ~ "No",)))
## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Paso 11
df_eav23 <- df_eav23 %>%
mutate_at(vars(actividad_laboral, motivo_traslado,
vehiculos_motor, tema_agua, calidad_aire, ing_mensual,problema_salud),
funs(ifelse(. %in% c(9999, 8888), NA, .)))
## Warning: `funs()` was deprecated in dplyr 0.8.0.
## ℹ Please use a list of either functions or lambdas:
##
## # Simple named list: list(mean = mean, median = median)
##
## # Auto named with `tibble::lst()`: tibble::lst(mean, median)
##
## # Using lambdas list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Paso 12
df_eav23 <- df_eav23[complete.cases(df_eav23), ]
# Paso 13
df_eav23$municipio <- as.factor(df_eav23$municipio)
df_eav23$sexo <- as.factor(df_eav23$sexo)
df_eav23$internet <- as.factor(df_eav23$internet)
df_eav23$motivo_traslado <- as.factor(df_eav23$motivo_traslado)
df_eav23$transporte_publico <- as.factor(df_eav23$transporte_publico)
df_eav23$viaje_bicicleta <- as.factor(df_eav23$viaje_bicicleta)
df_eav23$obesidad <- as.factor(df_eav23$problema_salud)
df_eav23$problema_salud <- as.factor(df_eav23$problema_salud)
df_eav23$ansiedad <- as.factor(df_eav23$ansiedad)
df_eav23$depresion <- as.factor(df_eav23$depresion)
df_eav23$insomnio <- as.factor(df_eav23$insomnio)
df_eav23$al_menos_un_problema_mental <- as.factor(df_eav23$al_menos_un_problema_mental)
df_eav23$victima_delita <- as.factor(df_eav23$victima_delita)
# Paso 14
df_eav23$quehaceres_hogar <- as.numeric(df_eav23$quehaceres_hogar)
df_eav23$cuidado_personas <- as.numeric(df_eav23$cuidado_personas)
df_eav23$total_min_trabajo_rem_y_norem <- as.numeric(df_eav23$total_min_trabajo_rem_y_norem)
df_eav23$vehiculos_motor <- as.numeric(df_eav23$vehiculos_motor)
df_eav23$tema_agua <- as.numeric(df_eav23$tema_agua)
df_eav23$frecuencia_parques <- as.numeric(df_eav23$frecuencia_parques)
df_eav23$calidad_aire <- as.numeric(df_eav23$calidad_aire)
df_eav23$siteconomica_pasado <- as.numeric(df_eav23$siteconomica_pasado)
df_eav23$siteconomica_futuro <- as.numeric(df_eav23$siteconomica_futuro)
df_eav23$siteconomica_presente <- as.numeric(df_eav23$siteconomica_presente)
df_eav23$num_discriminaciones <- as.numeric(df_eav23$num_discriminaciones)
df_eav23$ing_mensual <- as.numeric(df_eav23$ing_mensual)
df_eav23$seguro_municipio <- as.numeric(df_eav23$seguro_municipio)
La regresión logística es un método de análisis estadístico utilizado para predecir la probabilidad de ocurrencia de un evento binario (es decir, un evento con dos posibles resultados, como éxito/fallo, sí/no, presente/ausente) a partir de uno o más predictores, que pueden ser continuos o categóricos. A diferencia de la regresión lineal, que estima el valor esperado de la variable dependiente, la regresión logística estima la probabilidad de que la variable dependiente tome uno de dos posibles valores.
La fórmula básica para la regresión logística es:
\[ p=\frac{e^{\beta_0+\beta_1X_1+...+\beta_nX_n}}{1-e^{\beta_0+\beta_1X_1+...+\beta_nX_n}} \]
En la siguiente, se incluyen todas las variables de la base de datos, excepto el factor de expansión (dada su naturaleza), el municipio (pues son muchos para hacer un análisis conciso), la depresión, ansiedad e insomnio dada su natural autocorrelación con la variable respuesto. El modelo se describe en la siguiente.
model1 <- glm(al_menos_un_problema_mental~.-depresion-ansiedad-insomnio-factor-municipio-obesidad,data=df_eav23,family=binomial)
summary(model1)
##
## Call:
## glm(formula = al_menos_un_problema_mental ~ . - depresion - ansiedad -
## insomnio - factor - municipio - obesidad, family = binomial,
## data = df_eav23)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.2666762 0.3493211 -3.626 0.000288
## sexoMujer 0.2165757 0.0994343 2.178 0.029400
## internetSí 0.0129685 0.1079671 0.120 0.904392
## actividad_laboralEconómicamente Inactiva 0.3205450 0.1109583 2.889 0.003866
## quehaceres_hogar -0.0002307 0.0003939 -0.586 0.558122
## cuidado_personas 0.0005437 0.0003039 1.789 0.073657
## total_min_trabajo_rem_y_norem -0.0004816 0.0002410 -1.999 0.045650
## motivo_trasladoRutinarias -0.0534437 0.1012905 -0.528 0.597758
## transporte_publicoSí 0.0578917 0.0876115 0.661 0.508755
## viaje_bicicletaSí 0.6299586 0.1259675 5.001 5.70e-07
## vehiculos_motor -0.1329418 0.0582902 -2.281 0.022567
## abandonadasSí -0.3022548 0.0815709 -3.705 0.000211
## tema_agua 0.3000668 0.0374685 8.009 1.16e-15
## frecuencia_parques 0.0976038 0.0194305 5.023 5.08e-07
## calidad_aire 0.0722727 0.0428511 1.687 0.091680
## aire_acondicionadoSí -0.4472111 0.1116867 -4.004 6.22e-05
## calefaccionSí -0.1256496 0.1046473 -1.201 0.229869
## siteconomica_pasado -0.0985719 0.0662883 -1.487 0.137010
## siteconomica_futuro 0.1606485 0.0612241 2.624 0.008692
## siteconomica_presente -0.2493279 0.0769309 -3.241 0.001191
## num_discriminaciones 0.0146189 0.0074003 1.975 0.048217
## problema_saludSí 1.1667908 0.1388088 8.406 < 2e-16
## seguro_municipio -0.1140954 0.0582278 -1.959 0.050058
## victima_delitaSí 0.8214876 0.1416166 5.801 6.60e-09
## ing_mensual 0.0271153 0.0420214 0.645 0.518749
##
## (Intercept) ***
## sexoMujer *
## internetSí
## actividad_laboralEconómicamente Inactiva **
## quehaceres_hogar
## cuidado_personas .
## total_min_trabajo_rem_y_norem *
## motivo_trasladoRutinarias
## transporte_publicoSí
## viaje_bicicletaSí ***
## vehiculos_motor *
## abandonadasSí ***
## tema_agua ***
## frecuencia_parques ***
## calidad_aire .
## aire_acondicionadoSí ***
## calefaccionSí
## siteconomica_pasado
## siteconomica_futuro **
## siteconomica_presente **
## num_discriminaciones *
## problema_saludSí ***
## seguro_municipio .
## victima_delitaSí ***
## ing_mensual
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4430.6 on 3699 degrees of freedom
## Residual deviance: 3978.1 on 3675 degrees of freedom
## AIC: 4028.1
##
## Number of Fisher Scoring iterations: 4
Posteriormente, se seleccionaron solo las variables que son
significativas, pues esto le da un poder de interpretación y predicción
a nuestro modelo. Las variables restantes son sexo,
actividad_laboral,
total_min_trabajo_rem_y_norem,
viaje_bicicleta, vehiculos_motor,
abandonadas, tema_agua,
frecuencia_parques, aire_acondicionado,
siteconomica_presente, siteconomica_futuro,
num_discriminaciones, problema_salud y
victima_delita.
model2 <- glm(al_menos_un_problema_mental~sexo+actividad_laboral+total_min_trabajo_rem_y_norem+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+siteconomica_futuro+num_discriminaciones+problema_salud+victima_delita,data=df_eav23,family=binomial)
summary(model2)
##
## Call:
## glm(formula = al_menos_un_problema_mental ~ sexo + actividad_laboral +
## total_min_trabajo_rem_y_norem + viaje_bicicleta + vehiculos_motor +
## abandonadas + tema_agua + frecuencia_parques + aire_acondicionado +
## siteconomica_presente + siteconomica_futuro + num_discriminaciones +
## problema_salud + victima_delita, family = binomial, data = df_eav23)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.4071239 0.2917417 -4.823 1.41e-06
## sexoMujer 0.2704394 0.0795966 3.398 0.000680
## actividad_laboralEconómicamente Inactiva 0.4072136 0.1001242 4.067 4.76e-05
## total_min_trabajo_rem_y_norem -0.0002089 0.0001392 -1.501 0.133468
## viaje_bicicletaSí 0.6504984 0.1241349 5.240 1.60e-07
## vehiculos_motor -0.1363449 0.0538712 -2.531 0.011376
## abandonadasSí -0.3003725 0.0804512 -3.734 0.000189
## tema_agua 0.3027789 0.0366251 8.267 < 2e-16
## frecuencia_parques 0.0988163 0.0188997 5.228 1.71e-07
## aire_acondicionadoSí -0.5340543 0.0891317 -5.992 2.08e-09
## siteconomica_presente -0.3204533 0.0698090 -4.590 4.42e-06
## siteconomica_futuro 0.1304828 0.0577170 2.261 0.023776
## num_discriminaciones 0.0142718 0.0072914 1.957 0.050308
## problema_saludSí 1.1478102 0.1373484 8.357 < 2e-16
## victima_delitaSí 0.8355282 0.1408487 5.932 2.99e-09
##
## (Intercept) ***
## sexoMujer ***
## actividad_laboralEconómicamente Inactiva ***
## total_min_trabajo_rem_y_norem
## viaje_bicicletaSí ***
## vehiculos_motor *
## abandonadasSí ***
## tema_agua ***
## frecuencia_parques ***
## aire_acondicionadoSí ***
## siteconomica_presente ***
## siteconomica_futuro *
## num_discriminaciones .
## problema_saludSí ***
## victima_delitaSí ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4430.6 on 3699 degrees of freedom
## Residual deviance: 3993.9 on 3685 degrees of freedom
## AIC: 4023.9
##
## Number of Fisher Scoring iterations: 4
Se repitió ese proceso para solamente considerar las variables
significativas. Resultando en el modelo que considera las variables
sexo, actividad_laboral,
viaje_bicicleta, vehiculos_motor,
abandonadas, tema_agua,
frecuencia_parques, aire_acondicionado,
siteconomica_presente, siteconomica_futuro,
problema_salud, victima_delita.
model3 <- glm(al_menos_un_problema_mental~sexo+actividad_laboral+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data=df_eav23,family=binomial)
summary(model3)
##
## Call:
## glm(formula = al_menos_un_problema_mental ~ sexo + actividad_laboral +
## viaje_bicicleta + vehiculos_motor + abandonadas + tema_agua +
## frecuencia_parques + aire_acondicionado + siteconomica_presente +
## problema_salud + victima_delita, family = binomial, data = df_eav23)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.10538 0.24100 -4.587 4.50e-06
## sexoMujer 0.28221 0.07907 3.569 0.000358
## actividad_laboralEconómicamente Inactiva 0.47904 0.08875 5.398 6.75e-08
## viaje_bicicletaSí 0.64451 0.12369 5.211 1.88e-07
## vehiculos_motor -0.13595 0.05342 -2.545 0.010934
## abandonadasSí -0.31252 0.08002 -3.906 9.39e-05
## tema_agua 0.30528 0.03636 8.397 < 2e-16
## frecuencia_parques 0.09480 0.01883 5.033 4.82e-07
## aire_acondicionadoSí -0.50674 0.08748 -5.792 6.93e-09
## siteconomica_presente -0.29465 0.06798 -4.335 1.46e-05
## problema_saludSí 1.15639 0.13661 8.465 < 2e-16
## victima_delitaSí 0.83464 0.13981 5.970 2.38e-09
##
## (Intercept) ***
## sexoMujer ***
## actividad_laboralEconómicamente Inactiva ***
## viaje_bicicletaSí ***
## vehiculos_motor *
## abandonadasSí ***
## tema_agua ***
## frecuencia_parques ***
## aire_acondicionadoSí ***
## siteconomica_presente ***
## problema_saludSí ***
## victima_delitaSí ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4430.6 on 3699 degrees of freedom
## Residual deviance: 4003.3 on 3688 degrees of freedom
## AIC: 4027.3
##
## Number of Fisher Scoring iterations: 4
El modelo que intenta predecir los problemas de salud mental tiene los siguientes resultados.
Intercepto: Es el efecto base
cuando todas las demás variables son cero. En este caso, el valor del
intercepto es -1.10538.
sexoMujer: Ser mujer (comparado con
hombre) se asocia con un aumento de 0.28221 en el logaritmo de la odds
de tener al menos un problema mental.
actividad_laboralEconómicamenteInactiva:
Estar económicamente inactivo (comparado con activo) está asociado con
un aumento de 0.47904 en el logaritmo de la odds de tener al menos un
problema mental.
viaje_bicicletaSí: Viajar en
bicicleta (comparado con no viajar) está asociado con un aumento de
0.64451 en el logaritmo de la odds de tener al menos un problema
mental.
vehiculos_motor: Tener vehículos de
motor se asocia con una disminución de 0.13595 en el logaritmo de la
odds de tener al menos un problema mental.
abandonadasSí: Estar en un área con
casas abandonadas (comparado con no estar) está asociado con una
disminución de 0.31252 en el logaritmo de la odds de tener al menos un
problema mental.
tema_agua: La preocupación por
temas relacionados con el agua está asociada con un aumento de 0.30528
en el logaritmo de la odds de tener al menos un problema
mental.
frecuencia_parques: La frecuencia
de visitas a parques está asociada con un aumento de 0.09480 en el
logaritmo de la odds de tener al menos un problema mental.
aire_acondicionadoSí: Tener aire
acondicionado (comparado con no tener) está asociado con una disminución
de 0.50674 en el logaritmo de la odds de tener al menos un problema
mental.
siteconomica_presente: La
percepción de la situación económica actual está asociada con una
disminución de 0.29465 en el logaritmo de la odds de tener al menos un
problema mental.
problema_saludSí: Tener problemas
de salud está asociado con un aumento de 1.15639 en el logaritmo de la
odds de tener al menos un problema mental.
victima_delitaSí: Ser víctima de
algún delito está asociado con un aumento de 0.83464 en el logaritmo de
la odds de tener al menos un problema mental.
El modelo también tiene un buen ajuste según el AIC, lo que sugiere que las variables incluidas son útiles para predecir la variable dependiente.
A continuación evaluamos la precisión del modelo creado dos sets de datos: uno para entrenar el modelo, y otro para probarlo.
Paso 1: Creamos el set de entrenamiento y de prueba con valores aleatorios, regidos por la semilla 123 para que tenga replicabilidad.
Paso 2: Entrenamos el modelo con el set de entrenamiento.
Paso 3: Predecimos los valores con el set de prueba.
Paso 4: Creamos la matriz de confusión.
# Paso 1
set.seed(123)
indices <- sample(1:nrow(df_eav23), round(0.7 * nrow(df_eav23)))
df_train <- df_eav23[indices,]
df_test <- df_eav23[-indices,]
# Paso 2
model1_train <- glm(al_menos_un_problema_mental~sexo+vehiculos_motor+actividad_laboral+viaje_bicicleta+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data=df_train,family=binomial)
# Paso 3
predictions1 <- predict(model1_train, newdata = df_test,type="response")
predicted_labels1 <- ifelse(predictions1 > 0.5, 1, 0)
confusion_matrix1 <- table(Predicted = predicted_labels1, Actual = df_test$al_menos_un_problema_mental)
# Paso 4
confusion_matrix1
## Actual
## Predicted No Sí
## 0 746 267
## 1 38 59
Los resultados de la matriz de confusión se interpretan a continuación:
La precisión del modelo se puede calcular utilizando la fórmula:
\[ \text{Precisión} = \frac{TP + TN}{TP + FP + TN + FN} \]
En este caso, la precisión sería:
\[ \text{Precisión} = \frac{59 + 746}{59 + 38 + 746 + 267} = \frac{805}{1110} \approx 0.725 \]
Esto indica que el modelo tiene una precisión del 72.5%, lo que significa que acierta en predecir si hay o no un problema mental en aproximadamente el 72.5% de los casos. También calculamos la sensibilidad y la especifidad.
\[ \text{Sensibilidad} = \frac{59}{59 + 267} \approx 0.181 \]Especificidad (también conocida como tasa de verdaderos negativos): Mide la proporción de casos negativos reales que fueron correctamente identificados por el modelo.
\[ \text{Especificidad} = \frac{746}{746 + 38} \approx 0.952 \]
Esto significa que:
#Paso 1
#Se hace la validación cruzada del modelo 3 para obtener el error
model3.err<-cv.glm(df_eav23, model3)
#Se muestran los errores de esa validación cruzada
model3.err$delta
## [1] 0.1819942 0.1819940
#Paso 2
#Se repite el proceso 5 veces para verificar que los resultados sean consistentes
cvmodel3.err<-rep(0,5)
for (i in 1:5){
cvmodel3.err[i]<-cv.glm(df_eav23,model3)$delta[1]
}
cvmodel3.err #se puede tener confianza en los resultados de esta validación porque son muy parecidos entre las 5 iteraciones
## [1] 0.1819942 0.1819942 0.1819942 0.1819942 0.1819942
El modelo tiene un error en el 17.53% de las predicciones que hace. A continuación se hará una validación cruzada K-Fold para ver si el error cambia.
#Paso 1
#Se repite el procedimiento para obtener el error de la validación cruzada para verificar que haya consistencia en los resultados
set.seed(100)
model3.err2<-rep(0,10) #se indica que el proceso de repetirá 10 veces
for (i in 1:10) {
model3.err2[i] <- cv.glm(df_eav23,model3,K=10)$delta[1] #k = 10 es una elección común para la validación cruzada K fold
}
#Observamos los resultados de las 10 repeticiones
model3.err2 #se puede tener confianza en los resultados de esta validación porque son muy parecidos entre las 10 iteraciones
## [1] 0.1821529 0.1820820 0.1822928 0.1822628 0.1819852 0.1820074 0.1818187
## [8] 0.1814962 0.1823620 0.1818948
plot(model3.err2, xlab = "Repeticiones", ylab = "Error", main = "Error de la Validación Cruzada K Fold",type="o")
El modelo se equivoca en el 17.83% de las predicciones que hace. El error en la validación cruzada K Fold es muy similar al error en la validación cruzada LOOCV, el cual también es 17.83 (solo cambian los decimales después del 3)
#Paso 1
#Crear la función bootsrap para nuestro modelo (model3)
boot.fn <- function(data, indices) {
subset_data <- data[indices, ]
model3 <- glm(al_menos_un_problema_mental ~ sexo + actividad_laboral + viaje_bicicleta + vehiculos_motor + abandonadas + tema_agua + frecuencia_parques + aire_acondicionado + siteconomica_presente + problema_salud + victima_delita,
family = binomial, data = subset_data)
return(coef(model3))
}
# Establecer la semilla para que el proceso sea replicable
set.seed(100)
# Definir el conjunto de datos
data <- df_eav23
# Realizar el bootstrap
bootstrap_results <- boot(data, boot.fn, R = 10)
# Mostrar los resultados del bootstrap
bootstrap_results
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = data, statistic = boot.fn, R = 10)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* -1.10538160 -0.073061664 0.25758436
## t2* 0.28221396 -0.029624137 0.08967614
## t3* 0.47903542 0.024205107 0.05406740
## t4* 0.64450517 -0.035830709 0.17026678
## t5* -0.13595412 0.004119662 0.03586686
## t6* -0.31251894 0.027959012 0.04988965
## t7* 0.30528324 0.018386198 0.03504236
## t8* 0.09479565 0.006136566 0.01686880
## t9* -0.50673690 -0.045943953 0.11796579
## t10* -0.29464996 0.002419260 0.06733544
## t11* 1.15639004 0.003643480 0.18501494
## t12* 0.83463734 -0.013959615 0.19357184
Como los valores de la columna de sesgo son muy bajos y esto indica que no hay mucha diferencia entre el coeficiente original de la regresión y el obtenido en el bootsrap, es posible asumir que los coeficientes originales de la regresión se capturaron adecuadamente porque se pudo replicar bien ese valor. La columna del error estándar indica el error de cada estimación bootstrap obtenida.
#Paso 1
#Definir x y y
set.seed(100)
x <- model.matrix(al_menos_un_problema_mental ~ sexo + actividad_laboral + viaje_bicicleta + vehiculos_motor + abandonadas + tema_agua + frecuencia_parques + aire_acondicionado + siteconomica_presente + problema_salud + victima_delita, df_eav23)[ ,-1]
#predictores guardados como una matriz en x #el -1 se refiere a la primera columna
y <- as.numeric(df_eav23$al_menos_un_problema_mental)
grid <- 10^seq(10,-2,length=100)
#cuadrícula para el valor de lambda
ridge.mod <- glmnet(x,y,alpha=0,lambda=grid)
dim(coef(ridge.mod))
## [1] 12 100
#vector de coeficientes almacenados en la matriz que están asociados al valor de lambda que generamos con la cuadrícula
Tenemos una matriz de 12 columnas por 100 filas. Esta matriz representa el vector de coeficientes almacenados en la matriz que están asociados al valor de lambda que generamos con la cuadrícula.
Se realizará el siguiente código para observar si los coeficientes del modelo ridge son más pequeños una vez que utilice una lambda más grande
Encontraremos la mejor lambda y ajustaremos los valores del modelo para ese valor particular de lambda
set.seed(100)
train <- sample(1:nrow(x), nrow(x)/2) #definir conjunto de entrenamiento
test <- (-train) #definir conjunto de prueba
y.test <- y[test]
cv.out <- cv.glmnet(x[train ,],y[train],alpha=0) #se usará la validación curzada para elegir el mejor valor de lambda. El mejor valor de lambda es aquel que reduce el MSE
plot(cv.out)
bestlam <- cv.out$lambda.min
ridge.pred <- predict(ridge.mod,s=bestlam ,newx=x[test,]) #predicción del modelo
MSE_ridge <- mean((ridge.pred-y.test)^2) #este es el MSE cuando hacemos una regresión Ridge con el mejor valor de lambda. Este valor se debe comparar con el MSE de nuestra regresión original para evaluar cuál modelo es mejor
cat("\n")
cat("El MSE con la función Ridge es", MSE_ridge) #MSE
## El MSE con la función Ridge es 0.1792093
out <- glmnet(x,y,alpha=0)
ridge.out <- predict(out, type="coefficients",s=bestlam,newx=x[test,])
ridge.out #los coeficientes cuando se usa la mejor lambda
## 12 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 1.27254141
## sexoMujer 0.04564015
## actividad_laboralEconómicamente Inactiva 0.08755328
## viaje_bicicletaSí 0.11134470
## vehiculos_motor -0.02055323
## abandonadasSí -0.05352558
## tema_agua 0.05027972
## frecuencia_parques 0.01492255
## aire_acondicionadoSí -0.09188129
## siteconomica_presente -0.04782202
## problema_saludSí 0.23243175
## victima_delitaSí 0.16151449
Como se puede observar, ningún coeficiente es iguala cero, por lo que por ahora se debe dejar a todas las variables en la regresión. Se revisará si esto cambia al hacer una regresión Lasso.
Se revisará si la regresión Lasso puede generar un modelo aún más preciso que aquel creado por ridge en donde alguna de las variables pueda ser eliminada.
set.seed(1)
cv.out2 <- cv.glmnet(x[train ,],y[train],alpha=1, family = "binomial" )
plot(cv.out2)
bestlam2 <- cv.out2$lambda.min #se encuentra la mejor lambda, la que minimice el MSE
bestlam2 # la lambda que reduce el MSE
## [1] 0.001064719
lasso.mod <- glmnet(x[train ,],y[train],alpha=1,lambda=bestlam2)
lasso.pred <- predict(lasso.mod,s=bestlam2 ,newx=x[test,])
mean((lasso.pred-y.test)^2) #MSE
## [1] 0.1799599
El MSE que se obtuvo en la validción cruzada de la regresión Lasso es un poco menor que el que se obtuvo haciendo el mismo proceso en la regresión Ridge. MSE Ridge: 0.17974 MSE Lasso: 0.1803393 MSE modelo 1: 0.1767406
Como se puede observar, el error estándar al cuadrado es menor en la regresión Lasso, por lo que se debe adoptar este modelo.
out2 <- glmnet(x,y,alpha=1,lambda=bestlam2)
lasso.coef <- predict(out,type="coefficients",s=bestlam2)
lasso.coef
## 12 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 1.27416394
## sexoMujer 0.05002479
## actividad_laboralEconómicamente Inactiva 0.09302125
## viaje_bicicletaSí 0.12229829
## vehiculos_motor -0.02064203
## abandonadasSí -0.05683139
## tema_agua 0.05338811
## frecuencia_parques 0.01626780
## aire_acondicionadoSí -0.09928307
## siteconomica_presente -0.05249848
## problema_saludSí 0.25042992
## victima_delitaSí 0.17364581
lasso.coef[lasso.coef!=0]
## [1] 1.27416394 0.05002479 0.09302125 0.12229829 -0.02064203 -0.05683139
## [7] 0.05338811 0.01626780 -0.09928307 -0.05249848 0.25042992 0.17364581
Como se puede observar, ninguno de los coeficientes de la regresión Lasso fue igual a cero, por lo que todas las variables utilizadas en la regresión ayudan a predecir si las personas han tenido al menos un problema mental.
Aunque las variables no cambiaron era importante que se realizaran las regresiones de Ridge y Lasso porque estos modelos indican mejor las variables que se deben utilizar en un modelo logístico, el cual es nuestro caso.
LDA, o Análisis Discriminante Lineal por sus siglas en inglés (Linear Discriminant Analysis), es una técnica de aprendizaje supervisado utilizada principalmente para la clasificación y reducción de dimensionalidad en conjuntos de datos. Funciona buscando la combinación lineal de características que mejor separa (discrimina) las clases en los datos.
LDA1 <- lda(al_menos_un_problema_mental~sexo+actividad_laboral+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data=df_eav23)
LDA1
## Call:
## lda(al_menos_un_problema_mental ~ sexo + actividad_laboral +
## viaje_bicicleta + vehiculos_motor + abandonadas + tema_agua +
## frecuencia_parques + aire_acondicionado + siteconomica_presente +
## problema_salud + victima_delita, data = df_eav23)
##
## Prior probabilities of groups:
## No Sí
## 0.7137838 0.2862162
##
## Group means:
## sexoMujer actividad_laboralEconómicamente Inactiva viaje_bicicletaSí
## No 0.4748201 0.2025748 0.08443771
## Sí 0.5354108 0.3220019 0.13408876
## vehiculos_motor abandonadasSí tema_agua frecuencia_parques
## No 0.7694055 0.5217721 2.488451 3.205604
## Sí 0.6100094 0.4230406 2.951841 3.576015
## aire_acondicionadoSí siteconomica_presente problema_saludSí victima_delitaSí
## No 0.7747066 2.957592 0.04354411 0.05035971
## Sí 0.6600567 2.864023 0.14164306 0.11803588
##
## Coefficients of linear discriminants:
## LD1
## sexoMujer 0.3548871
## actividad_laboralEconómicamente Inactiva 0.6553643
## viaje_bicicletaSí 0.8680489
## vehiculos_motor -0.1433894
## abandonadasSí -0.4002744
## tema_agua 0.3759822
## frecuencia_parques 0.1152748
## aire_acondicionadoSí -0.7021696
## siteconomica_presente -0.3726656
## problema_saludSí 1.7697216
## victima_delitaSí 1.2264970
predicciones <- predict(LDA1, newdata = df_test)
matriz_confusion <- table(predicciones$class, df_test$al_menos_un_problema_mental)
print(matriz_confusion)
##
## No Sí
## No 736 251
## Sí 48 75
El modelo tiene una precisión del 73.1%.
fit_1 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 1) + poly(tema_agua, 1) + poly(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_2 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 1) + poly(tema_agua, 1) + poly(frecuencia_parques, 2) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_3 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 1) + poly(tema_agua, 1) + poly(frecuencia_parques, 3) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_4 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 1) + poly(tema_agua, 1) + poly(frecuencia_parques, 4) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_5 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 1) + poly(tema_agua, 1) + poly(frecuencia_parques, 5) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_6 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 2) + poly(tema_agua, 2) + poly(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_7 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 2) + poly(tema_agua, 2) + poly(frecuencia_parques, 2) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_8 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 2) + poly(tema_agua, 2) + poly(frecuencia_parques, 3) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_9 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 2) + poly(tema_agua, 2) + poly(frecuencia_parques, 4) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_10 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 2) + poly(tema_agua, 2) + poly(frecuencia_parques, 5) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_11 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 3) + poly(tema_agua, 3) + poly(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_12 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 3) + poly(tema_agua, 3) + poly(frecuencia_parques, 2) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_13 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 3) + poly(tema_agua, 3) + poly(frecuencia_parques, 3) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_14 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 3) + poly(tema_agua, 3) + poly(frecuencia_parques, 4) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
fit_15 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 3) + poly(tema_agua, 3) + poly(frecuencia_parques, 5) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
data.frame(anova(fit_1, fit_2, fit_3, fit_4, fit_5, fit_6, fit_7, fit_8, fit_9, fit_10, fit_11, fit_12, fit_13, fit_14, fit_15, test = "Chisq"))
## Resid..Df Resid..Dev Df Deviance Pr..Chi.
## 1 3688 4003.256 NA NA NA
## 2 3687 3955.613 1 47.643207 5.112909e-12
## 3 3686 3948.419 1 7.193895 7.315202e-03
## 4 3685 3945.359 1 3.060115 8.023601e-02
## 5 3684 3943.836 1 1.522936 2.171757e-01
## 6 3686 3995.398 -2 -51.562470 6.358458e-12
## 7 3685 3946.329 1 49.069310 2.470759e-12
## 8 3684 3939.409 1 6.919838 8.524469e-03
## 9 3683 3937.165 1 2.244109 1.341241e-01
## 10 3682 3935.577 1 1.588042 2.076061e-01
## 11 3684 3992.201 -2 -56.624255 5.060569e-13
## 12 3683 3942.522 1 49.679135 1.810613e-12
## 13 3682 3935.381 1 7.141220 7.533190e-03
## 14 3681 3932.821 1 2.559731 1.096172e-01
## 15 3680 3931.374 1 1.447357 2.289526e-01
La tabla de Análisis de Desviación muestra la comparación de varios modelos que evalúan la relación entre la variable “al_menos_un_problema_mental” y la variable transformada “frecuencia_parques”,“tema_agua” y “vehiculos_motor” que son variables numéricas utilizando diferentes grados de polinomios.
El primer filtro que haremos para saber cual es el mejor modelo es revisar las significancias: el modelo 2, 6, 7, 11 y 12 son los más significativos. Seleccionaremos el modelo 11, ya que tiene la deviance, que se utiliza para evaluar qué tan bien se ajusta el modelo a los datos, más baja y un valor p altamente significativo.
# Asegúrate de que fit_11 y df_test están disponibles en el entorno
# fit_11 <- glm(al_menos_un_problema_mental ~ sexo + poly(vehiculos_motor, 3) + poly(tema_agua, 3) + poly(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
# Realiza las predicciones en el conjunto de prueba
pred_prob <- predict(fit_11, newdata = df_test, type = "response")
# Convierte las probabilidades en predicciones binarias usando un umbral de 0.5
pred_bin <- ifelse(pred_prob > 0.5, 1, 0)
# Crea la matriz de confusión
confusion_matrix <- table(Predicted = pred_bin, Actual = df_test$al_menos_un_problema_mental)
# Muestra la matriz de confusión
print(confusion_matrix)
## Actual
## Predicted No Sí
## 0 739 260
## 1 45 66
Es 72.5% la precisión del modelo polinomial.
Para los Modelos Spline se realizó el mismo modelo, pero ahora utilizando el método Spline.
spline_1 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) + ns(tema_agua, 1) + ns(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
spline_2 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) + ns(tema_agua, 1) + ns(frecuencia_parques, 2) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
spline_3 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) + ns(tema_agua, 1) + ns(frecuencia_parques, 3) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(frecuencia_parques, 3): shoving 'interior' knots matching
## boundary knots to inside
spline_4 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) + ns(tema_agua, 1) + ns(frecuencia_parques, 4) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(frecuencia_parques, 4): shoving 'interior' knots matching
## boundary knots to inside
spline_5 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) + ns(tema_agua, 1) + ns(frecuencia_parques, 5) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(frecuencia_parques, 5): shoving 'interior' knots matching
## boundary knots to inside
spline_6 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) + ns(tema_agua, 2) + ns(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
spline_7 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) + ns(tema_agua, 2) + ns(frecuencia_parques, 2) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
spline_8 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) + ns(tema_agua, 2) + ns(frecuencia_parques, 3) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(frecuencia_parques, 3): shoving 'interior' knots matching
## boundary knots to inside
spline_9 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) + ns(tema_agua, 2) + ns(frecuencia_parques, 4) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(frecuencia_parques, 4): shoving 'interior' knots matching
## boundary knots to inside
spline_10 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) + ns(tema_agua, 2) + ns(frecuencia_parques, 5) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(frecuencia_parques, 5): shoving 'interior' knots matching
## boundary knots to inside
spline_11 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
spline_12 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 2) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
spline_13 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 3) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
spline_14 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 4) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
## Warning in ns(frecuencia_parques, 4): shoving 'interior' knots matching
## boundary knots to inside
spline_15 <- glm(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 5) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
## Warning in ns(frecuencia_parques, 5): shoving 'interior' knots matching
## boundary knots to inside
data.frame(anova(spline_1, spline_2, spline_3, spline_4, spline_5, spline_6, spline_7, spline_8, spline_9, spline_10, spline_11, spline_12, spline_13, spline_14, spline_15, test = "Chisq"))
## Resid..Df Resid..Dev Df Deviance Pr..Chi.
## 1 3688 4003.256 NA NA NA
## 2 3687 3951.733 1 51.5225384 7.077985e-13
## 3 3686 3949.970 1 1.7637753 1.841543e-01
## 4 3685 3949.313 1 0.6563583 4.178486e-01
## 5 3684 3948.912 1 0.4011966 5.264719e-01
## 6 3686 3995.067 -2 -46.1548507 9.497330e-11
## 7 3685 3942.426 1 52.6413617 4.003680e-13
## 8 3684 3940.481 1 1.9441450 1.632192e-01
## 9 3683 3940.142 1 0.3394284 5.601594e-01
## 10 3682 3939.863 1 0.2787178 5.975429e-01
## 11 3684 3994.196 -2 -54.3322993 1.591810e-12
## 12 3683 3941.037 1 53.1583416 3.077159e-13
## 13 3682 3939.121 1 1.9165228 1.662405e-01
## 14 3681 3938.660 1 0.4603031 4.974824e-01
## 15 3680 3938.407 1 0.2530341 6.149468e-01
anova(spline_1, spline_2, spline_3, spline_4, spline_5, spline_6, spline_7, spline_8, spline_9, spline_10, spline_11, spline_12, spline_13, spline_14, spline_15, test = "Chisq")
## Analysis of Deviance Table
##
## Model 1: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) +
## ns(tema_agua, 1) + ns(frecuencia_parques, 1) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 2: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) +
## ns(tema_agua, 1) + ns(frecuencia_parques, 2) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 3: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) +
## ns(tema_agua, 1) + ns(frecuencia_parques, 3) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 4: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) +
## ns(tema_agua, 1) + ns(frecuencia_parques, 4) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 5: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 1) +
## ns(tema_agua, 1) + ns(frecuencia_parques, 5) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 6: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) +
## ns(tema_agua, 2) + ns(frecuencia_parques, 1) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 7: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) +
## ns(tema_agua, 2) + ns(frecuencia_parques, 2) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 8: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) +
## ns(tema_agua, 2) + ns(frecuencia_parques, 3) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 9: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) +
## ns(tema_agua, 2) + ns(frecuencia_parques, 4) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 10: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 2) +
## ns(tema_agua, 2) + ns(frecuencia_parques, 5) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 11: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) +
## ns(tema_agua, 3) + ns(frecuencia_parques, 1) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 12: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) +
## ns(tema_agua, 3) + ns(frecuencia_parques, 2) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 13: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) +
## ns(tema_agua, 3) + ns(frecuencia_parques, 3) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 14: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) +
## ns(tema_agua, 3) + ns(frecuencia_parques, 4) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Model 15: al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) +
## ns(tema_agua, 3) + ns(frecuencia_parques, 5) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 3688 4003.3
## 2 3687 3951.7 1 51.523 7.078e-13 ***
## 3 3686 3950.0 1 1.764 0.1842
## 4 3685 3949.3 1 0.656 0.4178
## 5 3684 3948.9 1 0.401 0.5265
## 6 3686 3995.1 -2 -46.155 9.497e-11 ***
## 7 3685 3942.4 1 52.641 4.004e-13 ***
## 8 3684 3940.5 1 1.944 0.1632
## 9 3683 3940.1 1 0.339 0.5602
## 10 3682 3939.9 1 0.279 0.5975
## 11 3684 3994.2 -2 -54.332 1.592e-12 ***
## 12 3683 3941.0 1 53.158 3.077e-13 ***
## 13 3682 3939.1 1 1.917 0.1662
## 14 3681 3938.7 1 0.460 0.4975
## 15 3680 3938.4 1 0.253 0.6149
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
El primer filtro que haremos para saber cual es el mejor modelo es revisar las significancias: el modelo 2, 6, 7, 11 y 12 son los más significativos. Seleccionaremos el modelo 11, ya que tiene la deviance, que se utiliza para evaluar qué tan bien se ajusta el modelo a los datos, más baja y un valor p altamente significativo.
# Realiza las predicciones en el conjunto de prueba
pred_prob_spline <- predict(spline_11, newdata = df_test, type = "response")
# Convierte las probabilidades en predicciones binarias usando un umbral de 0.5
pred_bin_spline <- ifelse(pred_prob_spline > 0.5, 1, 0)
# Crea la matriz de confusión
confusion_matrix_spline <- table(Predicted = pred_bin_spline, Actual = df_test$al_menos_un_problema_mental)
# Muestra la matriz de confusión
print(confusion_matrix_spline)
## Actual
## Predicted No Sí
## 0 740 258
## 1 44 68
La precisión del modelo es de 72.8%.
Los Generalized Additive Models (GAMs) son una extensión de los modelos lineales generalizados (GLM) que permiten una mayor flexibilidad en la forma de la relación entre las variables independientes y la variable dependiente. Dentro de los GAM, buscamos encontrar el mejor resumen del modelo del que se obtuvo en los Splines, donde tenemos que reemplazar nuestras variables y encontramos la significancia que tienen las variables del modelo.
modelo_gam <- gam(al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor, 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 1) + siteconomica_presente + actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado + problema_salud + victima_delita, family = binomial, data = df_eav23)
## Warning in ns(vehiculos_motor, 3): shoving 'interior' knots matching boundary
## knots to inside
summary(modelo_gam)
##
## Call: gam(formula = al_menos_un_problema_mental ~ sexo + ns(vehiculos_motor,
## 3) + ns(tema_agua, 3) + ns(frecuencia_parques, 1) + siteconomica_presente +
## actividad_laboral + viaje_bicicleta + abandonadas + aire_acondicionado +
## problema_salud + victima_delita, family = binomial, data = df_eav23)
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0142 -0.8130 -0.6018 1.0096 2.3406
##
## (Dispersion Parameter for binomial family taken to be 1)
##
## Null Deviance: 4430.594 on 3699 degrees of freedom
## Residual Deviance: 3994.195 on 3684 degrees of freedom
## AIC: 4026.195
##
## Number of Local Scoring Iterations: 4
##
## Anova for Parametric Effects
## Df Sum Sq Mean Sq F value Pr(>F)
## sexo 1 7.9 7.916 7.9134 0.0049330 **
## ns(vehiculos_motor, 3) 3 26.2 8.747 8.7442 8.902e-06 ***
## ns(tema_agua, 3) 3 99.6 33.208 33.1983 < 2.2e-16 ***
## ns(frecuencia_parques, 1) 1 15.9 15.884 15.8791 6.883e-05 ***
## siteconomica_presente 1 8.0 7.997 7.9947 0.0047169 **
## actividad_laboral 1 41.7 41.739 41.7273 1.186e-10 ***
## viaje_bicicleta 1 25.2 25.232 25.2246 5.345e-07 ***
## abandonadas 1 14.4 14.387 14.3832 0.0001515 ***
## aire_acondicionado 1 24.9 24.942 24.9352 6.204e-07 ***
## problema_salud 1 70.6 70.559 70.5389 < 2.2e-16 ***
## victima_delita 1 35.9 35.875 35.8645 2.318e-09 ***
## Residuals 3684 3685.1 1.000
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Todas las variables del modelo GAM son significativas.
# Realiza las predicciones en el conjunto de prueba
pred_prob_gam <- predict(modelo_gam, newdata = df_test, type = "response")
# Convierte las probabilidades en predicciones binarias usando un umbral de 0.5
pred_bin_gam <- ifelse(pred_prob_gam > 0.5, 1, 0)
# Crea la matriz de confusión
confusion_matrix_gam <- table(Predicted = pred_bin_gam, Actual = df_test$al_menos_un_problema_mental)
# Muestra la matriz de confusión
print(confusion_matrix_gam)
## Actual
## Predicted No Sí
## 0 740 258
## 1 44 68
Es igual que el spline11, la precisión es de 72.8%.
tree.problema<-tree(al_menos_un_problema_mental~sexo+actividad_laboral+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data=df_eav23)
## Warning in tree(al_menos_un_problema_mental ~ sexo + actividad_laboral + : NAs
## introduced by coercion
plot(tree.problema)
text(tree.problema, pretty=0, cex=0.9)
La poda se realiza para evitar el sobreajuste y mejorar la generalización del modelo. El proceso de poda elimina ramas que no proporcionan una mejora significativa en la predicción del modelo. Duespués se evalua la validación cruzada que nos ayuda a determinar el tamaño óptimo del árbol que minimiza el error de clasificación. En el analisis se implementa FUN=prune.misclass, utilizada para la poda, en este caso, minimizando la tasa de clasificación incorrecta.
Se puede resumir, que nuestro mejor modelo sería implementando por 4 nodos terminales, tenemos un misclassifiaction error rate de .2754, lo que nos da a entender que se tiene un buen modelo para la predición que se quiere realizar. La precisión del modelo se calcula como la proporción de predicciones correctas sobre el total de predicciones realizadas. Lo que nos da como resultado, 73.35845 % de las predicciones se realizaron correctamente .
set.seed(12)
cv.prune.problema<- cv.tree(tree.problema, FUN=prune.misclass)
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
cv.prune.problema$size
## [1] 4 3 1
prune.problema<- prune.misclass(tree.problema, best=4)
tree.pred.pruned<-predict(prune.problema, subset=df_test, type="class")
summary(prune.problema)
##
## Classification tree:
## tree(formula = al_menos_un_problema_mental ~ sexo + actividad_laboral +
## viaje_bicicleta + vehiculos_motor + abandonadas + tema_agua +
## frecuencia_parques + aire_acondicionado + siteconomica_presente +
## problema_salud + victima_delita, data = df_eav23)
## Variables actually used in tree construction:
## [1] "tema_agua" "problema_salud" "frecuencia_parques"
## Number of terminal nodes: 4
## Residual mean deviance: 1.133 = 4189 / 3696
## Misclassification error rate: 0.2754 = 1019 / 3700
prune.problema<-prune.misclass(tree.problema,best=4)
plot(prune.problema)
text(prune.problema,pretty=0,cex=0.7)
tree.pred<-predict(prune.problema,df_test,type="class")
## Warning in pred1.tree(object, tree.matrix(newdata)): NAs introduced by coercion
table(tree.pred,df_test$al_menos_un_problema_mental)
##
## tree.pred No Sí
## No 759 286
## Sí 25 40
prunedtree_precision <- (759+40)/(25+40+759+286)
cat("\n")
cat("El",prunedtree_precision*100,"% de las predicciones se realizaron correctamente.")
## El 71.98198 % de las predicciones se realizaron correctamente.
Crear el Modelo de Árbol de Decisión: Se crea un modelo de árbol de decisión utilizando las variables especificadas para predecir al_menos_un_problema_mental. Se realiza una podada de árbol para evitar el sobreajuste, elimina ramas que no mejoran significativamente la precisión del modelo.
Parámetro de complejidad (complexity parameter) utilizado para controlar el crecimiento del árbol. Un valor más alto de cp resulta en un árbol más pequeño, es por eso que se toma un valor chico para ver de mejor manera el árbol de clasificación.
tree_model <- rpart(al_menos_un_problema_mental~sexo+actividad_laboral+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data=df_eav23, method = "class", cp = 0.01)
prune_cp <- tree_model$cptable[which.min(tree_model$cptable[,"xerror"]), "CP"]
prune.problema <- prune(tree_model, cp = prune_cp)
fancyRpartPlot(prune.problema, main = "Árbol de Problema Mental")
Primero se realiza una validación cruzada del árbol de decisión tree.problema. En el siguente apartado se tiene cv.tree, que incluye información sobre el tamaño del árbol (número de nodos terminales), el error de clasificación y otros parámetros relevantes. Por utlimo, nos permite visualizar cómo cambia el error de clasificación a medida que se ajusta el tamaño del árbol, ayudando a identificar el tamaño óptimo del árbol.
Esto nos ayuda a realizar la poda del árbol de decisión mediante validación cruzada, asegurando que el modelo final tenga un equilibrio adecuado entre complejidad y precisión.
set.seed(123)
cv.tree<-cv.tree(tree.problema,FUN=prune.misclass)
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
## Warning in tree(model = m[rand != i, , drop = FALSE]): NAs introduced by
## coercion
## Warning in pred1.tree(tree, tree.matrix(nd)): NAs introduced by coercion
names(cv.tree)
## [1] "size" "dev" "k" "method"
cv.tree$size
## [1] 4 3 1
plot(cv.tree$size ,cv.tree$dev ,type="b")
Random Forest es un algoritmo de aprendizaje automático utilizado para tareas de clasificación y regresión. Se basa en la combinación de múltiples árboles de decisión. A continuación el código entrena el modelo, realiza predicciones y evalúa la precisión utilizando el MSE. Ya que proporciona información sobre qué variables son las más influyentes en las predicciones del modelo, permitiendo una mejor interpretación y uso del modelo en aplicaciones prácticas.
En el eje Y tenemos las variables del modelo, y en el eje X tenemos el valor de Mean Decrease Gini. Cada punto en el gráfico representa la importancia de una variable en términos de cómo disminuye la impureza de Gini. Como se puede observar, frecuencia_parques, es la variable más importante en el modelo, con el valor más alto de Mean Decrease Gini. Tema_agua, también tiene un alto valor de Mean Decrease Gini, indicando que es una variable importante. Siteconomica_presente, tiene un valor intermedio-alto, sugiriendo que es bastante relevante para las predicciones del modelo.
set.seed(100)
rf_model <- randomForest(al_menos_un_problema_mental~sexo+actividad_laboral+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data=df_eav23, mtry = 11, importance = TRUE)
print(rf_model)
##
## Call:
## randomForest(formula = al_menos_un_problema_mental ~ sexo + actividad_laboral + viaje_bicicleta + vehiculos_motor + abandonadas + tema_agua + frecuencia_parques + aire_acondicionado + siteconomica_presente + problema_salud + victima_delita, data = df_eav23, mtry = 11, importance = TRUE)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 11
##
## OOB estimate of error rate: 29.27%
## Confusion matrix:
## No Sí class.error
## No 2239 402 0.1522151
## Sí 681 378 0.6430595
set.seed(100)
rf_model <- randomForest(al_menos_un_problema_mental~sexo+actividad_laboral+viaje_bicicleta+vehiculos_motor+abandonadas+tema_agua+frecuencia_parques+aire_acondicionado+siteconomica_presente+problema_salud+victima_delita,data= df_train)
predicciones_rf <- predict(rf_model, newdata = df_test)
mse <- mean((predicciones_rf - df_test$al_menos_un_problema_mental)^2)
## Warning in Ops.factor(predicciones_rf, df_test$al_menos_un_problema_mental):
## '-' not meaningful for factors
print(mse)
## [1] NA
importancia <- importance(rf_model)
print(importancia)
## MeanDecreaseGini
## sexo 28.36716
## actividad_laboral 28.56862
## viaje_bicicleta 23.36599
## vehiculos_motor 51.81638
## abandonadas 33.81293
## tema_agua 69.10678
## frecuencia_parques 99.70629
## aire_acondicionado 31.78941
## siteconomica_presente 56.47439
## problema_salud 36.82492
## victima_delita 23.01406
varImpPlot(rf_model)
Cuando comparamos las precisiones de los modelos, observamos lo siguiente:
Modelo Logístico - 73.5% Modelo LDA - 73.1% Modelo Polinómico - 72.5% Modelo Splines y GAM - 72.8% Árbol de Decisiones - 72.4% Árbol de Decisiones Podado - 72.0% Random Forests - 70.7%
A partir de esto, seleccionamos el modelo logístico por que demuestra ser el más eficiente dentro de una muesrta aleatoria, además de ser significativo.
\[ p(problemamental) = \frac{e^{-1.11+0.28X_1+0.48X_2+0.64X_3-0.14X_4-0.31X_5+0.31X_6+0.09X_7-0.51X_8-0.29X_9+1.16X_{10}+0.83464X_{11}}}{1-e^{-1.11+0.28X_1+0.48X_2+0.64X_3-0.14X_4-0.31X_5+0.31X_6+0.09X_7-0.51X_8-0.29X_9+1.16X_{10}+0.83464X_{11}}} \] Donde \(X_1\) será igual a 1 si la persona es mujer. Donde \(X_2\) será igual a 1 si la persona no está económicamente activa. Donde \(X_3\) será igual a 1 si la persona viaja en bicicleta. Donde \(X_4\) será igual al numero de vehículos de motor que la persona tenga. Donde \(X_5\) será igual a 1 si la persona percibe un problema de casas abandonadas en su colonia. Donde \(X_6\) será igual a la variable ordinal que define la gravedad del problema del agua. Donde \(X_7\) será igual a la frecuencia con la que la pesrona visita los parques. Donde \(X_8\) será igual a 1 si la persona tiene aire acondicionado. Donde \(X_9\) será igual a la calidad de la situación económica actual de la persona. Donde \(X_10\) será igual a 1 si la persona tiene un problema de salud crónica. Donde \(X_11\) será igual a 1 si la persona ha sido víctima de delitos.
El modelo logístico es una herramienta poderosa en la evaluación y predicción de la salud mental. Al aplicar este modelo a datos relevantes, como los utilizados en el ejemplo anterior, se pueden identificar y comprender mejor los factores que influyen en la presencia de problemas de salud mental. La interpretación de los coeficientes en el modelo logístico permite entender cómo cada variable predictora contribuye a la probabilidad de experimentar problemas de salud mental.
En el caso específico del modelo mencionado, podemos concluir que variables como la actividad laboral, el uso de bicicleta como medio de transporte, la exposición a problemas de salud, la victimización por delitos, entre otras, están asociadas de manera significativa con la presencia de al menos un problema de salud mental. Estos hallazgos pueden ser útiles para diseñar intervenciones y políticas dirigidas a mejorar la salud mental de la población.
Es importante tener en cuenta que el modelo logístico proporciona una visión probabilística y no determinística de la salud mental. Esto significa que si bien podemos predecir la probabilidad de que alguien tenga un problema de salud mental, no podemos afirmar con certeza que lo tendrá o no lo tendrá solo en función de las variables incluidas en el modelo. La salud mental es un área compleja que involucra múltiples factores biopsicosociales, y el modelo logístico es una herramienta valiosa pero limitada en su capacidad para capturar toda la complejidad de este fenómeno.
Para solucionar este problema, invitamos a la organización ComoVamos a indagar más en la salud mental, más allá de solo preguntar 3 preguntas en todo el cuestionario, ya que la salud mental es una dimensión del bienestar y florecimiento humano.