Actividad Final- Regresión Logística Modelo Binomial
Adriana Mosquera - Luis Pino - Franklin Mantilla
12/3/2022
library(readxl)## Warning: package 'readxl' was built under R version 4.0.5Datos_Rotacion <- read_excel("C:/Datos/Clase9/Datos_Rotacion.xlsx")## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'tibble'## Warning: replacing previous import 'lifecycle::last_warnings' by
## 'rlang::last_warnings' when loading 'pillar'str(Datos_Rotacion)## tibble [1,470 x 24] (S3: tbl_df/tbl/data.frame)
## $ Rotación : chr [1:1470] "Si" "No" "Si" "No" ...
## $ Edad : num [1:1470] 41 49 37 33 27 32 59 30 38 36 ...
## $ Viaje de Negocios : chr [1:1470] "Raramente" "Frecuentemente" "Raramente" "Frecuentemente" ...
## $ Departamento : chr [1:1470] "Ventas" "IyD" "IyD" "IyD" ...
## $ Distancia_Casa : num [1:1470] 1 8 2 3 2 2 3 24 23 27 ...
## $ Educación : num [1:1470] 2 1 2 4 1 2 3 1 3 3 ...
## $ Campo_Educación : chr [1:1470] "Ciencias" "Ciencias" "Otra" "Ciencias" ...
## $ Satisfacción_Ambiental : num [1:1470] 2 3 4 4 1 4 3 4 4 3 ...
## $ Genero : chr [1:1470] "F" "M" "M" "F" ...
## $ Cargo : chr [1:1470] "Ejecutivo_Ventas" "Investigador_Cientifico" "Tecnico_Laboratorio" "Investigador_Cientifico" ...
## $ Satisfación_Laboral : num [1:1470] 4 2 3 3 2 4 1 3 3 3 ...
## $ Estado_Civil : chr [1:1470] "Soltero" "Casado" "Soltero" "Casado" ...
## $ Ingreso_Mensual : num [1:1470] 5993 5130 2090 2909 3468 ...
## $ Trabajos_Anteriores : num [1:1470] 8 1 6 1 9 0 4 1 0 6 ...
## $ Horas_Extra : chr [1:1470] "Si" "No" "Si" "Si" ...
## $ Porcentaje_aumento_salarial: num [1:1470] 11 23 15 11 12 13 20 22 21 13 ...
## $ Rendimiento_Laboral : num [1:1470] 3 4 3 3 3 3 4 4 4 3 ...
## $ Años_Experiencia : num [1:1470] 8 10 7 8 6 8 12 1 10 17 ...
## $ Capacitaciones : num [1:1470] 0 3 3 3 3 2 3 2 2 3 ...
## $ Equilibrio_Trabajo_Vida : num [1:1470] 1 3 3 3 3 2 2 3 3 2 ...
## $ Antigüedad : num [1:1470] 6 10 0 8 2 7 1 1 9 7 ...
## $ Antigüedad_Cargo : num [1:1470] 4 7 0 7 2 7 0 0 7 7 ...
## $ Años_ultima_promoción : num [1:1470] 0 1 0 3 2 3 0 0 1 7 ...
## $ Años_acargo_con_mismo_jefe : num [1:1470] 5 7 0 0 2 6 0 0 8 7 ...PUNTO N°1
La siguiente actividad nos permitirá realizar un análisis univariado , bivariado y construir un modelo de regresión logística que permita conocer las variables que se relacionan con la rotación de los Empleado y predecir aproximadamente un escenario de probabilidad rotación.
VARIABLES ESCOGIDAS
CUALITATIVAS : Satisfaccion Laboral , Estado Civil , Rendimiento laboral
CUANTITATIVAS:Ingresos mensual , antiguedad Empresa , Distancia a Casa
CUALITATIVAS:
RENDIMIENTO LABORAL : La Hipótesis es identificar si los empleados que rotan presentan bajo rendiemiento laboral lo cual puede ser un factor de rotación a lineado con la satisfacion laboral.
SATISFACCION LABORAL: Aquellas personas que tienen menor satisfacción laboral rotan mas intentando encontrar un trabajo donde se sientan que pueden desarrollarse desde el punto de vista laboral.
ESTADO CIVIL : Las personas casadas tienden rotar menos dado que buscan mayor estabilidad para su familia.
CUANTITATIVAS :
INGRESO MENSUAL : La Hipótesis inicial con esta variable, es poder identificar si existe una relación entre la Rotación y el ingreso. Es poder conocer si las personas con mayores ingresos rotan y las que tienen menores ingreso no rotan.
ANTIGUEDAD: Se espera que la antigüedad se relacionen con la rotación dado que las personas tienden a valorar positivamente la permanencia en una misma empresa. La hipótesis es que las personas que tienen mayor antigüedad tienen menor posibilidad de rotar.
DISTANCIA A CASA: Se espera que la distancia a casa se relacionen con la rotación debido a que las personas tienden a buscar empleos cercanos a su hogar. La hipótesis es que las personas que se encuentran a una mayor distancia de casa tienden a rotar más.
ANALISIS UNIVARIADO ANTIGUEDAD Y DISTANCIA A CASA
require(ggplot2)## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.0.5require(ggpubr)## Loading required package: ggpubr## Warning: package 'ggpubr' was built under R version 4.0.5g1=ggplot(Datos_Rotacion,aes(x=Antigüedad))+geom_histogram()+theme_bw()
g3=ggplot(Datos_Rotacion,aes(x=Distancia_Casa))+geom_histogram()+theme_bw()
ggarrange(g1, g3,labels = c("A", "B"),ncol = 2, nrow = 1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
data.frame(as.matrix(summary(Datos_Rotacion$Antigüedad)))| as.matrix.summary.Datos_Rotacion.Antigüedad.. | |
|---|---|
| Min. | 0.000000 |
| 1st Qu. | 3.000000 |
| Median | 5.000000 |
| Mean | 7.008163 |
| 3rd Qu. | 9.000000 |
| Max. | 40.000000 |
data.frame(as.matrix(summary(Datos_Rotacion$Distancia_Casa)))| as.matrix.summary.Datos_Rotacion.Distancia_Casa.. | |
|---|---|
| Min. | 1.000000 |
| 1st Qu. | 2.000000 |
| Median | 7.000000 |
| Mean | 9.192517 |
| 3rd Qu. | 14.000000 |
| Max. | 29.000000 |
Se puede observar en el histograma para la antigüedad que la mayoría de los datos se acumulan en los valores de 0 a 25, lo que quiere decir que la mayoría de los empleados evaluados tienen de 0 a 25 años de antiguedad en la compañía. A pesar de ello, el rango del histograma es hasta 40 pues existen algunos datos en este intervalo. También podemos observar que los datos no están distribuidos normalmente dado que no conservan una forma acampanada. Por el contrario, y debido a la acumulación en las primeras clases, los datos poseen una distribución con una cola larga a la derecha, es decir, muestra un sesgo positivo o asimétrica positiva. La mayoría de los empleados tienen poca trayectoria en la empresa. Al revisar las estadísticas descriptivas, en premodio la antigüedad de los trabajadores es de aproximadamente 7 años. Así mismo, valores para la media y la mediana, 7 y 5 años respectivamente, se puede observar que los datos no poseen una distribución simétrica debido a que estos dos valores no coinciden. Como la media es mayor a la media podemos decir que la distribución es asimétrica positiva. En cuanto a la antigüedad de los trabajadores también podemos decir que el 25% de ellos tienen una trayectoria en la compañía menor a 3 años. El 50% tiene una antigüedad por debajo de 5 años. Un 25% de los trabajadores tienen un recorrido mayor a 9 años. También, en premodio la antigüedad de los trabajadores es de aproximadamente 7 años, con una variación de aproximada de 6.13 años, lo que indica que la dispersión de los datos con respecto a la media es alta.
Interpretación Histograma y estadística descriptiva Distancia_Casa. Análogamente al análisis realizado para la antigüedad, la distancia promedio que los empleados tienen desde el trabajo a su casa es de 9,2 kms aproximadamente, y la mayoría de ellos viven entre 0 y 14 kilometros de distancia a su casa. Se observa que el comportamiento de las datos no se ajustan a una distribución normal, dado que presenta una acumulación en las primeras clases, y una división en la distribución de los datos.
ANÁLISIS BIVARIADO ANTIGUEDAD
require(ggplot2)
require(CGPfunctions)## Loading required package: CGPfunctions## Warning: package 'CGPfunctions' was built under R version 4.0.5Datos_Rotacion$Antigüedad_rango=cut(Datos_Rotacion$Antigüedad,breaks = seq(from = 0,to = 40,by = 5))
PlotXTabs2(data =Datos_Rotacion,x = "Antigüedad_rango",y="Rotación")
Tienen más rotación las personas que tienen entre 0 y 5 años en la compañia. Lo explicaria que no se adaptaron a la empresa o no dieron los resultados esperados. Luego la tasa de rotación es menor, con un dato importante con las personas que tinen entre 30 y 40 años en la compañía, tienen mayor rotación en ese periodo probablemente por que llegan a su edad de jubilación.
ANALISIS BIVARIADO DISTANCIA CASA
require(ggplot2)
require(CGPfunctions)
Datos_Rotacion$Distancia_Casa_rango=cut(Datos_Rotacion$Distancia_Casa,breaks = seq(from = 0,to = 29,by = 5))
table(Datos_Rotacion$Distancia_Casa_rango)##
## (0,5] (5,10] (10,15] (15,20] (20,25]
## 632 394 115 125 117require(GP)## Loading required package: GP## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'GP'PlotXTabs2(data = Datos_Rotacion,x=Distancia_Casa_rango,y=Rotación)
La distancia a casa si es un factor de rotación segun los datos. El vivir cerca a la empresa tine el mas bajo porcentaje de rotación, 14%, mientras que los que mas lejos viven tienen una mayor rotación (27%).
ANÁLISIS UNIVARIADO SATISFACCION LABORAL
require(ggplot2)
require(ggpubr)
g2=ggplot(Datos_Rotacion,aes(x=Satisfación_Laboral))+geom_bar()+theme_bw()
g2
Alrededor de mil personas de la base de datos tienen un nivel de satisfacción entre 3 y 4 considerado como alto. Tienen bajo nivel de satisfacción alrededor de 500 personas de la base.
require(ggplot2)
require(CGPfunctions)
PlotXTabs2(data = Datos_Rotacion,x = "Satisfación_Laboral",y="Rotación")
En el análisis bivariado entre rotación y satisfacción laboral se encontró que entre menor satisfacción laboral mayor rotación. Los menos satisfechos rotan 23%, mientras que los mas satisfechos rotan solo 11%. Lo que apoya la hipotesis.
ANÁLISIS UNIVARIADO ESTADO CIVIL
g2=ggplot(Datos_Rotacion,aes(x=Estado_Civil))+geom_bar()+theme_bw()
g2
##En el Análisis univariado del estado civil, las personas de la base de datos esta conformada por personas caadas, seguidas por personas solteras.
PlotXTabs2(data = Datos_Rotacion,x = "Estado_Civil",y="Rotación")
# ANÁLISIS BIVARIADO - ESTADO CIVI
En el analisis bivariado entre rotacion y estado civil encontramos que las personas solteras rotan mas con un 26%. Lo que apoya la hipotesis inicial que las personas que no tienen una familia primaria tienden a rotar con mayor frecuencia.
ANÁLISIS UNIVARIADO INGRESO MENSUAL
##INGRESO MENSUAL
library(ggplot2)
library(nortest)
require(ggipubr)## Loading required package: ggipubr## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'ggipubr'require(CGPfunctions)
require(GP)## Loading required package: GP## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'GP'##Las personas con mas ingresos rotan menos.
lillie.test(Datos_Rotacion$Ingreso_Mensual)##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: Datos_Rotacion$Ingreso_Mensual
## D = 0.16892, p-value < 2.2e-16g1=ggplot(Datos_Rotacion,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()
g1## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Datos_Rotacion$Ingreso_Mensual2=Datos_Rotacion$Ingreso_Mensual/1000
Datos_Rotacion$Ingreso_Mensual_rango=cut(Datos_Rotacion$Ingreso_Mensual2,breaks = seq(from = 0,to = 20,by = 5))
Datos_Rotacion$Edad_rango=cut(Datos_Rotacion$Edad,breaks = c(0,30,50,100))
require(GP)## Loading required package: GP## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'GP'PlotXTabs2(data = Datos_Rotacion,x=Ingreso_Mensual_rango,y=Rotación)
Despúes de realizar el análisis Bivariado entre las variables Rotación y Ingresos mensuales, se identificó que los empleados que poseen mayores ingresos tienen un porcentaje de rotación del 4% frente al 22% que presentan los de menores ingresos. La distribuccion de los datos presenta un Pvalio menor a 0.5 lo cual se define que la distribuccion no es de forma normal.
ANÁLISIS UNIVARIADO RENDIMIENTO LABORAL
require(ggplot2)
require(ggpubr)
##Datos_Rotacion$Rendimiento_Laboral
g2=ggplot(Datos_Rotacion,aes(x=Rendimiento_Laboral))+geom_bar()+theme_bw()
g2
_ Al evaluar la variable de rendimimiento laboral, definimos que esta presenta una valoracion de 3 y 4 en su distribución y una proporcionalidad de 84% no rotan con rendimiento 4 y 3 por lo cual la variable presenta ausencia de caracterización.
ANÁLISIS BIVARIADO - ESTADO CIVIL
require(ggplot2)
require(ggpubr)
g3=ggplot(Datos_Rotacion,aes(x=Rendimiento_Laboral))+geom_histogram()+theme_bw()
ggarrange(g1, g3,labels = c("A", "B"),ncol = 2, nrow = 1)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
data.frame(as.matrix(summary(Datos_Rotacion$Rendimiento_Laboral)))| as.matrix.summary.Datos_Rotacion.Rendimiento_Laboral.. | |
|---|---|
| Min. | 3.000000 |
| 1st Qu. | 3.000000 |
| Median | 3.000000 |
| Mean | 3.153742 |
| 3rd Qu. | 3.000000 |
| Max. | 4.000000 |
require(GP)## Loading required package: GP## Warning in library(package, lib.loc = lib.loc, character.only = TRUE,
## logical.return = TRUE, : there is no package called 'GP'PlotXTabs2(data = Datos_Rotacion,x = "Rendimiento_Laboral",y="Rotación")
El rendimiento laboral no es una variable que influya en la rotación. Dado que los dos niveles de rendiemiento tienen la misma probailidad de rotación.
PUNTO N°3 # REGRESIÓN LOGÍSTICA
Datos_Rotacion$y=as.numeric(Datos_Rotacion$Rotación=="Si")
modelo=glm(y~Distancia_Casa+Satisfación_Laboral+Estado_Civil+Ingreso_Mensual+Rendimiento_Laboral+Antigüedad,data=Datos_Rotacion)
summary(modelo)##
## Call:
## glm(formula = y ~ Distancia_Casa + Satisfación_Laboral + Estado_Civil +
## Ingreso_Mensual + Rendimiento_Laboral + Antigüedad, data = Datos_Rotacion)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.4157 -0.1994 -0.1286 -0.0326 1.1606
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.790e-01 8.707e-02 3.204 0.001384 **
## Distancia_Casa 3.651e-03 1.144e-03 3.192 0.001441 **
## Satisfación_Laboral -3.618e-02 8.399e-03 -4.308 1.76e-05 ***
## Estado_CivilDivorciado -2.340e-02 2.393e-02 -0.978 0.328263
## Estado_CivilSoltero 1.230e-01 2.143e-02 5.739 1.15e-08 ***
## Ingreso_Mensual -8.583e-06 2.299e-06 -3.733 0.000196 ***
## Rendimiento_Laboral -8.178e-04 2.568e-02 -0.032 0.974596
## Antigüedad -4.043e-03 1.764e-03 -2.292 0.022019 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.1259389)
##
## Null deviance: 198.79 on 1469 degrees of freedom
## Residual deviance: 184.12 on 1462 degrees of freedom
## AIC: 1135.9
##
## Number of Fisher Scoring iterations: 2resumen=summary(modelo)
data.frame(resumen$coefficients)| Estimate | Std..Error | t.value | Pr…t.. | |
|---|---|---|---|---|
| (Intercept) | 0.2789806 | 0.0870719 | 3.2040242 | 0.0013844 |
| Distancia_Casa | 0.0036508 | 0.0011436 | 3.1924582 | 0.0014407 |
| Satisfación_Laboral | -0.0361782 | 0.0083985 | -4.3076747 | 0.0000176 |
| Estado_CivilDivorciado | -0.0233997 | 0.0239274 | -0.9779457 | 0.3282630 |
| Estado_CivilSoltero | 0.1230036 | 0.0214312 | 5.7394726 | 0.0000000 |
| Ingreso_Mensual | -0.0000086 | 0.0000023 | -3.7331924 | 0.0001963 |
| Rendimiento_Laboral | -0.0008178 | 0.0256781 | -0.0318498 | 0.9745962 |
| Antigüedad | -0.0040428 | 0.0017635 | -2.2924904 | 0.0220188 |
PUNTO N°4 : El modelo de regresión logística informa que las variables más relacionadas con rotación son: Distancia a casa: entre mas distancia mas rotación. Satisfacción laboral: Entre mas satisfacción laboral menos rotan. Estado civil soltero: Las personas solteras tienen mayor probabilidad de rotar. Ingreso mensual: entre mayor es el ingreso menos rotación.
Interpretación Antiguedad y Distancia a casa regresión logística
Antiguedad: De acuerdo al valor p, podemos identificar que esta variable tiene poca importancia e impacto para el modelo a la hora de determinar la rotación de un empleado. El beta de esta variable, con un valor de -4.043e-03, indica que al aumentar la antiguedad disminuye la posibilidad que un empleado rote voluntariamente.
Distancia a Casa: La distancia a casa es una variable que es importante e influyente en el modelo. El coeficiente beta nos indican que al aumentar en 1 kilometro la distancia que tiene un empleado a su hogar se aumenta en aproximadamente en 3.6 la probabilidad de que el empleado se vaya de la compañía, o dicho de otra forma, se porduzca su rote voluntario.
PUNTO N° 5
Predicción del Modelo RLG :
predict(modelo,list(Distancia_Casa=20,Satisfación_Laboral=1,Estado_Civil="Soltero",Ingreso_Mensual=2000,Rendimiento_Laboral=1,Antigüedad=6),type="response")## 1
## 0.3965827Predicción: Una persona que vive a 20 km de la empresa con menor grado de satisfacción laboral, soltero, con un ingreso de 2 mmillones de pesos, bajo rendimiento laboral y antiguedad de 6 años tiene una probabilidad de rotar de 39%.
Con la Predicción realizada se puede comprobar que las variables Satisfacción laboral, estado Civil e ingresos influyen representativamente en la decisión de rotación de los empleados
table(Datos_Rotacion$y)##
## 0 1
## 1233 237