En este informe se busca comprender y prever los factores que mas influyen en la rotación de empleados, según los datos recolectados, con el fin de reducir la rotación de personal, se busca identificar correctamente los posibles caso de rotación antes de que sucedan.

1 LIMPIEZA Y SELECCION DE DATOS

1.1 Importar librerias necesaria y datos

library(paqueteMODELOS) # Datos
library(dplyr)       # Para manipulación de datos
library(ggplot2)     # Para Graficas
library(gridExtra)   # Graficas
library(mice)      # Datos faltantes
library(caret)       # Para partición de datos, métricas y creación de dummies
library(DMwR2)       # Para undersampling
library(pROC)        # Para la curva ROC y AUC
library(caret)       # Matriz de confusión
library(DMwR)        # SMOTE
library(grid)        # Modelo
library(pROC)        # calcular AUC y ROC
#Datos 
data("rotacion")

1.2 Manejo de Datos, Faltantes y Atipicos

Se verifican datos faltantes, se corrigen nombres de variables con espacios para posteriores análisis y se crea una nueva columna de rotación pero en nomenclatura binaria.

#Quitar espacios de las variables
colnames(rotacion)[colnames(rotacion) == "Viaje de Negocios"] <- "Viaje_de_Negocios"

#Datos faltantes
md.pattern(rotacion, plot = TRUE, rotate.names = TRUE)
##  /\     /\
## {  `---'  }
## {  O   O  }
## ==>  V <==  No need for mice. This data set is completely observed.
##  \  \|/  /
##   `-----'
Datos faltantes

Datos faltantes

##      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 0
# Convertir Rotación a factor binario (1 = Si, 0 = No)
rotacion$Rotacion_binaria <- ifelse(rotacion$Rotación == "Si", 1, 0)

2 SELECCION DE VARIABLES

Se separan variables numéricas y categóricas para realizar pruebas estadísticas.

2.1 Numericas

# Variables Numericas 

# Lista de variables numéricas
numericas <- c("Ingreso_Mensual", "Antigüedad", "Porcentaje_aumento_salarial",
               "Años_Experiencia", "Capacitaciones", "Antigüedad_Cargo", 
               "Años_ultima_promoción", "Años_acargo_con_mismo_jefe",
               "Distancia_Casa","Edad","Trabajos_Anteriores")

# Realizamos las pruebas de correlación Spearman para cada variable numérica
resultados_correlacion <- lapply(numericas, function(var) {
  cor.test(rotacion$Rotacion_binaria, rotacion[[var]], method = "spearman")
})

# Extraemos los valores p y las correlaciones
resultados_resumen <- sapply(resultados_correlacion, function(x) c(p_value = x$p.value, rho = x$estimate))

# Convertimos los resultados en un dataframe para mejor visualización
resultados_df <- as.data.frame(t(resultados_resumen))
resultados_df$Variable <- rownames(resultados_df)
rownames(resultados_df) <- NULL

# Ordenamos los resultados por valor p (de menor a mayor) y mostramos el top 3
resultados_df <- resultados_df[order(resultados_df$p_value), ]
top_3_significativas <- head(resultados_df, 3)

# Mostramos el top 3
top_3_significativas
##        p_value    rho.rho Variable
## 4 1.355298e-14 -0.1990020        4
## 1 1.680405e-14 -0.1983050        1
## 2 1.811379e-13 -0.1904191        2

Se seleccionan variables con p-value mas bajo para el modelo.

2.2 Categoricas

# Se trasforman variables categoricas a factor para realizar pruebas
rotacion$Educación <- as.factor(rotacion$Educación)
rotacion$Satisfacción_Ambiental <- as.factor(rotacion$Satisfacción_Ambiental)
rotacion$Satisfación_Laboral <- as.factor(rotacion$Satisfación_Laboral)
rotacion$Rendimiento_Laboral <- as.factor(rotacion$Rendimiento_Laboral)
rotacion$Equilibrio_Trabajo_Vida <- as.factor(rotacion$Equilibrio_Trabajo_Vida)

# Tabla de contingencia y prueba de Chi-cuadrado o fisher
chisq1 <- chisq.test(table(rotacion$Rotación, rotacion$Satisfación_Laboral))
chisq2 <- chisq.test(table(rotacion$Rotación, rotacion$Estado_Civil))
chisq3 <- chisq.test(table(rotacion$Rotación, rotacion$Horas_Extra))
chisq4 <- chisq.test(table(rotacion$Rotación, rotacion$Genero))
chisq5 <- chisq.test(table(rotacion$Rotación, rotacion$Viaje_de_Negocios))
fisher6 <- fisher.test(table(rotacion$Rotación, rotacion$Campo_Educación), workspace = 2e8) # Prueba fisher por desbalanceo de clases
chisq7 <- chisq.test(table(rotacion$Rotación, rotacion$Educación))
chisq8 <- chisq.test(table(rotacion$Rotación, rotacion$Satisfacción_Ambiental))
chisq9 <- chisq.test(table(rotacion$Rotación, rotacion$Rendimiento_Laboral))
chisq10 <- chisq.test(table(rotacion$Rotación, rotacion$Equilibrio_Trabajo_Vida))
chisq11 <- chisq.test(table(rotacion$Rotación, rotacion$Departamento))
chisq12 <- chisq.test(table(rotacion$Rotación, rotacion$Cargo))

# Resultados de p-valor
chisq_results <- data.frame(
  Variable_1 = c("Satisfacción Laboral", "Estado Civil", "Horas Extra", 
                 "Genero", "Viaje de Negocios", "Campo_Educación",
                 "Educación", "Satisfacción_Ambiental", "Rendimiento_Laboral",     "Equilibrio_Trabajo_Vida", "Departamento", "Cargo"),
  p_value = c(chisq1$p.value, chisq2$p.value, chisq3$p.value, chisq4$p.value, 
              chisq5$p.value, fisher6$p.value, chisq7$p.value, chisq8$p.value,
              chisq9$p.value, chisq10$p.value, chisq11$p.value, chisq12$p.value)
)

# Ordenamos los resultados por valor p (de menor a mayor) y mostramos el top 3
chisq_results <- chisq_results[order(chisq_results$p_value), ]
top_3_significativas_chi <- head(chisq_results, 3)

# Mostramos el top 3
top_3_significativas_chi
##      Variable_1      p_value
## 3   Horas Extra 8.158424e-21
## 12        Cargo 2.752482e-15
## 2  Estado Civil 9.455511e-11

De igual forma se seleccionan variables categóricas con mejor p-value.

3 HIPOTESIS

Se seleccionan variables con P-Value mas significativos con pruebas de spearman, para variables numéricas y pruebas de Chi-cuadrado y fisher para variables categóricas.

Variables Categóricas:

Cargo → Algunos cargos están relacionados con mayor rotación

Estado Civil → Empleados solteros podrían estar más dispuestos a cambiar de trabajo en comparación con los casados.

Horas Extras → Un indicador de sobrecarga laboral que podría aumentar la rotación.

Variables Cuantitativas:

Ingreso Mensual → Un salario bajo puede estar asociado con una mayor rotación.

Antigüedad → Se espera que empleados con menos años en la empresa tengan mayor probabilidad de rotación.

Años_Experiencia → Puede reflejar estabilidad o insatisfacción en el trabajo.

4 ANALISIS UNIVARIADO

4.1 Categoricas

# Gráficos de barras
a1 <- ggplot(rotacion, aes(x = factor(Cargo))) +
  geom_bar(fill = "steelblue") +
  theme_minimal() +
  labs(title = "Distribución de Cargos", x = "Cargo", y = "Frecuencia") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 10)) # Rotar etiquetas
print(a1)
Grafico de barras Distribución de Cargo

Grafico de barras Distribución de Cargo

table(rotacion$Cargo)
## 
##  Director_Investigación    Director_Manofactura        Ejecutivo_Ventas 
##                      80                     145                     326 
##                 Gerente Investigador_Cientifico        Recursos_Humanos 
##                     102                     292                      52 
##     Representante_Salud    Representante_Ventas     Tecnico_Laboratorio 
##                     131                      83                     259

Los cargos que mas se repiten en orden son: Ejecutivo de ventas, Investigador Científico y Técnico de laboratorio.

a2 <- ggplot(rotacion, aes(x = Estado_Civil)) +
  geom_bar(fill = "darkred") +
  theme_minimal() +
  labs(title = "Distribución de Estado Civil", x = "Estado Civil", y = "Frecuencia")
print(a2)
Grafico de barras Distribución de Estado Civil

Grafico de barras Distribución de Estado Civil

table(rotacion$Estado_Civil)
## 
##     Casado Divorciado    Soltero 
##        673        327        470

La mayoría de empleados son Casados seguido por los Solteros

a3 <- ggplot(rotacion, aes(x = Horas_Extra)) +
  geom_bar(fill = "darkgreen") +
  theme_minimal() +
  labs(title = "Distribución de Horas Extra", x = "Horas Extra", y = "Frecuencia")
print(a3)
Grafico de barras Distribución de Horas Extras

Grafico de barras Distribución de Horas Extras

table(rotacion$Horas_Extra)
## 
##   No   Si 
## 1054  416

La mayoría de los empleados No hacen horas extras.

4.2 Numericas

Resumen de las variables

#Numericas

# Resumen estadístico
summary(rotacion$Ingreso_Mensual)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1009    2911    4919    6503    8379   19999
summary(rotacion$Antigüedad)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   3.000   5.000   7.008   9.000  40.000
summary(rotacion$Años_Experiencia)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00    6.00   10.00   11.28   15.00   40.00

Histogramas

b1 <- ggplot(rotacion, aes(x = Ingreso_Mensual)) +
  geom_histogram(fill = "blue", bins = 30, color = "black") +
  theme_minimal() +
  labs(title = "Distribución de Ingreso Mensual", x = "Ingreso Mensual", y = "Frecuencia") +
  theme(plot.title = element_text(size = 12, face = "bold"))

b2 <- ggplot(rotacion, aes(x = Antigüedad)) +
  geom_histogram(fill = "red", bins = 30, color = "black") +
  theme_minimal() +
  labs(title = "Distribución de Antigüedad", x = "Antigüedad (años)", y = "Frecuencia") +
  theme(plot.title = element_text(size = 12, face = "bold"))

b3 <- ggplot(rotacion, aes(x = Años_Experiencia)) +
  geom_histogram(fill = "green", bins = 10, color = "black") +
  theme_minimal() +
  labs(title = "Distribución de Años de Experiencia", x = "Años de Experiencia", y = "Frecuencia") +
  theme(plot.title = element_text(size = 12, face = "bold"))

# Organizar los gráficos en filas 
grid.arrange(b1, b2, b3, ncol = 1)
Histogramas Variables Numericas

Histogramas Variables Numericas

Todas las variables numéricas presentan una distribución con sesgo hacia el lado izquierdo de la gráfica y valores extremos en el lado derecho que alargan las gráficas, la mayoria del Ingreso mensual esta por debajo de los 8379, en el cado de la antiguedad esta por debajo de los 9 años y los años de experiencia se encuentran la mayoria debajo de los 15 años

Diagramas de Caja

# Boxplots
c1 <- ggplot(rotacion, aes(y = Ingreso_Mensual)) +
  geom_boxplot(fill = "blue") +
  theme_minimal() +
  labs(title = "Ingreso Mensual", y = "Ingreso Mensual")

c2 <- ggplot(rotacion, aes(y = Antigüedad)) +
  geom_boxplot(fill = "red") +
  theme_minimal() +
  labs(title = "Antigüedad", y = "Antigüedad (años)")

c3 <- ggplot(rotacion, aes(y = Años_Experiencia)) +
  geom_boxplot(fill = "green") +
  theme_minimal() +
  labs(title = "Años de experiencia", y = "Años de experiencia")

grid.arrange(c1, c2, c3, ncol = 3)
Boxplot variables numericas

Boxplot variables numericas

Todas las variables presentan valores lejanos hacia la parte superior de la gráfica.

table(rotacion$Rotación)
## 
##   No   Si 
## 1233  237

En la variable rotación se observa un fuerte desbalance donde la mayoría de los datos corresponden a personas que no rotan, lo que podría afectar la capacidad de predicción del modelo y el análisis en general.

5 ANALISIS BIVARIADO

5.1 Numericas

# Boxplots para visualizar diferencias en la distribución
d1 <- ggplot(rotacion, aes(x = Rotación, y = Ingreso_Mensual)) +
  geom_boxplot(fill = "lightblue") +
  theme_minimal() + ggtitle("Ingreso Mensual vs Rotación")
print(d1)
Boxplot entre rotacion e ingreso mensual

Boxplot entre rotacion e ingreso mensual

#Pruebas estadísticas
wilcox.test(Ingreso_Mensual ~ Rotación, data = rotacion)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Ingreso_Mensual by Rotación
## W = 191601, p-value = 2.951e-14
## alternative hypothesis: true location shift is not equal to 0
cor.test(rotacion$Rotacion_binaria, rotacion$Ingreso_Mensual, method = "spearman")
## 
##  Spearman's rank correlation rho
## 
## data:  rotacion$Rotacion_binaria and rotacion$Ingreso_Mensual
## S = 634406941, p-value = 1.68e-14
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## -0.198305

Se aprecia una correlación negativa con un coeficiente de -0.198, y un ingreso medio mas elevado para los empleados que no rotan, es decir, a medida que esta variable aumenta es menos probable que haya rotación y hay una diferencia significativa entre ambos grupos (según test de wilcox).

d2 <- ggplot(rotacion, aes(x = Rotación, y = Antigüedad)) +
  geom_boxplot(fill = "lightgreen") +
  theme_minimal() + ggtitle("Antigüedad vs Rotación")
print(d2)
Boxplot entre rotacion y Antiguedad

Boxplot entre rotacion y Antiguedad

#Pruebas estadísticas
wilcox.test(Antigüedad ~ Rotación, data = rotacion)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Antigüedad by Rotación
## W = 189639, p-value = 2.916e-13
## alternative hypothesis: true location shift is not equal to 0
cor.test(rotacion$Rotacion_binaria, rotacion$Antigüedad, method = "spearman")
## 
##  Spearman's rank correlation rho
## 
## data:  rotacion$Rotacion_binaria and rotacion$Antigüedad
## S = 630231983, p-value = 1.811e-13
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##        rho 
## -0.1904191

De igual forma en esta variable la correlación es negativa con un coeficiente de -0.190, a medida que la antigüedad aumenta es menos probable que haya rotación, hay una diferencia significativa entre ambos grupos (según test de wilcox).

d3 <- ggplot(rotacion, aes(x = Rotación, y = Años_Experiencia)) +
  geom_boxplot(fill = "lightcoral") +
  theme_minimal() + ggtitle("Años de experiencia vs Rotación")
print(d3)
Boxplot entre rotacion y Años de experiencia

Boxplot entre rotacion y Años de experiencia

#Pruebas estadísticas
wilcox.test(Años_Experiencia ~ Rotación, data = rotacion)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Años_Experiencia by Rotación
## W = 191654, p-value = 2.4e-14
## alternative hypothesis: true location shift is not equal to 0
cor.test(rotacion$Rotacion_binaria, rotacion$Años_Experiencia, method = "spearman")
## 
##  Spearman's rank correlation rho
## 
## data:  rotacion$Rotacion_binaria and rotacion$Años_Experiencia
## S = 634775955, p-value = 1.355e-14
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## -0.199002

En la variable años de experiencia, la correlación es negativa con un coeficiente de -0.199, a medida que la experiencia aumenta es menos probable que haya rotación, según el test de wilcox, hay una diferencia significativa entre la media de experiencia entre los empleados que rotan comparado con los que no lo hacen.

5.2 Categoricas

# Rotación vs Horas Extra (Gráfico de barras)
e1 <- ggplot(rotacion, aes(x = factor(Rotación), fill = factor(Horas_Extra))) +
  geom_bar(position = "dodge") +
  theme_minimal() +
  ggtitle("Rotación vs Horas Extra") +
  xlab("Rotación") + ylab("Frecuencia") +
  scale_fill_manual(values = c("lightblue", "lightgreen"), labels = c("No", "Sí"))
print(e1)
Relación entre rotacion y Horas Extras

Relación entre rotacion y Horas Extras

#Prueba de Chi-cuadrado
print(chisq3)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(rotacion$Rotación, rotacion$Horas_Extra)
## X-squared = 87.564, df = 1, p-value < 2.2e-16

Dado que p es menor a 0.05 (Prueba chi-squared), significa que existe una asociación significativa entre Rotación y Horas_Extra. Si nos fijamos en el gráfico la mayoría de personas que se fueron habían hecho horas extras, caso contrario es para los que se quedaron.

# Rotación vs Estado Civil (Gráfico de barras)
e2 <- ggplot(rotacion, aes(x = factor(Rotación), fill = factor(Estado_Civil))) +
  geom_bar(position = "dodge") +
  theme_minimal() +
  ggtitle("Rotación vs Estado Civil") +
  xlab("Rotación") + ylab("Frecuencia") +
  scale_fill_manual(values = c("lightcoral", "lightblue", "lightpink"), 
                    labels = c("Casado", "Divorciado", "Soltero"))
print(e2)
Relación entre rotacion y Estado Civil

Relación entre rotacion y Estado Civil

#Prueba de Chi-cuadrado
print(chisq2)
## 
##  Pearson's Chi-squared test
## 
## data:  table(rotacion$Rotación, rotacion$Estado_Civil)
## X-squared = 46.164, df = 2, p-value = 9.456e-11

Al igual que el caso anterior obtenemos p menor a 0.05, y se puede comprobar en la gráfica que la mayor cantidad de personas que rotaron estaban solteros.

# Rotación vs Cargo (Gráfico de barras)
e3 <- ggplot(rotacion, aes(x = factor(Rotación), fill = factor(Cargo))) +
  geom_bar(position = "dodge") +
  theme_minimal() +
  ggtitle("Rotación vs Cargo") +
  xlab("Rotación") + 
  ylab("Frecuencia") +
  scale_fill_manual(values = c("lightblue", "lightgreen", "lightcoral", 
                               "lightpink", "goldenrod1", "cyan", 
                               "lightgray", "lightsalmon", "lightgoldenrod"),
                    labels = c("Director Investigación", "Director Manufactura", 
                               "Ejecutivo Ventas", "Gerente", 
                               "Investigador Científico", "Recursos Humanos", 
                               "Representante Salud", "Representante Ventas", 
                               "Técnico Laboratorio")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Rotar etiquetas para mejor lectura
print(e3)
Relación entre rotacion y Cargo

Relación entre rotacion y Cargo

#Prueba de Chi-cuadrado
print(chisq12)
## 
##  Pearson's Chi-squared test
## 
## data:  table(rotacion$Rotación, rotacion$Cargo)
## X-squared = 86.19, df = 8, p-value = 2.752e-15

Se confirma la variación según las prueba realizada (chi-squared), cuando no rotan el cargo mas frecuente es ejecutivo en ventas, mientras cuando si lo hacen el técnico de laboratorio tiene la mayoría de la frecuencia.

6 MODELO

#Seleccionar solo las variables de interés
rotacion_modelo <- rotacion %>%
  select(Rotacion_binaria, Cargo, Estado_Civil, Horas_Extra,
         Ingreso_Mensual, Antigüedad, Años_Experiencia)

#Convertir variables categóricas a dummies
rotacion_dummies <- dummyVars(Rotacion_binaria ~ ., data = rotacion_modelo, fullRank = TRUE)
rotacion_modelo <- predict(rotacion_dummies, newdata = rotacion_modelo) %>%
  as.data.frame()

# Añadir la variable objetivo de nuevo
rotacion_modelo$Rotacion_binaria <- rotacion$Rotacion_binaria

#Separar datos en entrenamiento (70%) y prueba (30%)
set.seed(123)
indice <- createDataPartition(rotacion_modelo$Rotacion_binaria, p = 0.7, list = FALSE)
train <- rotacion_modelo[indice, ]
test <- rotacion_modelo[-indice, ]

train$Rotacion_binaria <- as.factor(train$Rotacion_binaria)
# Aplicar SMOTE al conjunto de entrenamiento
train_smote <- SMOTE(Rotacion_binaria ~ ., data = train, perc.over = 100, perc.under = 200)

# Verificar la distribución de clases después de SMOTE
table(train_smote$Rotacion_binaria)
## 
##   0   1 
## 324 324
modelo_logistico_smote <- glm(Rotacion_binaria ~ ., family = binomial, data = train_smote)
summary(modelo_logistico_smote)
## 
## Call:
## glm(formula = Rotacion_binaria ~ ., family = binomial, data = train_smote)
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  -3.784e+00  1.169e+00  -3.238 0.001203 ** 
## CargoDirector_Manofactura     2.319e+00  9.765e-01   2.375 0.017540 *  
## CargoEjecutivo_Ventas         2.855e+00  9.547e-01   2.990 0.002788 ** 
## CargoGerente                  1.037e+00  9.577e-01   1.083 0.279010    
## CargoInvestigador_Cientifico  2.621e+00  1.065e+00   2.462 0.013824 *  
## CargoRecursos_Humanos         4.410e+00  1.144e+00   3.856 0.000115 ***
## CargoRepresentante_Salud      2.705e+00  1.012e+00   2.672 0.007531 ** 
## CargoRepresentante_Ventas     4.652e+00  1.142e+00   4.072 4.65e-05 ***
## CargoTecnico_Laboratorio      3.264e+00  1.068e+00   3.057 0.002238 ** 
## Estado_CivilDivorciado       -4.598e-02  2.820e-01  -0.163 0.870468    
## Estado_CivilSoltero           1.027e+00  2.032e-01   5.052 4.37e-07 ***
## Horas_ExtraSi                 1.526e+00  1.998e-01   7.639 2.19e-14 ***
## Ingreso_Mensual               5.183e-05  6.152e-05   0.842 0.399544    
## Antigüedad                    1.740e-02  2.441e-02   0.713 0.476017    
## Años_Experiencia             -4.773e-02  2.360e-02  -2.022 0.043144 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 898.32  on 647  degrees of freedom
## Residual deviance: 711.27  on 633  degrees of freedom
## AIC: 741.27
## 
## Number of Fisher Scoring iterations: 5
# Obtener probabilidades de predicción en el set de prueba
probabilidades_smote <- predict(modelo_logistico_smote, newdata = test, type = "response")

# Convertir probabilidades a etiquetas (umbral 0.5)
predicciones_smote <- ifelse(probabilidades_smote > 0.5, 1, 0)

# Matriz de confusión
confusionMatrix(factor(predicciones_smote), factor(test$Rotacion_binaria))
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 235  23
##          1 131  52
##                                           
##                Accuracy : 0.6508          
##                  95% CI : (0.6043, 0.6953)
##     No Information Rate : 0.8299          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.2133          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.6421          
##             Specificity : 0.6933          
##          Pos Pred Value : 0.9109          
##          Neg Pred Value : 0.2842          
##              Prevalence : 0.8299          
##          Detection Rate : 0.5329          
##    Detection Prevalence : 0.5850          
##       Balanced Accuracy : 0.6677          
##                                           
##        'Positive' Class : 0               
## 
# Calcular AUC y graficar la curva ROC
roc_obj_smote <- roc(test$Rotacion_binaria, probabilidades_smote)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(roc_obj_smote, col = "blue", main = "Curva ROC - Modelo")
Curva modelo

Curva modelo

auc(roc_obj_smote)
## Area under the curve: 0.7371

Las variables que influyen significativamente en la rotación (según los valores de p-value < 0.05) son:

Cargos con mayor riesgo de rotación (comparados con el grupo base):

  • Recursos Humanos (p = 0.0001, coef. = 4.410)

  • Representante de Ventas (p < 0.0001, coef. = 4.652)

  • Técnico de Laboratorio (p = 0.0022, coef. = 3.264)

  • Ejecutivo de Ventas (p = 0.0028, coef. = 2.855)

  • Investigador Científico (p = 0.0138, coef. = 2.621)

Los empleados de Recursos Humanos y Ventas son los más propensos a rotar.

Otros Factores Claves:

  • Estado civil soltero (p < 0.0001, coef. = 1.027)

  • Horas Extra (Sí) (p < 0.0001, coef. = 1.526)

  • Más años de experiencia (p = 0.043, coef. = -0.047)** significa menos riesgo de rotación.

Los solteros y los que trabajan horas extra tienen más riesgo de irse. Más experiencia se asocia con menor riesgo de rotación.

Exactitud (Accuracy) = 0.6508 (~65%)

  • Indica que el modelo clasifica correctamente el 65.08% de los casos.

Como el conjunto de datos está desbalanceado (clase 0 es más frecuente), este valor puede no reflejar la calidad del modelo adecuadamente.

Sensibilidad (Recall para la Clase 0) = 0.6421 (~64%)

  • Es decir, el modelo reconoce correctamente 64.21% de los empleados que no renunciaron.

Especificidad (Recall para la Clase 1) = 0.6933 (~69%)

  • El modelo detecta 69.33% de los empleados que sí renunciaron.

Valor Predictivo Positivo (Precision para la Clase 0) = 0.9109 (~91%)

  • Cuando el modelo predice “No Rotación”, acierta en el 91.09% de los casos.

  • Pero podría estar fallando en identificar correctamente a los empleados que sí renuncian.

Valor Predictivo Negativo (Precisión para la Clase 1) = 0.2842 (~28%)

  • Cuando el modelo predice “Rotación”, solo tiene razón en el 28.42% de los casos.

  • Esto indica que hay muchos falsos positivos (predice que alguien renunciará cuando en realidad no lo hará).

Balanced Accuracy = 0.6677 (~67%)

  • Media entre sensibilidad y especificidad.

  • Más fiable que la exactitud en casos de datos desbalanceados.

AUC-ROC = 0.7371 (~74%)

  • Un AUC de 0.7371 indica un rendimiento moderado (lejos de ser un modelo óptimo, pero mejor que el azar).

6.1 Predicción

## Prueba con valor aleatorio

# Seleccionar un empleado aleatorio del conjunto de prueba
set.seed(123) # Para reproducibilidad
empleado_random <- test[sample(1:nrow(test), 1), ]

# Ver detalles del empleado seleccionado
print(empleado_random)
##      CargoDirector_Manofactura CargoEjecutivo_Ventas CargoGerente
## 1394                         0                     1            0
##      CargoInvestigador_Cientifico CargoRecursos_Humanos
## 1394                            0                     0
##      CargoRepresentante_Salud CargoRepresentante_Ventas
## 1394                        0                         0
##      CargoTecnico_Laboratorio Estado_CivilDivorciado Estado_CivilSoltero
## 1394                        0                      0                   1
##      Horas_ExtraSi Ingreso_Mensual Antigüedad Años_Experiencia Rotacion_binaria
## 1394             0            4105          7                7                0
# Calcular su probabilidad de rotación
probabilidad_rotacion <- predict(modelo_logistico_smote, newdata = empleado_random, type = "response")

# Mostrar la probabilidad
print(probabilidad_rotacion)
##      1394 
## 0.5243181

Probabilidad de Rotación: 52.43% (Valor cerca al limite)

Variables más significativas:

  • Cargo: Ejecutivo de Ventas (puestos comerciales tienen alta rotación).

  • Estado civil: Soltero (mayor riesgo de rotación según el análisis).

  • Ingreso mensual: 4105 (puede influir en la decisión de permanecer o cambiar de empleo).

  • Antigüedad y experiencia: 7 años (podría estar buscando crecimiento profesional).

  • Horas extra: No realiza (descarta sobrecarga de trabajo como factor de riesgo).

NOTA:El NPV es solo 28.42%. Esto significa que hay una alta probabilidad de que el modelo haya clasificado erróneamente como rotación a un empleado que en realidad no se irá. Antes de tomar decisiones basadas en este resultado, se debería complementar con más información cualitativa

7 CONCLUSIONES

Dado que el modelo predice qué empleados tienen mayor riesgo de rotación, se propone aplicar estas estrategias:

Intervenir en Recursos Humanos y Ventas

  • Crear incentivos de permanencia (bonos, planes de carrera).

  • Mejorar condiciones de trabajo (menos carga laboral, ambiente positivo).

Reducir Horas Extra

  • Optimizar la carga de trabajo y mejorar la gestión del tiempo.

Fomentar estabilidad en empleados solteros

  • Ofrecer mayor flexibilidad laboral o beneficios personalizados.

  • Evaluar estrategias para empleados con poca experiencia

  • Programas de mentoría y formación para mejorar su compromiso.