# Instalación y cargue de librerías

library(paqueteMODELOS)
library(plotly)
library(dplyr)
library(ggplot2)
library(pROC)

1 Introducción

El presente ejercicio tiene como objetivo busca perfilar aquellos empleados más propensos a renunciar en una compañia que sirvan como insumo para el diseño e implementación de estrategias organizacionales que promuevan la retención de personal. La información base con la que se cuenta responde a variables (a) demográficas y profesionales del individuo y (b) relativas a su relación con la empresa. El modelo a emplear será una regresión logística.

2 Selección de variables

Se priorizarán 6 variables para este análisis: 3 categóricas y 3 cuantitativas partir del siguiente dataframe:

data("rotacion")

head(rotacion)

2.1 Variables categóricas:

  1. Cargo: aspectos intrínsecos a cada cargo pueden incidir en la rotación de empleados al ser una variable que se determina por aspectos como proyección a futuro, beneficios laborales, bonos y tolerancia a trabajar bajo presión.
  2. Estado Civil: la permanencia en una empresa podría verse afectada por la búsqueda de vidas con más tiempo libre o de estabiliad contractual.
  3. Departamento: para una empresa es necesario entender las lógicas de rotación de cada área con el fin de diseñar estrategias cada vez más puntuales y efectivas.

2.2 Variables cuantitativas:

  1. Ingreso mensual: el salario suele ser un incentivo fundamental para la decisión de permanencia o retiro de un trabajo.
  2. Edad: la edad puede ser una variable que incida en la forma como la persona se proyecta laboralmente y configure su disposición a explorar el mercado laboral de manera más dinámica.
  3. Porcentaje de aumento salarial: tiene una carga simbólica y práctica de retribución por el trabajo que se realiza y puede fortalecer o debilitar la relación del individuo con la compañia.

Así, priorizando las variables descritas, se trabaja sobre la siguiente base de datos con ningún valor nulo:

df <- rotacion[,c("Rotación", "Cargo", "Estado_Civil", "Departamento", 
                  "Ingreso_Mensual", "Edad", "Porcentaje_aumento_salarial")]
df<-as.data.frame(df)

nulos <- sum(is.na(df))

2.3 Hipótesis

  1. Cargo: las personas con los cargos laborales de mayor rango, dado que involucran mejor proyección y salario, mostrarán mayor tendencia a no retirarse de la empresa.
  2. Estado Civil: las personas casadas rotan menos entre empresas dado que prefieren la estabilidad laboral.
  3. Departamento: las personas que trabajan en el departamento de ventas tienden a rotar más de empresa debido a que es un campo profesional con alta demanda de mano de obra.
  4. Ingreso mensual: las personas con salarios más altos tenderán a retirarse en menor medida de la empresa.
  5. Edad: las personas jóvenes tienden a explorar de manera más activa el mercado laboral y sus vocaciones, por lo que se retirarán más seguido de la empresa.
  6. Porcentaje de aumento salarial: las personas que perciben menores retribuciones o incentivos económicos ofrecidos por la empresa tendrán un vínculo más débil con la misma y están más dispuestos a retirarse.

3 Análisis univariado

3.1 Cargo

Sus frecuencias son:

kable(table(df$Cargo))
Var1 Freq
Director_Investigación 80
Director_Manofactura 145
Ejecutivo_Ventas 326
Gerente 102
Investigador_Cientifico 292
Recursos_Humanos 52
Representante_Salud 131
Representante_Ventas 83
Tecnico_Laboratorio 259
grb_cargo <- ggplot(rotacion, aes(x = Cargo)) + 
  geom_bar(fill = "skyblue", color = "black", aes(y = ..count..)) +
  geom_text(aes(y = ..count.., label = scales::percent(..count../sum(..count..))), stat="count", position = position_dodge(0.9), vjust = -0.5) +
  labs(title = "Gráfico de barras para Cargo", x = "Cargo", y = "Frecuencia") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

print(grb_cargo)

Cómo se puede ver, la mayoría de cargos responden a procesos que requieren mayor mano de obra al soportar procesos de la cadena de valor del producto y no tanto gerencial o de estrategia de negocio.

3.2 Estado Civil

Sus frecuencias son:

kable(table(df$Estado_Civil))
Var1 Freq
Casado 673
Divorciado 327
Soltero 470
grb_ec <- ggplot(rotacion, aes(x = Estado_Civil)) + 
  geom_bar(fill = "skyblue", color = "black", aes(y = ..count..)) +
  geom_text(aes(y = ..count.., label = scales::percent(..count../sum(..count..))), stat="count", position = position_dodge(0.9), vjust = -0.5) +
  labs(title = "Gráfico de barras para Estado Civil", x = "Estado_Civil", y = "Frecuencia") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

print(grb_ec)

La mayoría de personas que trabajan en la empresa están casadas, lo que podría deberse a la modalidad de contratación de la empresa o características del sector.

3.3 Departamento

Sus frecuencias son:

kable(table(df$Departamento))
Var1 Freq
IyD 961
RH 63
Ventas 446
grb_dep <- ggplot(rotacion, aes(x = Departamento)) + 
  geom_bar(fill = "skyblue", color = "black", aes(y = ..count..)) +
  geom_text(aes(y = ..count.., label = scales::percent(..count../sum(..count..))), stat="count", position = position_dodge(0.9), vjust = -0.5) +
  labs(title = "Gráfico de barras para Departamento", x = "Departamento", y = "Frecuencia") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

print(grb_dep)

Como se puede observar, la empresa prioriza la innovación en el producto al contar con un personal marcadamente mayoritario en el área de Investigación y Desarrollo.

3.4 Ingreso Mensual

kable(df %>% 
        summarise(Media = mean(Ingreso_Mensual), 
                  Mediana = median(Ingreso_Mensual), 
                  Desv_Estandar = sd(Ingreso_Mensual), 
                  Minimo = min(Ingreso_Mensual), 
                  Maximo = max(Ingreso_Mensual)))
Media Mediana Desv_Estandar Minimo Maximo
6502.931 4919 4707.957 1009 19999

Teniendo un máximo de $ 20.000 y un mínimo de 1.000, una desviación estándar de 4700 y una media de 6503, se puede observar una alta variabilidad en los salarios, lo que puede incidir en las percepciones que desarrolle el individuo frente a su posición en la empresa.

plot_ly(data = rotacion, x = ~Ingreso_Mensual, type = "histogram", 
        marker = list(color = "skyblue")) %>%
  layout(title = "Histograma de Ingreso Mensual",
         xaxis = list(title = "Ingreso Mensual"),
         yaxis = list(title = "Frecuencia"))
bx_ingresos <- ggplot(df, aes(x = "", y = df$Ingreso_Mensual)) +
  geom_boxplot() +
  stat_summary(fun.data = function(y) {
    cuartiles <- quantile(y)
    return(data.frame(
      y = cuartiles[c(2, 3, 4)],
      label = c(paste("Q1:", round(cuartiles[2], 2)),
                paste("Mediana:", round(cuartiles[3], 2)),
                paste("Q3:", round(cuartiles[4], 2)))
    ))
  }, geom = "text", vjust = -0.5, color = "red") +
  labs(title = "Boxplot de Variable", y = "Valores") +
  theme_minimal()

print(bx_ingresos)

3.5 Edad

kable(df %>% 
        summarise(Media = mean(Edad), 
                  Mediana = median(Edad), 
                  Desv_Estandar = sd(Edad), 
                  Minimo = min(Edad), 
                  Maximo = max(Edad)))
Media Mediana Desv_Estandar Minimo Maximo
36.92449 36 9.135938 18 60

Cómo se puede ver se trata de una empresa con una fuerza laboral relativamente joven con un promedio de 36 años, pero con una gran cantidad de personas entre los 25 y 35 años, respecto a la cantidad de personas mayores de 40 años.

plot_ly(data = rotacion, x = ~Edad, type = "histogram", 
        marker = list(color = "skyblue")) %>%
  layout(title = "Histograma de Edad",
         xaxis = list(title = "Edad"),
         yaxis = list(title = "Frecuencia"))
bx_edad <- ggplot(df, aes(x = "", y = df$Edad)) +
  geom_boxplot() +
  stat_summary(fun.data = function(y) {
    cuartiles <- quantile(y)
    return(data.frame(
      y = cuartiles[c(2, 3, 4)],
      label = c(paste("Q1:", round(cuartiles[2], 2)),
                paste("Mediana:", round(cuartiles[3], 2)),
                paste("Q3:", round(cuartiles[4], 2)))
    ))
  }, geom = "text", vjust = -0.5, color = "red") +
  labs(title = "Boxplot de Variable", y = "Valores") +
  theme_minimal()

print(bx_edad)

3.6 Porcentaje de aumento salarial

kable(df %>% 
        summarise(Media = mean(Porcentaje_aumento_salarial), 
                  Mediana = median(Porcentaje_aumento_salarial), 
                  Desv_Estandar = sd(Porcentaje_aumento_salarial), 
                  Minimo = min(Porcentaje_aumento_salarial), 
                  Maximo = max(Porcentaje_aumento_salarial)))
Media Mediana Desv_Estandar Minimo Maximo
15.20952 14 3.659938 11 25

Dadas las características de la variable, se puede observar que la empresa tiene una política de aumento salarial en la que la mayoría percibe aumentos bajos y unos pocos aumentos más altos. Sin embargo, en términos reales, al tener como máximo el 25% y un promedio de 15% con una desviación estándar de 3.7%, se puede inferir que nadie percibe este beneficio de manera desproporcionada.

plot_ly(data = rotacion, x = ~Porcentaje_aumento_salarial, type = "histogram", 
        marker = list(color = "skyblue")) %>%
  layout(title = "Histograma de Porcentaje de aumento salarial",
         xaxis = list(title = "Porcentaje de aumento salarial"),
         yaxis = list(title = "Frecuencia"))
bx_aumento <- ggplot(df, aes(x = "", y = df$Porcentaje_aumento_salarial)) +
  geom_boxplot() +
  stat_summary(fun.data = function(y) {
    cuartiles <- quantile(y)
    return(data.frame(
      y = cuartiles[c(2, 3, 4)],
      label = c(paste("Q1:", round(cuartiles[2], 2)),
                paste("Mediana:", round(cuartiles[3], 2)),
                paste("Q3:", round(cuartiles[4], 2)))
    ))
  }, geom = "text", vjust = -0.5, color = "red") +
  labs(title = "Boxplot de Variable", y = "Valores") +
  theme_minimal()


print(bx_aumento)

4 Análisis Bivariado

4.1 Modelo lógistico - Cargo y rotación

# codificación
df$Rotación<-ifelse(df$Rotación=="Si",1,0)

# Modelo Cargo
modelo_cargo <- glm(Rotación ~ Cargo, data = df, family = binomial)
round(summary(modelo_cargo)$coefficients,2)
##                              Estimate Std. Error z value Pr(>|z|)
## (Intercept)                     -3.66       0.72   -5.12     0.00
## CargoDirector_Manofactura        1.06       0.79    1.35     0.18
## CargoEjecutivo_Ventas            2.11       0.73    2.89     0.00
## CargoGerente                     0.70       0.85    0.82     0.41
## CargoInvestigador_Cientifico     2.01       0.73    2.74     0.01
## CargoRecursos_Humanos            2.46       0.79    3.12     0.00
## CargoRepresentante_Salud         1.06       0.80    1.33     0.18
## CargoRepresentante_Ventas        3.25       0.75    4.33     0.00
## CargoTecnico_Laboratorio         2.51       0.73    3.43     0.00

El cargo más propenso a rotar en la empresa es el de Representante de ventas.

4.2 Modelo lógistico - Estado Civil y rotación

modelo_ec <- glm(Rotación ~ Estado_Civil, data = df, family = binomial)
round(summary(modelo_ec)$coefficients,2)
##                        Estimate Std. Error z value Pr(>|z|)
## (Intercept)               -1.95       0.12  -16.70     0.00
## Estado_CivilDivorciado    -0.24       0.22   -1.10     0.27
## Estado_CivilSoltero        0.88       0.16    5.57     0.00

Las personas solteras muestran una tendencia mucho mayor a rotar de empleo.

4.3 Modelo lógistico - Departamento y rotación

modelo_dep <- glm(Rotación ~ Departamento, data = df, family = binomial)
round(summary(modelo_dep)$coefficients,2)
##                    Estimate Std. Error z value Pr(>|z|)
## (Intercept)           -1.83       0.09  -19.58     0.00
## DepartamentoRH         0.38       0.33    1.14     0.25
## DepartamentoVentas     0.48       0.15    3.21     0.00

Las personas que trabajan en Investigación y Desarrollo tienden a rotar en mucha menor medida que los demás departamentos.

4.4 Modelo lógistico - Ingresos y rotación

modelo_im <- glm(Rotación ~ Ingreso_Mensual, data = df, family = binomial)
round(summary(modelo_im)$coefficients,5)
##                 Estimate Std. Error  z value Pr(>|z|)
## (Intercept)     -0.92911    0.12920 -7.19113        0
## Ingreso_Mensual -0.00013    0.00002 -5.87934        0

Un aumento en los ingresos mensuales está asociado con una ligera disminución en la probabilidad de renuncia

4.5 Modelo lógistico - Edad y rotación

modelo_ed <- glm(Rotación ~ Edad, data = df, family = binomial)
round(summary(modelo_ed)$coefficients,2)
##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)     0.21       0.31    0.67      0.5
## Edad           -0.05       0.01   -6.01      0.0

A medida que la edad de la persona aumenta, las probabilidades de rotación disminuyen.

4.6 Modelo lógistico - Porcentaje de aumento salarial y rotación

modelo_pas <- glm(Rotación ~ Porcentaje_aumento_salarial, data = df, family = binomial)
round(summary(modelo_pas)$coefficients,2)
##                             Estimate Std. Error z value Pr(>|z|)
## (Intercept)                    -1.50       0.30   -4.91     0.00
## Porcentaje_aumento_salarial    -0.01       0.02   -0.52     0.61

Las personas que más aumento salarial perciben, menor probabilidad tienen de dejar la empresa.

5 Estimación del modelo

modelo_log <- glm(Rotación ~ Cargo + Estado_Civil + Departamento + Ingreso_Mensual + Edad + Porcentaje_aumento_salarial , data = df, family = binomial)
summary(modelo_log)
## 
## Call:
## glm(formula = Rotación ~ Cargo + Estado_Civil + Departamento + 
##     Ingreso_Mensual + Edad + Porcentaje_aumento_salarial, family = binomial, 
##     data = df)
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  -3.033e+00  1.056e+00  -2.874  0.00406 ** 
## CargoDirector_Manofactura     1.079e+00  8.683e-01   1.243  0.21405    
## CargoEjecutivo_Ventas         2.146e+00  1.256e+00   1.708  0.08758 .  
## CargoGerente                  8.906e-01  9.354e-01   0.952  0.34102    
## CargoInvestigador_Cientifico  1.955e+00  9.081e-01   2.153  0.03134 *  
## CargoRecursos_Humanos         1.534e+01  4.322e+02   0.035  0.97168    
## CargoRepresentante_Salud      1.117e+00  8.738e-01   1.278  0.20109    
## CargoRepresentante_Ventas     3.142e+00  1.333e+00   2.358  0.01838 *  
## CargoTecnico_Laboratorio      2.496e+00  9.053e-01   2.757  0.00583 ** 
## Estado_CivilDivorciado       -2.050e-01  2.227e-01  -0.921  0.35712    
## Estado_CivilSoltero           7.890e-01  1.643e-01   4.802 1.57e-06 ***
## DepartamentoRH               -1.274e+01  4.322e+02  -0.029  0.97649    
## DepartamentoVentas           -5.932e-02  9.449e-01  -0.063  0.94995    
## Ingreso_Mensual               2.380e-05  4.360e-05   0.546  0.58510    
## Edad                         -2.516e-02  9.827e-03  -2.560  0.01047 *  
## Porcentaje_aumento_salarial  -8.014e-03  2.077e-02  -0.386  0.69958    
## ---
## 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: 1165.9  on 1454  degrees of freedom
## AIC: 1197.9
## 
## Number of Fisher Scoring iterations: 14

De acuerdo a los niveles de significancia de cada categoria, se puede decir que las características que más influyen para que una persona tome la decisión de dejar la empresa son: tener el cargo de Investigador Científico, de Representante de Ventas y Técnico de Laboratorio, en mayor medida. Así mismo, el estar soltero y la edad (mientras más edad menos probabilidad de rotación)

6 Evaluación del Modelo

predicciones <- predict(modelo_log, type = "response")
curva_roc <- roc(df$Rotación, predicciones)
plot(curva_roc, main="Curva ROC", col="purple", lwd=2)
abline(h=0, v=1, col="blue")

auc(curva_roc)
## Area under the curve: 0.723

De acuerdo al valor del Área Bajo la Curva, se puede concluir que el modelo tiene una capacidad de predicción aceptable frente a la probabilidad de rotación en una empresa.

#Predicciones

6.1 Empleado # 1

empleado_1 <- data.frame(
  `Cargo` = "Gerente",
  `Estado_Civil` = "Casado",  
  `Departamento` = "Ventas", 
  `Ingreso_Mensual` = 15000, 
  `Edad` = 32,
  `Porcentaje_aumento_salarial` = 1 
)
prediccion_e1 <- predict(modelo_log, newdata = empleado_1, type = "response")
print(prediccion_e1)
##          1 
## 0.06550227

Este empleado tiene una muy baja probabilidad de rotar, ya que se encuentra en un cargo gerencial, con menor disponibilidad de mano de obra en el mercado y un muy buen salario. Esto, a pesar de no percibir aumentos salariales significativos, por lo que no será necesario crear políticas o incentivos particulares para empleados similares a este perfil.

6.2 Empleado # 2

empleado_2 <- data.frame(
  `Cargo` = "Tecnico_Laboratorio",
  `Estado_Civil` = "Soltero",  
  `Departamento` = "IyD", 
  `Ingreso_Mensual` = 2000, 
  `Edad` = 25,
  `Porcentaje_aumento_salarial` = 8 
)
prediccion_e2 <- predict(modelo_log, newdata = empleado_2, type = "response")
print(prediccion_e2)
##         1 
## 0.4028651

El segundo empleado, en contraste, muestra una alta probabilidad de rotar, ya que tiene características que se han identificado como determinantes para dicho escenario, como lo es el estar Soltero, el trabajar como Técnico de Laboratorio y ser joven. Además de contar con un salario relativamente bajo y poco aumento salarial.

7 Conclusión

Según lo observado, la empresa deberá adelantar estrategias de retención pensando en los siguientes perfiles de empleados:

Solteros: beneficios en el manejo del tiempo libre, flexibilidad de horarios o modalidades, eventos de integración.

Por cargo: debe promoverse incentivos intelectuales y profesionales a las personas que se encuentran en cargos específicos y que son más propensos a tener rotación, como los Técnicos de Laboratorio o Representantes de Ventas.

Por edad: promover incentivos para que las personas identifiquen posibilidades de crecimiento personal y profesional en la empresa y logren proyectarlas y materializarlas.