1 Introducción

En una organización se busca comprender los factores que influyen en la rotación de empleados entre distintos cargos. La empresa dispone de datos como antigüedad, satisfacción laboral, salario, edad, entre otras variables. Con lo anterior se busca generar un modelo de regresión logística que permita estimar la probabilidad de que un empleado rote y así identificar los factores que más inciden en la decisión. Al final con esta información se podria llegar a medidas proactivas para retener talento clave

if (!requireNamespace("paqueteMODELOS", quietly = TRUE)) {
  install.packages("devtools")
  devtools::install_github("centromagis/paqueteMODELOS", force = TRUE)
}
if (!requireNamespace("pROC", quietly = TRUE)) install.packages("pROC")

library(paqueteMODELOS)
library(dplyr)
library(ggplot2)
library(scales)
library(broom)
library(knitr)
library(kableExtra)
library(pROC)

data("rotacion")
# Se homogenizan los nombres de las variables (se eliminan tildes y espacios)
rotacion <- rotacion %>%
  rename(
    Rotacion                = `Rotación`,
    Viaje_Negocios          = `Viaje de Negocios`,
    Educacion               = `Educación`,
    Campo_Educacion         = `Campo_Educación`,
    Satisfaccion_Ambiental  = `Satisfacción_Ambiental`,
    Satisfaccion_Laboral    = `Satisfación_Laboral`,
    Anios_Experiencia       = `Años_Experiencia`,
    Antiguedad              = `Antigüedad`,
    Antiguedad_Cargo        = `Antigüedad_Cargo`,
    Anios_ultima_promocion  = `Años_ultima_promoción`,
    Anios_acargo_mismo_jefe = `Años_acargo_con_mismo_jefe`
  )

# Variable respuesta codificada como 0/1 (y = 1 si rotación, y = 0 si no rotación)
rotacion <- rotacion %>%
  mutate(
    Rotacion_bin = ifelse(Rotacion == "Si", 1, 0),
    Satisfaccion_Laboral_f = factor(Satisfaccion_Laboral,
                                     levels = 1:4,
                                     labels = c("Muy insatisfecho", "Insatisfecho",
                                                "Satisfecho", "Muy satisfecho")),
    Genero = factor(Genero, levels = c("F", "M"), labels = c("Femenino", "Masculino")),
    Cargo  = factor(Cargo),
    Cargo  = relevel(Cargo, ref = "Tecnico_Laboratorio")
  )

1.1 Diccionario de datos

Las variables ordinales de la base se codifican con números enteros. Para interpretar correctamente las categorías (en particular la satisfacción laboral, que entra al modelo como factor) se toma como referencia el siguiente diccionario de datos:

diccionario <- data.frame(
  Variable = c("Rendimiento_Laboral", "Distancia_Casa", "Educacion",
               "Satisfaccion_Ambiental", "Satisfaccion_Laboral",
               "Trabajos_Anteriores", "Equilibrio_Trabajo_Vida"),
  Codificacion = c("1 = Bajo, 2 = Medio, 3 = Alto, 4 = Muy alto",
                   "Kilómetros de distancia desde la casa",
                   "1 = Primaria, 2 = Secundaria, 3 = Técnico/Tecnólogo, 4 = Pregrado, 5 = Posgrado",
                   "1 = Muy insatisfecho, 2 = Insatisfecho, 3 = Satisfecho, 4 = Muy satisfecho",
                   "1 = Muy insatisfecho, 2 = Insatisfecho, 3 = Satisfecho, 4 = Muy satisfecho",
                   "Cantidad de trabajos antes de ingresar a la empresa",
                   "1 = Muy bajo, 2 = Bajo, 3 = Medio, 4 = Alto")
)

kable(diccionario, caption = "Diccionario de datos de las variables codificadas") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Diccionario de datos de las variables codificadas
Variable Codificacion
Rendimiento_Laboral 1 = Bajo, 2 = Medio, 3 = Alto, 4 = Muy alto
Distancia_Casa Kilómetros de distancia desde la casa
Educacion 1 = Primaria, 2 = Secundaria, 3 = Técnico/Tecnólogo, 4 = Pregrado, 5 = Posgrado
Satisfaccion_Ambiental 1 = Muy insatisfecho, 2 = Insatisfecho, 3 = Satisfecho, 4 = Muy satisfecho
Satisfaccion_Laboral 1 = Muy insatisfecho, 2 = Insatisfecho, 3 = Satisfecho, 4 = Muy satisfecho
Trabajos_Anteriores Cantidad de trabajos antes de ingresar a la empresa
Equilibrio_Trabajo_Vida 1 = Muy bajo, 2 = Bajo, 3 = Medio, 4 = Alto

De acuerdo con este diccionario, las etiquetas de Satisfaccion_Laboral usadas en todo el documento son: Muy insatisfecho (1), Insatisfecho (2), Satisfecho (3) y Muy satisfecho (4). Así mismo, la Distancia_Casa se interpreta en kilómetros, por lo que su coeficiente en el modelo corresponde al cambio en el logaritmo de odds de rotar por cada kilómetro adicional de distancia.

2 Selección de variables

Se seleccionan 3 variables categóricas y 3 variables cuantitativas, distintas de la rotación, que se consideran relacionadas con la probabilidad de rotación del personal. A continuación se plantea la hipótesis de relación esperada para cada una.

2.1 Variables categóricas

1. Satisfacción laboral (Satisfaccion_Laboral)

La satisfacción laboral se mide en una escala ordinal de 1 (Muy insatisfecho) a 4 (Muy satisfecho). Se espera que exista una relación inversa, a menor satisfacción, mayor es la probabilidad de que se busque mejores ofertas en otras organizaciones. En términos del modelo logístico, se espera que los niveles “Insatisfecho”, “Satisfecho” y “Muy satisfecho” presenten coeficientes negativos

2. Cargo (Cargo)

Se espera que los cargos de mayor jerarquía como gerentes y directores presenten menor rotación que los cargos de entrada u operativos como Técnico de Laboratorio, Representante de Ventas o Investigador Científico. Esto se prevee ya que quienes ocupan cargos altos usualmente ya “escalaron” dentro de la organización, cuentan con mejores condiciones salariales y de estabilidad, y por lo tanto tienen menos incentivos para rotar

3. Género (Genero)

La proporción de rotación de los hombres, respecto al total de hombres, es mayor que la proporción de rotación de las mujeres respecto al total de mujeres. Esto se explicaria porque los hombres tienden a asumir mayores niveles de riesgo laboral, por ejemplo, aplicando a ofertas de trabajo para las cuales no cumplen totalmente los requisitos o cambiando de área con mayor facilidad

2.2 Variables cuantitativas

4. Distancia a la casa (Distancia_Casa)

Se espera una relación positiva: entre mayor sea la distancia entre la vivienda y el sitio de trabajo, mayor la probabilidad de rotación, ya que los empleados que viven más lejos tienden a buscar oportunidades laborales más cercanas a su hogar que reduzcan tiempos y costos de desplazamiento.

5. Edad (Edad)

Se espera una relación negativa: a mayor edad, menor probabilidad de rotación. Los empleados más jóvenes tienden a ser más arriesgados y a explorar más alternativas laborales, en terminos coloquiales se dice que la “cedula se vence” es decir que a medida que aumenta la edad también suelen incrementarse las responsabilidades personales y no se es tan atractivo para las empresas.

6. Ingreso mensual (Ingreso_Mensual)

Se espera una relación negativa: a mayor ingreso mensual, menor probabilidad de rotación, debido a que resulta más difícil encontrar ofertas que igualen o superen el salario actual, por lo que el empleado tiene menos incentivos económicos para cambiar de trabajo.

2.3 Resumen de hipótesis

tabla_hipotesis <- data.frame(
  Variable = c("Satisfacción laboral", "Cargo", "Género",
               "Distancia a la casa", "Edad", "Ingreso mensual"),
  Tipo = c("Categórica (ordinal)", "Categórica (nominal)", "Categórica (nominal)",
           "Cuantitativa", "Cuantitativa", "Cuantitativa"),
  `Relación esperada con la rotación` = c(
    "Inversa: a menor satisfacción, mayor rotación",
    "Inversa con la jerarquía: cargos altos rotan menos que cargos de entrada",
    "Mayor proporción de rotación en hombres que en mujeres",
    "Directa: a mayor distancia, mayor rotación",
    "Inversa: a mayor edad, menor rotación",
    "Inversa: a mayor ingreso, menor rotación"),
  check.names = FALSE
)

kable(tabla_hipotesis, caption = "Resumen de hipótesis de relación esperada") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Resumen de hipótesis de relación esperada
Variable Tipo Relación esperada con la rotación
Satisfacción laboral Categórica (ordinal) Inversa: a menor satisfacción, mayor rotación
Cargo Categórica (nominal) Inversa con la jerarquía: cargos altos rotan menos que cargos de entrada
Género Categórica (nominal) Mayor proporción de rotación en hombres que en mujeres
Distancia a la casa Cuantitativa Directa: a mayor distancia, mayor rotación
Edad Cuantitativa Inversa: a mayor edad, menor rotación
Ingreso mensual Cuantitativa Inversa: a mayor ingreso, menor rotación

3 Análisis univariado

3.1 Estructura general de los datos

glimpse(rotacion)
## Rows: 1,470
## Columns: 26
## $ Rotacion                    <chr> "Si", "No", "Si", "No", "No", "No", "No", …
## $ Edad                        <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35…
## $ Viaje_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…
## $ Educacion                   <dbl> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, …
## $ Campo_Educacion             <chr> "Ciencias", "Ciencias", "Otra", "Ciencias"…
## $ Satisfaccion_Ambiental      <dbl> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, …
## $ Genero                      <fct> Femenino, Masculino, Masculino, Femenino, …
## $ Cargo                       <fct> Ejecutivo_Ventas, Investigador_Cientifico,…
## $ Satisfaccion_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, …
## $ Anios_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, …
## $ Antiguedad                  <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2,…
## $ Antiguedad_Cargo            <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, …
## $ Anios_ultima_promocion      <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, …
## $ Anios_acargo_mismo_jefe     <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, …
## $ Rotacion_bin                <dbl> 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ Satisfaccion_Laboral_f      <fct> Muy satisfecho, Insatisfecho, Satisfecho, …

La base de datos contiene 1470 empleados y 26 variables, entre información sociodemográfica (edad, género, estado civil), condiciones del cargo y percepciones del empleado

3.2 Variable respuesta: Rotación

tabla_rot <- rotacion %>%
  count(Rotacion) %>%
  mutate(Proporcion = percent(n / sum(n)))

kable(tabla_rot, caption = "Distribución de la variable Rotación") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Distribución de la variable Rotación
Rotacion n Proporcion
No 1233 84%
Si 237 16% 
ggplot(rotacion, aes(x = Rotacion, fill = Rotacion)) +
  geom_bar() +
  geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.4) +
  scale_fill_manual(values = c("No" = "#2C7FB8", "Si" = "#D95F02")) +
  labs(title = "Distribución de la variable Rotación", x = "Rotación", y = "Número de empleados") +
  theme_minimal() +
  theme(legend.position = "none")

Con los anterior podemos decir que de los 1470 empleados, 237 (16%) presentaron rotación y 1233 (84%) permanecen en la empresa. Se trata de una variable desbalanceada, por lo que en la evaluación del modelo no basta con mirar la exactitud global, sino que es necesario revisar también la sensibilidad, la especificidad y el AUC.

3.3 Variables categóricas seleccionadas

graf_categorica <- function(datos, variable, titulo) {
  ggplot(datos, aes(x = .data[[variable]], fill = .data[[variable]])) +
    geom_bar() +
    geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.4) +
    labs(title = titulo, x = NULL, y = "Frecuencia") +
    theme_minimal() +
    theme(legend.position = "none", axis.text.x = element_text(angle = 30, hjust = 1))
}

kable(rotacion %>% count(Satisfaccion_Laboral_f) %>% mutate(Proporcion = percent(n/sum(n))),
      caption = "Frecuencia - Satisfacción Laboral")
Frecuencia - Satisfacción Laboral
Satisfaccion_Laboral_f n Proporcion
Muy insatisfecho 289 19.66%
Insatisfecho 280 19.05%
Satisfecho 442 30.07%
Muy satisfecho 459 31.22% 
graf_categorica(rotacion, "Satisfaccion_Laboral_f", "Satisfacción laboral")

kable(rotacion %>% count(Cargo) %>% mutate(Proporcion = percent(n/sum(n))),
      caption = "Frecuencia - Cargo")
Frecuencia - Cargo
Cargo n Proporcion
Tecnico_Laboratorio 259 17.62%
Director_Investigación 80 5.44%
Director_Manofactura 145 9.86%
Ejecutivo_Ventas 326 22.18%
Gerente 102 6.94%
Investigador_Cientifico 292 19.86%
Recursos_Humanos 52 3.54%
Representante_Salud 131 8.91%
Representante_Ventas 83 5.65% 
graf_categorica(rotacion, "Cargo", "Cargo")

kable(rotacion %>% count(Genero) %>% mutate(Proporcion = percent(n/sum(n))),
      caption = "Frecuencia - Género")
Frecuencia - Género
Genero n Proporcion
Femenino 588 40%
Masculino 882 60% 
graf_categorica(rotacion, "Genero", "Género")

Los datos o interpretacion generada es que la mayoría de los empleados reporta estar “Satisfecho” o “Muy satisfecho” con su trabajo; el cargo más frecuente es “Ejecutivo de Ventas” seguido de “Técnico de Laboratorio”; y hay una mayor proporción de hombres (60%) que de mujeres (40%) en la muestra.

3.4 Variables cuantitativas seleccionadas

summary(rotacion[, c("Edad", "Distancia_Casa", "Ingreso_Mensual")])
##       Edad       Distancia_Casa   Ingreso_Mensual
##  Min.   :18.00   Min.   : 1.000   Min.   : 1009  
##  1st Qu.:30.00   1st Qu.: 2.000   1st Qu.: 2911  
##  Median :36.00   Median : 7.000   Median : 4919  
##  Mean   :36.92   Mean   : 9.193   Mean   : 6503  
##  3rd Qu.:43.00   3rd Qu.:14.000   3rd Qu.: 8379  
##  Max.   :60.00   Max.   :29.000   Max.   :19999
graf_cuantitativa <- function(datos, variable, titulo) {
  ggplot(datos, aes(x = .data[[variable]])) +
    geom_histogram(fill = "#2C7FB8", color = "white", bins = 25) +
    labs(title = titulo, x = variable, y = "Frecuencia") +
    theme_minimal()
}

graf_cuantitativa(rotacion, "Edad", "Distribución de la Edad")

graf_cuantitativa(rotacion, "Distancia_Casa", "Distribución de la Distancia a la casa")

graf_cuantitativa(rotacion, "Ingreso_Mensual", "Distribución del Ingreso Mensual")

Resumiendo la edad promedio es de 36.9 años (mín. 18, máx. 60); la distancia a la casa tiene un promedio de 9.2 km y una distribución sesgada a la derecha; y el ingreso mensual presenta un fuerte sesgo a la derecha (mediana de 4919 frente a una media de 6503), lo cual se esperaria de las variables salariales.

4 Análisis bivariado

A continuacion se mira la relación de cada una de las 6 variables seleccionadas con la variable respuesta Rotacion (y = 1 si hay rotación, y = 0 si no la hay), mediante tablas de contingencia/diagramas de caja y un modelo de regresión logística simple (bivariado) para cada variable, con el fin de identificar el signo del coeficiente estimado y su significancia individual.

Debemos tener presente que las odds comparan los que rotan frente a los que no rotan, \(\frac{p}{1-p}\). Adicional, al usar el modelo logístico en el analisis bivariado a continuacio este trabaja sobre el logaritmo de las odds, y al exponenciar sus coeficientes se obtiene el Odds Ratio (OR), que indica cuántas veces cambian las odds de rotar, no la probabilidad.

4.1 Rotación vs. variables categóricas

tab_sat <- table(rotacion$Satisfaccion_Laboral_f, rotacion$Rotacion)
kable(addmargins(tab_sat), caption = "Rotación según Satisfacción Laboral")
Rotación según Satisfacción Laboral
No Si Sum
Muy insatisfecho 223 66 289
Insatisfecho 234 46 280
Satisfecho 369 73 442
Muy satisfecho 407 52 459
Sum 1233 237 1470 
kable(round(prop.table(tab_sat, 1) * 100, 1), caption = "Porcentaje de rotación por nivel de satisfacción")
Porcentaje de rotación por nivel de satisfacción
No Si
Muy insatisfecho 77.2 22.8
Insatisfecho 83.6 16.4
Satisfecho 83.5 16.5
Muy satisfecho 88.7 11.3 
ggplot(rotacion, aes(x = Satisfaccion_Laboral_f, fill = Rotacion)) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = percent) +
  labs(title = "Proporción de rotación por Satisfacción Laboral", x = "Satisfacción laboral", y = "Proporción") +
  theme_minimal()

modelo_sat <- glm(Rotacion_bin ~ Satisfaccion_Laboral_f, data = rotacion, family = binomial)
summary(modelo_sat)
## 
## Call:
## glm(formula = Rotacion_bin ~ Satisfaccion_Laboral_f, family = binomial, 
##     data = rotacion)
## 
## Coefficients:
##                                      Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                           -1.2175     0.1401  -8.689  < 2e-16 ***
## Satisfaccion_Laboral_fInsatisfecho    -0.4092     0.2137  -1.915   0.0555 .  
## Satisfaccion_Laboral_fSatisfecho      -0.4028     0.1899  -2.122   0.0339 *  
## Satisfaccion_Laboral_fMuy satisfecho  -0.8401     0.2033  -4.132 3.59e-05 ***
## ---
## 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: 1281.2  on 1466  degrees of freedom
## AIC: 1289.2
## 
## Number of Fisher Scoring iterations: 4

La categoría de referencia es “Muy insatisfecho” (queda representada en el intercepto). Ese intercepto sale muy significativo (p ≈ 0.000), pero eso solo indica que la tasa base de rotación del grupo “Muy insatisfecho” (22.8%) es distinta de 50%; no dice nada sobre la relación entre satisfacción y rotación. Lo que sí prueba la hipótesis son los coeficientes de las categorías no-referencia: “Insatisfecho” (β ≈ -0.41, p ≈ 0.056, al límite de la significancia al 5%), “Satisfecho” (β ≈ -0.40, p ≈ 0.034, significativo) y “Muy satisfecho” (β ≈ -0.84, p ≈ 0.000, claramente significativo). Los tres signos son negativos y de magnitud creciente, es decir que, frente a un empleado “Muy insatisfecho”, tener una satisfacción mayor reduce el logaritmo de odds de rotar — esto confirma la hipótesis planteada en el numeral 1.

tab_cargo <- table(rotacion$Cargo, rotacion$Rotacion)
kable(addmargins(tab_cargo), caption = "Rotación según Cargo")
Rotación según Cargo
No Si Sum
Tecnico_Laboratorio 197 62 259
Director_Investigación 78 2 80
Director_Manofactura 135 10 145
Ejecutivo_Ventas 269 57 326
Gerente 97 5 102
Investigador_Cientifico 245 47 292
Recursos_Humanos 40 12 52
Representante_Salud 122 9 131
Representante_Ventas 50 33 83
Sum 1233 237 1470 
ggplot(rotacion, aes(x = reorder(Cargo, Rotacion_bin, FUN = mean), fill = Rotacion)) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = percent) +
  coord_flip() +
  labs(title = "Proporción de rotación por Cargo", x = "Cargo", y = "Proporción") +
  theme_minimal()

modelo_cargo <- glm(Rotacion_bin ~ Cargo, data = rotacion, family = binomial)
summary(modelo_cargo)
## 
## Call:
## glm(formula = Rotacion_bin ~ Cargo, family = binomial, data = rotacion)
## 
## Coefficients:
##                              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   -1.1561     0.1456  -7.939 2.04e-15 ***
## CargoDirector_Investigación   -2.5075     0.7308  -3.431 0.000601 ***
## CargoDirector_Manofactura     -1.4466     0.3586  -4.034 5.49e-05 ***
## CargoEjecutivo_Ventas         -0.3956     0.2061  -1.920 0.054902 .  
## CargoGerente                  -1.8092     0.4812  -3.760 0.000170 ***
## CargoInvestigador_Cientifico  -0.4950     0.2158  -2.294 0.021783 *  
## CargoRecursos_Humanos         -0.0479     0.3599  -0.133 0.894117    
## CargoRepresentante_Salud      -1.4507     0.3749  -3.870 0.000109 ***
## CargoRepresentante_Ventas      0.7406     0.2674   2.769 0.005617 ** 
## ---
## 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: 1209.7  on 1461  degrees of freedom
## AIC: 1227.7
## 
## Number of Fisher Scoring iterations: 6

La referencia aquí es “Técnico de Laboratorio” (tasa base de rotación 23.9%), absorbida en el intercepto; su significancia (p ≈ 0.000) de nuevo solo refleja que esa tasa está lejos de 50/50, no una relación con la rotación. De los 8 coeficientes restantes, la mayoría son negativos y significativos (Director de Investigación, Director de Manufactura, Gerente, Investigador Científico, Representante de Salud, todos con p < 0.05), es decir que esos cargos rotan menos que el técnico de laboratorio, lo que confirma la hipótesis de que los cargos más altos o especializados presentan menor rotación. La excepción es Representante de Ventas, con coeficiente positivo y significativo (β ≈ 0.74, p ≈ 0.006), es decir mayor rotación que el técnico de laboratorio; mientras que Ejecutivo de Ventas (p ≈ 0.055, al límite) y Recursos Humanos (p ≈ 0.894, no significativo) no muestran una diferencia clara frente al cargo de referencia.

tab_gen <- table(rotacion$Genero, rotacion$Rotacion)
kable(addmargins(tab_gen), caption = "Rotación según Género")
Rotación según Género
No Si Sum
Femenino 501 87 588
Masculino 732 150 882
Sum 1233 237 1470 
kable(round(prop.table(tab_gen, 1) * 100, 1), caption = "Porcentaje de rotación por género")
Porcentaje de rotación por género
No Si
Femenino 85.2 14.8
Masculino 83.0 17.0 
ggplot(rotacion, aes(x = Genero, fill = Rotacion)) +
  geom_bar(position = "fill") +
  scale_y_continuous(labels = percent) +
  labs(title = "Proporción de rotación por Género", x = "Género", y = "Proporción") +
  theme_minimal()

modelo_genero <- glm(Rotacion_bin ~ Genero, data = rotacion, family = binomial)
summary(modelo_genero)
## 
## Call:
## glm(formula = Rotacion_bin ~ Genero, family = binomial, data = rotacion)
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -1.7507     0.1161 -15.073   <2e-16 ***
## GeneroMasculino   0.1656     0.1467   1.128    0.259    
## ---
## 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: 1297.3  on 1468  degrees of freedom
## AIC: 1301.3
## 
## Number of Fisher Scoring iterations: 4

Tomando como referencia “Femenino” (tasa base de rotación 14.8%), y su intercepto sale muy significativo (p ≈ 0.000) únicamente porque esa tasa está lejos de 50%, no porque exista una relación de la variable con la rotación. El coeficiente que realmente prueba la hipótesis, GeneroMasculino (β ≈ 0.166, p ≈ 0.259), tiene el signo positivo esperado (mayor rotación en hombres que en mujeres) pero no es estadísticamente significativo al 5%. Es decir, con la evidencia disponible no se puede afirmar que exista una diferencia real entre géneros en la probabilidad de rotación; la diferencia observada en las proporciones crudas (14.8% vs. 17.0%) es compatible con variación muestral y no descarta la hipótesis nula de que ambos géneros rotan igual.

4.2 Rotación vs. variables cuantitativas

rotacion %>%
  group_by(Rotacion) %>%
  summarise(across(c(Edad, Distancia_Casa, Ingreso_Mensual),
                    list(media = mean, mediana = median), .names = "{.col}_{.fn}")) %>%
  kable(caption = "Estadísticos descriptivos por grupo de Rotación", digits = 1)
Estadísticos descriptivos por grupo de Rotación
Rotacion Edad_media Edad_mediana Distancia_Casa_media Distancia_Casa_mediana Ingreso_Mensual_media Ingreso_Mensual_mediana
No 37.6 36 8.9 7 6832.7 5204
Si 33.6 32 10.6 9 4787.1 3202 
ggplot(rotacion, aes(x = Rotacion, y = Distancia_Casa, fill = Rotacion)) +
  geom_boxplot() + theme_minimal() + theme(legend.position = "none") +
  labs(title = "Distancia a la casa según Rotación")

ggplot(rotacion, aes(x = Rotacion, y = Edad, fill = Rotacion)) +
  geom_boxplot() + theme_minimal() + theme(legend.position = "none") +
  labs(title = "Edad según Rotación")

ggplot(rotacion, aes(x = Rotacion, y = Ingreso_Mensual, fill = Rotacion)) +
  geom_boxplot() + theme_minimal() + theme(legend.position = "none") +
  labs(title = "Ingreso Mensual según Rotación")

modelo_distancia <- glm(Rotacion_bin ~ Distancia_Casa, data = rotacion, family = binomial)
summary(modelo_distancia)
## 
## Call:
## glm(formula = Rotacion_bin ~ Distancia_Casa, family = binomial, 
##     data = rotacion)
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -1.890051   0.111382 -16.969  < 2e-16 ***
## Distancia_Casa  0.024710   0.008312   2.973  0.00295 ** 
## ---
## 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: 1290.0  on 1468  degrees of freedom
## AIC: 1294
## 
## Number of Fisher Scoring iterations: 4
modelo_edad <- glm(Rotacion_bin ~ Edad, data = rotacion, family = binomial)
summary(modelo_edad)
## 
## Call:
## glm(formula = Rotacion_bin ~ Edad, family = binomial, data = rotacion)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.20637    0.30597   0.674      0.5    
## Edad        -0.05225    0.00870  -6.006  1.9e-09 ***
## ---
## 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: 1259.1  on 1468  degrees of freedom
## AIC: 1263.1
## 
## Number of Fisher Scoring iterations: 4
modelo_ingreso <- glm(Rotacion_bin ~ Ingreso_Mensual, data = rotacion, family = binomial)
summary(modelo_ingreso)
## 
## Call:
## glm(formula = Rotacion_bin ~ Ingreso_Mensual, family = binomial, 
##     data = rotacion)
## 
## Coefficients:
##                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)     -9.291e-01  1.292e-01  -7.191 6.43e-13 ***
## Ingreso_Mensual -1.271e-04  2.162e-05  -5.879 4.12e-09 ***
## ---
## 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: 1253.1  on 1468  degrees of freedom
## AIC: 1257.1
## 
## Number of Fisher Scoring iterations: 5

Diferente a las variables categóricas, aquí no hay una “categoría de referencia” que se vuelva dummy: cada modelo tiene un único coeficiente de pendiente, y el intercepto pasa a representar el logaritmo de odds de rotación cuando la variable vale 0 (por ejemplo, Edad = 0 o Ingreso_Mensual = 0), un valor que normalmente está fuera del rango real de los datos y que rara vez tiene sentido práctico para el negocio — de hecho, para Edad el intercepto no es significativo (p ≈ 0.50), justamente porque ningún empleado de la muestra tiene 0 años y el modelo no tiene evidencia para estimarlo con precisión. Por eso, para variables cuantitativas lo relevante es el coeficiente de la pendiente (no el intercepto):

  • Distancia a la casa: β ≈ 0.0247 (p ≈ 0.003), positivo y significativo → por cada km adicional de distancia, aumenta el logaritmo de odds de rotar; confirma la hipótesis.
  • Edad: β ≈ -0.0523 (p ≈ 0.000), negativo y significativo → por cada año adicional, disminuye el logaritmo de odds de rotar; confirma la hipótesis.
  • Ingreso mensual: β ≈ -0.000127 (p ≈ 0.000), negativo y significativo → a mayor ingreso, menor es la probabilidad de rotar; confirma la hipótesis. El coeficiente luce muy pequeño solo porque el ingreso se mide en unidades monetarias (no en miles): por cada 1.000 unidades adicionales de ingreso, el logaritmo de odds cambia en promedio 1.000 × (-0.000127) ≈ -0.127.

4.3 Resumen comparativo: hipótesis vs. resultado observado

variables_biv  <- c("Satisfaccion_Laboral_f", "Cargo", "Genero",
                     "Distancia_Casa", "Edad", "Ingreso_Mensual")
hipotesis_signo <- c("Negativo", "Ver detalle por cargo", "Positivo (Masculino)",
                     "Positivo", "Negativo", "Negativo")

resumen_biv <- lapply(variables_biv, function(v) {
  formula_v <- as.formula(paste("Rotacion_bin ~", v))
  m  <- glm(formula_v, data = rotacion, family = binomial)
  lr <- anova(m, test = "Chisq")
  p_global <- lr$`Pr(>Chi)`[2]
  coefs <- coef(m)[-1]
  signo <- if (length(coefs) == 1) {
    ifelse(coefs > 0, "Positivo", "Negativo")
  } else {
    "Ver detalle por categoría"
  }
  data.frame(Variable = v, Signo_observado = signo,
             p_valor = signif(p_global, 4))
})
resumen_biv <- do.call(rbind, resumen_biv)
resumen_biv$Hipotesis_esperada <- hipotesis_signo
resumen_biv$Significativa <- ifelse(resumen_biv$p_valor < 0.05, "Sí", "No")

kable(resumen_biv, caption = "Comparación entre la hipótesis planteada y el resultado del análisis bivariado") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Comparación entre la hipótesis planteada y el resultado del análisis bivariado
Variable Signo_observado p_valor Hipotesis_esperada Significativa
1 Satisfaccion_Laboral_f Ver detalle por categoría 0.0005969 Negativo Sí
2 Cargo Ver detalle por categoría 0.0000000 Ver detalle por cargo Sí
GeneroMasculino Genero Positivo 0.2569000 Positivo (Masculino) No
Distancia_Casa Distancia_Casa Positivo 0.0033990 Positivo Sí
Edad Edad Negativo 0.0000000 Negativo Sí
Ingreso_Mensual Ingreso_Mensual Negativo 0.0000000 Negativo Sí

Las variables cuya prueba de razón de verosimilitud (LR test) arroja un p-valor < 0.05 se consideran determinantes de la rotación en el análisis bivariado. El signo del coeficiente permite confirmar o refutar el sentido planteado en las hipotesis, un coeficiente negativo indica quea medida que aumenta la variable (o para esa categoría), disminuye el logaritmo de odds de rotar o viceversa

5 Estimación del modelo

Se estima un modelo de regresión logística múltiple en el que la variable respuesta es Rotacion (y = 1 si rotación, y = 0 si no rotación). De las 6 variables seleccionadas en el numeral 1 se excluye el género, ya que en el análisis bivariado no mostró una relación estadísticamente significativa con la rotación (p ≈ 0.259); por lo tanto, las covariables del modelo son: satisfacción laboral, cargo, distancia a la casa, edad e ingreso mensual.

modelo_completo <- glm(
  Rotacion_bin ~ Satisfaccion_Laboral_f + Cargo +
    Distancia_Casa + Edad + Ingreso_Mensual,
  data = rotacion, family = binomial(link = "logit")
)

summary(modelo_completo)
## 
## Call:
## glm(formula = Rotacion_bin ~ Satisfaccion_Laboral_f + Cargo + 
##     Distancia_Casa + Edad + Ingreso_Mensual, family = binomial(link = "logit"), 
##     data = rotacion)
## 
## Coefficients:
##                                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                           3.173e-02  3.801e-01   0.083 0.933458    
## Satisfaccion_Laboral_fInsatisfecho   -4.954e-01  2.250e-01  -2.202 0.027658 *  
## Satisfaccion_Laboral_fSatisfecho     -4.391e-01  1.991e-01  -2.205 0.027434 *  
## Satisfaccion_Laboral_fMuy satisfecho -9.182e-01  2.116e-01  -4.339 1.43e-05 ***
## CargoDirector_Investigación          -2.449e+00  8.994e-01  -2.723 0.006476 ** 
## CargoDirector_Manofactura            -1.432e+00  3.985e-01  -3.593 0.000327 ***
## CargoEjecutivo_Ventas                -3.837e-01  2.593e-01  -1.480 0.138992    
## CargoGerente                         -1.642e+00  7.491e-01  -2.192 0.028401 *  
## CargoInvestigador_Cientifico         -4.677e-01  2.192e-01  -2.133 0.032910 *  
## CargoRecursos_Humanos                -2.574e-03  3.704e-01  -0.007 0.994455    
## CargoRepresentante_Salud             -1.399e+00  4.162e-01  -3.360 0.000779 ***
## CargoRepresentante_Ventas             7.107e-01  2.766e-01   2.569 0.010187 *  
## Distancia_Casa                        2.724e-02  8.851e-03   3.078 0.002086 ** 
## Edad                                 -3.091e-02  9.870e-03  -3.132 0.001737 ** 
## Ingreso_Mensual                       1.787e-05  4.325e-05   0.413 0.679530    
## ---
## 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: 1171.1  on 1455  degrees of freedom
## AIC: 1201.1
## 
## Number of Fisher Scoring iterations: 6

5.1 Significancia global del modelo

dif_residuos <- modelo_completo$null.deviance - modelo_completo$deviance
df_dif       <- modelo_completo$df.null - modelo_completo$df.residual
p_value_glob <- pchisq(dif_residuos, df_dif, lower.tail = FALSE)

data.frame(
  `Diferencia de residuos (Chi-cuadrado)` = round(dif_residuos, 2),
  `Grados de libertad` = df_dif,
  `p-valor` = format.pval(p_value_glob, digits = 4),
  check.names = FALSE
) %>% kable(caption = "Prueba de razón de verosimilitud (Likelihood Ratio Test)")
Prueba de razón de verosimilitud (Likelihood Ratio Test)
Diferencia de residuos (Chi-cuadrado) Grados de libertad p-valor
127.51 14 < 2.2e-16

Dado que el p-valor es prácticamente cero, se rechaza la hipótesis nula de que todos los coeficientes son iguales a cero: el modelo en su conjunto es significativo.

5.2 Interpretación de los coeficientes (Odds Ratios)

tabla_or <- tidy(modelo_completo, exponentiate = TRUE, conf.int = TRUE) %>%
  mutate(across(where(is.numeric), ~round(.x, 4)),
         term = ifelse(term == "(Intercept)", "Intercepto", term)) %>%
  mutate(beta = signif(coef(modelo_completo), 4), .before = estimate)

kable(tabla_or, caption = "Coeficientes estimados (beta) y exponenciados (Odds Ratios) e intervalos de confianza al 95 por ciento") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Coeficientes estimados (beta) y exponenciados (Odds Ratios) e intervalos de confianza al 95 por ciento
term beta estimate std.error statistic p.value conf.low conf.high
Intercepto 0.0317300 1.0322 0.3801 0.0835 0.9335 0.4905 2.1793
Satisfaccion_Laboral_fInsatisfecho -0.4954000 0.6093 0.2250 -2.2021 0.0277 0.3903 0.9442
Satisfaccion_Laboral_fSatisfecho -0.4391000 0.6446 0.1991 -2.2053 0.0274 0.4361 0.9530
Satisfaccion_Laboral_fMuy satisfecho -0.9182000 0.3992 0.2116 -4.3387 0.0000 0.2628 0.6033
CargoDirector_Investigación -2.4490000 0.0864 0.8994 -2.7226 0.0065 0.0112 0.4330
CargoDirector_Manofactura -1.4320000 0.2389 0.3985 -3.5933 0.0003 0.1042 0.5030
CargoEjecutivo_Ventas -0.3837000 0.6814 0.2593 -1.4796 0.1390 0.4086 1.1308
CargoGerente -1.6420000 0.1936 0.7491 -2.1917 0.0284 0.0421 0.8114
CargoInvestigador_Cientifico -0.4677000 0.6265 0.2192 -2.1332 0.0329 0.4062 0.9610
CargoRecursos_Humanos -0.0025740 0.9974 0.3704 -0.0069 0.9945 0.4663 2.0133
CargoRepresentante_Salud -1.3990000 0.2470 0.4162 -3.3602 0.0008 0.1035 0.5366
CargoRepresentante_Ventas 0.7107000 2.0355 0.2766 2.5694 0.0102 1.1791 3.4958
Distancia_Casa 0.0272400 1.0276 0.0089 3.0777 0.0021 1.0098 1.0455
Edad -0.0309100 0.9696 0.0099 -3.1319 0.0017 0.9507 0.9882
Ingreso_Mensual 0.0000179 1.0000 0.0000 0.4131 0.6795 0.9999 1.0001

Es imporrtante tener en cuente con la interpretacion a continuacion que el modelo logístico no calcula la probabilidad como tal, sino el logaritmo de las odds de rotar, y siguiente con esta linea la beta indica cuánto cambia el logaritmo de las odds cuando la variable aumenta en una unidad o frente a la categoría de referencia, un OR/estimador mayor a 1 (beta positivo) indica mayor riesgo de rotación o viceversa, siendo 1 que no cambia que es el paralelo a un Beta igual a 0.

Interpretación con base en los resultados del modelo:

  • Satisfacción laboral: los niveles “Insatisfecho” (OR ≈ 0.61), “Satisfecho” (OR ≈ 0.65) y “Muy satisfecho” (OR ≈ 0.40) presentan Odds Ratios significativamente menores a 1 frente a la categoría de referencia “Muy insatisfecho”. Esto confirma la hipótesis: a mayor satisfacción laboral, menor es la probabilidad (odds) de rotar; por ejemplo, un empleado “Muy satisfecho” tiene odds de rotar aproximadamente un 60% menores que uno “Muy insatisfecho”, esto debido a que su estimate mostrado arriba es aprox 40%, manteniendo constantes las demás variables.
  • Cargo: frente al cargo de referencia (Técnico de Laboratorio), los cargos directivos y gerenciales (Director de Investigación, Director de Manufactura, Gerente) muestran Odds Ratios significativamente menores a 1 (entre 0.09 y 0.24), es decir, menor rotación, lo que confirma la hipótesis de que los cargos más altos rotan menos. Investigador Científico (OR ≈ 0.63) y Representante de Salud (OR ≈ 0.25) también presentan menor rotación que el cargo de referencia. En cambio, Representante de Ventas presenta un Odds Ratio significativamente mayor a 1 (≈ 2.04), es decir, mayor rotacion que el técnico de laboratorio; Ejecutivo de Ventas y Recursos Humanos no difieren de forma significativa del cargo de referencia.
  • Distancia a la casa: el Odds Ratio es mayor a 1 (≈ 1.03) y significativo, lo que confirma la hipótesis: por cada kilómetro adicional entre la vivienda y el trabajo, las odds de rotar aumentan en torno a un 2.8%.
  • Edad: el Odds Ratio es menor a 1 (≈ 0.97) y significativo, lo que confirma la hipótesis: por cada año adicional de edad, las odds de rotar disminuyen alrededor de un 3%.
  • Ingreso mensual: aunque en el análisis bivariado el ingreso mensual se relaciona de forma negativa y significativa con la rotación (a mayor ingreso, menor rotación), en el modelo múltiple su Odds Ratio es prácticamente 1 y pierde significancia estadística. Esto ocurre porque el ingreso está fuertemente correlacionado con el cargo (cada cargo tiene un rango salarial característico), de modo que, una vez se incluye Cargo en el modelo, este último absorbe gran parte del efecto que el ingreso tenía por sí solo.

6 Evaluación del modelo

Se evalúa el poder predictivo del modelo dividiendo la base en una muestra de entrenamiento (70%) y una de prueba (30%), y se calcula la matriz de confusión, además de la curva ROC y el AUC sobre la muestra de prueba.

set.seed(123)
n <- nrow(rotacion)
indice_train <- sample(seq_len(n), size = round(0.7 * n))
train <- rotacion[indice_train, ]
test  <- rotacion[-indice_train, ]

modelo_train <- glm(
  Rotacion_bin ~ Satisfaccion_Laboral_f + Cargo +
    Distancia_Casa + Edad + Ingreso_Mensual,
  data = train, family = binomial(link = "logit")
)

prob_test <- predict(modelo_train, newdata = test, type = "response")

# Función que construye la matriz de confusión y sus indicadores para un umbral dado
evaluar_umbral <- function(prob, observado, umbral) {
  predicho <- ifelse(prob > umbral, 1, 0)
  VP <- sum(predicho == 1 & observado == 1)
  VN <- sum(predicho == 0 & observado == 0)
  FP <- sum(predicho == 1 & observado == 0)
  FN <- sum(predicho == 0 & observado == 1)
  list(
    matriz = matrix(c(VN, FP, FN, VP), nrow = 2, byrow = TRUE,
                    dimnames = list(Observado = c("No", "Si"),
                                    Predicho  = c("No", "Si"))),
    indicadores = c(Exactitud     = (VP + VN) / length(predicho),
                    Sensibilidad  = VP / (VP + FN),
                    Especificidad = VN / (VN + FP),
                    Precision     = ifelse(VP + FP == 0, NA, VP / (VP + FP)),
                    Alertas       = VP + FP)
  )
}

# Gráfico de la matriz de confusión (mapa de calor)
graf_matriz <- function(matriz, titulo) {
  df <- as.data.frame(as.table(matriz))
  df$Porcentaje <- df$Freq / ave(df$Freq, df$Observado, FUN = sum)
  ggplot(df, aes(x = Predicho, y = factor(Observado, levels = c("Si", "No")), fill = Porcentaje)) +
    geom_tile(color = "white", linewidth = 1) +
    geom_text(aes(label = paste0(Freq, "\n(", percent(Porcentaje, accuracy = 0.1), ")")),
              size = 5, color = ifelse(df$Porcentaje > 0.5, "white", "black")) +
    scale_fill_gradient(low = "#F0F4F8", high = "#2C7FB8", labels = percent, limits = c(0, 1)) +
    labs(title = titulo, x = "Clase predicha", y = "Clase observada",
         fill = "% de la fila") +
    theme_minimal()
}

eval_05 <- evaluar_umbral(prob_test, test$Rotacion_bin, 0.5)
kable(eval_05$matriz, caption = "Matriz de confusión (umbral = 0.5, muestra de prueba)")
Matriz de confusión (umbral = 0.5, muestra de prueba)
No Si
No 360 6
Si 70 5 
data.frame(
  Indicador = c("Exactitud", "Sensibilidad", "Especificidad", "Precisión"),
  Valor = round(eval_05$indicadores[1:4], 3)
) %>% kable(caption = "Indicadores de desempeño con umbral 0.5", row.names = FALSE)
Indicadores de desempeño con umbral 0.5
Indicador Valor
Exactitud 0.828
Sensibilidad 0.067
Especificidad 0.984
Precisión 0.455

Dado el desbalance de clases (solo ~16% de rotación), es esperable que la sensibilidad (capacidad de detectar correctamente a quienes sí rotan) sea más baja que la especificidad. Con el umbral de 0.5 el modelo identifica correctamente solo 5 de los 75 empleados que efectivamente rotaron (sensibilidad de 6.7%), mientras que la exactitud global (82.8%) luce alta únicamente porque la mayoría de empleados no rota. Esto motiva evaluar, más adelante, un punto de corte distinto a 0.5.

6.1 Curva ROC y AUC

curva_roc <- roc(response = test$Rotacion_bin, predictor = prob_test,
                  levels = c(0, 1), direction = "<")
auc_valor <- round(auc(curva_roc), 4)

ggroc(curva_roc, color = "#D95F02", linewidth = 1) +
  geom_segment(aes(x = 1, y = 0, xend = 0, yend = 1), linetype = "dashed", color = "grey50") +
  labs(title = paste0("Curva ROC (AUC = ", auc_valor, ")"),
       x = "Especificidad", y = "Sensibilidad") +
  theme_minimal()

Un valor de AUC de 0.6663 indica el poder que tiene el modelo para discriminar entre empleados que rotan y los que no. Valores cercanos a 1 indican una excelente capacidad discriminante, mientras que un valor de 0.5 equivale a una clasificación aleatoria; en este caso el AUC refleja una capacidad discriminante moderada: si se toma al azar un empleado que rotó y uno que no, el modelo asigna mayor probabilidad al que rotó en aproximadamente 67% de los casos.

6.2 Matriz de confusión

La curva ROC y el AUC resumen el desempeño del modelo a lo largo de todos los umbrales posibles; la matriz de confusión, en cambio, muestra el resultado concreto de clasificar a los empleados de la muestra de prueba con un umbral específico. A continuación se presenta la matriz con el umbral por defecto de 0.5 (cada celda muestra el número de empleados y el porcentaje respecto al total de su clase observada):

graf_matriz(eval_05$matriz, "Matriz de confusión - umbral 0.5")

La fila “Si” evidencia el problema del umbral de 0.5: de los 75 empleados que rotaron, 70 son clasificados como “No” (falsos negativos), es decir, la gran mayoría de las rotaciones reales pasarían desapercibidas para Recursos Humanos.

7 Predicciones

7.1 Perfil hipotético

Se define un empleado hipotético: cargo de Ejecutivo de Ventas, muy insatisfecho con su trabajo, 24 años de edad, que vive a 20 km de la empresa y con un ingreso mensual de 2.500 (moneda de la base de datos). Este perfil representa a un empleado joven, con muy baja satisfacción, que vive lejos y devenga un ingreso relativamente bajo, es decir, un perfil de alto riesgo de rotación según las hipótesis planteadas,recordemos que como quitamos el genero este ya no seria necesario mencionarlo

empleado_hipotetico <- data.frame(
  Satisfaccion_Laboral_f = factor("Muy insatisfecho", levels = levels(rotacion$Satisfaccion_Laboral_f)),
  Cargo   = factor("Ejecutivo_Ventas", levels = levels(rotacion$Cargo)),
  Distancia_Casa  = 20,
  Edad            = 24,
  Ingreso_Mensual = 2500
)

prob_hipotetico <- predict(modelo_completo, newdata = empleado_hipotetico, type = "response")
prob_hipotetico
##         1 
## 0.3765179

La probabilidad estimada de que este empleado rote es de 37.7%.

7.2 Punto de corte y decisión de intervención

En lugar de usar por defecto un umbral de 0.5 que al ver la curva y como se ha dicho es poco adecuado por el desbalance de clases, se calcula el punto de corte óptimo mediante el índice de Youden (J = sensibilidad + especificidad - 1) sobre la curva ROC de la sección anterior.

corte_optimo <- coords(curva_roc, x = "best", best.method = "youden",
                        ret = c("threshold", "sensitivity", "specificity"))
kable(corte_optimo, caption = "Punto de corte óptimo (índice de Youden)", digits = 4)
Punto de corte óptimo (índice de Youden)
threshold sensitivity specificity
0.2244 0.4933 0.8306 
umbral <- as.numeric(corte_optimo["threshold"])

7.2.1 Matriz de confusión con el nuevo punto de corte

Se repite el ejercicio de clasificación sobre la muestra de prueba, ahora con el umbral de 0.224, y se compara con el resultado obtenido con 0.5.

eval_youden <- evaluar_umbral(prob_test, test$Rotacion_bin, umbral)
kable(eval_youden$matriz,
      caption = paste0("Matriz de confusión (umbral = ", round(umbral, 3), ", muestra de prueba)"))
Matriz de confusión (umbral = 0.224, muestra de prueba)
No Si
No 304 62
Si 38 37 
graf_matriz(eval_youden$matriz, paste0("Matriz de confusión - umbral ", round(umbral, 3), " (Youden)"))

comparacion <- data.frame(
  Indicador = c("Exactitud", "Sensibilidad", "Especificidad", "Precisión",
                "Empleados señalados para intervención"),
  `Umbral 0.5` = round(eval_05$indicadores, 3),
  `Umbral Youden` = round(eval_youden$indicadores, 3),
  check.names = FALSE
)
names(comparacion)[3] <- paste0("Umbral Youden (", round(umbral, 3), ")")
kable(comparacion, caption = "Comparación de desempeño: umbral 0.5 vs. umbral óptimo", row.names = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Comparación de desempeño: umbral 0.5 vs. umbral óptimo
Indicador Umbral 0.5 Umbral Youden (0.224)
Exactitud 0.828 0.773
Sensibilidad 0.067 0.493
Especificidad 0.984 0.831
Precisión 0.455 0.374
Empleados señalados para intervención 11.000 99.000

Con el nuevo punto de corte la sensibilidad pasa de 6.7% a 49.3%: el modelo ahora detecta 37 de los 75 empleados que efectivamente rotaron (frente a solo 5 con 0.5). El costo de esta ganancia es una reducción de la especificidad (de 98.4% a 83.1%) y de la exactitud global, ya que aumentan los falsos positivos (62 empleados señalados que en realidad no rotaron). Desde la perspectiva del negocio este intercambio suele ser conveniente: el costo de una acción de retención innecesaria (una conversación, un plan de carrera, un ajuste de horario) es normalmente mucho menor que el costo de reemplazar a un empleado que se va (reclutamiento, selección, curva de aprendizaje).

7.2.2 Decisión para el empleado hipotético

Finalmente, se repite el ejercicio de probabilidad del perfil hipotético y se contrasta con ambos puntos de corte. Adicionalmente, para analizar la sensibilidad de la decisión, se recalcula la probabilidad variando el nivel de satisfacción laboral y la distancia a la casa (las dos variables sobre las que la empresa puede actuar más directamente), manteniendo constantes las demás características del perfil.

data.frame(
  `Punto de corte` = c("0.5 (por defecto)", paste0(round(umbral, 3), " (Youden)")),
  `Probabilidad estimada` = round(as.numeric(prob_hipotetico), 3),
  `Decisión` = ifelse(as.numeric(prob_hipotetico) > c(0.5, umbral), "Intervenir", "No intervenir"),
  check.names = FALSE
) %>% kable(caption = "Decisión para el empleado hipotético según el punto de corte") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Decisión para el empleado hipotético según el punto de corte
Punto de corte Probabilidad estimada Decisión
0.5 (por defecto) 0.377 No intervenir
0.224 (Youden) 0.377 Intervenir 
escenarios <- expand.grid(
  Satisfaccion_Laboral_f = factor(levels(rotacion$Satisfaccion_Laboral_f),
                                  levels = levels(rotacion$Satisfaccion_Laboral_f)),
  Distancia_Casa = c(5, 20)
)
escenarios$Cargo           <- factor("Ejecutivo_Ventas", levels = levels(rotacion$Cargo))
escenarios$Edad            <- 24
escenarios$Ingreso_Mensual <- 2500
escenarios$Probabilidad    <- predict(modelo_completo, newdata = escenarios, type = "response")

escenarios %>%
  transmute(`Satisfacción laboral` = Satisfaccion_Laboral_f,
            `Distancia (km)` = Distancia_Casa,
            Probabilidad = round(Probabilidad, 3),
            `Decisión (umbral 0.5)` = ifelse(Probabilidad > 0.5, "Intervenir", "No intervenir"),
            `Decisión (umbral Youden)` = ifelse(Probabilidad > umbral, "Intervenir", "No intervenir")) %>%
  kable(caption = "Sensibilidad de la probabilidad y de la decisión ante cambios en satisfacción y distancia") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Sensibilidad de la probabilidad y de la decisión ante cambios en satisfacción y distancia
Satisfacción laboral Distancia (km) Probabilidad Decisión (umbral 0.5) Decisión (umbral Youden)
Muy insatisfecho 5 0.286 No intervenir Intervenir
Insatisfecho 5 0.196 No intervenir No intervenir
Satisfecho 5 0.206 No intervenir No intervenir
Muy satisfecho 5 0.138 No intervenir No intervenir
Muy insatisfecho 20 0.377 No intervenir Intervenir
Insatisfecho 20 0.269 No intervenir Intervenir
Satisfecho 20 0.280 No intervenir Intervenir
Muy satisfecho 20 0.194 No intervenir No intervenir 
ggplot(escenarios, aes(x = Satisfaccion_Laboral_f, y = Probabilidad,
                       color = factor(Distancia_Casa), group = factor(Distancia_Casa))) +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  geom_hline(yintercept = umbral, linetype = "dashed", color = "#D95F02") +
  geom_hline(yintercept = 0.5, linetype = "dotted", color = "grey40") +
  annotate("text", x = 4.4, y = umbral, label = "Youden", vjust = -0.5, color = "#D95F02", size = 3.5) +
  annotate("text", x = 4.4, y = 0.5, label = "0.5", vjust = -0.5, color = "grey40", size = 3.5) +
  scale_y_continuous(labels = percent, limits = c(0, 0.6)) +
  scale_color_manual(values = c("5" = "#2C7FB8", "20" = "#D95F02")) +
  labs(title = "Probabilidad de rotación del perfil hipotético por escenario",
       x = "Satisfacción laboral", y = "Probabilidad estimada", color = "Distancia (km)") +
  theme_minimal() +
  theme(legend.position = "bottom")

La probabilidad estimada para el empleado hipotético es de 0.377. Con el umbral por defecto de 0.5 la decisión sería No intervenir, esto debido a que la probabilidad del empleado fue menor al punto de corte, mientras que con el punto de corte óptimo de 0.224 la decisión recomendada es: Intervenir. Este contraste resume el valor del análisis de sensibilidad: un perfil que objetivamente concentra varios factores de riesgo (joven, muy insatisfecho, lejos de la empresa) quedaría por fuera de cualquier acción de retención si se usara el umbral de 0.5, mientras que el umbral ajustado sí lo señala.

El análisis por escenarios muestra además qué palancas modifican la decisión: la probabilidad baja de forma importante cuando el empleado pasa a estar “Muy satisfecho”, y también cuando vive más cerca de la empresa. En la vida real si bien no podemos mudar al empleado, una estrategia de retención para este perfil debería centrarse en mejorar su satisfacción laboral y, en lo posible, en reducir la carga del desplazamiento con trabajo híbrido, una ruta o auxilio de transporte, ya que son los cambios que más acercan su probabilidad por debajo del punto de corte. En general, si la probabilidad estimada de un empleado supera el punto de corte, se recomienda que Recursos Humanos active una estrategia de retencion

8 Conclusiones

  • El modelo de regresión logística estimado es en conjunto estadísticamente significativo; sin embargo, con los resultados de la matriz de confusión, si bien el umbral obtenido mediante el índice de Youden aumenta de forma considerable el detectar los empleados que efectivamente rotan, aun asi sigue sin parecer optimo, lo que puede sugerirnos, que se deberias en un posterior analisis escoger variables diferentes, o depurar aun mas las variables elegidas.
  • El genero fue excluido del modelo porque no resultó significativo en el análisis bivariado; la prueba de razón de verosimilitud entre modelos anidados y el AIC confirmaron que su inclsion no mejora el ajuste.
  • Las variables que resultaron significativas dentro del modelo múltiple son la satisfacción laboral, el cargo, la distancia a la casa y la edad; sus signos confirman las hipótesis planteadas en el numeral 1.
  • El ingreso mensual no resultó significativo dentro del modelo múltiple, aun previamente en el análisis bivariado si lo era por eso se tuvo en cuenta, pero probablemente como el cada cargo tiene unos rangos salariales, esta variable se tienen en cuenta dejandole “menor” importancia al salario.

8.1 Estrategia sugerida

Con base en las variables que sí resultaron significativas, podriamos sugerir diseñar planes de mejora del clima y la satisfacción laboral, priorizando a los empleados “Muy insatisfechos” y mas jovenes, donde el riesgo de rotación es mayor y por eso programas de mentoria o desarrollo de carrera podria generar un seguimiento a la par de retener ese talento joven; este foco hace empalme en los cargos de entrada u operativos (p. ej. Representante de Ventas), que presentan la mayor rotación, en contraste con los cargos directivos y gerenciales. Finalmente evaluar esquemas de trabajo híbrido, un bus con una ruta establecida hacia la empresa o subsidios de transporte. Por otro lado, como ya se ha mencionado varias veces el ingreso pierde significancia frente al cargo, una estrategia de retención basada únicamente en aumentos salariales no pareceria ser efectiva vs una centrada en el desarrollo de carrera y la satisfacción laboral dentro de cada cargo.