Análisis de la calidad de vida de los chilenos
Proyecto final curso de Aprendizaje Supervisado - MIA UC
Introducción
En Chile, las políticas públicas se asignan de manera focalizada de acuerdo a las características socioeconómicas de los individuos, tales como, edad, sexo, zona de residencia, grado de vulnerabilidad, composición del hogar, nivel de escolaridad entre otras.
Luego del Estallido Social del 2019 el Estado tomó consciencia de que las características observables o los indicadores absolutos de calidad de vida muchas veces no capturan el bienestar de los individuos. En este contexto se desarrolló la nueva encuesta de Encuesta de Bienestar Social (EBS), este instrumento es aplicado por el Observatorio Social que es parte de la Subsecretaría de Evaluación Social.
Esta encuesta tiene como objetivo complementar la información levantada por la encuesta de Caracterización Socio Económica (CASEN), recolectando información sobre la calidad de vida, las oportunidades y el logro de resultados a lo largo de la vida de los individuos y las familias chilenas.
En este informe se presentan diferentes técnicas y análisis para identificar las características más relevantes que influyen en el bienestar de las personas. Para eso utilizaremos modelos de clasificación, Regresión Logística, Naive Bayes y Random Forest, para entender si es posible predecir con las características levantadas en la encuesta de bienestar social y algunas características recabadas de la encuesta casen, el nivel de satisfacción actual de los chilenos.
Objetivos
El objetivo principal de este proyecto es identificar las características más relevantes que influyen en el bienestar de las personas. Para eso utilizaremos modelos de clasificación, Regresión Logística, Naive Bayes y Random Forest, para entender si es posible predecir con las características levantadas en la encuesta de bienestar social y algunas características recabadas de la encuesta casen, el nivel de satisfacción actual de los chilenos.
Un segundo objetivo es utilizar estos resultados para incentivar políticas públicas que ayuden al bienestar de las personas y generar recomendaciones en base a las dimensiones más relevantes que se deben priorizar.
Resultados
A continuación, se presentan los principales resultados del análisis y modelación.
Caracterización de la muestra
La Encuesta de Bienestar Social (EBS) es una encuesta que busca caracterizar a la población en términos de sus oportunidades, capacidades y percepción de satisfacción. La primera encuesta se realizó durante el primer semestre del año 2021.
- Muestra de 10.921 personas de 18 años o más.
- Sub-muestra de CASEN en Pandemia.
- Tiene representatividad a nivel nacional.
- Esta encuesta se realizó a través del formato CATI (Computer-assisted Telephone Interviewing).
- Tasa de rechazo del 13,4%.
Las dimensiones de la encuesta son: Ingreso, Trabajo, Vivienda, Estado de Salud, Balance vida y trabajo, Educación, Relaciones Sociales, Compromiso cívico y gobernanza, Calidad del medio ambiente, Seguridad personal, y Bienestar subjetivo.
Este instrumento es clave para el diagnóstico, diseño e implementación de Políticas Públicas.
Se realiza una preselección de las variables más ad-hoc para realizar la predicción del nivel de satisfacción de los chilenos.
El conjunto de datos de la encuesta utilizado para este proyecto es público y se encuentra en el siguiente enlace: (http://observatorio.ministeriodesarrollosocial.gob.cl/encuesta-bienestar-social)
Análisis exploratorio de datos
Variable de Interés:
Para iniciar el Análisis Exploratorio de los datos, se establece la variable objetivo, que es la variable respuesta a la pregunta “¿Cuán satisfecho(a) está con su vida en este momento?”.
Esta variable categórica se establece como dicotómica para “Satisfecho/a” que incluye la categoría “5. Totalmente satisfecho” y “4. Satisfecho”, siendo el resto de respuestas agrupadas en “No satisfecho/a”
Variables predictoras:
Con el propósito de acotar el dataframe utilizado, se seleccionan 43 variables para el análisis de Aprendizaje Supervisado. Las variables han sido seleccionadas de cada una de las dimensiones que la encuesta recoge, privilegiando preguntas generales por sobre preguntas específicas. De esta manera, consideramos:
Para la dimensión de caracterización de los entrevistados: - Región - Sexo - Edad - Cantidad de hijos - Estado civil - Pertenencia a pueblos indígenas - Inmigrante - Nivel de pobreza - Ingreso - Educación - Número de personas con las que comparte el hogar - Deudas
Para la dimensión trabajo: - Tiene o no trabajo - Reconocimiento en el trabajo - Beneficios laborales - Flexibilidad horaria - Teletrabajo - Posibilidad de ascender - Ambiente laboral - Tener conocidos para mejorar su empleabilidad - Desarrollo de sus habilidades
Para la dimensión Uso del tiempo - Horas destinadas al cuidado de niños o adultos mayores - Horas de trabajo no remunerado en el hogar - Horas de traslado al trabajo - Horas destinadas al ocio - Horas de sueño
Para la dimensión social - Cantidad de amigos - Confianza en otras personas - Sentimiento de maltrato - Sentimiento de maltrato por ser mujer - Sentimiento de maltrato por orientación sexual - Sentimiento de maltrato por clase social - Sentimiento de maltrato por ser extranjero - Sentimiento de maltrato por su edad - Sentimiento de maltrato por pertenecer a un pueblo indígena - Sentimiento de maltrato por tener alguna discapacidad
Para la dimensión salud - Estado de salud actual - Estatura - Peso - IMC - Salud mental
Para la dimensión vivienda - Calidad de la vivienda - Problemas de la vivienda - Medioambiente - Visita a parques
Para la dimensión medio ambiente - Calidad del medio ambiente - Problemáticas del medio ambiente - Problemas del entorno - Delincuencia - Ha sido víctima de delincuencia - Ha presenciado delincuencia
Evaluación de la variable región contenida en los datos y con respecto a la variable de interés.
Podemos observar como la variable región tiene representación en todas las regiones del país, siendo mayor en la región Metropolitana, Valparaíso y Biobío, que también concentran mayor población nacional. Para establecer un análisis por zonas, se delimitan secciones que agrupan la variable en Zona norte (desde Arica y Parinacota hasta Valparaíso), RM, Zona Centro (Desde O’Higgins hasta Biobío) y Zona Sur (desde Araucanía al sur).
A continuación, se presenta un análisis gráfico de las variables predictoras más relevantes coon respecto a la variable de interés.
- Distribución del nivel de satisfacción según sexo:
Distribución del nivel de satisfacción según edad:
Distribución del nivel de satisfacción según estado civil:
- Distribución del nivel de satisfacción según ingreso:
- Nivel de satistacción según nivel de deuda:
- Nivel de satisfacción según evaluación del estado de salud:
- Nivel de satisfacción según nivel de confianza en otras personas:
Todas las gráficas muestran un grado de asociación de las variables presentadas con la variable de interés.
Los análisis exploratorios del resto de las variables que son potenciales predictoras no se presentan en este informe, pero se pueden revisar en el código disponible en el anexo.
Modelación
Nuestra variable de interés es Nivel de satisfacción actual de los chilenos, categorizado como:
- 1: Satisfecho
- 0: No satisfecho
Debido a que nuestra variable respuesta es de tipo categórica y binaria, se prueban tres tipos de modelos: Regresión logística, Naive bayes y Random Forest.
Modelo lineal generalizado:
Se prueba un modelo lineal generalizado con enlace logit, es decir, se usa la regresión logística para predecir la probabilidad de que un individuo está satisfecho con su situación actual.
Para la selección de variables se utilizan los métodos stepwise: Forward, Backward: y Both. Las variables seleccionadas por estos métodos son:
| Variable | Forward | Backward | Both |
|---|---|---|---|
| ¿cuántos amigos(as) diría que usted tiene? | x | x | x |
| En general, ¿Cuánto confía usted en las personas? | x | x | x |
| Se ha sentido decaído(a), deprimido(a) o sin esperanzas | x | x | x |
| ¿cómo definiría la situación actual de sus deudas? | x | x | x |
| Cantidad de horas que duerme (< 7, entre 7 y 9, > de 9) | - | x | - |
| Estado Civil | x | x | x |
| Estatura | x | x | x |
| ¿Cuántas horas al día le dedica usted al trabajo doméstico? | x | x | x |
| ¿Cuántas horas al día le dedica usted al dormir? | - | x | - |
| ¿Cuántas horas al día le dedica usted al cuidado de niños? | x | x | x |
| ¿Cuántas horas al día le dedica usted al ocio? | x | x | x |
| Ingreso mes pasado (alcanzó bien, justo, con dificultades…) | x | x | x |
| ¿Es inmigrante? | x | x | x |
| Evaluación aspectos del medio ambiente que lo rodea | x | x | x |
| Cantidad de hijos menores de 18 años | x | x | x |
| Cantidad de problemas en la vivienda | x | x | x |
| Nota a su estado de salud | x | x | x |
| ¿Se ha sentido maltratado? | x | x | x |
| ¿Se ha sentido nervioso? | x | x | x |
| Sexo | x | x | x |
| ¿Ha tenido ascenso en su trabajo? | x | x | x |
| ¿Se ha sentido reconocido en su trabajo? | x | x | x |
| ¿Tiene la posibilidad de realizar teletrabajo? | x | x | x |
| ¿Está trabajando? | x | x | x |
Los tres modelos proponen casi las mismas variables, excepto backward que deja dos variables relacionadas con el sueño. El modelo seleccionado finalmente contiene las mismas variables que el modelo backward pero se eliminan las variables “Reconocimiento en el trabajo” y “Ascenso en el trabajo” ya que son linealmente dependientes de otras, también se agrega la variable región por la importancia que tiene en los análisis y porque parecía estar asociada de manera individual a la variable de interés.
Balanceo de la muestra
La variable respuesta está un poco desbalanceada:
| Categoría | Proporción |
|---|---|
| No Satisfecho | 21.39 |
| Satisfecho | 78.61 |
Sin embargo, el modelo clasifica bien sin balancear la muestra. Por lo tanto, se decide no balancear la muestra y ajustar el punto de corte para que realice una buena clasificación, según se detalla en la siguiente sección. El análisis del balanceo de la muestra se dejó comentado en el código.
Definición punto de corte
Como usamos la data desbalanceada, al revisar la distribución de la probabilidad predicha con la satisfacción, observamos que requerimos modificar el punto de corte para obtener una clasificación más adecuada del grupo más críticos que serían los no satisfechos. A simple vista un punto de corte de 0.75 nos daría una buena clasificación.
Para decidir el punto de corte, observamos los valores de Sensibilidad, especificidad y F1 Score para seleccionar el mejor punto de corte. Para nosotros la medida más crítica es la Sensibilidad ya que queremos clasificar correctamente a los no sastisfechos. Sin embargo, como la forma de la Sensibilidad no se estabiliza también miramos la Especificidad para y el F1 Score, para también obtener una buena clasificación.
De acuerdo a lo anterior, el punto de corte utilizado para la clasificación es: 0.78.
Desempeño del modelo
Para evaluar el desempeño del modelo, observamos la matriz de confusión y las métricas desempeño más relevantes para nuestro contexto.
De acuerdo a lo indicado anteriormente, en el contexto de este proyecto la medida más importante es la sensibilidad.
| Valor | |
|---|---|
| Sensitivity | 0.68 |
| Specificity | 0.74 |
| Precision | 0.43 |
| F1 Score | 0.53 |
Para el cálculo de las métricas de interés se define como clase positiva la categoría “No Satisfecho”.
Naive Bayes:
Se utiliza Naive Bayes ya que es una metodología muy útil para resolver problemas de clasificación siguiendo un enfoque probabilístico. Es un modelo muy apropiado cuando la dimensión del espacio de características es alta, así como la encuesta de bienestar social de este proyecto. También permite mezclar distribuciones de los predictores de tipo gaussianas con distribuciones multinomiales.
Para cumplir con el supuesto de independencia de las variables predictoras, usamos las mismas variables seleccionadas por Stepwise para probar el modelo.
Desempeño del modelo
Para evaluar el desempeño del modelo, observamos la matriz de confusión y las métricas desempeño más relevantes para nuestro contexto.
| Valor | |
|---|---|
| Sensitivity | 0.50 |
| Specificity | 0.84 |
| Precision | 0.48 |
| F1 Score | 0.49 |
Para el cálculo de las métricas de interés se define como clase positiva la categoría “No Satisfecho”.
Random Forest:
Usamos Random Forest ya que es una técnica muy poderosa y robusta para clasificación utilizando una serie de árboles de decisión, cuando tenemos distintos tipos de variables predictores, como es el caso de nuestra encuesta.
La selección de las variables se realiza en base a la importancia que tienen en el modelo según la media de disminución de GINI.
Desempeño del modelo
Para evaluar el desempeño del modelo, observamos la matriz de confusión y las métricas desempeño más relevantes para nuestro contexto.
| Valor | |
|---|---|
| Sensitivity | 0.68 |
| Specificity | 0.71 |
| Precision | 0.41 |
| F1 Score | 0.51 |
Para el cálculo de las métricas de interés se define como clase positiva la categoría “No Satisfecho”.
Validación cruzada
Se realiza validación cruzada k-Fold con \(k=10\) para evaluar cuál de los tres modelos tiene mayor capacidad de generalizar. Los resultados se presentan a continuación.
K Fold Regresión Logística:
| parallel | link | Accuracy | Kappa | AccuracySD | KappaSD |
|---|---|---|---|---|---|
| FALSE | loge | 0.8002532 | 0.2288393 | 0.0059136 | 0.0278177 |
| TRUE | loge | 0.8002532 | 0.2288393 | 0.0059136 | 0.0278177 |
K Fold Naive Bayes:
| mtry | Accuracy | Kappa | AccuracySD | KappaSD |
|---|---|---|---|---|
| 2 | 0.7902939 | 0.0371478 | 0.0020383 | 0.0122243 |
| 27 | 0.7945285 | 0.1837130 | 0.0100204 | 0.0418218 |
| 52 | 0.7945293 | 0.2051915 | 0.0133020 | 0.0527900 |
K Fold Random Forest:
| mtry | Accuracy | Kappa | AccuracySD | KappaSD |
|---|---|---|---|---|
| 2 | 0.7902939 | 0.0371478 | 0.0020383 | 0.0122243 |
| 27 | 0.7945285 | 0.1837130 | 0.0100204 | 0.0418218 |
| 52 | 0.7945293 | 0.2051915 | 0.0133020 | 0.0527900 |
De acuerdo a la desviación estándar de los indicadores, podemos concluir que la regresión logística tiene mayor capacidad de generalización.
Resultados modelo seleccionado
El modelo seleccionado es el modelo de regresión logística que contiene 22 variables. Se selecciona este modelo ya que es el que mejor generaliza en la validación cruzada. También con el fin de poder otorgar una interpretación que sirva de orientación a la generación de políticas públicas. Random Forest a nivel predictivo es mejor en menos de un 1% en cuanto a sensibilidad, pero no generalizaba tan bien en la validación cruzada.
Los coeficientes del ajuste del modelo de Regresión logística se presentan a continuación:
| Coef | Error Est. | Z | Valor-P | exp(Coef) | |
|---|---|---|---|---|---|
| (Intercept) | 2.2731 | 0.7804 | 2.9128 | 0.0036 | 9.71 |
| ingreso2. No les alcanzó, tuvo algunas dificultades | 0.3146 | 0.0881 | 3.5684 | 0.0004 | 1.37 |
| ingreso3. Les alcanzó justo, sin mayores dificultades | 0.7148 | 0.0866 | 8.2558 | 0.0000 | 2.04 |
| ingreso4. Les alcanzó bien, no tuvo dificultades | 0.9242 | 0.1068 | 8.6523 | 0.0000 | 2.52 |
| ingreso9. No sabe/No responde | 0.5553 | 0.5052 | 1.0992 | 0.2717 | 1.74 |
| salud | 0.1754 | 0.0230 | 7.6429 | 0.0000 | 1.19 |
| deprimido2. Algunos días | -0.5964 | 0.0748 | -7.9706 | 0.0000 | 0.55 |
| deprimido3. Más de la mitad de los días | -0.8333 | 0.1143 | -7.2933 | 0.0000 | 0.43 |
| deprimido4. Casi todos los días | -1.2023 | 0.1240 | -9.6997 | 0.0000 | 0.30 |
| trabajo_asc1 | -0.2640 | 0.1180 | -2.2371 | 0.0253 | 0.77 |
| trabajo_asc2 | -0.1077 | 0.1477 | -0.7291 | 0.4659 | 0.90 |
| trabajo_asc3 | 0.2033 | 0.1576 | 1.2896 | 0.1972 | 1.23 |
| trabajo_asc4 | 0.4522 | 0.1683 | 2.6868 | 0.0072 | 1.57 |
| trabajo_asc5 | 0.3901 | 0.2089 | 1.8671 | 0.0619 | 1.48 |
| prob_vivienda | 0.1644 | 0.0294 | 5.5881 | 0.0000 | 1.18 |
| sens_maltrato2. Poco | -0.1085 | 0.0787 | -1.3783 | 0.1681 | 0.90 |
| sens_maltrato3. Algo | -0.2513 | 0.0843 | -2.9819 | 0.0029 | 0.78 |
| sens_maltrato4. Bastante | -0.4833 | 0.1076 | -4.4908 | 0.0000 | 0.62 |
| sens_maltrato5. Mucho | -0.6581 | 0.1466 | -4.4900 | 0.0000 | 0.52 |
| confianza2. Poco | 0.0360 | 0.0898 | 0.4005 | 0.6888 | 1.04 |
| confianza3. Algo | 0.1265 | 0.0921 | 1.3739 | 0.1695 | 1.13 |
| confianza4. Bastante | 0.3910 | 0.1056 | 3.7017 | 0.0002 | 1.48 |
| confianza5. Mucho | 0.5216 | 0.1560 | 3.3432 | 0.0008 | 1.68 |
| estatura | -0.0087 | 0.0038 | -2.2939 | 0.0218 | 0.99 |
| estado_civil2. Conviviente sin AUC | 0.0380 | 0.1158 | 0.3282 | 0.7427 | 1.04 |
| estado_civil3. Conviviente con AUC | -0.2516 | 0.4455 | -0.5649 | 0.5721 | 0.78 |
| estado_civil4. Anulado(a) | -0.9493 | 0.5702 | -1.6649 | 0.0959 | 0.39 |
| estado_civil5. Separado(a) | -0.3570 | 0.1257 | -2.8402 | 0.0045 | 0.70 |
| estado_civil6. Divorciado(a) | -0.4139 | 0.1386 | -2.9871 | 0.0028 | 0.66 |
| estado_civil7. Viudo(a) | -0.2410 | 0.1279 | -1.8843 | 0.0595 | 0.79 |
| estado_civil8. Soltero(a) | -0.2440 | 0.0718 | -3.3971 | 0.0007 | 0.78 |
| inmigrante1. Inmigrante | -0.4906 | 0.1272 | -3.8560 | 0.0001 | 0.61 |
| inmigrante9. No sabe | 0.2456 | 0.2657 | 0.9241 | 0.3554 | 1.28 |
| sexoMujer | 0.3234 | 0.0823 | 3.9299 | 0.0001 | 1.38 |
| trabajo2 | -0.2547 | 0.1084 | -2.3498 | 0.0188 | 0.78 |
| deudas2. Tiene deudas, y todas se están pagando a tiempo | 0.1390 | 0.0748 | 1.8579 | 0.0632 | 1.15 |
| deudas3. Tiene deudas, y algunas se pueden pagar y otras no | -0.1522 | 0.0799 | -1.9033 | 0.0570 | 0.86 |
| deudas4. Tiene deudas, y ninguna se está pudiendo pagar | -0.1400 | 0.1118 | -1.2517 | 0.2107 | 0.87 |
| deudas9. No sabe / No responde | 0.0692 | 0.5946 | 0.1165 | 0.9073 | 1.07 |
| sentido_nervioso2. Algunos días | -0.1604 | 0.0759 | -2.1124 | 0.0347 | 0.85 |
| sentido_nervioso3. Más de la mitad de los días | -0.3321 | 0.1116 | -2.9764 | 0.0029 | 0.72 |
| sentido_nervioso4. Casi todos los días | -0.3416 | 0.1134 | -3.0128 | 0.0026 | 0.71 |
| horas_ocio | -0.0457 | 0.0139 | -3.3006 | 0.0010 | 0.96 |
| horas_domest | -0.0468 | 0.0163 | -2.8767 | 0.0040 | 0.95 |
| amigos | 0.0188 | 0.0089 | 2.1046 | 0.0353 | 1.02 |
| horas_ninos | -0.0268 | 0.0122 | -2.2008 | 0.0278 | 0.97 |
| nhijos | 0.0673 | 0.0376 | 1.7911 | 0.0733 | 1.07 |
| medio_amb | 0.0681 | 0.0497 | 1.3701 | 0.1706 | 1.07 |
| horas_dormir | -0.0907 | 0.0420 | -2.1622 | 0.0306 | 0.91 |
| dormir_normal2. Bajo | -0.2367 | 0.1135 | -2.0854 | 0.0370 | 0.79 |
| dormir_normal3. Alto | 0.1222 | 0.1527 | 0.8004 | 0.4235 | 1.13 |
| regionZC | 0.2039 | 0.1048 | 1.9455 | 0.0517 | 1.23 |
| regionZN | 0.1695 | 0.1014 | 1.6716 | 0.0946 | 1.18 |
| regionZS | 0.1265 | 0.1023 | 1.2359 | 0.2165 | 1.13 |
Se observa alta significancia de todas las variables, en el caso de las variables categóricas hay algunas categorías que aparecen con un valor p con alta probabilidad ya que no son significativamente diferentes de la categoría de referencia.
Algunas interpretaciones que podemos obtener:
salud (Nota a su salud actual): Por cada punto que mejora la evaluación de salud, la persona es un 19% de chance de estar más satisfecha.
estatura (Estatura en centímetros): Por cada centímetro que la persona es más alta, tiene una chance de soy tengo un 1% menos de chance de estar satisfecho. La razón es difícil de interpretar, se debe evaluar los outliers y si la estatura está relacionada con otros factores, por ejemplo, el sexo.
estado_civil (Estado Civil): Las personas casadas, convivientes sin AUC y convivientes con AUC, tienen más chance de estar satisfecho que el resto.
Las variables finales del modelo no tienen multicolinealidad, el Factor de Inflación de la Varianza es menor que 10 en todas las variables y se presenta en la siguiente tabla:
| GVIF | Df | GVIF^(1/(2*Df)) | |
|---|---|---|---|
| ingreso | 1.323070 | 4 | 1.035614 |
| salud | 1.167566 | 1 | 1.080540 |
| deprimido | 1.858330 | 3 | 1.108801 |
| trabajo_asc | 4.137362 | 5 | 1.152583 |
| prob_vivienda | 1.125580 | 1 | 1.060933 |
| sens_maltrato | 1.266235 | 4 | 1.029946 |
| confianza | 1.177677 | 4 | 1.020653 |
| estatura | 1.720995 | 1 | 1.311867 |
| estado_civil | 1.343289 | 7 | 1.021304 |
| inmigrante | 1.079796 | 2 | 1.019378 |
| sexo | 1.990898 | 1 | 1.410992 |
| trabajo | 3.479797 | 1 | 1.865422 |
| deudas | 1.381097 | 4 | 1.041185 |
| sentido_nervioso | 1.833306 | 3 | 1.106299 |
| horas_ocio | 1.901129 | 1 | 1.378814 |
| horas_domest | 1.559970 | 1 | 1.248987 |
| amigos | 1.107541 | 1 | 1.052398 |
| horas_ninos | 1.923635 | 1 | 1.386952 |
| nhijos | 1.427505 | 1 | 1.194783 |
| medio_amb | 1.194796 | 1 | 1.093067 |
| horas_dormir | 5.058218 | 1 | 2.249048 |
| dormir_normal | 4.906419 | 2 | 1.488302 |
| region | 1.176663 | 3 | 1.027485 |
La curva ROC y el AUC del modelo se presenta a continuación:
El modelo tiene un 78% de probabilidad de identificar correctamente los casos “Satisfechos” y los “No Satisfechos”.
Conclusión
Finalmente hemos seleccionado el modelo de regresión logística que contiene 22 variables. Es el que mejor generaliza según lo observado en la validación cruzada. Además, con el fin de poder otorgar una interpretación que sirva de orientación a la generación de políticas públicas. El modelo RandomForest es a nivel predictivo mejor en menos de un 1% en cuanto a sensibilidad, pero no generaliza de buena manera en la validación cruzada.
A partir de la interpretabilidad de estos modelos, pensamos apropiado su uso como recomendación para el desarrollo de políticas públicas, incluyendo las variables más determinantes y estableciendo a los sujetos “No satisfechos” como población objetivo a programas que mejoren su calidad de vida y satisfacción.
Sobre los resultados obtenidos, tenemos que las variables más relevantes se vinculan con la capacidad de distribución del presupuesto familiar, el pago de dudas, el estado actual de salud, entre otras. Por otro lado, personas que indican tener convivientes, o están casados y las mujeres se denominan como satisfechos con mayor frecuencia. Mientras que, quienes indican sentirse deprimidos y/o nerviosos tienen mayor chance de denominarse como “No satisfechos”. Finalmente, aun cuando en el análisis exploratorio nos pareció incidente las zonas geográficas con la variable objetivos, al modelar obtenemos resultados de bajan importancia al controlar otras variables.
Anexos
Coevaluación para cada integrante del grupo
Todo el equipo ha trabajado de manera colaborativa en el desarrollo del proyecto, nos hemos complementado bastante bien en cuanto a habilidades y conocimientos de las diferentes herramientas requeridas para el proyecto.
Creemos que todos deberíamos tener el mismo nivel de evaluación, por la dedicación y aporte al desarrollo del proyecto. De todas formas, a continuación, ponemos una evaluación individual para cada integrante y comentarios donde se destaca el aporte realizado por cada uno.
Ana María Alvarado: 7.0 - En el transcurso del proyecto mostró gran nivel de compromiso con el equipo, destaca en el apoyo del desarrollo metodológico gracias a su experiencia en el tema, sus conocimientos de R y gestiones de organización del equipo.
Ignacio Calderón: 7.0 - Durante el proyecto mostró su gran nivel de compromiso con el equipo, en la etapa inicial del proyecto fue analítico y proactivo en la selección del tema, aportó de gran manera en cuanto a conocimiento técnico y valiosa contribución en el desarrollo de las conclusiones y la presentación.
Jacinta Diestre: 7.0 - En el transcurso del proyecto mostró gran nivel de compromiso con el equipo, destaca por sus buenas ideas, experiencia en este tipo de modelamiento, conocimiento metodológico y valioso conocimiento del contexto del problema.
Gabriela Jeréz: 7.0 - Durante el proyecto mostró su gran nivel de compromiso con el equipo, destaca por su capacidad de interpretación de los resultados y hallazgos de los modelos, gran apoyo por su buen manejo del software R y desarrollo de análisis exploratorio.
Codigo R
## Proyecto Aprendizaje supervisado - MIA UC
## Julio 2022
## Ana Alvarado - Ignacio Calderón - Jacinta Diestre - Gabriela Jeréz
## Carga de paquetes ----------------------------------------------------------
library(haven)
library(skimr)
library(tidyverse)
library(naivebayes)
library(RColorBrewer)
library(randomForest)
library(caret)
# Carga de Datos ---------------------------------------------------------------
df <- read_dta("Base de datos EBS 2021 STATA.dta")
diccionario <- tibble(nombre = colnames(df),
etiqueta = map_chr(df, attr, "label"))
# Transformación e imputación de datos ----------------------------------------
df1 <- df %>%
mutate(region = case_when(region == 13 ~ "RM",
region %in% c(1,2,3,4,15) ~ "ZN",
region %in% c(5,6,7,8) ~ "ZC",
region %in% c(9,10,11,12,14,16) ~"ZS"),
indigena = haven::as_factor(indigena),
inmigrante = haven::as_factor(inmigrante),
pobreza = haven::as_factor(pobreza),
sexo = haven::as_factor(sexo),
# Modulo intresos
ingreso = haven::as_factor(i1),
deudas = haven::as_factor(i4),
satisfaccion = haven::as_factor(a1),
neduc = haven::as_factor(neduc_ebs),
# Módulo caracterización
npersonas = as.numeric(l0),
edad = as.numeric(l1),
nhijos = as.numeric(l3),
estado_civil = haven::as_factor(l2),
trabajo = as.factor(ifelse(is.na(l8), 3, haven::as_factor(l8))),
# Módulo trabajo
trabajo_rec = as.factor(ifelse(is.na(j2a_1), 0, haven::as_factor(j2a_1))),
trabajo_benef = as.factor(ifelse(is.na(j2a_2), 0, haven::as_factor(j2a_2))),
trabajo_flex = as.factor(ifelse(is.na(j2a_3), 0, haven::as_factor(j2a_3))),
trabajo_tele = as.factor(ifelse(is.na(j2a_4), 0, haven::as_factor(j2a_4))),
trabajo_asc = as.factor(ifelse(is.na(j2a_5), 0, haven::as_factor(j2a_5))),
trabajo_interac = as.factor(ifelse(is.na(j2a_6), 0, haven::as_factor(j2a_6))),
trabajo_redes = as.factor(ifelse(is.na(j3a_1), 0, haven::as_factor(j3a_1))),
trabajo_desarr = as.factor(ifelse(is.na(j3a_2), 0, haven::as_factor(j3a_2))),
# Módulo Balance vida y trabajo
horas_ninos = (as.numeric(substr(as.character(c1_1),1,2))*60+
as.numeric(substr(as.character(c1_1),4,5)))/60,
horas_domest = (as.numeric(substr(as.character(c1_2),1,2))*60+
as.numeric(substr(as.character(c1_2),4,5)))/60,
horas_traslado = (as.numeric(substr(as.character(c1_4),1,2))*60+
as.numeric(substr(as.character(c1_4),4,5)))/60,
horas_ocio = (as.numeric(substr(as.character(c1_5),1,2))*60+
as.numeric(substr(as.character(c1_5),4,5)))/60,
horas_dormir = (as.numeric(substr(as.character(c1_7),1,2))*60+
as.numeric(substr(as.character(c1_7),4,5)))/60,
dormir_normal = case_when(
horas_dormir <= 6 ~ "2. Bajo",
horas_dormir >= 10 ~ "3. Alto",
TRUE ~ "1. Normal" ),
# Modulo Relaciones Sociales
amigos = as.numeric(e1),
confianza = haven::as_factor(e4),
sens_maltrato = haven::as_factor(e5),
sens_maltrato_mujer = as.factor(ifelse(is.na(e7_1), 0, haven::as_factor(e7_1))),
sens_maltrato_orsex = as.factor(ifelse(is.na(e7_2), 0, haven::as_factor(e7_2))),
sens_maltrato_clase = as.factor(ifelse(is.na(e7_3), 0, haven::as_factor(e7_3))),
sens_maltrato_extranj = as.factor(ifelse(is.na(e7_4), 0, haven::as_factor(e7_4))),
sens_maltrato_edad = as.factor(ifelse(is.na(e7_5), 0, haven::as_factor(e7_5))),
sens_maltrato_indig = as.factor(ifelse(is.na(e7_6), 0, haven::as_factor(e7_6))),
sens_maltrato_disc = as.factor(ifelse(is.na(e7_7), 0, haven::as_factor(e7_7))),
# Modulo salud
salud = as.numeric(haven::as_factor(b1)),
estatura = as.numeric(b3),
peso = as.numeric(b4),
imc = peso/estatura^2,
int_hacer_cosas = haven::as_factor(b9_1),
deprimido = haven::as_factor(b9_2),
sentido_nervioso = haven::as_factor(b9_3),
preocupacion = haven::as_factor(b9_4),
# Modulo vivienda
prob_vivienda = (as.numeric(k3_1) + as.numeric(k3_2) +
as.numeric(k3_3) + as.numeric(k3_4)-4),
# Módulo calidad medio ambiental
visita_parques = haven::as_factor(g1),
medio_amb = (as.numeric(g2_1) + as.numeric(g2_2) +
as.numeric(g2_3))/4,
prob_medio_amb = (as.numeric(g3_1) + as.numeric(g3_2) + as.numeric(g3_3) +
as.numeric(g3_4) + as.numeric(g3_5) + as.numeric(g3_6) +
as.numeric(g3_7)-7),
prob_entorno = (as.numeric(g4_1) + as.numeric(g4_2) + as.numeric(g4_3) +
as.numeric(g4_4) + as.numeric(g4_5) - 5),
# Módulo seguridad física
victima_delito = haven::as_factor(h1),
presenciado_delito = (as.numeric(h3_1) + as.numeric(h3_2) + as.numeric(h3_3) +
as.numeric(h3_4) + as.numeric(h3_5) + as.numeric(h3_6))/6) %>%
select(satisfaccion, region, indigena, inmigrante, pobreza, sexo, estado_civil,
neduc, npersonas, edad, nhijos, trabajo, ingreso, deudas, trabajo_rec,
trabajo_benef, trabajo_flex, trabajo_tele, trabajo_asc, trabajo_interac,
trabajo_redes, trabajo_desarr, horas_ninos, horas_domest, horas_traslado,
horas_ocio, horas_dormir, dormir_normal,
amigos, confianza, sens_maltrato, sens_maltrato_mujer,sens_maltrato_orsex,
sens_maltrato_clase, sens_maltrato_extranj, sens_maltrato_edad,
sens_maltrato_indig, sens_maltrato_disc, salud, estatura, peso,
int_hacer_cosas, deprimido, sentido_nervioso, preocupacion, prob_vivienda,
visita_parques, medio_amb,
prob_medio_amb, prob_entorno, victima_delito, presenciado_delito , imc)
# Se ajustan niveles de estado civil
levels(df1$estado_civil)[2] <- "2. Conviviente sin AUC"
levels(df1$estado_civil)[3] <- "3. Conviviente con AUC"
# Se imputan horas 88 y 99
df1$horas_ninos[df1$horas_ninos>80] <- 0
df1$horas_domest[df1$horas_domest>80] <- 0
df1$horas_traslado[df1$horas_traslado>80] <- 0
df1$horas_traslado[is.na(df1$horas_traslado)]<-0 # las personas que no trabajan
df1$horas_ocio[df1$horas_ocio>80] <- 0
df1$horas_dormir[df1$horas_dormir>80] <- 0
df1$estatura[df1$estatura == 999] <- mean(df1$estatura) #imputar por knn
df1$peso[df1$peso == 999] <- mean(df1$peso) #imputar por knn
# Se crea variable imc (ya existe pero se reemplaza por las variables imputadas)
df1$imc = df1$peso/(df1$estatura/100)^2
# skimr::skim(df1)
# Análisis Exploratorio de Datos ----------------------------------------------
## Correlaciones variables continuas ------------------------------------------
corr <- df1 %>% select_if(is.numeric) %>% cor() %>% round(2)
ggcorrplot::ggcorrplot(corr, hc.order = TRUE, type = "lower",
outline.col = "white",
ggtheme = ggplot2::theme_bw,
colors = c("#6D9EC1", "white", "#E46726"))
## Asociación de variables categoricas ----------------------------------------
#H0: Las variables son independientes.
#H1: Las variables son dependientes y existe una relación entre ambas.
chisq.test(df1$satisfaccion, df1$sexo) # hay asociación
chisq.test(df1$satisfaccion, df1$region) # hay asociación
chisq.test(df1$satisfaccion, df1$neduc) # hay asociación
chisq.test(df1$satisfaccion, df1$trabajo) # hay asociación
chisq.test(df1$satisfaccion, df1$estado_civil) # hay asociación
chisq.test(df1$estado_civil, df1$sexo) # hay asociación
chisq.test(df1$estado_civil, df1$region) # hay asociación
chisq.test(df1$estado_civil, df1$neduc) # hay asociación
chisq.test(df1$estado_civil, df1$trabajo) # hay asociación
chisq.test(df1$estado_civil, df1$amigos) # hay asociación
## Análisis descriptivo -------------------
df_ex <- df1
g00 <- naniar::gg_miss_fct(x = df_ex, fct = satisfaccion) +
labs(title = "NA en la variable de interés")
## Variable de Interés -----------------------------
g0 <- df_ex %>%
ggplot() +
geom_bar(aes(y = satisfaccion , x = stat(prop),
group = 1), stat= "count", fill = "lightblue") +
geom_text( aes(label = stat(scales::percent(prop,accuracy = 0.1)),
y = satisfaccion,
x = stat(prop), group=1),
stat = "count", hjust=-0.1)+
theme_bw()+
theme(legend.position = "none")+
labs(title ='¿Cuán satisfecho(a) está con su vida \n en este momento?',
y = "Satisfacción", x = "Proporción")+
scale_x_continuous(labels = scales::percent, limits = c(0,0.85))
df_ex$satisfaccion <- as.numeric(df_ex$satisfaccion)
df_ex$satisfaccion[df_ex$satisfaccion %in% c(1,2,3)] <- "No satisfecho/a"
df_ex$satisfaccion[df_ex$satisfaccion %in% c(4,5)] <- "Satisfecho/a"
g0_0 <- df_ex %>%
ggplot() +
geom_bar(aes(y = satisfaccion , x = stat(prop),
group = 1), stat= "count", fill = "lightblue") +
geom_text( aes(label = stat(scales::percent(prop,accuracy = 0.1)),
y = satisfaccion,
x = stat(prop), group=1),
stat = "count", hjust=-0.1)+
theme_bw()+
theme(legend.position = "none")+
labs(title ='¿Cuán satisfecho(a) está con su vida \n en este momento?',
y = "Satisfacción", x = "Proporción")+
scale_x_continuous(labels = scales::percent, limits = c(0,0.8))
## Caracterización de la muestra -----------------------------------------------
g1 <- df %>%
ggplot() +
geom_bar(aes(y = factor(region), x = stat(prop),
group = 1), stat= "count", fill = "lightblue") +
geom_text( aes(label = stat(scales::percent(prop,accuracy = 0.1)),
y = factor(region),
x = stat(prop), group=1),
stat = "count", hjust=-0.1)+
theme_bw()+
theme(legend.position = "none")+
scale_x_continuous(labels = scales::percent, limit = c(0,0.12))+
labs(title ="Distribucion por Región",y = "Región", x = "Proporción")
# ¿Cuál es la población objetivo de la encuesta?. Todo el país.
g1_1 <- df_ex %>%
ggplot() +
geom_bar(aes(y = factor(region), x = stat(prop),
group = 1), stat= "count", fill = "lightblue") +
geom_text( aes(label = stat(scales::percent(prop,accuracy = 0.1)),
y = factor(region),
x = stat(prop), group=1),
stat = "count", hjust=-0.1)+
theme_bw()+
theme(legend.position = "none")+
scale_x_continuous(labels = scales::percent, limit = c(0,0.4))+
labs(title ="Distribución por Región",y = "Región", x = "Proporción")
g2 <- df_ex %>%
ggplot() +
geom_bar(aes(x = sexo , y = stat(prop),
group = 1), stat= "count", fill = "lightblue") +
geom_text( aes(label = stat(scales::percent(prop,accuracy = 0.1)),
x = factor(sexo),
y = stat(prop), group=1),
stat = "count", vjust=-0.3)+
theme_bw()+
theme(legend.position = "none")+
scale_y_continuous(labels = scales::percent)+
labs(title ="Distribución por Sexo",x = "Sexo", y = "Proporción")
g2
g3 <- df_ex %>%
ggplot() +
geom_histogram(aes(x = edad), col = "white", fill = "lightblue", bins = 30) +
theme_bw()+
theme(legend.position = "none")+
scale_x_continuous(breaks = seq(0,100, by = 10))+
labs(title ="Distribución por Edad",y = "Cantidad", x = "Edad")
g3
g4 <- df_ex %>%
ggplot() +
geom_bar(aes(x = nhijos), col = "white", fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ="Distribución Cantidad de Hijos",
y = "Cantidad", x = "Cantidad de Hijos")
g4
# gridExtra::grid.arrange(g1, g2, g3, g4, ncol = 2)
g5 <- df_ex %>%
ggplot() +
geom_bar(aes(y = estado_civil , x = stat(prop),
group = 1), stat= "count", fill = "lightblue") +
geom_text( aes(label = stat(scales::percent(prop,accuracy = 0.1)),
y = estado_civil,
x = stat(prop), group=1),
stat = "count", hjust=-0.1)+
theme_bw()+
theme(legend.position = "none")+
labs(title ="Distribución por Estado Civil",
y = "Estado Civil", x = "Proproción")+
scale_x_continuous(labels = scales::percent, limit = c(0,0.45))
g5
## Análisis multivariado ----------------------
# Macrozona País vs variable respuesta
g1_1_1 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = region))+
facet_grid(cols = vars(region))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Macrozona País")
g1_1_1
# Sexo vs variable respuesta
g2_1 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sexo))+
facet_grid(cols = vars(sexo))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sexo")
g2_1
# Edad vs variable respuesta
g3_1 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = edad , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfaccion vs Edad',
y = "Edad", x = "Satisfacción")
g3_1
# Número de hijos vs variable respuesta
df_ex$nhijos_f <- rep("NA",length(df_ex$nhijos))
df_ex$nhijos_f[df_ex$nhijos==0] <- "0. Sin hijos"
df_ex$nhijos_f[df_ex$nhijos==1] <- "1. Un hijo"
df_ex$nhijos_f[df_ex$nhijos %in% c(2,3)] <- "2. Dos a tres hijos"
df_ex$nhijos_f[df_ex$nhijos %in% c(4,5,6)] <- "3. Cuatro hijos o más"
g4_1 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = nhijos_f))+
facet_grid(cols = vars(nhijos_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Número de hijos")
g4_1
# Estado civil
g5_1 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = estado_civil))+
facet_grid(cols = vars(estado_civil))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Estado civil")
g5_1
# Indígena vs variable respuesta
g6_1 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = indigena))+
facet_grid(cols = vars(indigena))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nPertenencia a pueblos indígenas")
g6_1
# Inmigrante vs variable respuesta
g6_2 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = inmigrante))+
facet_grid(cols = vars(inmigrante))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nInmigrante")
g6_2
# Pobreza vs variable respuesta
g6_3 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = pobreza))+
facet_grid(cols = vars(pobreza))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nÍndice de pobreza")
g6_3
# Nivel de ingresos
levels(df_ex$ingreso)[1] <- "1. Muchas dificultades"
levels(df_ex$ingreso)[2] <- "2. Algunas dificultades"
levels(df_ex$ingreso)[3] <- "3. Les alcanzó justo"
levels(df_ex$ingreso)[4] <- "4. Les alcanzó bien"
g7 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = ingreso))+
facet_grid(cols = vars(ingreso))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Ingreso")
g7
# Nivel educacional
g8 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = neduc))+
facet_grid(cols = vars(neduc))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Educación")
g8
# personas compartiendo hogar
df_ex$npersonas_f <- rep("NA",length(df_ex$npersonas))
df_ex$npersonas_f[df_ex$npersonas==1] <- "1. Vive solo"
df_ex$npersonas_f[df_ex$npersonas %in% c(2,3,4,5)] <- "2. Comparte con hasta cuatro personas"
df_ex$npersonas_f[df_ex$npersonas %in% c(6,7,8,9,10)] <- "3. Comparte con cinco a nueve personas"
df_ex$npersonas_f[df_ex$npersonas %in% c(11,12,13,14,15,16,17,18,19)] <- "4. Comparte con más de diez personas"
g9 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = npersonas_f))+
facet_grid(cols = vars(npersonas_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Número de personas con el que comparte hogar")
g9
# Trabajo
df_ex$trabajo <- as.factor(df_ex$trabajo)
levels(df_ex$trabajo)[1] <- "1. Sí"
levels(df_ex$trabajo)[2] <- "2. No"
g10 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo))+
facet_grid(cols = vars(trabajo))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Tiene o no trabajo")
g10
# Deudas
g11 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = deudas))+
facet_grid(cols = vars(deudas))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Tiene o no deudas")
g11
# Reconocimiento en el trabajo
df_ex$trabajo_rec_f <- rep("3. No trabaja ",length(df_ex$trabajo_rec))
df_ex$trabajo_rec_f[df_ex$trabajo_rec %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_rec_f[df_ex$trabajo_rec %in% c(3,4,5)] <- "2. Sí"
g12 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_rec_f))+
facet_grid(cols = vars(trabajo_rec_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nReconocimiento en el trabajo")
g12
# Beneficios laborales
df_ex$trabajo_benef_f <- rep("3. No trabaja",length(df_ex$trabajo_benef))
df_ex$trabajo_benef_f[df_ex$trabajo_benef %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_benef_f[df_ex$trabajo_benef %in% c(3,4,5)] <- "2. Sí"
g13 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_benef_f))+
facet_grid(cols = vars(trabajo_benef_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nBeneficios laborales")
g13
# Flexibilidad horaria en el trabajo
df_ex$trabajo_flex_f <- rep("3. No trabaja",length(df_ex$trabajo_flex))
df_ex$trabajo_flex_f[df_ex$trabajo_flex %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_flex_f[df_ex$trabajo_flex %in% c(3,4,5)] <- "2. Sí"
g14 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_flex_f))+
facet_grid(cols = vars(trabajo_flex_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nFlexibilidad horaria en el trabajo")
g14
# Puede realizar teletrabajo
df_ex$trabajo_tele_f <- rep("3. No trabaja",length(df_ex$trabajo_tele))
df_ex$trabajo_tele_f[df_ex$trabajo_tele %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_tele_f[df_ex$trabajo_tele %in% c(3,4,5)] <- "2. Sí"
g15 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_tele_f))+
facet_grid(cols = vars(trabajo_tele_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nPuede realizar teletrabajo")
g15
# Posibilidad de ascender en el trabajo
df_ex$trabajo_asc_f <- rep("3. No trabaja",length(df_ex$trabajo_asc))
df_ex$trabajo_asc_f[df_ex$trabajo_asc %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_asc_f[df_ex$trabajo_asc %in% c(3,4,5)] <- "2. Sí"
g16 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_asc_f))+
facet_grid(cols = vars(trabajo_asc_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nPosibilidad de ascender en el trabajo")
# Buen ambiente laboral
df_ex$trabajo_interac_f <- rep("3. No trabaja",length(df_ex$trabajo_interac))
df_ex$trabajo_interac_f[df_ex$trabajo_interac %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_interac_f[df_ex$trabajo_interac %in% c(3,4,5)] <- "2. Sí"
g17 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_interac_f))+
facet_grid(cols = vars(trabajo_interac_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nBuen ambiente laboral")
g17
# Tener conocidos para mejorar empleabilidad
df_ex$trabajo_redes_f <- rep("3. No trabaja",length(df_ex$trabajo_redes))
df_ex$trabajo_redes_f[df_ex$trabajo_redes %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_redes_f[df_ex$trabajo_redes %in% c(3,4,5)] <- "2. Sí"
g18 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_redes_f))+
facet_grid(cols = vars(trabajo_redes_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nTener conocidos para mejorar empleabilidad")
# Desarrollo de habilidades en el trabajo
df_ex$trabajo_desarr_f <- rep("3. No trabaja",length(df_ex$trabajo_desarr))
df_ex$trabajo_desarr_f[df_ex$trabajo_desarr %in% c(1,2)] <- "1. No o muy poco"
df_ex$trabajo_desarr_f[df_ex$trabajo_desarr %in% c(3,4,5)] <- "2. Sí"
g19 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = trabajo_desarr_f))+
facet_grid(cols = vars(trabajo_desarr_f))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nDesarrollo de sus habilidades en el trabajo")
# Horas de Cuidado de niños o enfermos
df_ex$horas_ninos[df_ex$horas_ninos==0] <- NA
g20 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = horas_ninos , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfacción vs \nHoras de Cuidado de niños o enfermos',
y = "Horas de Cuidado de niños o enfermos", x = "Satisfacción")
# Horas de trabajo no remunerado en el hogar
df_ex$horas_domest[df_ex$horas_domest==0] <- NA
g21 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = horas_domest , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfacción vs \nHoras de trabajo no remunerado en el hogar',
y = "Horas de trabajo no remunerado en el hogar", x = "Satisfacción")
# Horas en trasladarse al lugar de trabajo
df_ex$horas_traslado[df_ex$horas_traslado==0] <- NA
g22 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = horas_traslado , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfacción vs \nHoras en trasladarse al lugar de trabajo',
y = "Horas en trasladarse al lugar de trabajo", x = "Satisfacción")
# Horas de ocio
g23 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = horas_ocio , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfacción vs \nHoras de ocio',
y = "Horas de ocio", x = "Satisfacción")
# Horas de sueño
df_ex$horas_dormir[df_ex$horas_dormir==0] <- NA
g24 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = horas_dormir , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfacción vs \nHoras de sueño',
y = "Horas de sueño", x = "Satisfacción")
g24_1 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = dormir_normal))+
facet_grid(cols = vars(dormir_normal))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Calidad de sueño")
# amigos
g25 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = amigos , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfacción vs Número de amigos cercanos',
y = "Número de amigos cercanos", x = "Satisfacción")
# confianza
g26 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = confianza))+
facet_grid(cols = vars(confianza))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Confianza en las personas")
# sens_maltrato
g27 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato))+
facet_grid(cols = vars(sens_maltrato))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato")
# sens_maltrato_mujer
df_ex$sens_maltrato_mujer<- as.numeric(df_ex$sens_maltrato_mujer)
df_ex$sens_maltrato_mujer[df_ex$sens_maltrato_mujer==0] <- "0. No responde"
df_ex$sens_maltrato_mujer[df_ex$sens_maltrato_mujer==1] <- "1. Sí"
df_ex$sens_maltrato_mujer[df_ex$sens_maltrato_mujer==2] <- "2. No"
g28 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_mujer))+
facet_grid(cols = vars(sens_maltrato_mujer))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por género")
# sens_maltrato_orsex
df_ex$sens_maltrato_orsex<- as.numeric(df_ex$sens_maltrato_orsex)
df_ex$sens_maltrato_orsex[df_ex$sens_maltrato_orsex==0] <- "0. No responde"
df_ex$sens_maltrato_orsex[df_ex$sens_maltrato_orsex==1] <- "1. Sí"
df_ex$sens_maltrato_orsex[df_ex$sens_maltrato_orsex==2] <- "2. No"
g29 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_orsex))+
facet_grid(cols = vars(sens_maltrato_orsex))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por orientación sexual")
# sens_maltrato_clase
df_ex$sens_maltrato_clase<- as.numeric(df_ex$sens_maltrato_clase)
df_ex$sens_maltrato_clase[df_ex$sens_maltrato_clase==0] <- "0. No responde"
df_ex$sens_maltrato_clase[df_ex$sens_maltrato_clase==1] <- "1. Sí"
df_ex$sens_maltrato_clase[df_ex$sens_maltrato_clase==2] <- "2. No"
g30 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_clase))+
facet_grid(cols = vars(sens_maltrato_clase))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por clase social")
# sens_maltrato_extranj
df_ex$sens_maltrato_extranj<- as.numeric(df_ex$sens_maltrato_extranj)
df_ex$sens_maltrato_extranj[df_ex$sens_maltrato_extranj==0] <- "0. No responde"
df_ex$sens_maltrato_extranj[df_ex$sens_maltrato_extranj==1] <- "1. Sí"
df_ex$sens_maltrato_extranj[df_ex$sens_maltrato_extranj==2] <- "2. No"
g31 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_extranj))+
facet_grid(cols = vars(sens_maltrato_extranj))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por ser extranjero")
# sens_maltrato_edad
df_ex$sens_maltrato_edad<- as.numeric(df_ex$sens_maltrato_edad)
df_ex$sens_maltrato_edad[df_ex$sens_maltrato_edad==0] <- "0. No responde"
df_ex$sens_maltrato_edad[df_ex$sens_maltrato_edad==1] <- "1. Sí"
df_ex$sens_maltrato_edad[df_ex$sens_maltrato_edad==2] <- "2. No"
g31 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_edad))+
facet_grid(cols = vars(sens_maltrato_edad))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por su edad")
# sens_maltrato_indig
df_ex$sens_maltrato_indig<- as.numeric(df_ex$sens_maltrato_indig)
df_ex$sens_maltrato_indig[df_ex$sens_maltrato_indig==0] <- "0. No responde"
df_ex$sens_maltrato_indig[df_ex$sens_maltrato_indig==1] <- "1. Sí"
df_ex$sens_maltrato_indig[df_ex$sens_maltrato_indig==2] <- "2. No"
g32 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_indig))+
facet_grid(cols = vars(sens_maltrato_indig))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por su origen")
# sens_maltrato_disc
df_ex$sens_maltrato_disc<- as.numeric(df_ex$sens_maltrato_disc)
df_ex$sens_maltrato_disc[df_ex$sens_maltrato_disc==0] <- "0. No responde"
df_ex$sens_maltrato_disc[df_ex$sens_maltrato_disc==1] <- "1. Sí"
df_ex$sens_maltrato_disc[df_ex$sens_maltrato_disc==2] <- "2. No"
g33 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sens_maltrato_disc))+
facet_grid(cols = vars(sens_maltrato_disc))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Sentimiento de maltrato por discapacidad")
# salud
df_ex$salud <- as.factor(df_ex$salud)
levels(df_ex$salud)[1] <- "1. Muy malo"
levels(df_ex$salud)[2] <- "2. Malo"
levels(df_ex$salud)[3] <- "3. No tan malo"
levels(df_ex$salud)[4] <- "4. Regular"
levels(df_ex$salud)[5] <- "5. No tan bueno"
levels(df_ex$salud)[6] <- "6. Bueno"
levels(df_ex$salud)[7] <- "7. Muy bueno"
g34 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = salud))+
facet_grid(cols = vars(salud))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs Estado de salud")
# estatura
g35 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = estatura , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Nivel de satisfacción con la vida vs Estatura',
y = "Estatura en metros", x = "Satisfacción")
# peso
g36 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = peso , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Nivel de satisfacción con la vida vs Peso',
y = "Peso en kilos", x = "Satisfacción")
# IMC
g36_1 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = imc , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Nivel de satisfacción con la vida vs IMC',
y = "IMC", x = "Satisfacción")
# b9_1 Poco interés o placer en hacer cosas
g37 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = int_hacer_cosas))+
facet_grid(cols = vars(int_hacer_cosas))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nPoco interés o placer en hacer cosas")
# b9_2 Se ha sentido decaído(a), deprimido(a) o sin esperanzas
g38 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = deprimido))+
facet_grid(cols = vars(deprimido))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nSe ha sentido decaído(a), deprimido(a) o sin esperanzas")
# b9_3 Se ha sentido nervioso(a), ansioso(a) o con los nervios de punta
g39 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = sentido_nervioso))+
facet_grid(cols = vars(sentido_nervioso))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nSe ha sentido nervioso(a), ansioso(a) o con los nervios de punta")
# b9_4 No ha sido capaz de parar o controlar su preocupación
g40 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = preocupacion))+
facet_grid(cols = vars(preocupacion))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nNo ha sido capaz de parar o controlar su preocupación")
# Problemas en la vivienda
df_ex$prob_vivienda[df_ex$prob_vivienda==0] <- "0. Mala"
df_ex$prob_vivienda[df_ex$prob_vivienda==1] <- "1. Regular mala"
df_ex$prob_vivienda[df_ex$prob_vivienda==2] <- "2. Regular"
df_ex$prob_vivienda[df_ex$prob_vivienda==3] <- "3. Regular buena"
df_ex$prob_vivienda[df_ex$prob_vivienda==4] <- "4. Buena"
df_ex$prob_vivienda <- as.factor(df_ex$prob_vivienda)
g41 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = prob_vivienda))+
facet_grid(cols = vars(prob_vivienda))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nCalidad de la vivienda")
# visita_parques
g42 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = visita_parques))+
facet_grid(cols = vars(visita_parques))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nVisita a parques")
# medio_amb
g43 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = medio_amb , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Nivel de satisfacción con la vida vs Calidad de Medio Ambiente',
y = "Calidad de Medio Ambiente", x = "Satisfacción")
# prob_medio_amb
df_ex$prob_medio_amb[df_ex$prob_medio_amb %in% c(0,1)] <- "0. Mala"
df_ex$prob_medio_amb[df_ex$prob_medio_amb %in% c(2,3)] <- "1. Regular mala"
df_ex$prob_medio_amb[df_ex$prob_medio_amb==4] <- "2. Regular"
df_ex$prob_medio_amb[df_ex$prob_medio_amb %in% c(5,6)] <- "3. Regular buena"
df_ex$prob_medio_amb[df_ex$prob_medio_amb==7] <- "4. Buena"
df_ex$prob_medio_amb <- as.factor(df_ex$prob_medio_amb)
g44 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = prob_medio_amb))+
facet_grid(cols = vars(prob_medio_amb))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nProblemáticas del medio ambiente")
# prob_medio_amb
df_ex$prob_entorno[df_ex$prob_entorno %in% c(0,1)] <- "0. Mala"
df_ex$prob_entorno[df_ex$prob_entorno %in% c(2,3)] <- "1. Regular mala"
df_ex$prob_entorno[df_ex$prob_entorno==4] <- "2. Regular"
df_ex$prob_entorno[df_ex$prob_entorno %in% c(5,6)] <- "3. Regular buena"
df_ex$prob_entorno[df_ex$prob_entorno==7] <- "4. Buena"
df_ex$prob_entorno <- as.factor(df_ex$prob_entorno)
g45 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = prob_entorno))+
facet_grid(cols = vars(prob_entorno))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nProblemas del entorno")
# victima_delito
g46 <- df_ex %>%
ggplot() +
geom_bar(aes(x = satisfaccion , y = stat(prop), group = 1, fill = victima_delito))+
facet_grid(cols = vars(victima_delito))+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Proporción", title = "Satisfaccion vs \nVeces que ha sido víctima de delito")
# presenciado_delito
g47 <- df_ex %>%
ggplot() +
geom_boxplot(aes(y = presenciado_delito , x = satisfaccion), fill = "lightblue") +
theme_bw()+
theme(legend.position = "none")+
labs(title ='Satisfaccion vs Presenciado delito',
y = "Presenciado delito", x = "Satisfacción")
# Modelo ---------------------------------------
df2 <- df1 %>%
mutate(y = case_when(satisfaccion %in%
c("5. Totalmente satisfecho", "4. Satisfecho") ~ 1,
TRUE ~ 0)) %>%
select(-satisfaccion)
set.seed(93)
indice <- sample(1:length(df2$y), size = length(df2$y)*0.8, replace = F )
train <- df2[indice,]
test <- df2[-indice,]
# dim(train)
# dim(test)
### Balanceo de la muestra de entrenamiento -------------------------
t_balanceo <- round(prop.table(table(factor(train$y, labels = c("No Satisfecho", "Satisfecho"))))*100, 2)
# 21% No Satisfecho
# 78% satisfecho
# Mezcla de oversampling y undersampling.
#positivos <- train[train$y == 1, ]
#negativos <- train[train$y == 0, ]
#indice2 <- sample(1:length(positivos$y), size = length(positivos$y)*0.4)
#indice3 <- sample(1:length(negativos$y), size = length(negativos$y)*0.5)
#positivos <- positivos[-indice2,]
#negativos <- negativos[indice3,] %>% bind_rows(negativos)
#train <- bind_rows(positivos, negativos)
#prop.table(table(train$y))
# Se decide no realizar balanceo de la muestra, ya que el modelo clasifica bien
# sin balancear, sin embargo, se modifica el punto de corte para ajustar
# la clasificación.
# Seleccion de Modelos -------------------------------------------------------
glm_completo <- glm(y ~ ., data = train, family = "binomial")
glm_nulo <- glm(y ~ 1, data = train, family = "binomial")
summary(glm_completo)
### Método Forward ---------------------------------------------------------------
#glm_forward <- step(glm_nulo, scope = formula(glm_completo), direction = "forward")
# summary(glm_forward)
# y ~ deprimido + ingreso + salud + trabajo_asc +
# prob_vivienda + sens_maltrato + confianza + sexo + estado_civil +
# inmigrante + trabajo + sentido_nervioso + deudas + trabajo_rec +
# horas_ocio + horas_domest + estatura + amigos + trabajo_tele +
# horas_ninos + nhijos + medio_amb
glm_forward <- glm(y ~ deprimido + ingreso + salud + trabajo_asc + prob_vivienda +
sens_maltrato + confianza + sexo + estado_civil + inmigrante +
trabajo + sentido_nervioso + deudas + trabajo_rec + horas_ocio +
horas_domest + estatura + amigos + trabajo_tele + horas_ninos +
nhijos + medio_amb,
data = train, family = "binomial")
# sens_maltrato_indig + horas_dormir + dormir_normal
### Método Backward ----------------------------------------------------------------
# glm_backward <- step(glm_completo, direction = "backward")
# summary(glm_backward)
# y ~ inmigrante + sexo + estado_civil + nhijos +
# trabajo + ingreso + deudas + trabajo_rec + trabajo_tele +
# trabajo_asc + horas_ninos + horas_domest + horas_ocio + horas_dormir +
# dormir_normal + amigos + confianza + sens_maltrato + salud +
# estatura + deprimido + sentido_nervioso + prob_vivienda + medio_amb
# Mismas variables que forward
glm_backward <- glm(formula = y ~ inmigrante + sexo + estado_civil + nhijos +
trabajo + ingreso + deudas + trabajo_rec + trabajo_tele +
trabajo_asc + horas_ninos + horas_domest + horas_ocio + horas_dormir +
dormir_normal + amigos + confianza + sens_maltrato + salud +
estatura + deprimido + sentido_nervioso + prob_vivienda +
medio_amb, family = "binomial", data = train)
### Método Both ----------------------------------------------------------------
# glm_both <- step(glm_nulo, scope = formula(glm_completo), direction = "both")
# summary(glm_both)
# Se deja comentado para que no se ejecute en el informe, ya que tarda unos minutos.
# y ~ deprimido + ingreso + salud + trabajo_asc +
# prob_vivienda + sens_maltrato + confianza + estatura + estado_civil +
# inmigrante + sexo + trabajo + trabajo_rec + deudas + sentido_nervioso +
# horas_ocio + horas_domest + amigos + trabajo_tele + horas_ninos +
# nhijos + medio_amb + horas_dormir + dormir_normal
# Mismo modelo que forward
glm_both <- glm(formula = y ~ deprimido + ingreso + salud + trabajo_asc +
prob_vivienda + sens_maltrato + confianza + sexo + estado_civil +
inmigrante + trabajo + sentido_nervioso + deudas + trabajo_rec +
horas_ocio + horas_domest + estatura + amigos + trabajo_tele +
horas_ninos + nhijos + medio_amb, family = "binomial", data = train)
f1 <- tibble(Variable = rownames(summary(glm_forward)$coefficients),
Forward = rep("x", length(Variable)))
f2 <- tibble(Variable = rownames(summary(glm_backward)$coefficients),
Backward = rep("x", length(Variable)))
f3 <- tibble(Variable = rownames(summary(glm_both)$coefficients),
Both = rep("x", length(Variable)))
met_selec <- f1 %>% full_join(f2) %>% full_join(f3) %>% arrange(Variable)
# write_csv(met_selec, "met_sel.csv")
### Modelo seleccionado -------------------------------------------------------
# Se eliminan las variables colineales algunas variables para dar más sentido.
# Trabajo_rec., trabajo_asc, sens_maltrato_indig
glm_final <- glm(y ~ ingreso + salud + deprimido + trabajo_asc + prob_vivienda +
sens_maltrato + confianza + estatura + estado_civil +
inmigrante + sexo + trabajo + deudas + sentido_nervioso +
horas_ocio + horas_domest + amigos + horas_ninos +
nhijos + medio_amb + horas_dormir + dormir_normal + region,
data = train, family = "binomial")
logistica_final <- summary(glm_final)
coef <- data.frame(round(logistica_final$coefficients,4))
coef$exp <- round(exp(coef[,1]),2)
# write.csv(coef, "coeficientes.csv")
car::vif(glm_final) # no existe multicolinealidad.
summary(glm_final)
## Definición punto de corte ------------------------------------------------
probs <- predict.glm(glm_final, type = "response", newdata = test)
reales <- factor(test$y, labels = c("No Satisfecho", "Satisfecho"))
g_boxplot_res <- tibble(probabilidad = probs, reales= factor(reales)) %>%
ggplot() +
geom_boxplot(aes(x = reales , y = probabilidad), fill = "lightblue")+
theme_bw() +
theme(legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1) )+
labs(y ="Probabilidad", title = "Valores reales vs probabilidad predicha", x = "")+
geom_hline(yintercept = 0.77, col = "red", linetype = "dashed")
g_boxplot_res
# punto de corte optimo
## la métrica de desempeño de interés es la sensitividad.
# De todas formas se observa el comportamiento de otras.
corte <- InformationValue::optimalCutoff(as.numeric(reales), probs,
returnDiagnostics = T,
optimiseFor = "misclasserror")
corte
1-corte$optimalCutoff
#plot(corte$sensitivityTable)
F1_score <- c()
p <- c()
s <- c()
e <- c()
corte <- seq(0.14,0.90, by = 0.02)
for(i in 1:length(corte)){
predicciones <- factor(as.numeric(probs > corte[i]), labels = c("No Satisfecho", "Satisfecho"))
p[i] <- caret::precision(table(predicciones,reales), relevant = "No Satisfecho")
s[i] <- caret::sensitivity(table(predicciones,reales), relevant = "No Satisfecho")
e[i] <- caret::specificity(table(predicciones,reales), relevant = "No Satisfecho")
F1_score[i] <- (2*s[i]*p[i])/(s[i]+p[i])
}
metricas <- tibble(F1_Score = F1_score, Punto_Corte = corte, Sensitividad = s,
Precision = p, Especificidad = e)
g_punto_corte <- metricas %>%
ggplot() +
geom_line(aes(y = Especificidad, x = Punto_Corte, col = "Especificidad"), size = 0.8) +
geom_line(aes(y = Sensitividad, x = Punto_Corte, col = "Sensibilidad"), size = 0.8)+
#geom_line(aes(y = Precision, x = Punto_Corte, col = "Precisión"), size = 0.8)+
geom_line(aes(y = F1_score, x = Punto_Corte, col = "F1_Score"), size = 0.8)+
scale_x_continuous(breaks = seq(0.1,0.9, 0.05))+
labs(y = "Indicador", x = "Punto de corte", title = "Punto de Corte Óptimo",
col = "Medida")+
theme_bw()
g_punto_corte
# Sensibilidad, es la capacidad de detectar a los "no satisfechos", entre todos
# los no satisfechos.
# De todos los "no satisfecho" marcados como "no satisfechos" cuantos eran realmente
# "no satisfechos".
## Métricas de desempeño del modelo ------------------------------------------
corte_def <- 0.78
predicciones <- factor(as.numeric(probs > corte_def), labels = c("No Satisfecho", "Satisfecho"))
table(predicciones,reales)
p <- caret::precision(table(predicciones,reales), relevant = "No Satisfecho")
s <- caret::sensitivity(table(predicciones,reales), relevant = "No Satisfecho")
e <- caret::specificity(table(predicciones,reales), relevant = "No Satisfecho")
F1_score <- (2*s*p)/(s+p)
c(p, s, e, F1_score)
#### Matriz de confusión -----------------------------------------------------
indicadores_logistica <- caret::confusionMatrix(factor(predicciones),
factor(reales), positive = "No Satisfecho",
dnn = c("Prediction", "Reference"))
tabla_log <- data.frame(table(predicciones,reales))
g_mconf_logistica <- ggplot(data = tabla_log, mapping = aes(x = reales, y = predicciones)) +
geom_tile(aes(fill = Freq), colour = "white") +
geom_text(aes(label = sprintf("%1.0f", Freq)), vjust = 1) +
scale_fill_gradient2(low = "#efedf5", high = "#756bb1") +
theme_bw() + theme(legend.position = "none")+
ylim(rev(levels(tabla_log$predicciones)))+
labs(x = "Valores Reales", y = "Valores Predichos")
g_mconf_logistica
#### Curva ROC --------------------------------------------------------------
InformationValue::plotROC(as.numeric(reales)-1, probs)
# El área bajo la curva ROC es un 78%
# Es decir, hay un 78% de probabilidad de que el modelo asigne una probabilidad
# más alta a un caso positivo que a uno negativo.
# un 78% de predecir bien a una persona con satisfecha y otra no satisfecha.
# Naive bayes --------------------------------------------------------------
train$y <- factor(as.numeric(train$y))
naive <- naive_bayes(y ~ deprimido + ingreso + salud + trabajo_asc + prob_vivienda +
sens_maltrato + confianza + estatura + estado_civil +
inmigrante + sexo + trabajo + deudas + sentido_nervioso +
horas_ocio + horas_domest + amigos + horas_ninos +
nhijos + medio_amb + horas_dormir + dormir_normal + region,
data = train)
summarynaive <- summary(naive)
seleccionadas <- c("deprimido", "ingreso", "salud", "trabajo_asc", "prob_vivienda",
"sens_maltrato", "confianza", "estatura", "estado_civil",
"inmigrante", "sexo", "trabajo","deudas", "sentido_nervioso",
"horas_ocio", "horas_domest", "amigos", "horas_ninos",
"nhijos", "medio_amb", "horas_dormir", "dormir_normal", "region")
pred.naive <- as.numeric(predict(naive, newdata = test[,seleccionadas]))-1
table(pred.naive, test$y)
indicadores_naive_bayes <- caret::confusionMatrix(factor(pred.naive),
factor(test$y), positive = "0",
dnn = c("Prediction", "Reference"))
tabla_naive <- data.frame(table(factor(pred.naive,
labels = c("No Satisfecho", "Satisfecho")),reales))
g_mconf_naive <- ggplot(data = tabla_naive, mapping = aes(x = reales, y = Var1)) +
geom_tile(aes(fill = Freq), colour = "white") +
geom_text(aes(label = sprintf("%1.0f", Freq)), vjust = 1) +
scale_fill_gradient2(low = "#efedf5", high = "#756bb1") +
theme_bw() + theme(legend.position = "none")+
ylim(rev(levels(tabla_naive$Var1)))+
labs(x = "Valores Reales", y = "Valores Predichos")
g_mconf_naive
Grid <- data.frame(usekernel=TRUE,laplace = 0,adjust=1)
naive2 = train(y ~ ., data = train, method = "naive_bayes",
trControl = trainControl(),
tuneGrid = Grid)
# caret::varImp(naive2)
# Random Forest -----------------------------------------------------------------
rand.forest <- randomForest(y ~ .,
data=train, ntree = 400,
mtry = 30,
cutoff = c(0.25,0.75))
rand.forest
imp <- rand.forest$importance
rownames(imp)
importancia <- tibble(Variable = rownames(imp), Importancia = imp) %>%
arrange(desc(Importancia))
gg_importancia <- importancia[1:40,] %>%
ggplot(aes(x = Importancia, y = reorder(Variable, Importancia)))+
geom_bar(stat="identity", position="dodge", fill = "lightblue")+
labs(title = "Importancia de las Variables",
x = "Media disminución GINI",
y = "Variables")+
theme_bw()
gg_importancia
#rand.forest2 <- randomForest(y ~ deprimido + ingreso + salud + trabajo_asc + prob_vivienda +
# sens_maltrato + confianza + estado_civil +
# inmigrante + sexo + trabajo + deudas + sentido_nervioso +
# horas_ocio + horas_domest + amigos + horas_ninos +
# nhijos + medio_amb + horas_dormir + dormir_normal + region,
# data = train, ntree = 400, mtry = 20,
# cutoff = c(0.2,0.7))
#imp2 <- rand.forest2$importance
#rownames(imp2)
#importancia2 <- tibble(Variable = rownames(imp2), Importancia = imp2) %>% arrange(desc(Importancia))
# plot(rand.forest2) # Medida de error vs cantidad de arboles empleados en el modelo
#gg_importancia2 <- importancia2[1:22,] %>%
# ggplot(aes(x = Importancia, y = reorder(Variable, Importancia)))+
# geom_bar(stat="identity", position="dodge", fill = "lightblue")+
# labs(title = "Importancia de las Variables",
# x = "Media disminución GINI",
# y = "Variables")+
# theme_bw()
pred.rf1 <- predict(rand.forest, test)
indicadores_rand.forest <- caret::confusionMatrix(factor(pred.rf1,labels = c("0","1")),
factor(test$y), positive = "0",
dnn = c("Prediction", "Reference"))
tabla_rf<- data.frame(table(factor(pred.rf1,
labels = c("No Satisfecho", "Satisfecho")),reales))
g_mconf_randforest <- ggplot(data = tabla_rf, mapping = aes(x = reales, y = Var1)) +
geom_tile(aes(fill = Freq), colour = "white") +
geom_text(aes(label = sprintf("%1.0f", Freq)), vjust = 1) +
scale_fill_gradient2(low = "#efedf5", high = "#756bb1") +
theme_bw() + theme(legend.position = "none")+
ylim(rev(levels(tabla_rf$Var1)))+
labs(x = "Valores Reales", y = "Valores Predichos")
g_mconf_randforest
#pred.rf2 <- predict(rand.forest2, test)
#indicadores_rand.forest2 <- caret::confusionMatrix(factor(pred.rf2, labels = c("No Satisfecho", "Insatisfecho")),
# factor(test$y, labels = c("No Satisfecho", "Insatisfecho")),
# positive = "No Satisfecho",
# dnn = c("Prediction", "Reference"))
#indicadores_logistica
#indicadores_naive_bayes
#indicadores_rand.forest
#indicadores_rand.forest2
# Validación cruzada ------------------------------------------------------------
train.control <- trainControl(method = "cv", number = 10)
set.seed(93)
## Regresión logística ------
kfold.glm <- train(y ~ deprimido + ingreso + salud + trabajo_asc + prob_vivienda +
sens_maltrato + confianza + estado_civil +
inmigrante + sexo + trabajo + deudas + sentido_nervioso +
horas_ocio + horas_domest + amigos + horas_ninos +
nhijos + medio_amb + horas_dormir + dormir_normal + region,
data = train,
trControl=train.control,
method="vglmAdjCat" )
kfold.glm$resample
kfold.glm$results
## Random forest ----
set.seed(93)
#kfold.rf <- train(y ~ deprimido + ingreso + salud + trabajo_asc + prob_vivienda +
# sens_maltrato + confianza + estado_civil +
# inmigrante + sexo + trabajo + deudas + sentido_nervioso +
# horas_ocio + horas_domest + amigos + horas_ninos +
# nhijos + medio_amb + horas_dormir + dormir_normal + region,
# data = train,
# trControl=train.control,
# method="rf")
#saveRDS(kfold.rf, file = "kfold_rf.rds") # dejamos guardado este objeto ya que demora algunos minutos en ejecutarse
kfold.rf <- readRDS(file = "kfold_rf.rds")
kfold.rf$resample
kfold.rf$results # Con 27 variables se obtiene un buen accuracy.
## naive bayes ----
#kfold.naive <- train(y ~ deprimido + ingreso + salud + trabajo_asc + prob_vivienda +
# sens_maltrato + confianza + estado_civil +
# inmigrante + sexo + trabajo + deudas + sentido_nervioso +
# horas_ocio + horas_domest + amigos + horas_ninos +
# nhijos + medio_amb + horas_dormir + dormir_normal + region,
# data = train,
# trControl=train.control,
# method="naive_bayes")
#saveRDS(kfold.naive, file = "kfold_naive.rds") # dejamos guardado este objeto ya que demora algunos minutos en ejecutarse
kfold.naive <- readRDS(file = "kfold_rf.rds")
kfold.naive$resample
kfold.naive$results # Con 27 variables se obtiene un buen accuracy.