Modelos_Estadisticos_Informe_Actividad_3_JSGV
Joan Sebastián García Villa
2024-03-30
1. Introducción
El siguiente informe se ejecuta un análisis de los factores que influyen en la rotación de empleados, con el objetivo de responder pro activamente a la retención de talento y fomentar un mejor ambiente laboral. Este documento se divide en las secciones: Introducción, objetivos, métodos, conclusiones.
2. Objetivo
- Evaluar un modelo de regresión logística que permita estimar la probabilidad de que un empleado cambie de cargo en el próximo periodo.
3. Métodos
Este informe realiza un análisis de la información suministrada por una compañía, para lo cual se realizan los siguientes pasos: 1) Selección de variables, 2) Análisis Univariado, 3) Análisis bivariado, 4) Estimación del modelo, 5) Evaluación del modelo, 6) predicciones, 7) Conclusiones.
Importación de información
library(paqueteMODELOS)
data("rotacion")
head(rotacion)str(rotacion,vec.len=2, digits.d=2, give.attr=FALSE)## tibble [1,470 × 24] (S3: tbl_df/tbl/data.frame)
## $ Rotación : chr [1:1470] "Si" "No" ...
## $ Edad : num [1:1470] 41 49 37 33 27 ...
## $ Viaje de Negocios : chr [1:1470] "Raramente" "Frecuentemente" ...
## $ Departamento : chr [1:1470] "Ventas" "IyD" ...
## $ Distancia_Casa : num [1:1470] 1 8 2 3 2 ...
## $ Educación : num [1:1470] 2 1 2 4 1 ...
## $ Campo_Educación : chr [1:1470] "Ciencias" "Ciencias" ...
## $ Satisfacción_Ambiental : num [1:1470] 2 3 4 4 1 ...
## $ Genero : chr [1:1470] "F" "M" ...
## $ Cargo : chr [1:1470] "Ejecutivo_Ventas" "Investigador_Cientifico" ...
## $ Satisfación_Laboral : num [1:1470] 4 2 3 3 2 ...
## $ Estado_Civil : chr [1:1470] "Soltero" "Casado" ...
## $ Ingreso_Mensual : num [1:1470] 5993 5130 ...
## $ Trabajos_Anteriores : num [1:1470] 8 1 6 1 9 ...
## $ Horas_Extra : chr [1:1470] "Si" "No" ...
## $ Porcentaje_aumento_salarial: num [1:1470] 11 23 15 11 12 ...
## $ Rendimiento_Laboral : num [1:1470] 3 4 3 3 3 ...
## $ Años_Experiencia : num [1:1470] 8 10 7 8 6 ...
## $ Capacitaciones : num [1:1470] 0 3 3 3 3 ...
## $ Equilibrio_Trabajo_Vida : num [1:1470] 1 3 3 3 3 ...
## $ Antigüedad : num [1:1470] 6 10 0 8 2 ...
## $ Antigüedad_Cargo : num [1:1470] 4 7 0 7 2 ...
## $ Años_ultima_promoción : num [1:1470] 0 1 0 3 2 ...
## $ Años_acargo_con_mismo_jefe : num [1:1470] 5 7 0 0 2 ...require(mice)
require(VIM)
md.pattern(rotacion, plot=TRUE, rotate.names=TRUE)## /\ /\
## { `---' }
## { O O }
## ==> V <== No need for mice. This data set is completely observed.
## \ \|/ /
## `-----'
## Rotación Edad Viaje de Negocios Departamento Distancia_Casa Educación
## 1470 1 1 1 1 1 1
## 0 0 0 0 0 0
## Campo_Educación Satisfacción_Ambiental Genero Cargo Satisfación_Laboral
## 1470 1 1 1 1 1
## 0 0 0 0 0
## Estado_Civil Ingreso_Mensual Trabajos_Anteriores Horas_Extra
## 1470 1 1 1 1
## 0 0 0 0
## Porcentaje_aumento_salarial Rendimiento_Laboral Años_Experiencia
## 1470 1 1 1
## 0 0 0
## Capacitaciones Equilibrio_Trabajo_Vida Antigüedad Antigüedad_Cargo
## 1470 1 1 1 1
## 0 0 0 0
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## 1470 1 1 0
## 0 0 0Paso 1: Selección de variables
Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación.
Variables Categoricas:
Horas_extra: Variable categorica Nominal
Estado_Civil: Variable Categórica Nominal
Viaje de Negocios: Variable Categórica Nominal
Hipótesis Variables Categóricas:
Horas_extra: Las personas que realizan horas extras se espera busque una rotación con el objetivo de no seguir reduciendo su tiempo libre con el laboral. Hipótesis: Las personas que no laboran horas extras tienen una menor posibilidad de rotar que los que si ejecutan horas extras.
Estado_Civil: Los trabajadores que se encuentran solteros tienen mayor libertad en su vida personal para buscar rotaciones que las personas que se encuentran casadas. Hipótesis: Las personas casadas presentan una mayor posibilidad de no rotar comparado con las personas solteras.
Viaje de Negocios: los empleados que viajan por solicitud de la compañía a pesar de obtener beneficios económicos y sociales por los viajes buscan con mayor frecuencia una rotación ya que no compensa con el agotamiento físico/mental. Hipótesis: Las personas que realizan viajes de negocios presentan una mayor posibilidad de rotación que las personas que no presentan viajes de negocio.
Variables Cuantitativas
Edad: Variable cuantitativa discreta
Satisfacción_Laboral: Variable Cuantitativa discreta
Ingreso_mensual: Variable Cuantitativa continua
Hipótesis Variables Cuantitativas:
Edad: Las personas con mayor edad pueden presentar una menor rotación por que hay una mayor aversión al riesgo e incertidumbre que nuevos empleos generan. Hipótesis: los trabajadores con mayor edad tienen una menor probabilidad de realizar una rotación.
Satisfacción_Laboral: Los empleados con mayores calificaciones de satisfacción laboral encuentran menos razones para realizar una rotación que una persona con satisfacción baja. Hipótesis: Las personas con mejores calificaciones de satisfacción laboral presentan una menor posibilidad de rotación que los que tienen una calificación de satisfacción baja.
Ingreso_mensual: Se espera que las personas con mayores salarios no deseen realizar cambios de empleo que puedan desmejorar sus condicionales salariales actuales. Hipótesis: las personas con ingresos salariales más altos tiene una menor posibilidad de realizar una rotación que las personas con salarios más bajos.
nombres <- names(rotacion)
print(nombres)## [1] "Rotación" "Edad"
## [3] "Viaje de Negocios" "Departamento"
## [5] "Distancia_Casa" "Educación"
## [7] "Campo_Educación" "Satisfacción_Ambiental"
## [9] "Genero" "Cargo"
## [11] "Satisfación_Laboral" "Estado_Civil"
## [13] "Ingreso_Mensual" "Trabajos_Anteriores"
## [15] "Horas_Extra" "Porcentaje_aumento_salarial"
## [17] "Rendimiento_Laboral" "Años_Experiencia"
## [19] "Capacitaciones" "Equilibrio_Trabajo_Vida"
## [21] "Antigüedad" "Antigüedad_Cargo"
## [23] "Años_ultima_promoción" "Años_acargo_con_mismo_jefe"df_rotacion <- subset(rotacion, select= c(Rotación, Edad, `Viaje de Negocios`, Horas_Extra, Satisfación_Laboral, Estado_Civil, Ingreso_Mensual))
head(df_rotacion)Paso 2: Análisis univariado
Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion.
Variables Categoricas
Rotación
Se observa un total de 1470 registros donde la mayoria de ellos son de empleados sin rotación de cargo con 1233, 83.9%, mientras que personas con rotación son 237, equivalente a 16.1%.
library(ggplot2)
library(ggpubr)
library(table1)
library(knitr)
library(tidyverse)
library(ggmosaic)
library(plotly)
df_r <- df_rotacion %>%
group_by(Rotación) %>%
summarise(Total=n()) %>%
dplyr::mutate(Porcentaje = round(Total/sum(Total)*100, 1))
ggplot(df_r, aes(x=`Rotación`, y=Total,fill=Rotación) ) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank())+
geom_bar(width = 0.9, stat="identity", position = position_dodge())+
geom_text(aes(label=paste0(Total," ", "", "(", Porcentaje, "%",")")),
vjust=2,
color="black",
hjust=0.5,
position = position_dodge(0.9),
angle=0,
size=4.0
)
Horas Extra
Se observa en primera instancia que de la población de empleados la mayoría de ellos no realiza Horas extra con un porcentaje de 71.7% equivalente a 1054 de personas, frente a 416 que si realizan horas extra (28.3%)
df_horas <- df_rotacion %>%
group_by(Horas_Extra) %>%
summarise(Total=n()) %>%
dplyr::mutate(Porcentaje = round(Total/sum(Total)*100, 1))
ggplot(df_horas, aes(x=`Horas_Extra`, y=Total,fill=Horas_Extra) ) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank())+
geom_bar(width = 0.9, stat="identity", position = position_dodge())+
geom_text(aes(label=paste0(Total," ", "", "(", Porcentaje, "%",")")),
vjust=2,
color="black",
hjust=0.5,
position = position_dodge(0.9),
angle=0,
size=4.0
)
Estado Civil
Se observa a continuación que el grupo población con mayor presencia son las personas casadas con 45.8%, seguido por solteros con 32% y por ultimo divorciados, 22.2%.
df_estado <- df_rotacion %>%
group_by(Estado_Civil) %>%
summarise(Total=n()) %>%
dplyr::mutate(Porcentaje = round(Total/sum(Total)*100, 1))
ggplot(df_estado, aes(x=`Estado_Civil`, y=Total,fill=Estado_Civil) ) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank())+
geom_bar(width = 0.9, stat="identity", position = position_dodge())+
geom_text(aes(label=paste0(Total," ", "", "(", Porcentaje, "%",")")),
vjust=2,
color="black",
hjust=0.5,
position = position_dodge(0.9),
angle=0,
size=4.0
)
Viaje de Negocios
Al observar la información se distingue que el porcentaje más alto de empleados raramente viaja por razones laborales, con un 71% de los registros.
df_viaje <- df_rotacion %>%
group_by(`Viaje de Negocios`) %>%
summarise(Total=n()) %>%
dplyr::mutate(Porcentaje = round(Total/sum(Total)*100, 1))
ggplot(df_viaje, aes(x=`Viaje de Negocios`, y=Total,fill=`Viaje de Negocios`) ) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank())+
geom_bar(width = 0.9, stat="identity", position = position_dodge())+
geom_text(aes(label=paste0(Total," ", "", "(", Porcentaje, "%",")")),
vjust=2,
color="black",
hjust=0.5,
position = position_dodge(0.9),
angle=0,
size=4.0
)
Variables cuantitativas
Para las variables cuantitativas, inicialmente se evalúa su resumen de estadísticos principales y unos histogramas.
summary(df_rotacion[, c("Edad","Satisfación_Laboral","Ingreso_Mensual")])## Edad Satisfación_Laboral Ingreso_Mensual
## Min. :18.00 Min. :1.000 Min. : 1009
## 1st Qu.:30.00 1st Qu.:2.000 1st Qu.: 2911
## Median :36.00 Median :3.000 Median : 4919
## Mean :36.92 Mean :2.729 Mean : 6503
## 3rd Qu.:43.00 3rd Qu.:4.000 3rd Qu.: 8379
## Max. :60.00 Max. :4.000 Max. :19999vcn1=ggplot(df_rotacion,aes(x=Edad))+geom_bar()
vcn2=ggplot(df_rotacion,aes(x=Ingreso_Mensual))+geom_histogram()
vcn3=ggplot(df_rotacion,aes(x=Satisfación_Laboral))+geom_bar()+geom_text(stat='count', aes(x=Satisfación_Laboral,label=..count..),vjust=2, col="white")+theme_bw()
ggarrange(vcn1, vcn2, vcn3,ncol = 2, nrow = 2)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Encontrando los siguientes mensajes:
- Edad: Las personas que laboran en la compañía tiene una edad entre 18 y 60 años, con un valor promedio de 36 años y el 50% de sus empleados se encuentra entre 30 y 43 años.
- Satisfacción Laboral: La mínima y máxima calificación en la empresa es de 1 y 4 respectivamente, donde el promedio de los empleados ha dado una calificación de 3. las menores calificación de 1 y 2 están muy cercanas entre ellas con 280 y 289 personas con este registro mientras que en 3 y 4 son cercanas entre ellas de 442 y 459, se puede entender que las personas en su mayoría poseen una satisfacción laboral percibida como buena (61% entre 3 y 4).
- Ingreso Mensual: Los trabajadores tiene un ingreso de entre 1009 y 19999 y el promedio de ellos tiene un ingreso de 4919. El 75% de ellos ganan 8379 o menos, sin embargo el otro 25% puede llegar a tener salarios de hasta 19999.
Paso 3: Análisis bivariado
Realiza un análisis de bivariado en donde la variable respuesta sea rotacion codificada de la siguiente manera (y=1 es si rotación, y=0 es no rotación). Con base en estos resultados identifique cuales son las variables determinantes de la rotación e interpretar el signo del coeficiente estimado. Compare estos resultados con la hipótesis planteada en el punto 2.
Se realiza la codificación requerida de 1 y 0:
df_rotacion$Rotación <- ifelse(df_rotacion$Rotación == "Si", 1, 0)
head(df_rotacion)A continuación se realiza el análisis bivariado de cada una de las variables seleccionadas junto a la rotación:
Horas Extra
Evaluando la información se encuentra que hay una mayor rotación de personas en el grupo que realizan horas extras con un 31% frente al 10% de las personas que no hacen horas extras. Esto soporta la hipótesis previamente planteada.
library(CGPfunctions)## Warning: package 'CGPfunctions' was built under R version 4.3.3Hextra = PlotXTabs2(data = df_rotacion,x = Horas_Extra, y = Rotación)
Hextra
horasE <- table1::table1(~ Horas_Extra | Rotación, data = df_rotacion)## Warning in table1.formula(~Horas_Extra | Rotación, data = df_rotacion): Terms
## to the right of '|' in formula 'x' define table columns and are expected to be
## factors with meaningful labels.horasE| 0 (N=1233) |
1 (N=237) |
Overall (N=1470) |
|
|---|---|---|---|
| Horas_Extra | |||
| No | 944 (76.6%) | 110 (46.4%) | 1054 (71.7%) |
| Si | 289 (23.4%) | 127 (53.6%) | 416 (28.3%) |
Se elabora un modelo de regresión lineal de la rotacion y si trabaja o no horas extra:
mod_horas = glm(Rotación ~ Horas_Extra, data= df_rotacion, family="binomial")
summary(mod_horas)##
## Call:
## glm(formula = Rotación ~ Horas_Extra, family = "binomial", data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.1496 0.1007 -21.338 <2e-16 ***
## Horas_ExtraSi 1.3274 0.1466 9.056 <2e-16 ***
## ---
## 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: 1217.2 on 1468 degrees of freedom
## AIC: 1221.2
##
## Number of Fisher Scoring iterations: 4Encontrando que el modelo posee un coeficiente de ~ 1.33 para cuando el empleado SI realiza Horas extra, indicando que esta variable y respuesta afirmativa incrementa la posibilidad de rotación, alineado con la hipótesis inicial.
Estado Civil
Evaluando la información se encuentra que hay una mayor rotación de personas en el grupo de solteros con un 26% frente al 10% del grupo de divorciados y un 12% de los casados. Adicionalmente, se observa que el grupo de personas solteras tiene el 50.6% de la totalidad de las personas que realizaron rotación frente un 35.4% de personas casadas y por ultimo 13.9% de divorciados. Estos mensajes soporta la hipótesis previamente planteada.
En el modelo de regresión lineal se encuentra un intercepto negativo para la categoría de divorciados -0.239 indicando que esta característica al tomar este valor tiende a reducir la probabilidad de rotación sin embargo para los casos de solteros el coeficiente es positivo de 0.787 indicando que incrementa la probabilidad de rotacion, adicionalmente presenta un P-value de 2.5e-08 < 0.05, indicando que es estadisticamente significativo mientras que si es divorciado No lo es.
estadoC = PlotXTabs2(data = df_rotacion,x = Estado_Civil, y = Rotación)
estadoC
Ecivil <- table1::table1(~ Estado_Civil | Rotación, data = df_rotacion)
print(Ecivil)## <table class="Rtable1">
## <thead>
## <tr>
## <th class='rowlabel firstrow lastrow'></th>
## <th class='firstrow lastrow'><span class='stratlabel'>0<br><span class='stratn'>(N=1233)</span></span></th>
## <th class='firstrow lastrow'><span class='stratlabel'>1<br><span class='stratn'>(N=237)</span></span></th>
## <th class='firstrow lastrow'><span class='stratlabel'>Overall<br><span class='stratn'>(N=1470)</span></span></th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td class='rowlabel firstrow'>Estado_Civil</td>
## <td class='firstrow'></td>
## <td class='firstrow'></td>
## <td class='firstrow'></td>
## </tr>
## <tr>
## <td class='rowlabel'>Casado</td>
## <td>589 (47.8%)</td>
## <td>84 (35.4%)</td>
## <td>673 (45.8%)</td>
## </tr>
## <tr>
## <td class='rowlabel'>Divorciado</td>
## <td>294 (23.8%)</td>
## <td>33 (13.9%)</td>
## <td>327 (22.2%)</td>
## </tr>
## <tr>
## <td class='rowlabel lastrow'>Soltero</td>
## <td class='lastrow'>350 (28.4%)</td>
## <td class='lastrow'>120 (50.6%)</td>
## <td class='lastrow'>470 (32.0%)</td>
## </tr>
## </tbody>
## </table>mod_estadoC = glm(Rotación ~ Estado_Civil, data= df_rotacion, family="binomial")
summary(mod_estadoC)##
## Call:
## glm(formula = Rotación ~ Estado_Civil, family = "binomial",
## data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.9476 0.1166 -16.699 < 2e-16 ***
## Estado_CivilDivorciado -0.2395 0.2175 -1.101 0.271
## Estado_CivilSoltero 0.8772 0.1575 5.571 2.54e-08 ***
## ---
## 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: 1254.6 on 1467 degrees of freedom
## AIC: 1260.6
##
## Number of Fisher Scoring iterations: 4Viaje de Negocios
Evaluando la información se encuentra que hay una mayor rotación de personas en el grupo que viaja frecuentemente por negocios con un 25% frente al 15% del grupo que viaja raramente y un 8% de los que no viajan. Adicionalmente, se logra visualizar que del total de personas en la categoría de rotacion = 1, la mayor proporción de personas se encuentra en los trabajadores que viajan raramente con un 65.8%, mientras que los que lo hacen frecuentemente tienen de esta categoría de rotación = 1, un porcentaje de 29.1%, este valor no es bajo pero es contra intuitivo ya que se pensaría que esta iba a ser quien tuviera el mayor porcentaje, mientras que si se puede confirmar que los que no viajan representan solo el 5.1%. Estos mensajes soporta la hipótesis previamente planteada.
Para el caso de la regresión binominal viajar raramente o no viajar presentan coeficientes negativos indicando una reducción de la posibilidad de que suceda una rotación.
PlotXTabs2(data = df_rotacion,x = `Viaje de Negocios`,y = Rotación)
viajeN <- table1::table1(~ `Viaje de Negocios` | Rotación, data = df_rotacion)
print(viajeN)## <table class="Rtable1">
## <thead>
## <tr>
## <th class='rowlabel firstrow lastrow'></th>
## <th class='firstrow lastrow'><span class='stratlabel'>0<br><span class='stratn'>(N=1233)</span></span></th>
## <th class='firstrow lastrow'><span class='stratlabel'>1<br><span class='stratn'>(N=237)</span></span></th>
## <th class='firstrow lastrow'><span class='stratlabel'>Overall<br><span class='stratn'>(N=1470)</span></span></th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td class='rowlabel firstrow'>Viaje de Negocios</td>
## <td class='firstrow'></td>
## <td class='firstrow'></td>
## <td class='firstrow'></td>
## </tr>
## <tr>
## <td class='rowlabel'>Frecuentemente</td>
## <td>208 (16.9%)</td>
## <td>69 (29.1%)</td>
## <td>277 (18.8%)</td>
## </tr>
## <tr>
## <td class='rowlabel'>No_Viaja</td>
## <td>138 (11.2%)</td>
## <td>12 (5.1%)</td>
## <td>150 (10.2%)</td>
## </tr>
## <tr>
## <td class='rowlabel lastrow'>Raramente</td>
## <td class='lastrow'>887 (71.9%)</td>
## <td class='lastrow'>156 (65.8%)</td>
## <td class='lastrow'>1043 (71.0%)</td>
## </tr>
## </tbody>
## </table>mod_viajeN = glm(Rotación ~ `Viaje de Negocios`, data= df_rotacion, family="binomial")
summary(mod_viajeN)##
## Call:
## glm(formula = Rotación ~ `Viaje de Negocios`, family = "binomial",
## data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.1034 0.1389 -7.943 1.98e-15 ***
## `Viaje de Negocios`No_Viaja -1.3389 0.3315 -4.039 5.36e-05 ***
## `Viaje de Negocios`Raramente -0.6346 0.1638 -3.873 0.000107 ***
## ---
## 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: 1274.8 on 1467 degrees of freedom
## AIC: 1280.8
##
## Number of Fisher Scoring iterations: 5Edad
Evaluando el gráfico se encuentra una tendencia a que a menor edad hay un mayor porcentaje de rotacion de cargos y conforme la edad es mayor este porcentaje se reduce hasta llegar a edades cercanas a los 54 año o más donde aumenta ligeramente la rotación de cargos. También se observa que Las personas con o sin rotación de cargo, pueden encontrarse en todo el rango de edades de los empleados sin embargo si se logra apreciar que las personas que rotan tienen a tener un promedio de edad menor, 33.6 años, comparado con la edad promedio de las personas que no rotan, 37.6 años. Fortaleciendo la hipótesis previamente planteada en numerales anteriores.
En el modelo lineal se observa que el coeficiente de la edad es negativo con -0.05 indicando que es inverso a la decisión de realizar rotacion.
df_rotacion$Edad_agrup=cut(df_rotacion$Edad,breaks = c(18,24,30,36,42,48,54,60))
PlotXTabs2(data = df_rotacion,x = Edad_agrup,y = Rotación)
cualit <- table1::table1(~ Edad | Rotación, data = df_rotacion)## Warning in table1.formula(~Edad | Rotación, data = df_rotacion): Terms to the
## right of '|' in formula 'x' define table columns and are expected to be factors
## with meaningful labels.cualit| 0 (N=1233) |
1 (N=237) |
Overall (N=1470) |
|
|---|---|---|---|
| Edad | |||
| Mean (SD) | 37.6 (8.89) | 33.6 (9.69) | 36.9 (9.14) |
| Median [Min, Max] | 36.0 [18.0, 60.0] | 32.0 [18.0, 58.0] | 36.0 [18.0, 60.0] |
mod_edad = glm(Rotación ~ Edad, data= df_rotacion, family="binomial")
summary(mod_edad)##
## Call:
## glm(formula = Rotación ~ Edad, family = "binomial", data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.20637 0.30597 0.674 0.5
## Edad -0.05225 0.00870 -6.006 1.9e-09 ***
## ---
## 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: 1259.1 on 1468 degrees of freedom
## AIC: 1263.1
##
## Number of Fisher Scoring iterations: 4Satisfaccion Laboral
Evaluando el gráfico se observa que personas con calificaciones de satisfacción laboral más bajas, de 1, tienden a tener un mayor porcentaje de rotacion que las personas con calificación más alta en este caso de 4, y que las personas con calificaciones intermedias de 2 o 3 tienen un porcentaje similar entre ellos, lo cual podría enunciar que este es un grupo intermedio de rotacion. Adicionalmente, las personas con o sin rotacion pueden tener calificaciones de 1 a 4, sin embargo las personas que rotan tienden a tener una calificación promedio ligeramente menor frente a los que no lo hacen, 2.47 vs 2.78 respectivamente. En el modelo de regresión el coeficiente para la satisfacción laboral presenta un valor negativo de -0.25 indicando que conforme aumenta la satisfacción laboral se reduce la posibilidad de rotacion.
PlotXTabs2(data = df_rotacion,x = Satisfación_Laboral,y = Rotación)
cualit <- table1::table1(~ Satisfación_Laboral | Rotación, data = df_rotacion)## Warning in table1.formula(~Satisfación_Laboral | Rotación, data = df_rotacion):
## Terms to the right of '|' in formula 'x' define table columns and are expected
## to be factors with meaningful labels.cualit| 0 (N=1233) |
1 (N=237) |
Overall (N=1470) |
|
|---|---|---|---|
| Satisfación_Laboral | |||
| Mean (SD) | 2.78 (1.09) | 2.47 (1.12) | 2.73 (1.10) |
| Median [Min, Max] | 3.00 [1.00, 4.00] | 3.00 [1.00, 4.00] | 3.00 [1.00, 4.00] |
mod_satisL = glm(Rotación ~ Satisfación_Laboral, data= df_rotacion, family="binomial")
summary(mod_satisL)##
## Call:
## glm(formula = Rotación ~ Satisfación_Laboral, family = "binomial",
## data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.9903 0.1757 -5.635 1.75e-08 ***
## Satisfación_Laboral -0.2510 0.0637 -3.940 8.16e-05 ***
## ---
## 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: 1283.1 on 1468 degrees of freedom
## AIC: 1287.1
##
## Number of Fisher Scoring iterations: 4Ingresos Mensuales
- Las personas que rotan o no, están para efectos prácticos en un mismo espacio salarial de 1000 a 20000, sin embargo las personas que rotan tienen en promedio un menor ingreso comparado con las personas que no rotan, 4790 vs 6830 respectivamente. Adicionalmente, las personas que rotan tienen una mediana o el 50% de ellos presentan un ingreso salarial igual o menor a 3200, que comparado con los que no rotan de 5200, lo cual es mucho menor. También se logra observar que salarios por encima de 13000 tienden a tener porcentajes más bajos de rotacion.
En el modelo de regresión el coeficiente para el ingreso mensual es negativo con un valor de -1.27e-04, indicando que conforme aumenta el salario existe una menor posibilidad de rotacion del empleado.
df_rotacion$Ingr_agrup=cut(df_rotacion$Ingreso_Mensual,breaks = c(1000,4000,7000,10000,13000,15000,18000,21000))
PlotXTabs2(data = df_rotacion,x = Ingr_agrup,y = Rotación)
cualit <- table1::table1(~ Ingreso_Mensual | Rotación, data = df_rotacion)## Warning in table1.formula(~Ingreso_Mensual | Rotación, data = df_rotacion):
## Terms to the right of '|' in formula 'x' define table columns and are expected
## to be factors with meaningful labels.cualit| 0 (N=1233) |
1 (N=237) |
Overall (N=1470) |
|
|---|---|---|---|
| Ingreso_Mensual | |||
| Mean (SD) | 6830 (4820) | 4790 (3640) | 6500 (4710) |
| Median [Min, Max] | 5200 [1050, 20000] | 3200 [1010, 19900] | 4920 [1010, 20000] |
mod_ingresos = glm(Rotación ~ Ingreso_Mensual, data= df_rotacion, family="binomial")
summary(mod_ingresos)##
## Call:
## glm(formula = Rotación ~ Ingreso_Mensual, family = "binomial",
## data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.291e-01 1.292e-01 -7.191 6.43e-13 ***
## Ingreso_Mensual -1.271e-04 2.162e-05 -5.879 4.12e-09 ***
## ---
## 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: 1253.1 on 1468 degrees of freedom
## AIC: 1257.1
##
## Number of Fisher Scoring iterations: 5Paso 4: Estimación del modelo
Realiza la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotacion (y=1 es si rotación, y=0 es no rotación) y las covariables las 6 seleccionadas en el punto 1. Interprete los coeficientes del modelo y la significancia de los parámetros.
modelo1 <-
glm(Rotación ~ Horas_Extra + Estado_Civil + `Viaje de Negocios` + Edad + Satisfación_Laboral + Ingreso_Mensual, family = binomial(link = "logit"), data = df_rotacion)
summary(modelo1)##
## Call:
## glm(formula = Rotación ~ Horas_Extra + Estado_Civil + `Viaje de Negocios` +
## Edad + Satisfación_Laboral + Ingreso_Mensual, family = binomial(link = "logit"),
## data = df_rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 6.171e-01 4.250e-01 1.452 0.146536
## Horas_ExtraSi 1.508e+00 1.597e-01 9.443 < 2e-16 ***
## Estado_CivilDivorciado -3.182e-01 2.307e-01 -1.379 0.167840
## Estado_CivilSoltero 8.414e-01 1.718e-01 4.896 9.76e-07 ***
## `Viaje de Negocios`No_Viaja -1.304e+00 3.542e-01 -3.683 0.000230 ***
## `Viaje de Negocios`Raramente -6.663e-01 1.815e-01 -3.671 0.000241 ***
## Edad -3.120e-02 1.022e-02 -3.053 0.002267 **
## Satisfación_Laboral -3.317e-01 6.970e-02 -4.759 1.94e-06 ***
## Ingreso_Mensual -9.856e-05 2.507e-05 -3.931 8.44e-05 ***
## ---
## 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: 1075.0 on 1461 degrees of freedom
## AIC: 1093
##
## Number of Fisher Scoring iterations: 5ratio_Odds=exp(modelo1$coefficients)
ratio_Odds## (Intercept) Horas_ExtraSi
## 1.8534648 4.5165259
## Estado_CivilDivorciado Estado_CivilSoltero
## 0.7274502 2.3196229
## `Viaje de Negocios`No_Viaja `Viaje de Negocios`Raramente
## 0.2713281 0.5136093
## Edad Satisfación_Laboral
## 0.9692803 0.7176972
## Ingreso_Mensual
## 0.9999014Se realiza la estimación del modelo y los ratios de Odds, evaluando esta información se observa que:
- Horas_ExtraSi, posee un coeficiente de 1.58, y una razón de Odds de 4.51, indicando que hay una asociación positiva y un incremento en la probabilidad de rotacion del empleado.
- Estado_CivilDivorciado, posee un coeficiente de -0.3182, y una razón de Odds de 0.727, indicando una relación negativa, indicando que si un empleado se encuentra en este estado civil disminuye la probabilidad de rotacion.
- Estado_CivilSoltero, posee un coeficiente de 0.841 y una razón de Odds de 2.31, indicando que hay una asociación positiva y que la probabilidad de rotacion se multiplican 2.31 veces, aumento entonces la posibilidad de rotacion.
Viaje de NegociosNo_Viaja yViaje de NegociosRaramente, poseen coeficientes de -1.3 y -6.66, con razón de Odds de 0.27 y 0.51, indicando relaciones negativas y reducciones de probabilidad multiplicadas por factores de 0.27 y 0.51, indicando que los empleados que no viajan o lo hacen raramente por negocios disminuyen su posibilidad de rotacion.- La edad posee un coeficiente de -3.12e-02 y una razón de odds de 0.96, indicando una relación negativa con la rotacion, y explicando que la probabilidad del empleado de rotar se reduce multiplicando por un factor de 0.96, y que conforme la edad aumenta se reduce la probabilidad de que los empleados roten.
- la Satisfacción_Laboral presenta un coeficiente negativo de -3.32e-01 y una razón de Odds de 0.717, indicando que conforme la satisfacción del empleado sube, ru probabilidad de rotar se reduce siendo multiplicada por un factor de 0.717.
- El ingreso mensual presenta también un coeficiente negativo de -9.85e-05 y una razón de Odds de 0.9999, un valor muy cercano a 1, lo cual puede sugerir una ligera asociación negativa con la rotacion, entendiéndose que conforme aumenta el salario hay una ligera reducción de probabilidad de rotar sin embargo podría llegar a despreciarse.
Se puede apreciar que las variables significativas son:Horas_Extra, Estado civil específicamente si es soltero, Viajes de Negocio, Satisfacción laboral, ingresos mensuales y edad.
Las variables que no son significativas fue Estado_CivilDivorciado, lo cual podría evaluarse si debe ser eliminada del modelo y si esto traería una mejora en predicción.
Paso 5: Evaluación
Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
##Horas_Extra + Estado_Civil + `Viaje de Negocios` + Edad + Satisfación_Laboral + Ingreso_Mensual
library(pROC)
prediccion1= predict(modelo1,list( Horas_Extra=df_rotacion$Horas_Extra, Estado_Civil=df_rotacion$Estado_Civil, `Viaje de Negocios` = df_rotacion$`Viaje de Negocios`, Edad = df_rotacion$Edad, Satisfación_Laboral = df_rotacion$Satisfación_Laboral, Ingreso_Mensual = df_rotacion$Ingreso_Mensual ),type = "response")ROC_rotacion= roc(rotacion$Rotación~prediccion1, percent = F, ci=T)
ROC_rotacion##
## Call:
## roc.formula(formula = rotacion$Rotación ~ prediccion1, percent = F, ci = T)
##
## Data: prediccion1 in 1233 controls (rotacion$Rotación No) < 237 cases (rotacion$Rotación Si).
## Area under the curve: 0.7808
## 95% CI: 0.7459-0.8157 (DeLong)plot(ROC_rotacion,print.auc=T,print.thres = "best",col="red"
,xlab = "Specificity", ylab = "Sensitivity")
El Área bajo la Curva (AUC), muestra un rendimiento adecuado al
presentar un valor de 0.781 > 0.5 y al presentar una curva cercana al
punto (0,1) indicando que logra predecir si los empleados tienen
probabilidad de rotacion o no, adicionalmente el intervalo de confianza
del 95% indica que existe una alta probabilidad de que el AUC este entre
74.6 y 81.6%.
Paso 6: Predicciones
Realiza una predicción la probabilidad de que un individuo (hipotético) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
El caso hipotético planteado es el siguiente: un empleado que no trabaja horas extra, se encuentra soltero, raramente viaja por negocios,tiene una edad de 32 años, su satisfacción laboral es 4 y sus ingresos mensuales son de 12500. Teniendo en cuenta esta información se realiza la predicción:
(predict(modelo1,list(Horas_Extra="Si",Estado_Civil="Soltero",`Viaje de Negocios`="Raramente",Edad=32,Satisfación_Laboral=3, Ingreso_Mensual=12500),type="response"))## 1
## 0.2838103Teniendo una corte de 20%, y con esta información se obtiene una probabilidad de 28% de rotación para este empleado, lo cual es relativamente alto para una corte, recomendando por ende la intervención y definición de una estrategia de motivación la cual consistirá en:
- No continuar con las Horas Extras.
- Eliminar los viajes de negocios por completo.
- No se ejecutara aumento salarial debido a que se encuentra por encima de la media de la compañía
- La situación sentimental del empleado no puede ser modificada o alterada por la compañía por lo cual esta no sera cambiada.
- Se espera una mejora en la calificación de satisfacción laboral sin embargo al encontrarse en la media, se decide mantener esta calificación.
(predict(modelo1,list(Horas_Extra="No",Estado_Civil="Soltero",`Viaje de Negocios`="No_Viaja",Edad=32,Satisfación_Laboral=3, Ingreso_Mensual=12500),type="response"))## 1
## 0.04429758Con esta estrategia se espera una reducción en la probabilidad a un 4% y por ende una retención del empleado en el cargo actual y compañía.
4. Paso 7: Conclusiones
En las conclusiones adicione una discusión sobre cuál sería la estrategia para disminuir la rotación en la empresa (con base en las variables que resultaron significativas en el punto 3).
Teniendo en cuenta cada una de las 6 variables evaluadas para la construcción del modelo y la revisión univariada, bivariada y su impacto en el modelo de regresión se plantea lo siguiente:
- Horas extra: Se deben implementar políticas de reducción y/o eliminación de horas extras ya que aumentan en 4.51 veces la probabilidad de rotación de los empleados y es la variable con impacto más alto de las 6 evaluadas.
- Estado Civil: A pesar de que la compañía no interviene directamente en el estado civil de los empleados, se pueden buscar estrategias comerciales o de beneficios para casados que motiven a las personas solteras a buscar este estilo de vida, ya que comprenden el 32% de la compañía, y reducir esta categoría incide en reducción de probabilidad de rotación.
- Viajes de Negocio: La mejor estrategia para la compañía y de acuerdo al análisis univariado es continuar motivando una frecuencia baja de viajes, actualmente es el 71% y esta categoría reduce la probabilidad de rotación de empleados.
- Edad: Se puede plantear una estrategia de contratación de trabajadores superiores a 24 años ya que el rango de 18 a 24 tiene un mayor porcentaje de rotación, sin embargo no se debe sacrificar completamente este rango inferior de edad, ya que el impacto en rotación se evaluó fue bajo debido a a una razón de Odds de 0.96 bastante cercano a 1.
- Ingreso Mensual: en la razón de odds se observo un impacto bastante bajo casi nulo de esta variable sin embargo podría ser evaluado la factibilidad de reajustar la base salarial de la compañía o de ciertas personas con una alta probabilidad de rotacion, ya que como fue observado en el análisis bivariado, las personas con rotación tendieron a tener salarios bajos comparados con los que no rotaron.
- Satisfacción laboral: esta calificación usualmente es el resultado de todas las políticas de bienestar y condiciones laborales, por ende se debe re evaluar esta calificación posterior a la implementación de nuevas practicas y estrategias como las previamente mencionadas.