Regresion Logistica - People Analytics
Juan Pablo Gomez Bravo
29/9/2022
#Cargue Librerias
library(readxl)
library(ggplot2)
library(CGPfunctions)## Warning: package 'CGPfunctions' was built under R version 4.1.2library(sqldf)## Loading required package: gsubfn## Loading required package: proto## Loading required package: RSQLitePUNTO 1 Hipotesis 1: Se espera que a mayor edad se presente menor Rotacion ya que las personas maduras tienden a rotar en menor proporcion.
Hipotesis 2: Se espera que la gente con menor Antiguedad rote en mayor proporcion ya que puede tratarse de personas con menor tiempo de adaptacion a la cultura de la empresa.
Hipotesis 3: Se espera que la gente con menor Ingreso Mensual rote en mayor proporcion ya que puede tratarse de personas en busqueda de un incremento salarial.
Hipotesis 4: Se espera que exista una mayor incidencia de Rotacion en los Hombres, dado que son la mayor participacion en la base y son normalmente mas inestables en sus labores.
Hipotesis 5: Se espera que exista una mayor incidencia de Rotacion en empleados que tengan horas extras, ya que esto puede representar una sobrecarga laboral.
Hipotesis 6: Se espera que exista una diferenciacion de Rotacion en empleados segun su estado civil, donde personas solteras deberian presentar una mayor incidencia.
PUNTO 2
datos1 = read_excel("G:/ACADEMIA/JAVERIANA CALI/2. SEMESTRE 2022 - II/2. Met. Estad. para la Toma Decisiones/Logistica/Datos_Rotacion.xlsx")
head(datos1)## # A tibble: 6 x 24
## Rotacion Edad Viaje_Negocios Departamento Distancia_Casa Educacion
## <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 Si 41 Raramente Ventas 1 2
## 2 No 49 Frecuentemente IyD 8 1
## 3 Si 37 Raramente IyD 2 2
## 4 No 33 Frecuentemente IyD 3 4
## 5 No 27 Raramente IyD 2 1
## 6 No 32 Frecuentemente IyD 2 2
## # ... with 18 more variables: Campo_EducaciĆ³n <chr>,
## # Satisfaccion_Ambiental <dbl>, Genero <chr>, Cargo <chr>,
## # Satisfacion_Laboral <dbl>, Estado_Civil <chr>, Ingreso_Mensual <dbl>,
## # Trabajos_Anteriores <dbl>, Horas_Extra <chr>,
## # Porcentaje_aumento_salarial <dbl>, Rendimiento_Laboral <dbl>,
## # Anos_Experiencia <dbl>, Capacitaciones <dbl>,
## # Equilibrio_Trabajo_Vida <dbl>, Antiguedad <dbl>, ...#Analisis Univariado variables Continuas
#Edad
Prom_Edad=mean(datos1$Edad)
Desv_Edad=sd(datos1$Edad)
P25_Edad=quantile(datos1$Edad, prob=c(0.25))
P50_Edad=quantile(datos1$Edad, prob=c(0.50))
P75_Edad=quantile(datos1$Edad, prob=c(0.75))
data.frame(Prom_Edad,Desv_Edad,P25_Edad,P50_Edad,P75_Edad)## Prom_Edad Desv_Edad P25_Edad P50_Edad P75_Edad
## 25% 36.92381 9.135373 30 36 43#Ingreso Mensual
Prom_Ingreso=mean(datos1$Ingreso_Mensual)
Desv_Ingreso=sd(datos1$Ingreso_Mensual)
P25_Ingreso=quantile(datos1$Ingreso_Mensual, prob=c(0.25))
P50_Ingreso=quantile(datos1$Ingreso_Mensual, prob=c(0.50))
P75_Ingreso=quantile(datos1$Ingreso_Mensual, prob=c(0.75))
data.frame(Prom_Ingreso,Desv_Ingreso,P25_Ingreso,P50_Ingreso,P75_Ingreso)## Prom_Ingreso Desv_Ingreso P25_Ingreso P50_Ingreso P75_Ingreso
## 25% 6502.931 4707.957 2911 4919 8379#Antiguedad
Prom_Antiguedad=mean(datos1$Antiguedad)
Desv_Antiguedad=sd(datos1$Antiguedad)
P25_Antiguedad=quantile(datos1$Antiguedad, prob=c(0.25))
P50_Antiguedad=quantile(datos1$Antiguedad, prob=c(0.50))
P75_Antiguedad=quantile(datos1$Antiguedad, prob=c(0.75))
data.frame(Prom_Antiguedad,Desv_Antiguedad,P25_Antiguedad,P50_Antiguedad,P75_Antiguedad)## Prom_Antiguedad Desv_Antiguedad P25_Antiguedad P50_Antiguedad
## 25% 7.008163 6.126525 3 5
## P75_Antiguedad
## 25% 9#Analisis Univariado Categoricas
#Genero
prop.table(table(datos1$Genero))*100##
## F M
## 40 60#Horas Extras
prop.table(table(datos1$Horas_Extra))*100##
## No Si
## 71.70068 28.29932#Estado Civil
prop.table(table(datos1$Estado_Civil))*100##
## Casado Divorciado Soltero
## 45.78231 22.24490 31.97279#Grafico Edad
ggplot(datos1,aes(x=Edad))+geom_histogram()+theme_bw()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Grafico Ingreso Mensual
ggplot(datos1,aes(x=Ingreso_Mensual))+geom_histogram()+theme_bw()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Grafico Antiguedad
ggplot(datos1,aes(x=Antiguedad))+geom_histogram()+theme_bw()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#Grafico Genero
ggplot(datos1,aes(x=Genero))+geom_bar()+theme_bw()
#Grafico Horas Extra
ggplot(datos1,aes(x=Horas_Extra))+geom_bar()+theme_bw()
#Grafico Estado Civil
ggplot(datos1,aes(x=Estado_Civil))+geom_bar()+theme_bw()
PUNTO 3
#Analisis Bivariado
#edad vs rotacion
boxplot(datos1$Edad~datos1$Rotacion,
xlab = 'Rotacion',
ylab = 'Edad',
main= 'Rotacion vs Edad',
col= 'ivory')
sqldf('select Rotacion,
avg(Edad) as Edad_Prom,
stdev(Edad) as Edad_desv
from datos1
group by Rotacion
')## Rotacion Edad_Prom Edad_desv
## 1 No 37.56123 8.88836
## 2 Si 33.60759 9.68935Se evidencia una edad promedio menor en aquellos empleados que presentan rotacion
boxplot(datos1$Antiguedad~datos1$Rotacion,
xlab = 'Rotacion',
ylab = 'Antiguedad',
main= 'Rotacion vs Antiguedad',
col= 'khaki')
sqldf('select Rotacion,
avg(Antiguedad) as Antiguedad_Prom,
stdev(Antiguedad) as Antiguedad_desv
from datos1
group by Rotacion
')## Rotacion Antiguedad_Prom Antiguedad_desv
## 1 No 7.369019 6.096298
## 2 Si 5.130802 5.949984Se evidencia una menor antiguedad en los empleados que presentan rotacion
boxplot(datos1$Ingreso_Mensual~datos1$Rotacion,
xlab = 'Rotacion',
ylab = 'Ingreso Mensual',
main= 'Rotacion vs Ingreso Mensual',
col= 'lightcyan')
sqldf('select Rotacion,
avg(Ingreso_Mensual) as Ingreso_Mensual_Prom,
stdev(Ingreso_Mensual) as Ingreso_Mensual_desv
from datos1
group by Rotacion
')## Rotacion Ingreso_Mensual_Prom Ingreso_Mensual_desv
## 1 No 6832.740 4818.208
## 2 Si 4787.093 3640.210Se evidencia que los empleados con rotacion tienen un Ingreso Mensual promedio menor.
PlotXTabs(datos1, Rotacion, Genero, "percent")## Plotted dataset datos1 variables Rotacion by Genero
NO se evidencia una diferencia significativa en la Rotacion x Genero
PlotXTabs(datos1, Rotacion, Horas_Extra, "percent")## Plotted dataset datos1 variables Rotacion by Horas_Extra
SI se evidencia una diferencia significativa en la Rotacion x Horas_extra
PlotXTabs(datos1, Rotacion, Estado_Civil, "percent")## Plotted dataset datos1 variables Rotacion by Estado_Civil
SI se evidencia una diferencia significativa en la Rotacion x Estado Civil, en particular en quienes son Solteros
PUNTO 4
#cambio de la variable objetivo
datos1$Rotacion[datos1$Rotacion=="Si"] = 1
datos1$Rotacion[datos1$Rotacion=="No"] = 0head(datos1)## # A tibble: 6 x 24
## Rotacion Edad Viaje_Negocios Departamento Distancia_Casa Educacion
## <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 1 41 Raramente Ventas 1 2
## 2 0 49 Frecuentemente IyD 8 1
## 3 1 37 Raramente IyD 2 2
## 4 0 33 Frecuentemente IyD 3 4
## 5 0 27 Raramente IyD 2 1
## 6 0 32 Frecuentemente IyD 2 2
## # ... with 18 more variables: Campo_EducaciĆ³n <chr>,
## # Satisfaccion_Ambiental <dbl>, Genero <chr>, Cargo <chr>,
## # Satisfacion_Laboral <dbl>, Estado_Civil <chr>, Ingreso_Mensual <dbl>,
## # Trabajos_Anteriores <dbl>, Horas_Extra <chr>,
## # Porcentaje_aumento_salarial <dbl>, Rendimiento_Laboral <dbl>,
## # Anos_Experiencia <dbl>, Capacitaciones <dbl>,
## # Equilibrio_Trabajo_Vida <dbl>, Antiguedad <dbl>, ...datos1$Rotacion=as.factor(datos1$Rotacion)#estimacion del modelo
mod_glm1 <- glm(Rotacion ~ Edad + Antiguedad + Ingreso_Mensual + Genero +
Horas_Extra + Estado_Civil,
data = datos1, family = "binomial")
summary(mod_glm1)##
## Call:
## glm(formula = Rotacion ~ Edad + Antiguedad + Ingreso_Mensual +
## Genero + Horas_Extra + Estado_Civil, family = "binomial",
## data = datos1)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5047 -0.5937 -0.4122 -0.2608 3.2002
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.026e+00 3.606e-01 -2.846 0.00443 **
## Edad -2.728e-02 9.963e-03 -2.739 0.00617 **
## Antiguedad -3.651e-02 1.829e-02 -1.996 0.04589 *
## Ingreso_Mensual -7.566e-05 2.635e-05 -2.871 0.00409 **
## GeneroM 2.697e-01 1.594e-01 1.692 0.09062 .
## Horas_ExtraSi 1.482e+00 1.566e-01 9.463 < 2e-16 ***
## Estado_CivilDivorciado -2.899e-01 2.270e-01 -1.277 0.20156
## Estado_CivilSoltero 8.438e-01 1.695e-01 4.977 6.46e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1298.6 on 1469 degrees of freedom
## Residual deviance: 1109.7 on 1462 degrees of freedom
## AIC: 1125.7
##
## Number of Fisher Scoring iterations: 5Las variables incorporadas resultan significativas para el modelo, en una menor medidad el estar Divorciado.
A menor edad, antiguedad e ingreso mensual se aumenta la posibilidad de Rotacion.
El ser Hombre, hacer horas extras y ser soltero aumenta la posibilidad de Rotacion.
PUNTO 5
#CALCULO ROC Y AUC
# estimamos la probabilidad
rotacion_prob <- predict(mod_glm1, type = "response")# Pintamos ROC of the stepwise model
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varROC <- roc(datos1$Rotacion, rotacion_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(ROC, col = "blue")
auc(ROC)## Area under the curve: 0.76Bajo el criterio de AUC, se obtiene un modelo con caracteristicas adecuadas para predecir.
PUNTO 6
predict(mod_glm1,list(
Edad=34,
Antiguedad=6,
Ingreso_Mensual=2500,
Genero="M",
Horas_Extra="Si",
Estado_Civil="Soltero"),
interval="confidence",
level=0.95,
type = "response")## 1
## 0.5580196En el caso hipotetico evaluado se obtiene un probabilidad de 55% de Rotacion, por lo que se se considera un corte del 0.5, este empleado seria sujeto a intervenir su rotacion
PUNTO 7 Algunas estrategias: - Brindar planes de carrera a los mas jovenes - Bonos de antiguedad para estimular aquellos que permanecen en la empresa - reducir las horas extras