Introducción

La rotación de personal es un fenómeno crítico en las organizaciones, con implicaciones directas en la productividad, cultura laboral y costos operativos. La salida de empleados no solo genera gastos asociados al reclutamiento y la formación de nuevos colaboradores, sino que también puede afectar la moral del equipo y la continuidad de proyectos estratégicos.

En este contexto, el People Analytics se ha convertido en una herramienta clave para comprender y gestionar la rotación laboral. Mediante el uso de datos y modelos analíticos, las empresas pueden identificar patrones, predecir riesgos y diseñar estrategias proactivas para mejorar la retención del talento.

Este estudio se enfocará en analizar diversas variables que podrían estar relacionadas con la rotación de empleados en una empresa. Se examinarán tanto variables categóricas como variables cuantitativas, seleccionadas con base en hipótesis que justifican su posible influencia en la decisión de un empleado de abandonar la organización.

El análisis incluirá:

  • Un estudio univariado y bivariado para caracterizar los datos y evaluar la validez de las hipótesis propuestas.
  • La construcción de un modelo predictivo que identifique a los empleados con mayor riesgo de rotación.
  • La evaluación del modelo con métricas de clasificación y la definición de umbrales de probabilidad para mejorar la precisión de la predicción.
  • Un análisis de escenarios de riesgo (bajo, medio y alto) con el fin de proporcionar información clave para la toma de decisiones en la gestión del personal.

Finalmente, con base en los hallazgos del análisis, se propondrán estrategias prácticas para reducir la rotación laboral, mejorando la estabilidad del talento y el bienestar de los empleados. Este enfoque basado en datos permitirá a las organizaciones no solo mitigar pérdidas por rotación, sino también fomentar una cultura laboral más sólida y atractiva para sus colaboradores.

# Cargar librerías necesarias
library(readxl)
library(dplyr)
library(ggplot2)
library(corrplot)
library(caret)
library(shiny)
library(plotly)

Conjunto de Datos

El conjunto de datos utilizado en este análisis contiene información sobre empleados de una empresa, incluyendo variables demográficas, laborales y de desempeño que podrían estar relacionadas con la rotación de personal. Se incluyen tanto variables categóricas como cuantitativas, permitiendo realizar un análisis integral sobre los factores que influyen en la decisión de los empleados de permanecer o dejar la empresa.

# Leer datos
datos <- read_excel("Datos_Rotación.xlsx")

# Transformar nombres de columnas
cols <- iconv(colnames(datos), from = "UTF-8", to = "ASCII//TRANSLIT")

# Eliminar caracteres no deseados como apóstrofes, comillas y tildes incorrectas
cols <- gsub("['~\"]", "", cols)

# Asignar los nuevos nombres al dataset
colnames(datos) <- cols

# Mostrar los nombres de columna limpios
colnames(datos)
##  [1] "Rotacion"                    "Edad"                       
##  [3] "Viaje de Negocios"           "Departamento"               
##  [5] "Distancia_Casa"              "Educacion"                  
##  [7] "Campo_Educacion"             "Satisfaccion_Ambiental"     
##  [9] "Genero"                      "Cargo"                      
## [11] "Satisfacion_Laboral"         "Estado_Civil"               
## [13] "Ingreso_Mensual"             "Trabajos_Anteriores"        
## [15] "Horas_Extra"                 "Porcentaje_aumento_salarial"
## [17] "Rendimiento_Laboral"         "Anos_Experiencia"           
## [19] "Capacitaciones"              "Equilibrio_Trabajo_Vida"    
## [21] "Antiguedad"                  "Antiguedad_Cargo"           
## [23] "Anos_ultima_promocion"       "Anos_acargo_con_mismo_jefe"

Resumen estadístico de los datos

summary(datos)
##    Rotacion              Edad       Viaje de Negocios  Departamento      
##  Length:1470        Min.   :18.00   Length:1470        Length:1470       
##  Class :character   1st Qu.:30.00   Class :character   Class :character  
##  Mode  :character   Median :36.00   Mode  :character   Mode  :character  
##                     Mean   :36.92                                        
##                     3rd Qu.:43.00                                        
##                     Max.   :60.00                                        
##  Distancia_Casa     Educacion     Campo_Educacion    Satisfaccion_Ambiental
##  Min.   : 1.000   Min.   :1.000   Length:1470        Min.   :1.000         
##  1st Qu.: 2.000   1st Qu.:2.000   Class :character   1st Qu.:2.000         
##  Median : 7.000   Median :3.000   Mode  :character   Median :3.000         
##  Mean   : 9.193   Mean   :2.913                      Mean   :2.722         
##  3rd Qu.:14.000   3rd Qu.:4.000                      3rd Qu.:4.000         
##  Max.   :29.000   Max.   :5.000                      Max.   :4.000         
##     Genero             Cargo           Satisfacion_Laboral Estado_Civil      
##  Length:1470        Length:1470        Min.   :1.000       Length:1470       
##  Class :character   Class :character   1st Qu.:2.000       Class :character  
##  Mode  :character   Mode  :character   Median :3.000       Mode  :character  
##                                        Mean   :2.729                         
##                                        3rd Qu.:4.000                         
##                                        Max.   :4.000                         
##  Ingreso_Mensual Trabajos_Anteriores Horas_Extra       
##  Min.   : 1009   Min.   :0.000       Length:1470       
##  1st Qu.: 2911   1st Qu.:1.000       Class :character  
##  Median : 4919   Median :2.000       Mode  :character  
##  Mean   : 6503   Mean   :2.693                         
##  3rd Qu.: 8379   3rd Qu.:4.000                         
##  Max.   :19999   Max.   :9.000                         
##  Porcentaje_aumento_salarial Rendimiento_Laboral Anos_Experiencia
##  Min.   :11.00               Min.   :3.000       Min.   : 0.00   
##  1st Qu.:12.00               1st Qu.:3.000       1st Qu.: 6.00   
##  Median :14.00               Median :3.000       Median :10.00   
##  Mean   :15.21               Mean   :3.154       Mean   :11.28   
##  3rd Qu.:18.00               3rd Qu.:3.000       3rd Qu.:15.00   
##  Max.   :25.00               Max.   :4.000       Max.   :40.00   
##  Capacitaciones  Equilibrio_Trabajo_Vida   Antiguedad     Antiguedad_Cargo
##  Min.   :0.000   Min.   :1.000           Min.   : 0.000   Min.   : 0.000  
##  1st Qu.:2.000   1st Qu.:2.000           1st Qu.: 3.000   1st Qu.: 2.000  
##  Median :3.000   Median :3.000           Median : 5.000   Median : 3.000  
##  Mean   :2.799   Mean   :2.761           Mean   : 7.008   Mean   : 4.229  
##  3rd Qu.:3.000   3rd Qu.:3.000           3rd Qu.: 9.000   3rd Qu.: 7.000  
##  Max.   :6.000   Max.   :4.000           Max.   :40.000   Max.   :18.000  
##  Anos_ultima_promocion Anos_acargo_con_mismo_jefe
##  Min.   : 0.000        Min.   : 0.000            
##  1st Qu.: 0.000        1st Qu.: 2.000            
##  Median : 1.000        Median : 3.000            
##  Mean   : 2.188        Mean   : 4.123            
##  3rd Qu.: 3.000        3rd Qu.: 7.000            
##  Max.   :15.000        Max.   :17.000

Selección de Variables y Análisis Univariado

En este análisis, se han seleccionado tres variables categóricas y tres variables cuantitativas que podrían estar relacionadas con la rotación de empleados. A continuación, se presenta cada variable junto con la hipótesis correspondiente.

Variables Categóricas

Horas Extra

Intuición: El exceso de trabajo puede generar desgaste físico y mental, afectando la satisfacción laboral y aumentando la probabilidad de renuncia.
Hipótesis: Los empleados que trabajan más horas extra tienen mayor probabilidad de rotación. Escala de medición: Varía entre “Sí” y “No”.

datos %>%
  group_by(`Horas_Extra`) %>%
  summarise(Frecuencia = n(),
            Proporcion = n() / nrow(datos))
Horas_Extra Frecuencia Proporcion
No 1054 0.7170068
Si 416 0.2829932
# Gráfico de Barras
ggplot(datos, aes(x = `Horas_Extra`)) +
  geom_bar(fill = "steelblue", color = "black", alpha = 0.7) +
  theme_minimal() +
  labs(title = "Frecuencia de Empleados con Horas Extra", x = "Categoria", y = "Frecuencia")

Se observa que la cantidad de empleados que no realizan horas extras es aproximadamente el doble de aquellos que sí las realizan.

Satisfacción Ambiental

Intuición: Evalúa el nivel de comodidad del empleado en su entorno laboral. Un ambiente desfavorable puede aumentar la insatisfacción y la intención de renunciar.
Hipótesis: Un ambiente laboral poco satisfactorio aumenta la probabilidad de que un empleado renuncie.
Escala de medición: De 1 a 4, donde 1 es “Muy Insatisfecho” y 4 es “Muy Satisfecho”.

# Calcular la frecuencia como dataframe
frecuencia_ambiental <- as.data.frame(table(datos$Satisfaccion_Ambiental))

# Crear gráfico de barras
ggplot(frecuencia_ambiental, aes(x = Var1, y = Freq)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  labs(title = "Frecuencia de Satisfacción Ambiental",
       x = "Nivel de Satisfacción",
       y = "Frecuencia") +
  theme_minimal()

Se observa una mayor concentración de empleados con una satisfacción ambiental positiva, con una diferencia mínima entre las categorías 3 (“Satisfecho”) y 4 (“Muy satisfecho”). De manera similar, las categorías 1 y 2 que reflejan una menor satisfacción, poseen poca variabilidad entre ellas.

Género

Intuición: Factores como discriminación, falta de oportunidades o diferencias en responsabilidades personales pueden influir en la rotación de empleados según su género.
Hipótesis: La tasa de rotación puede ser diferente entre hombres y mujeres.
Escala de medición: Femenino (F) o Masculino (M).

datos %>%
  group_by(`Genero`) %>%
  summarise(Frecuencia = n(),
            Proporcion = n() / nrow(datos))
Genero Frecuencia Proporcion
F 588 0.4
M 882 0.6
ggplot(datos, aes(x = `Genero`)) +
  geom_bar(fill = "steelblue", color = "black", alpha = 0.7) +
  theme_minimal() +
  labs(title = "Frecuencia de Generos", x = "Categoria", y = "Frecuencia")

Se observa una diferencia significativa en la distribución de empleados según su género, con aproximadamente 200 empleados más en la categoría masculina en comparación con la femenina. Esta discrepancia podría sugerir la existencia de sesgos en los procesos de contratación o posibles dinámicas de discriminación dentro de la empresa.


Variables Cuantitativas

Distancia a la Casa

Intuición: Un tiempo de desplazamiento largo puede afectar la calidad de vida del empleado, incrementando su insatisfacción y reduciendo su compromiso con la empresa.
Hipótesis: Los empleados que viven más lejos tienen una mayor probabilidad de rotación.

summary(datos$`Distancia_Casa`)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   2.000   7.000   9.193  14.000  29.000
# Histograma de Distribución
ggplot(datos, aes(x = `Distancia_Casa`)) +
  geom_histogram(binwidth = 2, fill = "steelblue", color = "black", alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribucion de la Distancia a la Casa", x = "Distancia (km)", y = "Frecuencia")

La frecuencia de empleados según la distancia a la empresa muestra variaciones menores, con una mayor concentración de empleados que viven a menos de 5 km de su lugar de trabajo.

Antigüedad

Intuición: El tiempo que un empleado ha permanecido en la empresa puede estar relacionado con su nivel de compromiso y lealtad.
Hipótesis: Los empleados con menor antigüedad tienen mayor probabilidad de rotación.

summary(datos$`Antiguedad`)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   3.000   5.000   7.008   9.000  40.000
# Histpgrama de Distribución
ggplot(datos, aes(x = `Antiguedad`)) +
  geom_histogram(binwidth = 2, fill = "steelblue", color = "black", alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribucion de la antiguedad", x = "Anos", y = "Frecuencia")

Se observa un pico en la frecuencia de empleados con una antigüedad entre 0 y 6 años, seguido de una disminución notable en aquellos con más de 10 años en la empresa. Esto sugiere que los primeros años podrían representar un período crítico en el que una gran cantidad de empleados decide renunciar.

Porcentaje de Aumento Salarial

Intuición: Un bajo incremento salarial puede generar insatisfacción y motivar la búsqueda de nuevas oportunidades laborales.
Hipótesis: Los empleados con menores aumentos salariales tienen mayor probabilidad de rotación.

# Resumen general de la data
summary(datos$`Porcentaje_aumento_salarial`)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   11.00   12.00   14.00   15.21   18.00   25.00
# Histpgrama de Distribución
ggplot(datos, aes(x = `Porcentaje_aumento_salarial`)) +
  geom_histogram(binwidth = 2, fill = "steelblue", color = "black", alpha = 0.7) +
  theme_minimal() +
  labs(title = "Distribucion del porcentaje de aumento Salarial", x = "Porcentaje", y = "Frecuencia")

Se observa que la mayoría de los empleados han recibido aumentos salariales en el rango del 0 % al 15 %, siendo este el intervalo con la mayor frecuencia en comparación con los demás. —

Analisis Bivariado

Se llevará a cabo un análisis detallado de la relación entre cada una de las variables seleccionadas y la rotación, con el objetivo de identificar patrones y dependencias que puedan influir en la rotación de empleados. Para ello, se extraerá un subconjunto específico de la base de datos, compuesto únicamente por las variables de interés y la variable objetivo, asegurando que la información relevante se mantenga y la irrelevante se deseche, facilitando la construcción posterior del modelo.

# Seleccionar las variables de la data
subdata <- datos[, c("Rotacion", "Horas_Extra", "Satisfaccion_Ambiental", "Genero", 
                     "Distancia_Casa", "Antiguedad", "Porcentaje_aumento_salarial")]

# Verificar la subdata
head(subdata)
Rotacion Horas_Extra Satisfaccion_Ambiental Genero Distancia_Casa Antiguedad Porcentaje_aumento_salarial
Si Si 2 F 1 6 11
No No 3 M 8 10 23
Si Si 4 M 2 0 15
No Si 4 F 3 8 11
No No 1 M 2 2 12
No No 4 M 2 7 13

En primer lugar, se utiliza una matriz de correlación entre las variables seleccionadas para identificar y eliminar aquellas variables que no presentan una relación significativa con la Rotación, optimizando así el proceso de entrenamiento.

# Convertir variables categóricas en numéricas
subdata$Rotacion <- ifelse(subdata$Rotacion == "No", 0, 1)
subdata$Horas_Extra <- ifelse(subdata$Horas_Extra == "No", 0, 1)
# Convertir "Masculino" a 0 y "Femenino" a 1 en Genero
subdata$Genero <- ifelse(subdata$Genero == "M", 0, 1)

# Calcular la matriz de correlación
matriz_cor <- cor(subdata, use = "complete.obs")

# Visualizar con corrplot
corrplot(matriz_cor, method = "color", type = "upper", tl.col = "black", tl.srt = 45)

Se observa una relación mínima entre la Rotación y las variables “Genero” y “Porcentaje_aumento_salarial”. Por esta razón, se ha decidido excluirlas del conjunto de variables predictoras en el modelo.

# Seleccionar las variables de la data
subdata <- subdata[, c("Rotacion", "Horas_Extra", "Satisfaccion_Ambiental",             "Distancia_Casa", "Antiguedad")]

# Verificar la subdata
head(subdata)
Rotacion Horas_Extra Satisfaccion_Ambiental Distancia_Casa Antiguedad
1 1 2 1 6
0 0 3 8 10
1 1 4 2 0
0 1 4 3 8
0 0 1 2 2
0 0 4 2 7
crear_grafico_interactivo <- function(data, variable) {
  # Verificar si la variable existe en el dataframe
  if (!(variable %in% colnames(data))) {
    stop(paste("Error: La columna", variable, "no existe en el dataframe. Revisa el nombre."))
  }

  # Convertir el nombre de la variable en símbolo
  variable_sym <- sym(variable)

  # Contar las frecuencias
  data_count <- data %>%
    count(!!variable_sym, Rotacion, name = "Frecuencia")

  # Crear el gráfico
  p <- ggplot(data_count, aes(x = as.factor(!!variable_sym), y = Frecuencia, fill = factor(Rotacion))) +
    geom_bar(stat = "identity", position = "fill") +
    coord_flip() +
    scale_fill_manual(name = "Rotación", values = c("#1f78b4", "#a6cee3")) + # Tonos de azul
    labs(title = paste("Rotación por", variable), x = variable, y = "Proporción") +
    theme_minimal()

  # Convertir a gráfico interactivo
  ggplotly(p)
}

crear_grafico_interactivo(subdata, "Horas_Extra")
crear_grafico_interactivo(subdata, "Satisfaccion_Ambiental")
crear_grafico_interactivo(subdata, "Distancia_Casa")
crear_grafico_interactivo(subdata, "Antiguedad")

Modelo Predictivo

Este análisis busca predecir la rotación de empleados utilizando un modelo de regresión logística. Se utilizarán variables como horas extra, satisfacción ambiental, distancia al hogar y antigüedad.

División del Conjunto de Datos

# Fijar la semilla para garantizar reproducibilidad
set.seed(42)

# Dividir los datos en 70% entrenamiento y 30% prueba
division <- createDataPartition(subdata$Rotacion, p = 0.7, list = FALSE)
train_data <- subdata[division, ]  # Datos de entrenamiento
test_data <- subdata[-division, ]  # Datos de prueba

Se divide el conjunto de datos en entrenamiento (70%) y prueba (30%) para evaluar el rendimiento del modelo.

Ajuste del Modelo de Regresión Logística

# Entrenar un modelo de regresión logística
model <- glm(Rotacion ~ Horas_Extra + Satisfaccion_Ambiental + Distancia_Casa + 
               Antiguedad,
             data = train_data, 
             family = "binomial")

# Resumen del modelo
summary(model)
## 
## Call:
## glm(formula = Rotacion ~ Horas_Extra + Satisfaccion_Ambiental + 
##     Distancia_Casa + Antiguedad, family = "binomial", data = train_data)
## 
## Coefficients:
##                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)            -1.20143    0.27951  -4.298 1.72e-05 ***
## Horas_Extra             1.49117    0.18590   8.021 1.05e-15 ***
## Satisfaccion_Ambiental -0.33409    0.08351  -4.001 6.31e-05 ***
## Distancia_Casa          0.02278    0.01101   2.068 0.038593 *  
## Antiguedad             -0.07130    0.01909  -3.736 0.000187 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 879.08  on 1028  degrees of freedom
## Residual deviance: 782.18  on 1024  degrees of freedom
## AIC: 792.18
## 
## Number of Fisher Scoring iterations: 5

Se ajusta un modelo de regresión logística para predecir la rotación de empleados en función de las variables explicativas.

Gráfica del modelo

Como ilustración, se presenta una gráfica del modelo entrenado, donde los ejes representan la Rotación, la Satisfacción Ambiental y la Antigüedad.

# Crear una malla de valores para Horas_Extra y Satisfaccion_Ambiental
grid <- expand.grid(
  Horas_Extra = seq(min(train_data$Horas_Extra), max(train_data$Horas_Extra), length.out = 50),
  Satisfaccion_Ambiental = seq(min(train_data$Satisfaccion_Ambiental), max(train_data$Satisfaccion_Ambiental), length.out = 50)
)

# Agregar las demás variables necesarias con su media (o un valor fijo razonable)
grid$Distancia_Casa <- mean(train_data$Distancia_Casa, na.rm = TRUE)
grid$Antiguedad <- mean(train_data$Antiguedad, na.rm = TRUE)

# Predecir la probabilidad de Rotación en la malla
grid$Rotacion_Prob <- predict(model, newdata = grid, type = "response")

# Crear la gráfica 3D
fig <- plot_ly() %>%
  add_markers(data = train_data, x = ~Horas_Extra, y = ~Satisfaccion_Ambiental, z = ~Rotacion,
              color = ~Rotacion, colors = c("blue", "red"), opacity = 0.7) %>%
  add_surface(x = unique(grid$Horas_Extra), y = unique(grid$Satisfaccion_Ambiental), 
              z = matrix(grid$Rotacion_Prob, nrow = 50), 
              showscale = TRUE) %>%
  layout(title = "Regresión Logística: Superficie de Predicción",
         scene = list(xaxis = list(title = "Horas Extra"),
                      yaxis = list(title = "Satisfacción Ambiental"),
                      zaxis = list(title = "Probabilidad de Rotación")))

# Mostrar la gráfica
fig

Umbral de corte de probabilidad

Se evalúa el desempeño del modelo para diferentes umbrales de probabilidad, generando métricas como sensibilidad, especificidad, desempeño (accuracy) y una métrica compuesta. Posteriormente, se identifican los mejores umbrales utilizando tres criterios distintos.

Predicción de Probabilidades

Se calculan las probabilidades de que un empleado rote (1) o no rote (0) con base en el modelo ajustado. Esto se calcula para cada empleado en la data.

# Obtener las probabilidades de predicción en todo el conjunto de datos
probabilidades <- predict(model, test_data, type = "response")

# Visualizar las primeras probabilidades generadas
head(probabilidades)
##          1          2          3          4          5          6 
## 0.17527537 0.16347990 0.32838533 0.06564707 0.20642155 0.38911863

Métricas usadas en el análisis

  • Sensibilidad (Recall): Capacidad del modelo para detectar correctamente los casos positivos.

  • Especificidad: Capacidad del modelo para detectar correctamente los casos negativos.

  • Desempeño (Accuracy): Proporción total de predicciones correctas.

  • Métrica Compuesta: Promedio de sensibilidad y especificidad, usada para balancear ambas métricas.

Evaluación del Modelo con Diferentes Umbrales

Calculamos las métricas mencionadas para umbrales entre \(0.1\) y \(0.9\).

# Definir una secuencia de umbrales para evaluar el desempeño del modelo
umbrales <- seq(0.1, 0.9, by = 0.1)

# Crear un dataframe para almacenar los resultados de precisión, recall, F1, sensibilidad, especificidad, desempeño y métrica compuesta
resultados <- data.frame(Umbral = umbrales,
                         Sensibilidad = NA, 
                         Especificidad = NA, 
                         Desempeño = NA, 
                         Metrica_Compuesta = NA)

test_real <- as.factor(test_data$Rotacion)  # Valores reales en datos de prueba

for (i in 1:length(umbrales)) {
  umbral <- umbrales[i]
  predicciones <- ifelse(probabilidades >= umbral, 1, 0)
  confusion <- confusionMatrix(as.factor(predicciones), test_real)
  
  # Guardar métricas en el dataframe
  resultados$Sensibilidad[i] <- confusion$byClass["Sensitivity"]
  resultados$Especificidad[i] <- confusion$byClass["Specificity"]
  resultados$Desempeño[i] <- confusion$overall["Accuracy"]
  resultados$Metrica_Compuesta[i] <- mean(c(confusion$byClass["Sensitivity"], confusion$byClass["Specificity"]))
}

# Mostrar los resultados
print(resultados)
##   Umbral Sensibilidad Especificidad Desempeño Metrica_Compuesta
## 1    0.1    0.5318560        0.7750 0.5759637         0.6534280
## 2    0.2    0.7977839        0.5500 0.7528345         0.6738920
## 3    0.3    0.9224377        0.3625 0.8208617         0.6424688
## 4    0.4    0.9778393        0.1375 0.8253968         0.5576697
## 5    0.5    0.9944598        0.0500 0.8231293         0.5222299
## 6    0.6    1.0000000        0.0125 0.8208617         0.5062500
## 7    0.7    1.0000000        0.0000 0.8185941         0.5000000
## 8    0.8    1.0000000        0.0000 0.8185941         0.5000000
## 9    0.9    1.0000000        0.0000 0.8185941         0.5000000

Visualización de los resultados de las métricas

# Visualización de las métricas
resultados_long <- reshape2::melt(resultados, id.vars = "Umbral", variable.name = "Métrica", value.name = "Valor")

ggplot(resultados_long, aes(x = Umbral, y = Valor, color = Métrica)) +
  geom_line(size = 1) +
  geom_point() +
  labs(title = "Desempeño del Modelo con Diferentes Umbrales",
       x = "Umbral de Probabilidad",
       y = "Valor de la Métrica") +
  theme_minimal()

Determinación del mejor umbral

Usamos tres métodos distintos para encontrar el mejor umbral:

  • Según la métrica compuesta: Se selecciona el umbral que maximiza la media entre sensibilidad y especificidad, encontrando un balance entre los verdaderos positivos y verdaderos negativos.

  • Según el índice de Youden: El índice de Youden se define como

\[J = Sensibilidad + Especificidad - 1\] Se busca entonces el umbral que maximiza este índice

  • Según el desempeño (accuarcy): Se maximiza la medida de desempeño.
# Mejor umbral según métrica compuesta
mejor_umbral_compuesto <- resultados$Umbral[which.max(resultados$Metrica_Compuesta)]
print(paste("Mejor umbral según la métrica compuesta:", mejor_umbral_compuesto))
## [1] "Mejor umbral según la métrica compuesta: 0.2"
# Mejor umbral según el índice de Youden (J = Sensibilidad + Especificidad - 1)
resultados$Youden <- resultados$Sensibilidad + resultados$Especificidad - 1
mejor_umbral_youden <- resultados$Umbral[which.max(resultados$Youden)]
print(paste("Mejor umbral según el índice de Youden:", mejor_umbral_youden))
## [1] "Mejor umbral según el índice de Youden: 0.2"
# Mejor umbral según el desempeño (Accuracy)
mejor_umbral_desempeno <- resultados$Umbral[which.max(resultados$Desempeño)]
print(paste("Mejor umbral según desempeño (Accuracy):", mejor_umbral_desempeno))
## [1] "Mejor umbral según desempeño (Accuracy): 0.4"

Conclusiones

Las conclusiones principales sobre la relación entre la rotación de empleados y las variables explicativas son:

    1. Horas Extra (+): Es la variable con el mayor impacto positivo en la rotación. Su coeficiente (= 1.49) es positivo y altamente significativo (p < 0.001), lo que indica que los empleados que trabajan más horas extra tienen una probabilidad significativamente mayor de renunciar.
    1. Satisfacción Ambiental (-): Tiene un efecto negativo y significativo en la rotación (= -0.33, p < 0.001). Esto sugiere que a mayor satisfacción con el ambiente laboral, menor es la probabilidad de que un empleado renuncie.
    1. Distancia Casa (+): Tiene un coeficiente positivo (= 0.022) y un p-valor de 0.038, lo que indica que la distancia entre el hogar y el trabajo influye positivamente en la rotación, aunque su efecto es más débil en comparación con las otras variables.
    1. Antigüedad (-): Su coeficiente es negativo (= -0.071, p < 0.001), lo que implica que los empleados con mayor antigüedad tienen una menor probabilidad de rotar. Es decir, a medida que aumenta el tiempo en la empresa, es menos probable que el empleado renuncie.

Consideraciones adicionales:

  • El Intercepto negativo sugiere que, en ausencia de otros factores, la rotación base es baja.

  • El modelo tiene un AIC de 792.18, lo que permite compararlo con otros modelos si se busca mejorar su ajuste.

  • La significancia estadística de todas las variables indica que tienen un efecto relevante en la rotación, aunque su magnitud varía.

En conclusión, la rotación de empleados está fuertemente influenciada por las horas extra y la satisfacción ambiental, seguidas por la distancia a casa y la antigüedad. Para reducir la rotación, las empresas podrían enfocarse en mejorar las condiciones laborales y controlar las horas extra.

Aplicación Interactiva del modelo

# Definir la interfaz de usuario (UI)
ui <- fluidPage(
  titlePanel("Evaluación de Riesgo de Rotación de Empleados"),
  
  sidebarLayout(
    sidebarPanel(
      numericInput("horas_extra", "Trabaja horas extra (0: No, 1: Sí):", value = 0, min = 0, max = 1),
      numericInput("satisfaccion", "Satisfacción ambiental (1-5):", value = 3, min = 1, max = 5),
      numericInput("distancia", "Distancia de casa al trabajo (km):", value = 10, min = 1, max = 50),
      numericInput("antiguedad", "Antigüedad en la empresa (años):", value = 5, min = 1, max = 30),
      actionButton("calcular", "Evaluar Riesgo")
    ),
    
    mainPanel(
      h3("Resultado:"),
      textOutput("resultado"),
      br(),
      textOutput("mensaje"),
      br(),
      tags$style("#resultado { font-size: 24px; font-weight: bold; color: blue; }")
    )
  )
)

# Definir la lógica del servidor
server <- function(input, output) {
  
  riesgo_rotacion <- eventReactive(input$calcular, {
    # Crear un dataframe con los valores ingresados
    datos_empleado <- data.frame(
      Horas_Extra = as.numeric(input$horas_extra),
      Satisfaccion_Ambiental = as.numeric(input$satisfaccion),
      Distancia_Casa = as.numeric(input$distancia),
      Antiguedad = as.numeric(input$antiguedad)
    )
    
    # Calcular la probabilidad de rotación
    prob <- predict(model, datos_empleado, type = "response")
    
    return(prob)
  })
  
  output$resultado <- renderText({
    req(riesgo_rotacion())
    paste("Probabilidad de que el empleado se vaya:", round(riesgo_rotacion() * 100, 2), "%")
  })
  
  output$mensaje <- renderText({
    req(riesgo_rotacion())
    if (riesgo_rotacion() > 0.35) {
      return("⚠️ ¡Alerta! Alto riesgo de rotación.")
    } else if (riesgo_rotacion() > 0.2) {
      return("🔶 Riesgo moderado de rotación.")
    } else {
      return("🟢 Bajo riesgo. El empleado es estable.")
    }
  })

}

# Ejecutar la aplicación
shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents