actividad3
andres_arroyo
2025-09-21
Predicción de attrition
Lectura Dataset & Librerías
#install.packages("devtools") # solo la primera vez
#devtools::install_github("centromagis/paqueteMODELOS", force =TRUE)
library(paqueteMODELOS)
data("rotacion")
#install.packages("dlookr")
#install.packages("ggcorrplot")
#install.packages("caret")
#install.packages("pROC") library(paqueteMODELOS)
library(dplyr)
library(dlookr)
library(caret)
data("rotacion")
glimpse(rotacion)## Rows: 1,470
## Columns: 24
## $ Rotación <chr> "Si", "No", "Si", "No", "No", "No", "No", …
## $ Edad <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35…
## $ `Viaje de Negocios` <chr> "Raramente", "Frecuentemente", "Raramente"…
## $ Departamento <chr> "Ventas", "IyD", "IyD", "IyD", "IyD", "IyD…
## $ Distancia_Casa <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 2…
## $ Educación <dbl> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, …
## $ Campo_Educación <chr> "Ciencias", "Ciencias", "Otra", "Ciencias"…
## $ Satisfacción_Ambiental <dbl> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, …
## $ Genero <chr> "F", "M", "M", "F", "M", "M", "F", "M", "M…
## $ Cargo <chr> "Ejecutivo_Ventas", "Investigador_Cientifi…
## $ Satisfación_Laboral <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, …
## $ Estado_Civil <chr> "Soltero", "Casado", "Soltero", "Casado", …
## $ Ingreso_Mensual <dbl> 5993, 5130, 2090, 2909, 3468, 3068, 2670, …
## $ Trabajos_Anteriores <dbl> 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1, 0, …
## $ Horas_Extra <chr> "Si", "No", "Si", "Si", "No", "No", "Si", …
## $ Porcentaje_aumento_salarial <dbl> 11, 23, 15, 11, 12, 13, 20, 22, 21, 13, 13…
## $ Rendimiento_Laboral <dbl> 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3, 3, …
## $ Años_Experiencia <dbl> 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, 10, 5…
## $ Capacitaciones <dbl> 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1, 2, …
## $ Equilibrio_Trabajo_Vida <dbl> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, …
## $ Antigüedad <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2,…
## $ Antigüedad_Cargo <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, …
## $ Años_ultima_promoción <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, …
## $ Años_acargo_con_mismo_jefe <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, …library(pROC)# Crear el dataframe de seguridad
df <- as.data.frame(rotacion)
df <- df %>%
rename(Attrition = Rotación)Estadisticas descriptivas:
describe(df)## # A tibble: 16 × 26
## described_variables n na mean sd se_mean IQR skewness
## <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Edad 1470 0 3.69e1 9.14e+0 2.38e-1 13 0.413
## 2 Distancia_Casa 1470 0 9.19e0 8.11e+0 2.11e-1 12 0.958
## 3 Educación 1470 0 2.91e0 1.02e+0 2.67e-2 2 -0.290
## 4 Satisfacción_Ambiental 1470 0 2.72e0 1.09e+0 2.85e-2 2 -0.322
## 5 Satisfación_Laboral 1470 0 2.73e0 1.10e+0 2.88e-2 2 -0.330
## 6 Ingreso_Mensual 1470 0 6.50e3 4.71e+3 1.23e+2 5468 1.37
## 7 Trabajos_Anteriores 1470 0 2.69e0 2.50e+0 6.52e-2 3 1.03
## 8 Porcentaje_aumento_salarial 1470 0 1.52e1 3.66e+0 9.55e-2 6 0.821
## 9 Rendimiento_Laboral 1470 0 3.15e0 3.61e-1 9.41e-3 0 1.92
## 10 Años_Experiencia 1470 0 1.13e1 7.78e+0 2.03e-1 9 1.12
## 11 Capacitaciones 1470 0 2.80e0 1.29e+0 3.36e-2 1 0.553
## 12 Equilibrio_Trabajo_Vida 1470 0 2.76e0 7.06e-1 1.84e-2 1 -0.552
## 13 Antigüedad 1470 0 7.01e0 6.13e+0 1.60e-1 6 1.76
## 14 Antigüedad_Cargo 1470 0 4.23e0 3.62e+0 9.45e-2 5 0.917
## 15 Años_ultima_promoción 1470 0 2.19e0 3.22e+0 8.40e-2 3 1.98
## 16 Años_acargo_con_mismo_jefe 1470 0 4.12e0 3.57e+0 9.31e-2 5 0.833
## # ℹ 18 more variables: kurtosis <dbl>, p00 <dbl>, p01 <dbl>, p05 <dbl>,
## # p10 <dbl>, p20 <dbl>, p25 <dbl>, p30 <dbl>, p40 <dbl>, p50 <dbl>,
## # p60 <dbl>, p70 <dbl>, p75 <dbl>, p80 <dbl>, p90 <dbl>, p95 <dbl>,
## # p99 <dbl>, p100 <dbl>Missing Values
na_df <- data.frame(
Variable = names(df),
Missing = colSums(is.na(df)),
row.names = NULL
)
na_df## Variable Missing
## 1 Attrition 0
## 2 Edad 0
## 3 Viaje de Negocios 0
## 4 Departamento 0
## 5 Distancia_Casa 0
## 6 Educación 0
## 7 Campo_Educación 0
## 8 Satisfacción_Ambiental 0
## 9 Genero 0
## 10 Cargo 0
## 11 Satisfación_Laboral 0
## 12 Estado_Civil 0
## 13 Ingreso_Mensual 0
## 14 Trabajos_Anteriores 0
## 15 Horas_Extra 0
## 16 Porcentaje_aumento_salarial 0
## 17 Rendimiento_Laboral 0
## 18 Años_Experiencia 0
## 19 Capacitaciones 0
## 20 Equilibrio_Trabajo_Vida 0
## 21 Antigüedad 0
## 22 Antigüedad_Cargo 0
## 23 Años_ultima_promoción 0
## 24 Años_acargo_con_mismo_jefe 01. Selección de variables
Variables Cuantitativas
# Se adiciona equivalencia de rotación
df$rotacion_2 <- ifelse(df$Attrition == "Si", 1, 0)# Se seleccionan las variables númericas del dataset
df_num <- df[ , sapply(df, is.numeric)]
# Generación de matriz de correlación
cor_matrix <- cor(df_num, use = "complete.obs", method = "pearson")library(ggcorrplot)## Warning: package 'ggcorrplot' was built under R version 4.4.3cor_matrix <- cor(df_num, use = "complete.obs", method = "pearson")
ggcorrplot(cor_matrix,
hc.order = TRUE, # cluster similar variables
type = "lower", # only lower triangle
lab = TRUE, # add correlation values
lab_size = 4,
tl.cex = 10,
colors = c("red", "white", "blue"),
title = "Correlation Matrix Heatmap")## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the ggcorrplot package.
## Please report the issue at <https://github.com/kassambara/ggcorrplot/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
No se encuentran correlaciones positivas muy grandes entre la variable rotacion_2 (1 o 0), sin embargo si existen correlaciones negativas que indican las variables que más podrían agregar valor al modelo como lo son Angigüedad_Cargo, Años con le mismo jefe, Edad, Ingreso_Mensual, Años de experiencia y Satisfacción Laboral. Variables que dentro del contexto del problema si son críticas, puesto que la edad y el salario son variables que influeyen la toma de decisión para cambiar de trabajo.
Variables Categoricas
# Selección de variables categoricas
df_nonnum <- df[ , !sapply(df, is.numeric)]2. Análisis Univariado
Variables Cuantitativas
Edad
Estadisticas descriptividad de edad:
summary(df_num$Edad)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.00 30.00 36.00 36.92 43.00 60.00Se puede evidenciar que es un grupo de trabajo relativamente joven, que va desde los 18 hasta los 60 años, sin embargo la mayoría se esta concentrando entre los 30 y 40 años, ajustandose a una distribución normal. Dentro del análisis del negocio, es una muestra buena pues tiene en cuenta una edad en la que por lo general se llega a una madurez laboral temprana y es importante retener los talentos que pasan de junior a senior y puedan aportar a la compañía
ggplot(df_num, aes(x = Edad)) +
geom_histogram(binwidth = 5, fill = "#91C7FA", color = "#000000", alpha = 0.7) +
labs(title = "Distribución de Edad", x = "Edad", y = "Frecuencia") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
Antiguedad Cargo
Estadisticas descriptivas Antigüedad en el cargo:
summary(df_num$Antigüedad_Cargo)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.000 3.000 4.229 7.000 18.000ggplot(df_num, aes(x = Antigüedad_Cargo)) +
geom_histogram(binwidth = 5, fill = "#91C7FA", color = "#000000", alpha = 0.7) +
labs(title = "Distribución de Antigüedad en el cargo", x = "Antiguedad", y = "Frecuencia") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
Se puede evidenciar que los empleados se concentran entre los 0 y 5 años de antigüedad.
Ingreso Mensual
Estadistias descriptivas del ingreso mensual:
summary(df_num$Ingreso_Mensual)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1009 2911 4919 6503 8379 19999ggplot(df_num, aes(x = Ingreso_Mensual)) +
geom_histogram(binwidth = 500, fill = "#91C7FA", color = "#000000", alpha = 0.7) +
labs(title = "Distribucion de Ingreso Mensual", x = "Ingreso Mensual", y = "Frecuencia") +
scale_x_continuous(labels = scales::comma) + # Añadir comas en los números grandes del eje x
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
Esta es una variable fundamental para el análisis del attrition y tiene un promedio de 4919, sin embargo es un valor que está sesgado ya que se tiene una base con múltiples cargos que tienen perfiles diferentes y por ende grados salariales diferentes.
Variables Categoricas
Departamento
ggplot(df_nonnum, aes(x = Departamento)) +
geom_bar(fill = "#91C7FA", color = "#000000", alpha = 0.7) +
geom_text(stat = "count", aes(label = after_stat(count)),
vjust = -0.3, size = 4) +
labs(title = "Distribucion Departamento", x = "Departamento", y = "Frecuencia") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
La mayor cantidad de empleados están en las áreas de Investigación y desarrollo y ventas
Horas Extras
# Crear gráfico de barras para una variable categórica
ggplot(df_nonnum, aes(y = Horas_Extra)) +
geom_bar(fill = "#91C7FA", color = "#000000", alpha = 0.7) +
geom_text(stat = "count",
aes(x = after_stat(count), label = after_stat(count)),
hjust = 1.2, color = "black", size = 4) +
labs(title = "Distribucion de Horas Extra", x = "Frecuencia", y = "Horas Extra") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
Aproximadamente el 28% de los colaboradores está tomando horas extras para cumplir con sus objetivos.
3. Análisis Bivariado
Variables Cuantitativas
Edad
ggplot(df, aes(x = Attrition, y = Edad, color = Attrition)) +
geom_boxplot() +
geom_jitter(width = 0.3) +
labs(x = "Rotacion", y = "Edad",
title = "Distribución de Edad por Attrition")
De acuerdo con la gráfica anterior, las personas más jovenes tienden a abandonar la compañía ya que la media de ellos es inferior
Antiguedad en el cargo
ggplot(df, aes(x = Attrition, y = Antigüedad_Cargo, color = Attrition)) +
geom_boxplot() +
geom_jitter(width = 0.3) +
labs(x = "Rotacion", y = "Antigüedad_Cargo",
title = "Distribución de Antigüedad_Cargo por Attrition")
Un comportamiento muy similar a la edad, las personas con menor antigüedad en el cargo tienden a abandonar la compañía, puede ser debido a búsqueda de una mejora salarial que puede obtener al cambiar de empleo o de nuevos retos profesionales.
Ingreso Mensual
ggplot(df, aes(x = Attrition, y = Ingreso_Mensual, color = Attrition)) +
geom_boxplot() +
geom_jitter(width = 0.3) +
labs(x = "Rotacion", y = "Ingreso_Mensual",
title = "Distribución de Ingreso_Mensual por Attrition")
A pesar de que existe un mix de cargos en el data set, son los colaboradores con menor salario los que muestran una tendencia a abandonar la compañía
Variables Categoricas
Departamento
Horas Extras
# Se crea tabla para análisis cruzado
df_he = table(df$Attrition, df$Horas_Extra)
# Se crea tabla incluyendo los porcentajes
df_he_pct1 <- prop.table(df_he, margin = 1) * 100
# Visualización de las tablas
df_he # En valores##
## No Si
## No 944 289
## Si 110 127#df_he_pct1 # Con porcentajes
# Se crea una variante en la manera de calcular los porcentajes
df_he_pct2 <- prop.table(df_he, margin = 2) * 100
#df_he_pct2Se realiza test de chi-cuadrado para evaluar si hay asociación entre las dos variables categoricas
# Prueba de Chi Cuadrado
chisq.test(df_he)##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: df_he
## X-squared = 87.564, df = 1, p-value < 2.2e-16El resultado del chi-cuadrado (p-value = 2.2e-16) indica una relación estadísticamente significativa entre Horas Extras y Rotación de personal. Esto significa que la decisión de renunciar no es independiente de trabajar horas extras, aunque se requiere revisar las frecuencias para identificar la dirección de la relación
# Convert to dataframe for ggplot
df_he_pct1 <- as.data.frame(df_he_pct1)
names(df_he_pct1) <- c("Attrition", "Horas_Extra", "Percentage")
# Plot with labels
ggplot(df_he_pct1, aes(x = Horas_Extra,
y = Percentage,
fill = Attrition)) +
geom_col(position = position_dodge(width = 0.9), alpha = 0.8) +
geom_text(aes(label = sprintf("%.1f%%", Percentage)),
position = position_dodge(width = 0.9),
vjust = -0.3, size = 4) +
scale_fill_manual(values = c("No" = "lightblue",
"Si" = "#d62728")) +
labs(title = "Porcentaje de Horas_Extra por Attrition (1)",
x = "Horas_Extra",
y = "Porcentaje (%)") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
# Convert to dataframe for ggplot
df_he_pct2 <- as.data.frame(df_he_pct2)
names(df_he_pct2) <- c("Attrition", "Horas_Extra", "Percentage")
# Plot with labels
ggplot(df_he_pct2, aes(x = Horas_Extra,
y = Percentage,
fill = Attrition)) +
geom_col(position = position_dodge(width = 0.9), alpha = 0.8) +
geom_text(aes(label = sprintf("%.1f%%", Percentage)),
position = position_dodge(width = 0.9),
vjust = -0.3, size = 4) +
scale_fill_manual(values = c("No" = "lightblue",
"Si" = "#d62728")) +
labs(title = "Porcentaje de Horas_Extra por Attrition (2)",
x = "Horas_Extra",
y = "Porcentaje (%)") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
De las personas que si tomaron horas extras, el 30,5% renunció, mientras que el 69.5% trabajaban dentro de su horario regular decidieron permanecer. Un indicador importante para el análisis de la distribución de cargas laborales
Satisfacción Laboral
# Se crea tabla para análisis cruzado
df_sl = table(df$Attrition, df$Satisfación_Laboral)
# Se crea tabla incluyendo los porcentajes
df_sl_pct1 <- prop.table(df_sl, margin = 1) * 100
# Se crea una variante en la manera de calcular los porcentajes
df_sl_pct2 <- prop.table(df_sl, margin = 2) * 100
#df_sl_pct2
df_sl##
## 1 2 3 4
## No 223 234 369 407
## Si 66 46 73 52#df_sl_pct1Se realiza test de chi-cuadrado para evaluar si hay asociación entre las dos variables categoricas
# Prueba de Chi Cuadrado
chisq.test(df_sl)##
## Pearson's Chi-squared test
##
## data: df_sl
## X-squared = 17.505, df = 3, p-value = 0.0005563El p-value = 0.0005563 indica que la rotación de personal está asociada significativamente con la satisfacción laboral: a menor satisfacción, mayor probabilidad de renunciar
library(ggplot2)
# Convert to dataframe for ggplot
df_sl_pct1 <- as.data.frame(df_sl_pct1)
names(df_sl_pct1) <- c("Attrition", "Satisfacion_Laboral", "Percentage")
# Plot with labels
ggplot(df_sl_pct1, aes(x = Satisfacion_Laboral,
y = Percentage,
fill = Attrition)) +
geom_col(position = position_dodge(width = 0.9), alpha = 0.8) +
geom_text(aes(label = sprintf("%.1f%%", Percentage)),
position = position_dodge(width = 0.9),
vjust = -0.3, size = 4) +
scale_fill_manual(values = c("No" = "lightblue",
"Si" = "#d62728")) +
labs(title = "Porcentaje de Satisfacción Laboral por Attrition",
x = "Satisfacción Laboral",
y = "Porcentaje (%)") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
Aproximadamente el 31% de los colaboradores que abandonó la empresa estaban Satisfechos con su trabajo actual, siendo la proporción más alta, sin embargo muy cercano a la proporción de colaboradres Muy Insatisfechos con un 28%. Lo que puede indicar presencia de un mercado laboral atractivo en el área de la organización, ya que apesar de estar satisfechos dejan la empresa por algo en teoría mejor.
# Convert to dataframe for ggplot
df_sl_pct2 <- as.data.frame(df_sl_pct2)
names(df_sl_pct2) <- c("Attrition", "Satisfacion_Laboral", "Percentage")
# Plot with labels
ggplot(df_sl_pct2, aes(x = Satisfacion_Laboral,
y = Percentage,
fill = Attrition)) +
geom_col(position = position_dodge(width = 0.9), alpha = 0.8) +
geom_text(aes(label = sprintf("%.1f%%", Percentage)),
position = position_dodge(width = 0.9),
vjust = -0.3, size = 4) +
scale_fill_manual(values = c("No" = "lightblue",
"Si" = "#d62728")) +
labs(title = "Porcentaje de Satisfacción Laboral por Attrition",
x = "Satisfacción Laboral",
y = "Porcentaje (%)") +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
axis.title = element_text(size = 14),
axis.text = element_text(size = 12)
)
4. Estimación del modelo
df$Attrition <- factor(df$Attrition, levels = c("No","Si"),labels = c(0,1))
#df$Attrition<- as.numeric(df$Attrition=="Si")
#rotacion$Estado_Civil <- as.factor(rotacion$Estado_Civil)
df$Horas_Extra <- as.factor(df$Horas_Extra)
df$Departamento <- as.factor(df$Departamento)
#rotacion$Satisfación_Laboral <- as.factor(rotacion$Satisfación_Laboral)
mod1 <- glm(Attrition ~ Edad + Antigüedad_Cargo + Ingreso_Mensual + Horas_Extra + Departamento + Satisfación_Laboral, data = df, family = binomial(link = "logit"))
summary(mod1)##
## Call:
## glm(formula = Attrition ~ Edad + Antigüedad_Cargo + Ingreso_Mensual +
## Horas_Extra + Departamento + Satisfación_Laboral, family = binomial(link = "logit"),
## data = df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.615e-01 3.758e-01 0.962 0.336038
## Edad -3.167e-02 1.005e-02 -3.150 0.001631 **
## Antigüedad_Cargo -1.054e-01 2.685e-02 -3.925 8.69e-05 ***
## Ingreso_Mensual -8.738e-05 2.642e-05 -3.307 0.000942 ***
## Horas_ExtraSi 1.482e+00 1.569e-01 9.445 < 2e-16 ***
## DepartamentoRH 4.447e-01 3.633e-01 1.224 0.220886
## DepartamentoVentas 6.704e-01 1.657e-01 4.047 5.19e-05 ***
## Satisfación_Laboral -3.117e-01 6.875e-02 -4.533 5.80e-06 ***
## ---
## 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: 1100.8 on 1462 degrees of freedom
## AIC: 1116.8
##
## Number of Fisher Scoring iterations: 5Resultados:
Edad (Estimate = -0.0317, p = 0.0016) → A mayor edad, menor probabilidad de rotación.
Antigüedad en el cargo (Estimate = -1.075, p < 0.001) → A mayor antigüedad, menor probabilidad de rotación.
Ingreso mensual (Estimate = -0.0046, p = 0.0094) → A mayor ingreso, menor probabilidad de rotación.
Horas Extra (Sí) (Estimate = 1.482, p < 0.001) → Quienes hacen horas extra tienen mayor probabilidad de renunciar.
Departamento RH (Estimate = 1.447, p = 0.2208) → No es significativo, no podemos concluir relación.
Departamento Ventas (Estimate =+6.704, p < 0.001) → Muy significativo; empleados del departamento de Ventas tienen una probabilidad mucho mayor de rotación en comparación a los otros
Satisfacción Laboral (Estimate = -3.117, p < 0.001) → A mayor satisfacción laboral, menor probabilidad de rotación. Adicional, como se está manejando una escala progresiva se asume que el salto de 1 a 2 es igual de fuerte que el de 3 a 4, obteniendo el mismo efecto lineal sobre la probabilidad de renunciar
5. Evaluación del modelo
# Dividir la base de datos en conjuntos de entrenamiento y prueba
set.seed(123)# Para reproducibilidad
indice_particion <- createDataPartition(rotacion$Rotación, p = 0.7, list = FALSE)
df_training <- df[indice_particion, ]
df_testing <- df[-indice_particion, ]
# Entrenar el modelo
mod2 <- glm(Attrition ~ Edad + Antigüedad_Cargo + Ingreso_Mensual + Departamento + Horas_Extra + Satisfación_Laboral, data = df_training, family = binomial(link = "logit"))
summary(mod2)##
## Call:
## glm(formula = Attrition ~ Edad + Antigüedad_Cargo + Ingreso_Mensual +
## Departamento + Horas_Extra + Satisfación_Laboral, family = binomial(link = "logit"),
## data = df_training)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.692e-01 4.552e-01 0.372 0.710170
## Edad -2.582e-02 1.217e-02 -2.122 0.033878 *
## Antigüedad_Cargo -1.189e-01 3.206e-02 -3.708 0.000209 ***
## Ingreso_Mensual -8.519e-05 3.129e-05 -2.723 0.006475 **
## DepartamentoRH 4.286e-01 4.031e-01 1.063 0.287638
## DepartamentoVentas 5.922e-01 1.953e-01 3.033 0.002425 **
## Horas_ExtraSi 1.349e+00 1.855e-01 7.276 3.45e-13 ***
## Satisfación_Laboral -2.710e-01 8.168e-02 -3.317 0.000909 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 909.69 on 1029 degrees of freedom
## Residual deviance: 781.31 on 1022 degrees of freedom
## AIC: 797.31
##
## Number of Fisher Scoring iterations: 5levels(df_training$Attrition)## [1] "0" "1"valor_pronosticado <- predict(mod2, newdata = df_training, type = "response")
curva_roc <- roc(df_training$Attrition, valor_pronosticado,
levels = c("0", "1"), direction = "<")
auc(curva_roc)## Area under the curve: 0.7541plot(curva_roc, col = "blue", main = "Curva ROC - Modelo Logístico")
Con un AUC de 0.7541 se concluye que el modelo tiene un buen poder
predictivo, es decir, logra distinguir bastante bien entre empleados que
se van y los que se quedan. No es excelente, pero es una base sólida que
permitirá tomar decisiones para crear estrategias para los planes de
carrera y equilibrio laboral en la compañía
6. Predicciones
set.seed(1112228283) # Semilla para aleatoriedad
random_number <- sample(1:nrow(rotacion), 1) # Se selecciona una fila aleatoria para evaluar
# Selección y visualización del registro a evaluar
predict_sample = rotacion[random_number,]
predict_sample## # A tibble: 1 × 24
## Rotación Edad `Viaje de Negocios` Departamento Distancia_Casa Educación
## <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 No 26 Raramente IyD 4 2
## # ℹ 18 more variables: Campo_Educación <chr>, Satisfacción_Ambiental <dbl>,
## # Genero <chr>, Cargo <chr>, Satisfación_Laboral <dbl>, Estado_Civil <chr>,
## # Ingreso_Mensual <dbl>, Trabajos_Anteriores <dbl>, Horas_Extra <chr>,
## # Porcentaje_aumento_salarial <dbl>, Rendimiento_Laboral <dbl>,
## # Años_Experiencia <dbl>, Capacitaciones <dbl>,
## # Equilibrio_Trabajo_Vida <dbl>, Antigüedad <dbl>, Antigüedad_Cargo <dbl>,
## # Años_ultima_promoción <dbl>, Años_acargo_con_mismo_jefe <dbl>De acuerdo con el valor aleatorio generado, se obtuvo una mujer soltera de 26 años pertenenciente al departamento de Investigación & Desarrollo que aunque realiza horas extras, se encuentra muy satisfecha laboralmente y cuenta con 8 años de experiencia laboral que han sido dentro de la compañía, en la cual lleva 5 años en el mismo cargo y 2 bajo la misma dirección
# Resultados del modelo
logit_results <- predict(mod2, newdata = predict_sample, type = "link") # Log-odds
odds_results <- exp(logit_results) # Odds
prob_results <- odds_results / (1 + odds_results) # Probabilidades
# Crear un dataframe con los resultados
resultados_df <- data.frame(
Empleado = 1:length(prob_results),
Odds = odds_results,
Probabilidad_Rotacion = prob_results
)
# Mostrar la tabla
print(resultados_df)## Empleado Odds Probabilidad_Rotacion
## 1 1 0.3409803 0.2542769Según el modelo mod2, la empleada seleccionada tiene una baja probabilidad de attrition (25%), y es más probable que permanezca en la empresa que que se vaya, lo cual indica que el modelo refleja coherencia pues al estar satisfecha y con estabilidad, la probabilidad de rotación tienda a bajar
Asimismo, al obtener un Odds menor que 1 e igual a 0.341, significa que la probabilidad de que esta persona se vaya es menor que la de que se quede y se puede decir que por cada un empleado que se va, hay aproximadamente 2.9 que se quedan
7. Conclusiones
El modelo podría mejorarse segementando inicialmente el dataset por tipos de cargos, como por ejemplo cargos operativos, cargos de análisis y cargos estrátegicos que permitan unos grupos más homogéneos y darle otro enfoque con mayor detalle al problema. Sin embargo, aplicar una regresión logística a problemas de attrition es una base para la toma de decisiones de acuerdo con los resultados y pruebas obtenidas, que permitiría los equipos de RH crear indicadores y alertas para disminuir el attrition con una fuerza laboral motivada y eficiente.
La selección de variables fue adecuada y permitieron dar valor al modelo, inclusó se pudo observar o confirmar que los departamentos de ventas suelen tener alta rotación.
Estrategia:
- Horas extras
Se propone establecer límites de horas extras y promover una mejor distribución de la carga laboral a través de una revisión de los perfiles y/o descripciones del cargo, ya que de acuerdo con el valor p muy significativo, el exceso de horas extras está altamente asociado con la rotación. Al reducirlas se disminuye el desgaste y el burnout.
- Ingreso mensual
Es relativamente complejo generar una estrategia, ya que como se mencionó anteriormente, existe un mix de cargos y niveles profesionales. No obstante se puede diseñar un bono de objetivos de la compañía para repartir en la nómina, dando así una bonificación de resultados.
- Departamento
Realizar una encuesta de ambiente laboral para identificar cuáles son los posibles motivos por área que están generando descontento
- Edad & Antigüedad en el cargo
Diseñar un plan carrera para promover los ascensos o movimientos verticales que permitan a los colaboradores durar y aportar más a la compañía en diferentes áreas
- Satisfacción laboral
La mejora en la satisfacción laboral se evidenciará al gestionar los puntos anteriormente comentados.