Introducción: Retención Laboral en la Era del People Analytics

En el dinámico mercado laboral actual, la pérdida de talento humano representa uno de los costos ocultos más significativos para las organizaciones, impactando no solo la rentabilidad financiera sino también la continuidad operativa y el clima organizacional. Tradicionalmente, la gestión del talento ha dependido de intuiciones o análisis reactivos; sin embargo, la Analítica de Personas (People Analytics) ofrece hoy la oportunidad de transformar datos crudos en estrategias preventivas de alto impacto.

Este proyecto presenta el desarrollo y validación de un modelo predictivo de rotación de personal basado en algoritmos de regresión logística. El objetivo principal es identificar de manera temprana aquellos colaboradores con una alta probabilidad de renuncia, permitiendo a las áreas de Gestión Humana intervenir de forma proactiva.

A lo largo de este informe, se detalla un proceso riguroso de ciencia de datos que incluye:

  • Ingeniería de Características: Creación de variables sintéticas como el Ingreso Efectivo para capturar la relación entre compensación y carga laboral.
  • Balanceo de Datos: Implementación de la técnica SMOTE para corregir el sesgo de clases minoritarias.
  • Optimización Estadística: Selección de un modelo parsimonioso validado mediante el Área Bajo la Curva (AUC: 0.784) y la prueba de calibración de Hosmer-Lemeshow (\(p=0.1317\)).

Finalmente, el documento propone estrategias de retención diferenciadas, demostrando cómo un modelo matemático puede convertirse en una herramienta táctica que optimiza los recursos de la organización y protege su capital más valioso: su gente.

Definición de Hipótesis

  • Selección de las 6 variables (3 categóricas y 3 cuantitativas) basándonos en la estructura del dataset rotacion.

Selección de Variables e Hipótesis

Se justifica la relación esperada (Hipótesis) para cada una:

Variables Categóricas

  • Horas_Extra: Se sustenta en la Teoría del Agotamiento (Burnout) de Maslach. El trabajo suplementario excesivo reduce el tiempo de recuperación, incrementando la intención de renuncia.

  • Estado_Civil: Basado en la Teoría de la Estabilidad Social. Los empleados casados suelen buscar mayor estabilidad financiera y beneficios debido a dependientes, mientras que los solteros poseen una menor “barrera de salida”.

  • Viaje de Negocios: Se relaciona con el conflicto Trabajo-Familia (Work-Family Conflict) de Greenhaus. La alta frecuencia de viajes interrumpe las rutinas personales, lo que aumenta el deseo de buscar roles más estables.

Variables Cuantitativas

  • Ingreso_Mensual: Respaldado por la Teoría de los Dos Factores de Herzberg (Factor Higiénico). Un salario percibido como insuficiente genera insatisfacción, siendo un detonante primario para la rotación externa.

  • Edad: Se apoya en la Teoría del Desarrollo de la Carrera de Super. Los trabajadores más jóvenes están en una etapa de “exploración”, mientras que los mayores entran en una etapa de “mantenimiento” y estabilidad.

  • Distancia_Casa: Justificado por la Economía del Transporte y Bienestar. El tiempo de conmutación prolongado actúa como un estresor diario que degrada la satisfacción ambiental y laboral.

Exploración y Caracterización

Antes de generar las gráficas en R, debemos caracterizar la variable respuesta Rotación.

# Configuración de tema visual
theme_set(theme_minimal())

# 1. Caracterización de la variable respuesta
table(rotacion$Rotación)
## 
##   No   Si 
## 1233  237
prop.table(table(rotacion$Rotación))
## 
##        No        Si 
## 0.8387755 0.1612245
# 2.1. Análisis de la Variable Respuesta: Rotación
ggplot(rotacion, aes(x = Rotación, fill = Rotación)) +
  geom_bar() +
  labs(title = "Distribución de la Rotación Laboral", 
       subtitle = "Proporción de empleados que abandonaron su cargo",
       x = "Rotación", y = "Frecuencia") +
  scale_fill_manual(values = c("No" = "steelblue", "Si" = "firebrick"))

Los resultados muestran una tasa de rotación del 16,12%. En contextos de analítica de talento, una tasa de rotación superior al 15% ya suele considerarse un punto de atención para la gestión humana. En términos técnicos, esto supone también enfrentarse a un dataset desbalanceado, lo cual influirá en cómo evaluar el modelo más adelante (Punto 5).

Análisis univariado

  • Interpretación de Variables cuantitativas
# 2.2. Análisis de Variables Cuantitativas (Histogramas/Boxplots)

# Ingreso mensual
p1_1 <- ggplot(rotacion, aes(x = Ingreso_Mensual)) + 
  geom_histogram(bins = 30, fill = "seagreen", color = "white") +
  labs(title = "Distribución de Ingreso Mensual")

p1_2 <- ggplot(rotacion, aes(x = Ingreso_Mensual)) + 
  geom_boxplot(fill = "orange", alpha = 0.7) +
  labs(title = "Boxplot de Ingreso Mensual")


# Edad
p2_1 <- ggplot(rotacion, aes(x = Edad)) + 
  geom_histogram(bins = 30, fill = "seagreen", color = "white") +
  labs(title = "Distribución de Edad")

p2_2 <- ggplot(rotacion, aes(x = Edad)) + 
  geom_boxplot(fill = "orange", alpha = 0.7) +
  labs(title = "Boxplot de Edad")


# Distancia_casa
p3_1 <- ggplot(rotacion, aes(x = Distancia_Casa)) + 
  geom_histogram(bins = 30, fill = "seagreen", color = "white") +
  labs(title = "Distribución de Distancia a casa")

p3_2 <- ggplot(rotacion, aes(x = Distancia_Casa)) + 
  geom_boxplot(fill = "orange", alpha = 0.7) +
  labs(title = "Boxplot de Distancia a casa")

grid.arrange(p1_1, p1_2,
             p2_1, p2_2,
             p3_1, p3_2, ncol = 2)

  • Ingreso Mensual: De acuerdo con el gráfico, la variable presenta un fuerte sesgo a la derecha . La mayoría de los empleados ganan menos de $10,000 UM (Unidades Monetarias), con un pico muy marcado entre los 2,500 y 5,000. Por su parte, el boxplot muestra una presencia significativa de valores atípicos en la parte superior (empleados que ganan cerca de 20,000).

Existe una base piramidal ancha. Si la rotación se concentra en los niveles salariales bajos, el factor económico será un predictor clave.

  • Edad: Es la variable con la distribución más equilibrada (parecida a una normal), aunque con un ligero sesgo a la derecha . El grueso de la población está entre los 30 y 40 años.No se observan muchos valores atípicos. Tenemos representación desde jóvenes de 18 años hasta personas cercanas a los 60.La empresa cuenta con una fuerza laboral madura pero activa.

  • Distancia a Casa: Extremadamente sesgada. La gran mayoría de los empleados vive muy cerca del trabajo (menos de 5 km/unidades de medida). A pesar de que la mayoría vive cerca, el boxplot muestra una cola larga que llega hasta los 30 km. No hay outliers marcados porque la variabilidad es continua.

Aunque la mayoría vive cerca, aquellos que viven lejos (cola derecha) podrían estar bajo un estrés de transporte que detone la rotación.

Al observar los tres paneles, podemos concluir lo siguiente para la fase de modelado:

  • Heterogeneidad de Escalas: las variables tienen rangos muy distintos (Ingreso llega a 20,000, Edad a 60, Distancia a 30). Al realizar la Regresión Logística, los coeficientes no serán directamente comparables a menos que estandaricemos o interpretemos mediante Odds Ratios.

  • Riesgo de Segmentación: la combinación de “Ingreso Mensual Bajo”, “Edad Joven” y “Alta Distancia a Casa” probablemente definirá el perfil con mayor probabilidad de rotación.

  • Calidad de los Datos: No se observan errores de digitación evidentes o valores imposibles (como edades negativas), lo que indica que la base está lista para el análisis bivariado.

  • Interpretación de variables cualitativas

p1 <- ggplot(rotacion, aes(x = Horas_Extra, fill = Horas_Extra)) +
  geom_bar() +
    geom_text(aes(label = 
    scales::percent(after_stat(count)/sum(after_stat(count)))), 
              stat = "count", 
              position = position_stack(vjust = 0.5),
              color = "black",
              size = 4,
              fontface = "bold") +
  labs(title = "Distribución de trabajadores", 
       subtitle = "Proporción de empleados que hacen horas Extra",
       x = "Horas Extra", y = "Frecuencia") +
  scale_fill_manual(values = c("No" = "steelblue", "Si" = "firebrick"))

p2 <- ggplot(rotacion, aes(x = Estado_Civil, fill = Estado_Civil)) +
  geom_bar() +
    geom_text(aes(label = 
    scales::percent(after_stat(count)/sum(after_stat(count)))), 
              stat = "count", 
              position = position_stack(vjust = 0.5),
              color = "black",
              size = 4,
              fontface = "bold") +
  labs(title = "Distribución de trabajadores", 
       subtitle = "Proporción de empleados según estado civil",
       x = "Estado civil", y = "Frecuencia") +
  scale_fill_manual(values = c("Casado" = "steelblue", "Divorciado" = "firebrick", "Soltero" = "salmon"))

p3 <- ggplot(rotacion, aes(x = `Viaje de Negocios`, fill = `Viaje de Negocios`)) +
  geom_bar() +
    geom_text(aes(label = 
    scales::percent(after_stat(count)/sum(after_stat(count)))), 
              stat = "count", 
              position = position_stack(vjust = 0.5),
              color = "black",
              size = 3,
              fontface = "bold") +
  labs(title = "Distribución de trabajadores", 
       subtitle = "Proporción de empleados por frecuencia de Viaje",
       x = "Viaje de Negocios:", y = "Frecuencia") +
  scale_fill_manual(values = c("Frecuentemente" = "steelblue", "No_viaja" = "firebrick", "Raramente" = "salmon"))

grid.arrange(p1, p2, p3, ncol = 1)

  • Horas Extra: El 28% de la población analizada realiza horas extra. Aunque la mayoría no las hace (72%), este grupo del 28% es significativo, ya que en la literatura de recursos humanos este factor suele ser un predictor “gatillo” para la renuncia por agotamiento.

  • Estado Civil: Los empleados Casados son el grupo mayoritario con un 45.8%. El grupo de Solteros (32%) es el segundo en importancia, seguido por los Divorciados (22.2%). Según nuestra hipótesis inicial, el 32% de solteros podría representar el segmento con mayor movilidad potencial.

  • Viaje de Negocios: La gran mayoría de los empleados viaja Raramente (71%).Un 18.8% viaja Frecuentemente, lo cual representa a casi 1 de cada 5 empleados enfrentando el desgaste que implican los desplazamientos constantes.El 10.2% restante no viaja en absoluto.

Al mirar estos tres gráficos de forma integrada podemos concluir para la fase de modelado:

  • Perfil Dominante: El empleado promedio de esta base de datos es una persona Casada que Raramente viaja por negocios y No realiza horas extra.

  • Segmentos de Riesgo: Para el análisis bivariado que sigue, debemos prestar especial atención a las categorías “minoritarias” pero estresantes: el 28% que hace horas extra y el 18.8% que viaja frecuentemente.

  • Hipótesis a Contrastar: Es probable que la rotación real del 16.1% que que se identificó previamente antes se concentre desproporcionadamente en estos grupos de menor frecuencia pero mayor carga laboral.

Relaciones Bivariadas

Para el análisis bivariado de las variables cuantitativas (Ingreso Mensual, Edad y Distancia a Casa) frente a la variable respuesta Rotación, se han tomado las siguientes decisiones metodológicas:

  1. Transformación Logarítmica: Se aplica una transformación logarítmica (\(log(x)\)) a las variables Ingreso Mensual y Distancia a Casa. Esta decisión se fundamenta en el sesgo a la derecha identificado en el análisis univariado.

La transformación busca tanto estabilizar la varianza como reducir el impacto de los valores atípicos (outliers) presentes en los niveles salariales más altos. Además, en modelos logísticos, el uso de logaritmos permite interpretar las relaciones en términos de elasticidades o cambios porcentuales, facilitando la comprensión del fenómeno de rotación.

  1. Dualidad de Pruebas: t-Student y Wilcoxon: Dada la naturaleza del dataset (\(n = 1,470\)), se optó por ejecutar ambas pruebas de contraste de hipótesis:

  • Prueba t-Student: Se justifica por el Teorema del Límite Central, el cual sugiere que, ante tamaños de muestra grandes, la distribución de la media muestral tiende a la normalidad, permitiendo el uso de pruebas paramétricas para evaluar diferencias de medias.

  • Prueba de Wilcoxon (Mann-Whitney): Se utiliza como respaldo no paramétrico. Al ser una prueba basada en rangos, es robusta frente a las distribuciones remanentes de sesgo y confirma si las diferencias en las medianas de los grupos (“Si” vs “No”) son estadísticamente significativas sin asumir una distribución específica.

  • Transformaciones de escala Primero debemos crear las versiones logarítmicas. Sumaremos 1 en la distancia para evitar errores con valores de cero:

rotacion <- rotacion %>%
  mutate(log_ingreso = log(Ingreso_Mensual),
         log_distancia = log(Distancia_Casa + 1))

Pruebas Estadísticas para Cuantitativas

Ejecutaremos tanto la prueba t-Student (por el gran tamaño de muestra \(n=1470\)) como la prueba Wilcoxon (por la naturaleza no paramétrica de los datos originales).

# 1. Realizar cálculos de p-values dinámicamente
test_ingreso_t <- t.test(log_ingreso ~ Rotación, data = rotacion)$p.value
test_ingreso_w <- wilcox.test(log_ingreso ~ Rotación, data = rotacion)$p.value

test_edad_t <- t.test(Edad ~ Rotación, data = rotacion)$p.value
test_edad_w <- wilcox.test(Edad ~ Rotación, data = rotacion)$p.value

test_dist_t <- t.test(log_distancia ~ Rotación, data = rotacion)$p.value
test_dist_w <- wilcox.test(log_distancia ~ Rotación, data = rotacion)$p.value

# 2. Crear la tabla informativa
resumen_cuantitativas <- data.frame(
  Variable = c("Log(Ingreso Mensual)", "Edad", "Log(Distancia Casa)"),
  `p-value (t-Student)` = format.pval(c(test_ingreso_t, test_edad_t, test_dist_t), digits = 3),
  `p-value (Wilcoxon)` = format.pval(c(test_ingreso_w, test_edad_w, test_dist_w), digits = 3),
  `Relación Esperada` = c("Inversa (Menos ingreso, más rotación)", 
                          "Inversa (Menor edad, más rotación)", 
                          "Directa (Más distancia, más rotación)")
)

# 3. Renderizar tabla elegante
knitr::kable(resumen_cuantitativas, 
             caption = "Tabla 1. Pruebas de Hipótesis para Variables Cuantitativas",
             booktabs = TRUE) %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"), full_width = F)
Tabla 1. Pruebas de Hipótesis para Variables Cuantitativas
Variable p.value..t.Student. p.value..Wilcoxon. Relación.Esperada
Log(Ingreso Mensual) 5.29e-14 2.95e-14 Inversa (Menos ingreso, más rotación)
Edad 1.37e-08 5.28e-11 Inversa (Menor edad, más rotación)
Log(Distancia Casa) 0.00299 0.00239 Directa (Más distancia, más rotación)

La relación entre las variables cuantitativas y la rotación (\(Y=1\)), los resultados de las pruebas \(t\) y Wilcoxon arrojan las siguientes conclusiones:

  • Log(Ingreso Mensual) (\(p < 0.001\)): Es la variable con mayor significancia estadística. El resultado valida la Hipótesis Inversa: los empleados con menores ingresos tienen una probabilidad significativamente mayor de rotar. Esto sugiere que el salario es un factor determinante crítico en esta organización.

  • Edad (\(p < 0.001\)): Se confirma la Hipótesis Inversa. Existe una diferencia significativa de edades entre los grupos; el talento más joven presenta una mayor tendencia a abandonar el cargo, lo que coincide con la teoría de etapas de exploración de carrera.

  • Log(Distancia Casa) (\(p = 0.0029\)): Aunque tiene un \(p\text{-value}\) mayor que las anteriores, sigue siendo altamente significativo (menor al umbral de \(0.05\)). Se valida la Hipótesis Directa: a medida que aumenta la distancia entre el hogar y la oficina, aumenta la rotación.

Dado que todos los \(p\text{-values}\) son menores a \(0.05\), se rechaza la hipótesis nula de igualdad en todos los casos. Esto nos indica que las estas 3 covariables seleccionadas son candidatas robustas para el modelo de regresión logística.

Análisis Bivariado: Variables Categóricas

Ahora debemos realizar el mismo ejercicio para Horas_Extra, Estado_Civil y Viaje_de_Negocios utilizando la prueba Chi-cuadrado de Pearson.

Aquí tienes el bloque de código para procesar las tres de una vez y generar una tabla de resumen similar a la anterior:

# 1. Pruebas Chi-cuadrado
chi_horas <- chisq.test(table(rotacion$Horas_Extra, rotacion$Rotación))$p.value
chi_civil <- chisq.test(table(rotacion$Estado_Civil, rotacion$Rotación))$p.value
chi_viaje <- chisq.test(table(rotacion$`Viaje de Negocios`, rotacion$Rotación))$p.value

# 2. Tabla de resumen categóricas
resumen_categoricas <- data.frame(
  Variable = c("Horas Extra", "Estado Civil", "Viaje de Negocios"),
  `p-value (Chi-cuadrado)` = format.pval(c(chi_horas, chi_civil, chi_viaje), digits = 3),
  `Relación Esperada` = c("Mayor rotación en 'Si'", 
                          "Mayor rotación en 'Soltero'", 
                          "Mayor rotación en 'Frecuente'")
)

knitr::kable(resumen_categoricas, 
             caption = "Tabla 2. Pruebas de Independencia (Chi-cuadrado)",
             booktabs = TRUE) %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"), full_width = F)
Tabla 2. Pruebas de Independencia (Chi-cuadrado)
Variable p.value..Chi.cuadrado. Relación.Esperada
Horas Extra < 2e-16 Mayor rotación en ‘Si’
Estado Civil 9.46e-11 Mayor rotación en ‘Soltero’
Viaje de Negocios 5.61e-06 Mayor rotación en ‘Frecuente’

Al observar los resultados de las pruebas de Chi-cuadrado (\(p < 0.001\) en todos los casos), se puede concluir que, estos \(p\text{-values}\) confirman que no se está eligiendo variables al azar, sino factores con un peso real en la decisión de los empleados.

  1. Interpretación de la Significancia Estadística
  • Horas Extra (\(p < 2 \times 10^{-16}\)): Es la variable con la significancia más extrema de todo el conjunto. Un valor tan cercano a cero indica que la relación entre trabajar horas extra y rotar es prácticamente una certeza estadística en esta muestra.
  • Estado Civil (\(p = 9.46 \times 10^{-11}\)): Existe una evidencia abrumadora de que la distribución de la rotación no es uniforme entre casados, solteros y divorciados. Esto valida la hipótesis de que la situación civil influye en la estabilidad laboral.
  • Viaje de Negocios (\(p = 5.61 \times 10^{-06}\)): Aunque es el \(p\text{-value}\) “más alto” de la tabla, sigue siendo significativamente menor al umbral estándar de \(0.05\). Esto confirma que la frecuencia de viajes altera las tasas de rotación de forma medible.
  1. Contraste con las Hipótesis Iniciales (Punto 3 de la rúbrica) Para las tres variables, se rechaza la hipótesis nula (\(H_0\)) de independencia. Esto significa que los resultados observados apoyan las hipótesis de investigación.

Los datos muestran que las categorías identificadas como “riesgosas” (hacer horas extra, ser soltero o viajar frecuentemente) efectivamente presentan las mayores frecuencias de rotación en el dataset.

Conclusión inicial para la Fase de Modelado

Desde la perspectiva de la Ciencia de Datos, estos resultados significan que las seis variables son excelentes candidatas para el modelo logístico; es muy probable que la mayoría resulten significativas en la ecuación final. Además, de que no se estaría incluyendo información irrelevante que pueda ensuciar los errores estándar del modelo.

Gráficamente, podemos resumir las relaciones encontradas de la siguiente forma:

# Creamos un dataframe específico con las variables transformadas a numéricas
df_estudio <- rotacion %>%
  mutate(
    Rotacion_Si = ifelse(Rotación == "Si", 1, 0),
    Hace_Horas_Extra = ifelse(Horas_Extra == "Si", 1, 0),
    Es_Soltero = ifelse(Estado_Civil == "Soltero", 1, 0),
    Viaja_Frecuente = ifelse(`Viaje de Negocios` == "Frecuentemente", 1, 0)
  ) %>%
  select(Rotacion_Si, log_ingreso, Edad, log_distancia, 
         Hace_Horas_Extra, Es_Soltero, Viaja_Frecuente)


library(GGally)

ggpairs(df_estudio,
        # PARTE SUPERIOR: Solo el número de la correlación
        upper = list(continuous = wrap("cor", size = 4, color = "black")),
        # DIAGONAL: Histogramas para ver la distribución
        diag = list(continuous = wrap("barDiag", fill = "steelblue", bins = 15)),
        # PARTE INFERIOR: Puntos de dispersión
        lower = list(continuous = wrap("points", alpha = 0.3, size = 0.5, color = "darkred")),
        title = "Matriz de Correlación: Factores Críticos de Rotación") +
  theme_minimal() +
  theme(panel.grid.major = element_blank(),
        strip.text = element_text(size = 7, face = "bold"))

  1. Relación con la Variable Respuesta (Rotacion_Si) La primera fila y columna nos indican qué tanto influye cada factor en la probabilidad de que alguien se vaya: * Horas Extra (Hace_Horas_Extra): Es el predictor con la correlación positiva más alta (0.246). Esto confirma visualmente lo que sospechábamos: trabajar extras es el detonante más claro de la rotación en este dataset. * Ingreso y Edad: Presentan correlaciones negativas (-0.198 y -0.159 respectivamente). Esto valida tus hipótesis inversas: a menor salario y menor edad, la probabilidad de rotar aumenta significativamente. * Estado Civil y Viajes: El ser soltero (0.175) y viajar frecuentemente (0.115) muestran una relación directa con la rotación, aunque con una fuerza ligeramente menor que el sueldo o las horas extra.

  2. Análisis de Multicolinealidad (Predictoras entre sí) Este punto es vital para la salud del modelo de regresión logística. * Edad vs. Log_Ingreso: Existe una correlación positiva moderada (0.494). Es lógico: a mayor edad, mayor salario. Al ser menor a 0.70, no representa un riesgo de multicolinealidad grave, pero es un factor a vigilar. * Independencia de Factores: Las variables de “riesgo” (Hace_Horas_Extra, Es_Soltero, Viaja_Frecuente) tienen correlaciones muy cercanas a cero entre sí. Esto es bueno para el modelo, ya que significa que cada una aporta información nueva y distinta a la predicción de la rotación.

  3. Visualización de las Distribuciones (Diagonal) Los histogramas de las variables dummy (0 y 1) muestran la proporción de la población en riesgo. Por ejemplo, en Hace_Horas_Extra, el grupo que “No” hace extras es mucho más grande, pero el grupo que “Sí” (barra derecha) es el que está “empujando” la tasa de rotación hacia arriba.

La matriz de correlación confirma que las 6 variables seleccionadas tienen relaciones estadísticamente significativas con la rotación (\(p < 0.05\)). No se detectan problemas de redundancia extrema entre las variables predictoras, lo que hace esperar a que el modelo de regresión logística del siguiente punto será estable y sus coeficientes serán interpretables de forma independiente.

Modelado y Diagnóstico

Estimación del modelo de regresión logística (\(y = \text{Rotación}\)).

# Ajuste del modelo logístico
rotacion <- rotacion %>%
  mutate(y = ifelse(Rotación == "Si", 1, 0))

modelo_rotacion <- glm(y ~ log_ingreso + Edad + log_distancia + 
                       Horas_Extra + Estado_Civil + `Viaje de Negocios`, 
                       data = rotacion, 
                       family = binomial(link = "logit"))

# Ver resumen estadístico
summary(modelo_rotacion)
## 
## Call:
## glm(formula = y ~ log_ingreso + Edad + log_distancia + Horas_Extra + 
##     Estado_Civil + `Viaje de Negocios`, family = binomial(link = "logit"), 
##     data = rotacion)
## 
## Coefficients:
##                              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                   5.03512    1.14924   4.381 1.18e-05 ***
## log_ingreso                  -0.80471    0.14824  -5.428 5.69e-08 ***
## Edad                         -0.02457    0.01008  -2.436 0.014842 *  
## log_distancia                 0.32933    0.09392   3.506 0.000454 ***
## Horas_ExtraSi                 1.47891    0.15964   9.264  < 2e-16 ***
## Estado_CivilDivorciado       -0.28000    0.23093  -1.212 0.225330    
## Estado_CivilSoltero           0.86681    0.17309   5.008 5.50e-07 ***
## `Viaje de Negocios`No_Viaja  -1.37647    0.35526  -3.875 0.000107 ***
## `Viaje de Negocios`Raramente -0.63954    0.18159  -3.522 0.000428 ***
## ---
## 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: 1072.8  on 1461  degrees of freedom
## AIC: 1090.8
## 
## Number of Fisher Scoring iterations: 5

La estimación del modelo de regresión logística revela que la rotación laboral está fuertemente influenciada por factores de carga de trabajo, compensación y estabilidad personal. El factor con mayor impacto es el cumplimiento de horas extra (\(\beta = 1.48, p < 0.001\)), el cual incrementa sustancialmente el riesgo de abandono. En contraste, el ingreso mensual actúa como el principal factor protector (\(\beta = -0.80, p < 0.001\)), sugiriendo que niveles salariales competitivos son críticos para la retención. Asimismo, se observa que la distancia al hogar penaliza la permanencia, mientras que la madurez (edad) y el no viajar frecuentemente fomentan la estabilidad del empleado. En términos sociodemográficos, los empleados solteros muestran una propensión a rotar significativamente mayor que sus colegas casados o divorciados. Finalmente, el modelo presenta un AIC de 1090.8 y una reducción considerable en la devianza respecto al modelo nulo, lo que indica un ajuste estadísticamente robusto y con alta capacidad explicativa para la toma de decisiones estratégicas en RRHH.

  • Interpretación de los Coeficientes (Odds Ratios) y niveles de significancia (\(p\text{-values}\)).

Para obtener los Odds Ratios (OR), debemos aplicar la función exponencial a los coeficientes del modelo (\(e^\beta\)). En una regresión logística, el OR nos indica cuánto cambia la probabilidad (en términos de ventaja) de que ocurra el evento por cada unidad que aumenta la variable predictora.

# Calcular Odds Ratios e Intervalos de Confianza al 95%
library(dplyr)
library(broom)

tabla_or <- tidy(modelo_rotacion, exponentiate = TRUE, conf.int = TRUE) %>%
  select(term, estimate, conf.low, conf.high, p.value) %>%
  mutate(across(where(is.numeric), ~round(., 3)))

# Presentación en Kable
knitr::kable(tabla_or, 
             col.names = c("Variable", "Odds Ratio", "IC Inferior", "IC Superior", "p-value"),
             caption = "Punto 4: Interpretación mediante Odds Ratios",
             booktabs = TRUE) %>%
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"))
Punto 4: Interpretación mediante Odds Ratios
Variable Odds Ratio IC Inferior IC Superior p-value
(Intercept) 153.717 16.540 1503.326 0.000
log_ingreso 0.447 0.333 0.596 0.000
Edad 0.976 0.956 0.995 0.015
log_distancia 1.390 1.158 1.674 0.000
Horas_ExtraSi 4.388 3.215 6.015 0.000
Estado_CivilDivorciado 0.756 0.475 1.178 0.225
Estado_CivilSoltero 2.379 1.698 3.349 0.000
Viaje de NegociosNo_Viaja 0.252 0.121 0.491 0.000
Viaje de NegociosRaramente 0.528 0.370 0.756 0.000

El análisis mediante Odds Ratios (OR) permite cuantificar el impacto real de las políticas corporativas sobre la retención. El hallazgo más alarmante, de nuevo, es el efecto de las Horas Extra, las cuales multiplican por 4.38 la probabilidad de rotación, posicionándose como el principal detonante de abandono. En una línea similar, los empleados solteros presentan un riesgo 2.37 veces mayor en comparación con los casados, lo que sugiere una menor barrera de salida en este segmento.

Por otro lado, el modelo identifica potentes factores de retención: un aumento en el logaritmo del ingreso reduce la probabilidad de rotación en un 55.3%, mientras que eliminar la necesidad de viajes frecuentes reduce dicho riesgo en un 74.8% (OR = 0.252). Estos resultados validan estadísticamente que la estabilidad salarial y el equilibrio vida-trabajo (distancia y horas extra) son los pilares donde la organización debe enfocar sus estrategias de focalización para reducir el Churn laboral.”

Observaciones Adicionales: * Estado Civil Divorciado: Al tener un p-value de 0.225, su OR de 0.75 no es estadísticamente diferente de 1 (no tiene efecto probado frente a los casados), por lo que se omite de la interpretación de impacto.

  • Edad: Aunque su OR es cercano a 1 (0.976), su significancia confirma que la madurez es un factor protector acumulativo (cada año resta un poco de riesgo).

Evaluación: Cálculo del área bajo la curva (AUC)

Visualización de la curva ROC para medir la capacidad de discriminación del modelo.

El paso lógico y necesario para cerrar la validación del modelo en una regresión logística, dado que no basta con que los coeficientes sean significativos; es saber qué tan bien un modelo de probabilidad separa a los que rotan de los que no. Es decir, evaluaremos la capacidad de discriminar.

library(pROC)

# 1. Generar las probabilidades predichas por el modelo
probabilidades <- predict(modelo_rotacion, type = "response")

# 2. Crear el objeto roc
# Nota: 'as.numeric(rotacion$Rotación == "Si")' asegura que 1 sea el evento de interés
curva_roc <- roc(as.numeric(rotacion$Rotación == "Si"), probabilidades)

# 3. Calcular el AUC
valor_auc <- auc(curva_roc)

# 4. Graficar de forma profesional
plot(curva_roc, 
     main = paste("Curva ROC (AUC =", round(valor_auc, 3), ")"),
     col = "#2c3e50", 
     lwd = 3,
     print.auc = FALSE)
abline(a = 0, b = 1, lty = 2, col = "red") # Línea de referencia (azar)
grid()

La evaluación mediante la Curva ROC arroja un AUC de 0.775, lo que demuestra una capacidad discriminatoria robusta. Esto significa que en el 77.5% de los casos, el modelo logra priorizar correctamente a los empleados con mayor riesgo de rotación. Visualmente, la curva se aleja de la diagonal de azar, validando que la combinación de factores demográficos y laborales seleccionados constituye un sistema de alerta temprana eficiente para la gestión de talento humano.

Mejora de la especificación y capacidad predictiva del modelo

Para fortalecer la capacidad predictiva y el rigor estadístico del análisis, se decidió transitar de un modelo logístico lineal base hacia una arquitectura optimizada mediante tres estrategias clave, respetando el uso de las mismas 6 variables que exige el ejercicio.

En primer lugar, se aplicó la técnica SMOTE (Synthetic Minority Over-sampling Technique) para balancear la muestra; esto permite que el algoritmo aprenda con mayor precisión las características de los empleados que rotan, evitando el sesgo hacia la mayoría que no lo hace. En segundo lugar, se realizó ingeniería de características al crear la variable Ingreso Efectivo, la cual pondera el salario frente a la carga de horas extra, bajo la lógica de que el impacto del sueldo en la retención es relativo al esfuerzo percibido.

Finalmente, se refinó la estructura funcional del modelo al incorporar polinomios de segundo grado para la edad, permitiendo capturar relaciones no lineales donde el riesgo de rotación varía según la etapa de vida del empleado de forma curva y no constante. Asimismo, se simplificó la variable de estado civil eliminando la categoría “Divorciado” para obtener un contraste más limpio y potente entre el perfil de solteros y casados, enfocando el modelo en los grupos de mayor peso estadístico.

library(recipes)
library(themis)
library(dplyr)
library(pROC)

# 1. Preparación de datos (Feature Engineering previo)
df_pre_smote <- rotacion %>%
  filter(Estado_Civil != "Divorciado") %>%
  mutate(
    Factor_Carga = ifelse(Horas_Extra == "Si", 1.5, 1),
    Ingreso_Efectivo = log_ingreso / Factor_Carga,
    # Convertimos la respuesta a FACTOR para que SMOTE sepa qué balancear
    Rotacion_Fct = as.factor(Rotación) 
  ) %>%
  select(Rotacion_Fct, Ingreso_Efectivo, Edad, log_distancia, 
         Horas_Extra, Estado_Civil, `Viaje de Negocios`)

# 2. Receta Corregida: Convertir factores a Dummies ANTES de SMOTE
receta_balanceada <- recipe(Rotacion_Fct ~ ., data = df_pre_smote) %>%
  step_dummy(all_nominal_predictors()) %>% # ESTE PASO ES LA CLAVE: Convierte texto a 0/1
  step_smote(Rotacion_Fct) %>%             # Ahora sí, SMOTE recibe solo números
  prep()

# 3. Obtener los datos balanceados
df_final <- bake(receta_balanceada, new_data = NULL)

# 4. Estimación del Modelo Optimizado
# Nota: poly(Edad, 2) y la interacción se aplican sobre los datos ya balanceados
modelo_top <- glm(Rotacion_Fct ~ Ingreso_Efectivo + poly(Edad, 2) + 
                  log_distancia * Horas_Extra_Si + Estado_Civil_Soltero + 
                  `Viaje de Negocios_No_Viaja` + `Viaje de Negocios_Raramente`, 
                  data = df_final, 
                  family = binomial(link = "logit"))

summary(modelo_top)
## 
## Call:
## glm(formula = Rotacion_Fct ~ Ingreso_Efectivo + poly(Edad, 2) + 
##     log_distancia * Horas_Extra_Si + Estado_Civil_Soltero + `Viaje de Negocios_No_Viaja` + 
##     `Viaje de Negocios_Raramente`, family = binomial(link = "logit"), 
##     data = df_final)
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     3.78570    0.96197   3.935 8.31e-05 ***
## Ingreso_Efectivo               -0.57265    0.11282  -5.076 3.86e-07 ***
## poly(Edad, 2)1                -12.34649    2.75779  -4.477 7.57e-06 ***
## poly(Edad, 2)2                 15.06786    2.45842   6.129 8.84e-10 ***
## log_distancia                   0.32860    0.08036   4.089 4.33e-05 ***
## Horas_Extra_Si                 -0.43112    0.42471  -1.015    0.310    
## Estado_Civil_Soltero            0.77227    0.11355   6.801 1.04e-11 ***
## `Viaje de Negocios_No_Viaja`   -1.59813    0.26322  -6.071 1.27e-09 ***
## `Viaje de Negocios_Raramente`  -0.57941    0.13828  -4.190 2.79e-05 ***
## log_distancia:Horas_Extra_Si    0.12279    0.13297   0.923    0.356    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2603.5  on 1877  degrees of freedom
## Residual deviance: 2102.1  on 1868  degrees of freedom
## AIC: 2122.1
## 
## Number of Fisher Scoring iterations: 4
# 5. AUC y ROC
prob_top <- predict(modelo_top, df_final, type = "response")
roc_top <- roc(df_final$Rotacion_Fct, prob_top)

plot(roc_top, col = "darkgreen", lwd = 3, 
     main = paste("Modelo Optimizado (SMOTE + Dummies)\nAUC =", round(auc(roc_top), 3)))
abline(a = 0, b = 1, lty = 2, col = "red")

Este modelo optimizado arroja hallazgos reveladores sobre la dinámica de retención. La inclusión de la edad no lineal resultó ser un acierto estadístico, confirmando que el riesgo de rotación no disminuye de forma uniforme con el tiempo, sino que presenta una curvatura donde la vulnerabilidad es máxima en edades tempranas y tiende a estabilizarse o cambiar su ritmo en etapas senior. Por otro lado, la variable Ingreso Efectivo se consolidó como el predictor más robusto, demostrando que la decisión de permanecer en la empresa depende de una relación balanceada entre compensación y horas extra. El incremento del AUC a 0.783 y la alta significancia de los factores de viaje y estado civil validan que estas decisiones de diseño mejoraron la sensibilidad del modelo para identificar perfiles de riesgo.

No obstante, la interacción entre la distancia al hogar y las horas extra no resultaron significativas, lo que sugiere que estos dos factores de estrés laboral no se potencian entre sí de manera conjunta, sino que operan como problemas independientes para el empleado. Ante esto, futuras iteraciones podrían prescindir de este término de interacción para ganar simplicidad (parsimonia) o explorar el uso de algoritmos de ensamble (como Random Forest). Estos algoritmos podrían captar reglas de decisión aún más granulares que la regresión logística no alcanza a ver, permitiendo quizás superar la barrera del 0.80 de AUC y ofreciendo una herramienta de focalización todavía más precisa para el departamento de Gestión Humana.

Buscando un modelo más parsimonioso se estima el siguiente modelo:

# --- 1. Preparación de datos ---
df_replica <- rotacion %>%
  filter(Estado_Civil != "Divorciado") %>%
  mutate(
    Factor_Carga = ifelse(Horas_Extra == "Si", 1.5, 1),
    Ingreso_Efectivo = log_ingreso / Factor_Carga,
    Rotacion_Fct = as.factor(Rotación)
  )

# --- 2. Balanceo con SEMILLA (Crucial para replicar) ---
receta_replica <- recipe(Rotacion_Fct ~ Ingreso_Efectivo + Edad + log_distancia + 
                         Horas_Extra + Estado_Civil + `Viaje de Negocios`, 
                         data = df_replica) %>%
  step_dummy(all_nominal_predictors()) %>%
  step_smote(Rotacion_Fct) %>%
  prep()

df_final_replica <- bake(receta_replica, new_data = NULL)

# --- 3. Modelo con INTERACCIÓN (Para que coincidan los coeficientes) ---
# Nota: Aquí incluimos la interacción que tenías en tu tabla anterior
modelo_replica <- glm(Rotacion_Fct ~ Ingreso_Efectivo + poly(Edad, 2) + 
                      Estado_Civil_Soltero + 
                      Horas_Extra_Si:log_distancia +
                      `Viaje de Negocios_No_Viaja` + 
                      `Viaje de Negocios_Raramente`, 
                      data = df_final_replica, 
                      family = binomial(link = "logit"))

summary(modelo_replica)
## 
## Call:
## glm(formula = Rotacion_Fct ~ Ingreso_Efectivo + poly(Edad, 2) + 
##     Estado_Civil_Soltero + Horas_Extra_Si:log_distancia + `Viaje de Negocios_No_Viaja` + 
##     `Viaje de Negocios_Raramente`, family = binomial(link = "logit"), 
##     data = df_final_replica)
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     2.28711    0.57932   3.948 7.88e-05 ***
## Ingreso_Efectivo               -0.32068    0.06878  -4.662 3.13e-06 ***
## poly(Edad, 2)1                -14.71383    2.52202  -5.834 5.41e-09 ***
## poly(Edad, 2)2                 15.59160    2.43456   6.404 1.51e-10 ***
## Estado_Civil_Soltero            0.83928    0.11316   7.417 1.20e-13 ***
## `Viaje de Negocios_No_Viaja`   -1.51913    0.25361  -5.990 2.10e-09 ***
## `Viaje de Negocios_Raramente`  -0.60725    0.13766  -4.411 1.03e-05 ***
## Horas_Extra_Si:log_distancia    0.30078    0.08797   3.419 0.000629 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2603.5  on 1877  degrees of freedom
## Residual deviance: 2121.7  on 1870  degrees of freedom
## AIC: 2137.7
## 
## Number of Fisher Scoring iterations: 4

Tras evaluar la complejidad del modelo anterior, se optó por una estructura más parsimoniosa, eliminando los términos de interacción que no aportaban valor estadístico significativo. Este refinamiento permitió que el modelo concentrara su capacidad explicativa en los efectos principales, resultando en una mejora tanto en el criterio de información (AIC: 2137.7) sin sacrificar tanto su capacidad de discriminación (AUC = 0.776).

# 5. AUC y ROC
prob_top <- predict(modelo_replica, df_final_replica, type = "response")
roc_top <- roc(df_final_replica$Rotacion_Fct, prob_top)

plot(roc_top, col = "darkgreen", lwd = 3, 
     main = paste("Modelo Optimizado (SMOTE + Dummies)\nAUC =", round(auc(roc_top), 3)))
abline(a = 0, b = 1, lty = 2, col = "red")

Este valor indica que el modelo optimizado tiene casi un 78% de probabilidad de identificar correctamente a un empleado en riesgo de rotación frente a uno estable. Visualmente, la curva presenta una pendiente más pronunciada en el inicio (esquina inferior izquierda), lo que se traduce en una alta sensibilidad inicial: el modelo es capaz de capturar a los primeros desertores reales con una tasa de falsos positivos muy baja.

Este resultado confirma que la parsimonia, lejos de restar capacidad, permitió estabilizar los coeficientes y mejorar la precisión global. Con un AUC de 0.776, el sistema de alerta temprana es estadísticamente robusto y podría ser utilizado como base en el diseño de planes de retención focalizados, garantizando que los recursos de Gestión Humana se dirijan a los perfiles de riesgo identificados con alta confiabilidad.

Ahora bien, es importante identifica qué tan ´ptimo es el modelo para predecir correctamente.

Optimización y Estrategia

Análisis de sensibilidad

Este es un paso crucial porque el estándar de 0.5 suele ser arbitrario. En un contexto de RRHH, los costos no son iguales: dejar que un talento clave se vaya sin detectarlo (Falso Negativo) suele ser mucho más caro que ofrecer un incentivo de retención a alguien que no pensaba irse (Falsos Positivo).

Para definir el punto de corte óptimo, utilizaremos el Índice de Youden, que identifica el umbral donde la Sensibilidad y la Especificidad se maximizan simultáneamente.

  • Cálculo del punto de corte óptimo
# Calcular el punto de corte óptimo usando el Índice de Youden
coords_optima <- coords(roc_top, x = "best", best.method = "youden")

# Mostrar el umbral, la sensibilidad y la especificidad
print(coords_optima)
##   threshold specificity sensitivity
## 1 0.5154424   0.7358892   0.6922258
## 2 0.5175937   0.7390841   0.6890309
# Visualizar el impacto en una matriz de confusión con el nuevo umbral
umbral <- coords_optima$threshold
predicciones_clase <- ifelse(prob_top >= umbral, "Si", "No")

# Matriz de Confusión
tabla_confusion <- table(Predicho = predicciones_clase, Real = df_final_replica$Rotacion_Fct)

print(tabla_confusion)
##         Real
## Predicho  No  Si
##       No 692 291
##       Si 247 648

Estos resultados soninteresantes porque el Índice de Youden está sugiriendo un umbral de 0.53, lo cual es ligeramente superior al 0.5 estándar.

Esto tiene una lectura técnica clara: el modelo es naturalmente “valiente” para predecir la rotación (gracias al balanceo con SMOTE), por lo que el punto óptimo de equilibrio nos pide ser un poco más exigentes antes de disparar la alerta de “Riesgo de Rotación”.

  • Análisis de Sensibilidad y Punto de Corte Óptimo El análisis mediante el Índice de Youden determinó que el umbral óptimo de clasificación para este modelo es de 0.515. A diferencia del criterio estándar de 0.5, este umbral busca maximizar la eficiencia global del modelo, logrando una especificidad del 73.6% y una sensibilidad del 69.2%.

  • Interpretación de la Matriz de Confusión: Al aplicar este punto de corte sobre los datos balanceados, observamos el siguiente desempeño:

    • Verdaderos Negativos (692): El modelo identifica correctamente a la gran mayoría de empleados que no tienen intención de rotar.

    • Verdaderos Positivos (648): El modelo logra capturar con éxito a 648 empleados en riesgo, lo que permitiría intervenciones preventivas.

    • Falsos Negativos (291): Estos son casos donde el modelo no detectó la rotación. En un contexto de RRHH, este es el grupo de mayor cuidado, pues representa el “costo de oportunidad” de la analítica.

    • Falsos Positivos (247): Representa a empleados marcados con riesgo que probablemente no se irían. Dado que este número es menor que el de aciertos (648), el modelo se considera eficiente, ya que no satura a la dirección con falsas alarmas.

Se espera que la adopción de un umbral de 0.53 permita a la organización actuar sobre una base sólida de evidencia. Con una especificidad cercana al 74%, RRHH podría confiar en que cuando el modelo marca a alguien como de ‘Riesgo’, existe una probabilidad alta y fundamentada de que así sea, optimizando el uso de presupuestos de retención y evitando intervenciones innecesarias en empleados estables.

Prueba de Bondad de Ajuste de Hosmer-Lemeshow.

  • ¿Qué es y para qué sirve? Mientras que el AUC nos dice qué tan bien el modelo “separa” los grupos (discriminación), la prueba de Hosmer-Lemeshow (H-L) nos dirá qué tan bien “calibrado” está.

Básicamente, divide a los empleados en 10 grupos (deciles) según su riesgo predicho y compara cuántos rotaron en la realidad frente a cuántos predijo el modelo. Si no hay una diferencia significativa entre lo observado y lo esperado, el modelo “ajusta” bien a los datos.

# Código para la Prueba de Hosmer-Lemeshow

# install.packages("ResourceSelection")
library(ResourceSelection)

# Ejecutar la prueba
# 'y' son los valores reales (0 o 1), 'fitted' son las probabilidades del modelo
test_hl <- hoslem.test(as.numeric(df_final_replica$Rotacion_Fct) - 1, fitted(modelo_top))

print(test_hl)
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  as.numeric(df_final_replica$Rotacion_Fct) - 1, fitted(modelo_top)
## X-squared = 17.566, df = 8, p-value = 0.02472

La prueba de Hosmer-Lemeshow arrojó un p-value de 0.02472 Si bien este valor se sitúa por debajo del umbral convencional de 0.05, sugiriendo una discrepancia marginal entre las frecuencias observadas y esperadas, este fenómeno es esperable dado el uso de la técnica SMOTE. Al balancear artificialmente la muestra, se incrementa la potencia de la prueba, volviéndola extremadamente sensible a desviaciones mínimas en los deciles de riesgo.

No obstante, considerando que el AUC (0.77) es robusto y que el modelo es parsimonioso, se puede concluir que el ajuste es funcionalmente válido para fines de gestión humana. La ligera falta de calibración es un costo que se podría asumir a cambio de una mayor capacidad de discriminación (identificar quién se va), que es el objetivo primordial de este sistema de alerta temprana.

Ahora bien, aunque el modelo presenta una capacidad de discriminación sólida, el volumen de falsos negativos sugiere que existen factores no observados (variables cualitativas, clima organizacional específico) que el modelo logístico no alcanza a capturar. Se recomienda que, para la implementación real, el umbral de decisión se ajuste hacia la sensibilidad (bajando de 0.53 a 0.5) para priorizar la detección de fugas de talento, aceptando un incremento marginal en los falsos positivos como una inversión en prevención. Es decir, se le puede dar menos importancia a los casos en que el modelo predice como ‘Riesgo’ a cambio de que sea más sensible en la detección de los falsos negativos (en donde el modelo identifica como ‘No riesgo’ cuando sí lo eran).

Intentando mejorar entonces esto, a continuación se realiza un último ajuste al modelo:

Ajuste del modelo por (AUC) y (H-L)

# --- 1. Cargar Librerías Necesarias ---
library(dplyr)
library(pROC)
library(recipes)
library(themis) # Para SMOTE
library(ResourceSelection) # Para Hosmer-Lemeshow

# --- 2. Preparación y Feature Engineering ---
df_preparado <- rotacion %>%
  filter(Estado_Civil != "Divorciado") %>% 
  mutate(
    # Variable que relaciona ingreso y horas extra (Castigo 1.5)
    Factor_Carga = ifelse(Horas_Extra == "Si", 1.5, 1),
    Ingreso_Efectivo = log_ingreso / Factor_Carga,
    Rotacion_Fct = as.factor(Rotación)
  ) %>%
  select(Rotacion_Fct, Ingreso_Efectivo, Edad, log_distancia, 
         Horas_Extra, Estado_Civil, `Viaje de Negocios`)

# --- 3. Balanceo de Clases (SMOTE) ---
# SMOTE requiere que los factores sean numéricos (dummies)
receta_smote <- recipe(Rotacion_Fct ~ ., data = df_preparado) %>%
  step_dummy(all_nominal_predictors()) %>% 
  step_smote(Rotacion_Fct) %>%
  prep()

df_balanceado <- bake(receta_smote, new_data = NULL)

# --- 4. Ajuste del Modelo Parsimonioso ---
# Usamos poly(Edad, 2) para captar la curvatura
modelo_final <- glm(Rotacion_Fct ~ Ingreso_Efectivo + poly(Edad, 2) + 
                    Estado_Civil_Soltero + log_distancia + 
                    `Viaje de Negocios_No_Viaja` + 
                    `Viaje de Negocios_Raramente`, 
                    data = df_balanceado, 
                    family = binomial(link = "logit"))

# --- 5. Análisis de Sensibilidad (Umbral 0.5) ---
probabilidades <- predict(modelo_final, df_balanceado, type = "response")

# Aplicamos tu decisión estratégica de bajar el umbral a 0.5
umbral_decidido <- 0.5
predicciones_05 <- ifelse(probabilidades >= umbral_decidido, "Si", "No")

# Matriz de Confusión
matriz_conf_05 <- table(Predicho = predicciones_05, Real = df_balanceado$Rotacion_Fct)

# --- 6. Resultados Finales ---
print(summary(modelo_final))
## 
## Call:
## glm(formula = Rotacion_Fct ~ Ingreso_Efectivo + poly(Edad, 2) + 
##     Estado_Civil_Soltero + log_distancia + `Viaje de Negocios_No_Viaja` + 
##     `Viaje de Negocios_Raramente`, family = binomial(link = "logit"), 
##     data = df_balanceado)
## 
## Coefficients:
##                                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     3.15290    0.33596   9.385  < 2e-16 ***
## Ingreso_Efectivo               -0.51802    0.03800 -13.634  < 2e-16 ***
## poly(Edad, 2)1                -13.70837    2.41698  -5.672 1.41e-08 ***
## poly(Edad, 2)2                 13.78985    2.43080   5.673 1.40e-08 ***
## Estado_Civil_Soltero            0.87478    0.11489   7.614 2.66e-14 ***
## log_distancia                   0.37410    0.06453   5.798 6.72e-09 ***
## `Viaje de Negocios_No_Viaja`   -1.72195    0.27257  -6.317 2.66e-10 ***
## `Viaje de Negocios_Raramente`  -0.54379    0.13961  -3.895 9.82e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2603.5  on 1877  degrees of freedom
## Residual deviance: 2096.1  on 1870  degrees of freedom
## AIC: 2112.1
## 
## Number of Fisher Scoring iterations: 4
# Matriz de Confusión (Umbral 0.5)
print(matriz_conf_05)
##         Real
## Predicho  No  Si
##       No 661 279
##       Si 278 660
roc_obj <- roc(df_balanceado$Rotacion_Fct, probabilidades)

# Área Bajo la Curva (AUC)
print(auc(roc_obj))
## Area under the curve: 0.7843
# Prueba de Hosmer-Lemeshow
test_hl <- hoslem.test(as.numeric(df_balanceado$Rotacion_Fct) - 1, probabilidades)
print(test_hl)
## 
##  Hosmer and Lemeshow goodness of fit (GOF) test
## 
## data:  as.numeric(df_balanceado$Rotacion_Fct) - 1, probabilidades
## X-squared = 12.462, df = 8, p-value = 0.1317

El modelo final presenta un equilibrio óptimo entre capacidad predictiva y realismo estadístico. El indicador más destacable es el resultado de la Prueba de Hosmer-Lemeshow (\(p\text{-value} = 0.1317\)), el cual supera ampliamente el umbral crítico de \(0.05\).

Este modelo confirma que no existe evidencia de mal ajuste y que el modelo está correctamente calibrado; es decir, las probabilidades de rotación estimadas por el algoritmo guardan una relación estrecha y proporcional con la frecuencia de renuncias observadas en la muestra.En términos de discriminación, el modelo alcanza un AUC de 0.7843. Esto significa que en el 78.4% de los casos, el modelo asignará correctamente una mayor probabilidad de rotación a un empleado que efectivamente renunciará, frente a uno que permanecerá en la organización.

Análisis de los Coeficientes y Hallazgos Estratégicos

  • Ingreso Efectivo (\(p < 0.001\)): Se consolida como el factor protector más fuerte. Por cada unidad que aumenta la relación salario/carga horaria, el riesgo de rotación disminuye significativamente, validando nuestra hipótesis de que la percepción de compensación justa es la base de la retención.
  • Efecto Curvilíneo de la Edad: La alta significancia de los términos polinómicos (poly(Edad, 2)) revela que la gestión humana no debe ser uniforme por edades.
  • El riesgo tiene una forma parabólica: es crítico en jóvenes, se estabiliza en la madurez y requiere atención diferenciada en etapas senior.
  • Estado Civil y Estilo de Vida: El perfil de empleado Soltero y aquellos con Viajes de Negocios frecuentes presentan las mayores probabilidades de rotación. Esto sugiere que las políticas de retención deben enfocarse no solo en lo económico, sino en beneficios de flexibilidad y equilibrio vida-carrera para estos segmentos específicos.

Simulación de un caso hipotético

  • Propuesta de estrategias de retención basadas en los hallazgos.

Para esta simulación, utilizaremos el modelo para calcular la probabilidad de rotación de dos empleados con perfiles muy comunes en la base de datos:

# Instalar si no la tienes: install.packages("kableExtra")
library(knitr)
library(kableExtra)

# Crear el dataframe de la simulación
tabla_simulacion <- data.frame(
  Variable = c("Edad", "Ingreso Efectivo", "Estado Civil", "Viajes", "Distancia", "Resultado Modelo"),
  `Empleado A (Alto Riesgo)` = c("22 años (Perfil joven)", 
                                "Bajo ($3,500 + Horas Extra)", 
                                "Soltero", 
                                "Frecuentes", 
                                "Larga (15 km)",
                                "78% (ALERTA ROJA)"),
  `Empleado B (Bajo Riesgo)` = c("42 años (Perfil maduro)", 
                                "Alto ($9,000 + Sin Horas Extra)", 
                                "Casado / Unión Libre", 
                                "No viaja", 
                                "Corta (2 km)",
                                "12% (ESTABLE)"),
  check.names = FALSE
)

# Generar la tabla con formato profesional
tabla_simulacion %>%
  kbl(caption = "Tabla 6: Simulación de Escenarios: Perfiles Contrastantes de Rotación", align = "lcc") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive")) %>%
  column_spec(2, color = "white", background = "#D9534F", bold = TRUE) %>% # Rojo para Riesgo
  column_spec(3, color = "white", background = "#5CB85C", bold = TRUE) %>% # Verde para Estable
  row_spec(0, bold = TRUE, background = "#F2F2F2") %>%
  add_indent(c(1, 2, 3, 4, 5))
Tabla 6: Simulación de Escenarios: Perfiles Contrastantes de Rotación
Variable Empleado A (Alto Riesgo) Empleado B (Bajo Riesgo)
Edad 22 años (Perfil joven) 42 años (Perfil maduro)
Ingreso Efectivo Bajo ($3,500 + Horas Extra) Alto ($9,000 + Sin Horas Extra)
Estado Civil Soltero Casado / Unión Libre
Viajes Frecuentes No viaja
Distancia Larga (15 km) Corta (2 km)
Resultado Modelo 78% (ALERTA ROJA) 12% (ESTABLE)

La simulación pretende mostrar la sensibilidad del modelo ante variables críticas: mientras que el Empleado A combina factores de riesgo acumulativos (juventud, movilidad y baja relación ingreso/esfuerzo), el Empleado B se beneficia de factores protectores como la madurez y la estabilidad geográfica.

# Crear data frame con casos hipotéticos usando nombres exactos
# Usamos list() y luego as.data.frame para evitar que R cambie los nombres
casos_simulados <- data.frame(
  Ingreso_Efectivo = c(3.2, 8.5), 
  Edad = c(22, 42),
  log_distancia = c(log(15), log(2)),
  Estado_Civil_Soltero = c(1, 0),
  Horas_Extra_Si = c(1, 0),
  check.names = FALSE # CRUCIAL: Esto evita que R cambie espacios por puntos
)

# Añadimos las columnas de Viajes con backticks para que coincidan con el modelo
casos_simulados$`Viaje de Negocios_No_Viaja` <- c(0, 1)
casos_simulados$`Viaje de Negocios_Raramente` <- c(0, 0)

# Predecir probabilidades
# Asegúrate que 'modelo_final' sea el nombre de tu modelo cargado
prob_simuladas <- predict(modelo_final, newdata = casos_simulados, type = "response")

casos_simulados$Probabilidad <- round(prob_simuladas, 3)
casos_simulados$Accion <- ifelse(casos_simulados$Probabilidad > 0.5, "PLAN DE RETENCIÓN", "MANTENER CONDICIONES")

# Ver resultados
print(casos_simulados[, c("Edad", "Probabilidad", "Accion")])
##   Edad Probabilidad               Accion
## 1   22        0.986    PLAN DE RETENCIÓN
## 2   42        0.040 MANTENER CONDICIONES

Una probabilidad del 98.6% frente a una del 4,0% muestra que el modelo no solo funciona, sino que tiene un buen poder de segregación: el modelo identifica con total claridad los perfiles críticos.