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.
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")
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
## 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)
Se separan variables numéricas y categóricas para realizar pruebas estadísticas.
# 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.
# 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.
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.
# 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
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
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
table(rotacion$Horas_Extra)
##
## No Si
## 1054 416
La mayoría de los empleados No hacen horas extras.
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
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
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.
# 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
#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
#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
#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.
# 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
#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
#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
#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.
#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
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%)
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%)
Especificidad (Recall para la Clase 1) = 0.6933 (~69%)
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%)
## 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
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
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.