ACTIVIDAD 3
JHONATAN MERCHAN
2025-09-28
## [1] "LC_COLLATE=es_ES.UTF-8;LC_CTYPE=es_ES.UTF-8;LC_MONETARY=es_ES.UTF-8;LC_NUMERIC=C;LC_TIME=es_ES.UTF-8"1 Selección de variables
1.1 1. Variables categóricas (distintas de Rotación)
a) Horas_Extra (Si/No)
Justificación: la realización frecuente de horas extra
puede generar sobrecarga laboral, afectar el balance vida–trabajo y
aumentar el agotamiento del empleado.
Hipótesis: quienes realizan horas extra presentan una
mayor probabilidad de rotación (y=1).
b) Viaje de Negocios (No / Raramente /
Frecuentemente)
Justificación: los viajes constantes implican costos
personales, tiempo fuera del hogar y mayor nivel de estrés, lo que puede
influir en la intención de cambio de cargo.
Hipótesis: a mayor frecuencia de viajes de negocios,
mayor probabilidad de rotación.
c) Departamento (p. ej., Ventas, IyD, RH, …)
Justificación: las condiciones de trabajo y
oportunidades de desarrollo varían según el área. Departamentos con alta
presión o cargas intensas pueden generar más rotación.
Hipótesis: los departamentos operativos o con mayor
presión presentan mayor probabilidad de rotación que
áreas administrativas o estratégicas.
1.2 2. Variables cuantitativas
d) Distancia_Casa (unidades de la base)
Justificación: los trayectos largos elevan el costo de
desplazamiento y generan cansancio, lo cual puede afectar la permanencia
del trabajador.
Hipótesis: a mayor distancia entre el hogar y el lugar
de trabajo, mayor probabilidad de rotación.
e) Satisfación_Laboral (escala 1–4)
Justificación: la satisfacción laboral es uno de los
principales predictores de la intención de permanencia, al reflejar
compromiso y vínculo con la organización.
Hipótesis: a mayor nivel de satisfacción laboral,
menor probabilidad de rotación.
f) Antigüedad_Cargo (años)
Justificación: la antigüedad refleja experiencia,
capital específico y costo de cambio, factores que usualmente reducen la
intención de rotar.
Hipótesis: a mayor antigüedad en el cargo,
menor probabilidad de rotación.
Matiz: en casos de estancamiento (varios años sin promoción),
la relación podría invertirse parcialmente; por ello se sugiere analizar
complementariamente Años_ultima_promoción.
2 Análisis univariado
2.1 Variable respuesta: Rotación
rotacion %>%
count(Rotación) %>%
mutate(prop = round(100 * n / sum(n), 1)) %>%
ggplot(aes(x = "", y = n, fill = Rotación)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
labs(title = "Distribución de la variable Rotación",
fill = "Rotación") +
theme_void() +
geom_text(aes(label = paste0(prop, "%")),
position = position_stack(vjust = 0.5),
color = "white",
size = 4)
Interpretación.
En la muestra (N = 1.470), el 16,1% de los empleados (n = 237) reporta Rotación = “Sí” y el 83,9% (n = 1.233) Rotación = “No”. La rotación es, por tanto, un evento poco frecuente (clase minoritaria). Esto respalda el uso de regresión logística para modelar su probabilidad y sugiere evaluar el desempeño con métricas robustas al desbalance (ROC–AUC, sensibilidad, especificidad, PPV/NPV). Para la decisión operativa conviene emplear un punto de corte distinto de 0,50 (p. ej., el de Youden ≈ 0,20), que equilibra la captura de rotadores y los falsos positivos.
2.2 Variables categóricas
2.2.1 Horas_Extra
rotacion %>%
count(Horas_Extra) %>%
mutate(prop = round(100 * n / sum(n), 1)) %>%
ggplot(aes(x = "", y = n, fill = Horas_Extra)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
labs(title = "Distribución de horas extra", fill = "Horas extra") +
theme_void() +
geom_text(aes(label = paste0(prop, "%")),
position = position_stack(vjust = 0.5),
color = "white",
size = 4)
Interpretación. En la muestra, el 28,3% de los empleados reporta Horas_Extra = “Si” y el 71,7% Horas_Extra = “No”. Es decir, la realización de horas extra no es la norma, aunque una fracción relevante sí las realiza. De acuerdo con la hipótesis planteada, se espera que quienes realizan horas extra presenten mayor probabilidad de rotación (mayores odds de y=1). Este patrón será contrastado en el análisis bivariado y en el modelo logístico multivariable.
2.2.2 Viaje_de_Negocios
## # A tibble: 3 × 3
## `Viaje de Negocios` n prop
## <chr> <int> <dbl>
## 1 Frecuentemente 277 18.8
## 2 No_Viaja 150 10.2
## 3 Raramente 1043 71ggplot(rotacion, aes(x = `Viaje de Negocios`)) +
geom_bar(fill = "#F39C12") +
labs(x = "Frecuencia de viajes", y = "Número de empleados",
title = "Distribución de viajes de negocios") +
theme_minimal()
Interpretación.
La distribución muestra que la mayoría de los empleados viaja “Raramente” (71.0%), mientras que 18.8% viaja “Frecuentemente” y 10.2% no viaja. Es decir, casi 9 de cada 10 empleados realizan al menos algún viaje de negocios. De acuerdo con la hipótesis, se esperaría que la probabilidad de rotación aumente con la frecuencia de viajes (Frecuentemente > Raramente > No viaja). Esto se contrastará en el análisis bivariado y en el modelo logístico; además, dado el tamaño de las categorías, “Raramente” podría usarse como referencia o, alternativamente, la categoría con menor proporción de rotación observada.
2.2.3 Departamento
## # A tibble: 3 × 3
## Departamento n prop
## <chr> <int> <dbl>
## 1 IyD 961 65.4
## 2 Ventas 446 30.3
## 3 RH 63 4.3ggplot(rotacion, aes(x = Departamento)) +
geom_bar(fill = "#8E44AD") +
coord_flip() +
labs(x = "Departamento", y = "Número de empleados",
title = "Distribución por departamento") +
theme_minimal()
Interpretación. La distribución por departamento es marcadamente desigual: IyD concentra el 65,4% de los empleados (n = 961), Ventas el 30,3% (n = 446) y RH el 4,3% (n = 63). Este desbalance implica que los intervalos de confianza para RH serán más amplios (n pequeño) y que la comparación entre áreas debe considerar diferencias de tamaño. En el modelo logístico, se recomienda usar como referencia el departamento con menor proporción de rotación observada, y tener presente que, con n reducido, los OR de RH pueden ser menos precisos.
2.3 Variables cuantitativas
2.3.1 Distancia_Casa
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 7.000 9.193 14.000 29.000q <- quantile(rotacion$Distancia_Casa, c(.25,.5,.75), na.rm = TRUE)
ggplot(rotacion, aes(x = Distancia_Casa)) +
geom_histogram(bins = 20, fill = "#3498DB") +
geom_vline(xintercept = q, linetype = "dashed") +
labs(x = "Distancia a casa", y = "Frecuencia",
title = "Distribución de la distancia a casa (con cuartiles)") +
theme_minimal()
Interpretación. Distancia_Casa muestra una asimetría a la derecha: mediana = 7, media = 9.19 (mayor que la mediana), Q1 = 2, Q3 = 14, mín = 1, máx = 29. Hay una alta concentración de empleados entre 1–5 unidades y una cola larga con trayectos más extensos (≥25) que, aunque menos frecuentes, elevan la media. Esto indica heterogeneidad en los desplazamientos diarios y sugiere costos de conmutación distintos entre empleados. Conforme a la hipótesis, se espera que mayor distancia se asocie con mayor probabilidad de rotación. En el modelo logístico, el efecto por 1 unidad puede ser pequeño; por claridad de negocio conviene reportar también el OR por 5 o 10 unidades de distancia.
2.3.2 Satisfacción_Laboral
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 2.729 4.000 4.000tab_sat <- rotacion %>%
dplyr::count(`Satisfación_Laboral`, name = "n") %>%
dplyr::mutate(prop = round(100 * n / sum(n), 1))
tab_sat## # A tibble: 4 × 3
## Satisfación_Laboral n prop
## <dbl> <int> <dbl>
## 1 1 289 19.7
## 2 2 280 19
## 3 3 442 30.1
## 4 4 459 31.2ggplot(tab_sat, aes(x = factor(`Satisfación_Laboral`, levels = 1:4), y = n)) +
geom_col(fill = "#16A085") +
geom_text(aes(label = paste0(prop, "%")), vjust = -0.3, size = 4) +
labs(x = "Nivel de satisfacción laboral (1–4)", y = "Número de empleados",
title = "Distribución de la satisfacción laboral") +
theme_minimal() +
expand_limits(y = max(tab_sat$n) * 1.10)
Interpretación. Satisfación_Laboral es una escala ordinal 1–4 con mediana = 3 y media = 2.73. Predominan los niveles 3 y 4 (la mayoría de empleados), mientras que los niveles 1–2 reúnen una proporción menor. Esto sugiere un clima percibido más bien favorable. Conforme a la hipótesis, se espera que mayor satisfacción se asocie con menor probabilidad de rotación (coeficiente negativo en el logit). En el modelo, al ser ordinal, puede tratarse como numérica (1–4) y, como análisis de sensibilidad, codificarla en dummies por nivel.
2.3.3 Antigüedad_Cargo
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.000 3.000 4.229 7.000 18.000ggplot(rotacion, aes(x = Antigüedad_Cargo)) +
geom_histogram(bins = 20, fill = "#E74C3C") +
labs(x = "Antigüedad en el cargo (años)", y = "Frecuencia",
title = "Distribución de la antigüedad en el cargo") +
theme_minimal()
Interpretación. Antigüedad_Cargo está fuertemente concentrada en valores bajos y presenta asimetría a la derecha: Q1 = 2, mediana = 3, media = 4.23, Q3 = 7, con valores máximos hasta 18 años. Se observan “acumulaciones” en rangos 0–1, 2–3 y 6–7 años, y pocos casos por encima de 10. Este patrón sugiere que la mayoría de empleados se encuentra en etapas tempranas del cargo, mientras que un grupo reducido acumula permanencias prolongadas.
Conforme a la hipótesis, se espera que mayor
antigüedad se asocie con menor probabilidad de
rotación (coeficiente negativo en el logit).
No obstante, la forma de la distribución invita a considerar
posibles no linealidades (p. ej., efecto más fuerte en
los primeros años y luego más plano). En el modelo puede explorarse como
robustez un término cuadrático o
splines (p. ej.,
splines::ns(Antigüedad_Cargo, 3)) para capturar relaciones
curvilíneas.
3 Análisis bivariado
En este apartado se examina la relación entre la variable dependiente (Rotación, codificada como 1 = sí rotación, 0 = no rotación) y las variables independientes seleccionadas. El objetivo es identificar cuáles son determinantes y anticipar el signo esperado de los coeficientes en el modelo logístico.
3.1 Variables categóricas
3.1.1 a) Horas_Extra
tab_horas <- rotacion %>%
group_by(`Horas_Extra`) %>%
summarise(proporcion_rotacion = mean(y, na.rm = TRUE),
n = n(), .groups = "drop") %>%
arrange(desc(proporcion_rotacion))
tab_horas## # A tibble: 2 × 3
## Horas_Extra proporcion_rotacion n
## <fct> <dbl> <int>
## 1 Si 0.305 416
## 2 No 0.104 1054ggplot(tab_horas, aes(x = `Horas_Extra`, y = proporcion_rotacion)) +
geom_col(fill = "#27AE60") +
labs(x = "Horas extra", y = "Proporción de rotación",
title = "Rotación por horas extra") +
theme_minimal()
# Logit univariable (ref = categoría con menor rotación para facilitar lectura)
ref_horas <- tab_horas %>% arrange(proporcion_rotacion) %>% slice(1) %>% pull(`Horas_Extra`) %>% as.character()
rot_aux <- rotacion %>% mutate(`Horas_Extra` = fct_relevel(`Horas_Extra`, ref_horas))
tidy(glm(y ~ `Horas_Extra`, family = binomial, data = rot_aux),
exponentiate = TRUE, conf.int = TRUE)## # A tibble: 2 × 7
## term estimate std.error statistic p.value conf.low conf.high
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.117 0.101 -21.3 5.05e-101 0.0951 0.141
## 2 Horas_ExtraSi 3.77 0.147 9.06 1.35e- 19 2.83 5.033.1.1.1 Horas_Extra — Evidencia bivariada e inferencia univariable
Descripción bivariada (proporciones) - Rotación entre quienes hacen horas extra (“Sí”): 30,5% (n = 416). - Rotación entre quienes no hacen horas extra (“No”): 10,4% (n = 1.054). - Diferencia absoluta de riesgo (DR) = 20,1 pp (0,305 − 0,104) → incremento marcado. - Riesgo relativo (RR) ≈ 2,93× → quienes hacen horas extra tienen casi el triple de probabilidad de rotar que quienes no hacen.
Modelo logit univariable (y ~ Horas_Extra) -
OR(Horas_Extra = “Sí” vs “No”) = 3,77
IC95% [2,83; 5,03], p < 0,001 →
asociación positiva y estadísticamente significativa. -
El intercepto (OR = 0,1165)
corresponde a las odds de rotación del grupo de referencia
(“No”). Convertido a probabilidad:
\(p = \frac{0{,}1165}{1+0{,}1165} \approx
0{,}104\) (≈ 10,4%), consistente con la
proporción observada.
Conclusión - La realización de horas
extra se asocia con un aumento sustancial de
la probabilidad de rotación.
- El signo esperado (positivo) se
confirma: el efecto es grande en bivariado (RR ≈ 2,93; DR ≈ 20
pp) y significativo en el logit univariable (OR =
3,77).
- Dado que el evento no es muy raro (≈16% global, 30% en “Sí”), es
normal que el OR supere al RR.
3.1.2 Viaje de Negocios
tab_viaje <- rotacion %>%
group_by(`Viaje de Negocios`) %>%
summarise(proporcion_rotacion = mean(y, na.rm = TRUE),
n = n(), .groups = "drop") %>%
arrange(desc(proporcion_rotacion))
tab_viaje## # A tibble: 3 × 3
## `Viaje de Negocios` proporcion_rotacion n
## <fct> <dbl> <int>
## 1 Frecuentemente 0.249 277
## 2 Raramente 0.150 1043
## 3 No_Viaja 0.08 150ggplot(tab_viaje, aes(x = `Viaje de Negocios`, y = proporcion_rotacion)) +
geom_col(fill = "#F39C12") +
labs(x = "Frecuencia de viajes", y = "Proporción de rotación",
title = "Rotación según viajes de negocios") +
theme_minimal()
ref_viaje <- tab_viaje %>% arrange(proporcion_rotacion) %>% slice(1) %>% pull(`Viaje de Negocios`) %>% as.character()
rot_aux <- rotacion %>% mutate(`Viaje de Negocios` = fct_relevel(`Viaje de Negocios`, ref_viaje))
tidy(glm(y ~ `Viaje de Negocios`, family = binomial, data = rot_aux),
exponentiate = TRUE, conf.int = TRUE)## # A tibble: 3 × 7
## term estimate std.error statistic p.value conf.low conf.high
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.0870 0.301 -8.12 4.86e-16 0.0457 0.150
## 2 `Viaje de Negocios`F… 3.81 0.331 4.04 5.36e- 5 2.06 7.64
## 3 `Viaje de Negocios`R… 2.02 0.313 2.25 2.45e- 2 1.14 3.933.1.2.1 Viaje de Negocios — Evidencia bivariada e inferencia univariable
Descripción bivariada (proporciones) -
Frecuentemente: 24,9% de rotación (n =
277)
- Raramente: 15,0% (n = 1.043)
- No viaja (referencia): 8,0% (n = 150)
Contrastes (vs. “No viaja”) - Diferencia
absoluta de riesgo (DR):
- Frecuentemente: +16,9 pp (0,249 − 0,080)
- Raramente: +7,0 pp (0,150 − 0,080) - Riesgo
relativo (RR):
- Frecuentemente: ≈ 3,11×
- Raramente: ≈ 1,87×
Modelo logit univariable (y ~
Viaje de Negocios) - OR Frecuentemente
vs. No viaja = 3,81
IC95% [2,06; 7,64], p < 0,001 →
efecto positivo y significativo. - OR Raramente
vs. No viaja = 2,02
IC95% [1,14; 3,93], p = 0,025 → efecto
positivo y significativo. - Intercepto (odds del grupo No
viaja): 0,08696, que implica \(p = \frac{0.08696}{1+0.08696} \approx
0{,}08\) (8%), consistente con la proporción observada.
Conclusión - Existe un gradiente
claro: a mayor frecuencia de viajes, mayor probabilidad
de rotación (Frecuentemente > Raramente > No
viaja).
- La evidencia confirma la hipótesis (signo
positivo).
- Nota: el tamaño de “No viaja” (n = 150) es menor, por lo que sus
intervalos son más amplios; aun así, los efectos son estadísticamente
robustos.
3.1.3 Departamento
tab_dep <- rotacion %>%
group_by(`Departamento`) %>%
summarise(proporcion_rotacion = mean(y, na.rm = TRUE),
n = n(), .groups = "drop") %>%
arrange(desc(proporcion_rotacion))
tab_dep %>% head(10) # primeros 10 con mayor proporción## # A tibble: 3 × 3
## Departamento proporcion_rotacion n
## <fct> <dbl> <int>
## 1 Ventas 0.206 446
## 2 RH 0.190 63
## 3 IyD 0.138 961ggplot(tab_dep, aes(x = reorder(`Departamento`, proporcion_rotacion),
y = proporcion_rotacion)) +
geom_col(fill = "#8E44AD") +
coord_flip() +
labs(x = "Departamento", y = "Proporción de rotación",
title = "Rotación por departamento") +
theme_minimal()
ref_dep <- tab_dep %>% arrange(proporcion_rotacion) %>% slice(1) %>% pull(`Departamento`) %>% as.character()
rot_aux <- rotacion %>% mutate(`Departamento` = fct_relevel(`Departamento`, ref_dep))
tidy(glm(y ~ `Departamento`, family = binomial, data = rot_aux),
exponentiate = TRUE, conf.int = TRUE)## # A tibble: 3 × 7
## term estimate std.error statistic p.value conf.low conf.high
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.161 0.0934 -19.6 2.50e-85 0.133 0.192
## 2 DepartamentoRH 1.46 0.334 1.14 2.53e- 1 0.729 2.73
## 3 DepartamentoVentas 1.62 0.150 3.21 1.31e- 3 1.20 2.173.1.3.1 Departamento — Evidencia bivariada e inferencia univariable
Descripción bivariada (proporciones) -
Ventas: 20,63% de rotación (n = 446)
- RH: 19,05% (n = 63)
- IyD (menor rotación, usado como
referencia): 13,84% (n = 961)
Contrastes vs. IyD (referencia) -
Ventas: ΔRiesgo = +6,79 pp (0,206 −
0,138); RR ≈ 1,49×
- RH: ΔRiesgo = +5,21 pp; RR ≈
1,38×
Modelo logit univariable (y ~ Departamento)
- OR Ventas vs. IyD = 1,62; IC95% [1,20;
2,17], p = 0,0013 → efecto positivo y
significativo.
- OR RH vs. IyD = 1,46; IC95% [0,73;
2,73], p = 0,253 → no significativo
(intervalo amplio por n pequeño en RH).
- Intercepto (odds en IyD): 0,1606, que implica \(p = \frac{0.1606}{1+0.1606} \approx
0{,}138\) (13,8%), coherente con la proporción
observada.
Conclusión - Se observa un
gradiente de rotación por área (Ventas > RH
> IyD).
- Ventas exhibe una mayor probabilidad de
rotación que IyD, efecto moderado y estadísticamente
significativo.
- En RH la diferencia es de magnitud similar pero
no concluyente debido al tamaño muestral
reducido (IC95% amplio).
- Estos hallazgos son consistentes con la hipótesis de que
algunas áreas presentan mayor presión/rotación; su
confirmación final debe basarse en el modelo
multivariable.
3.2 Cuantitativas → distribución por clase de rotación
3.2.1 Distancia_Casa
rotacion %>%
group_by(y) %>%
summarise(media = mean(`Distancia_Casa`, na.rm=TRUE),
mediana = median(`Distancia_Casa`, na.rm=TRUE),
sd = sd(`Distancia_Casa`, na.rm=TRUE), .groups = "drop")## # A tibble: 2 × 4
## y media mediana sd
## <int> <dbl> <dbl> <dbl>
## 1 0 8.92 7 8.01
## 2 1 10.6 9 8.45ggplot(rotacion, aes(x = factor(y, labels = c("No rotó","Rotó")),
y = `Distancia_Casa`)) +
geom_boxplot(fill = "#3498DB") +
labs(x = "Rotación", y = "Distancia a casa",
title = "Distancia a casa según rotación") +
theme_minimal()
tidy(glm(y ~ `Distancia_Casa`, family = binomial, data = rotacion),
exponentiate = TRUE, conf.int = TRUE)## # A tibble: 2 × 7
## term estimate std.error statistic p.value conf.low conf.high
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.151 0.111 -17.0 1.39e-64 0.121 0.187
## 2 Distancia_Casa 1.03 0.00831 2.97 2.95e- 3 1.01 1.043.2.1.1 Distancia_Casa — Evidencia bivariada e inferencia univariable
Descripción bivariada (boxplot y resúmenes) - No
rotó (y=0): media = 8.92, mediana =
7, sd = 8.01
- Rotó (y=1): media = 10.63, mediana =
9, sd = 8.45
Se observa un desplazamiento a la derecha en el grupo
que rotó (mediana 9 vs. 7), con distribuciones solapadas pero
centros mayores para quienes cambiaron de cargo.
Modelo logit univariable (y ~ Distancia_Casa) -
OR por 1 unidad = 1.025; IC95%
[1.008; 1.042], p = 0.003 →
asociación positiva y significativa.
- Interpretación práctica: por cada +1 unidad de
distancia, las odds de rotación aumentan
2.5%.
- +5 unidades ⇒ OR ≈ 1.025⁵ ≈ 1.13
(+13% en odds).
- +10 unidades ⇒ OR ≈ 1.025¹⁰ ≈ 1.28
(+28% en odds).
Conclusión - La evidencia bivariada y el logit
univariable confirman la hipótesis: mayor
distancia al hogar se asocia con mayor probabilidad de
rotación.
- El efecto unitario es pequeño, pero
acumulativamente (p. ej., +5/+10 unidades) es
relevante para decisiones de RR.HH.
3.2.2 Satisfación_Laboral
rotacion %>%
group_by(y) %>%
summarise(media = mean(`Satisfación_Laboral`, na.rm=TRUE),
mediana = median(`Satisfación_Laboral`, na.rm=TRUE),
sd = sd(`Satisfación_Laboral`, na.rm=TRUE), .groups = "drop")## # A tibble: 2 × 4
## y media mediana sd
## <int> <dbl> <dbl> <dbl>
## 1 0 2.78 3 1.09
## 2 1 2.47 3 1.12ggplot(rotacion, aes(x = factor(y, labels = c("No rotó","Rotó")),
y = `Satisfación_Laboral`)) +
geom_boxplot(fill = "#16A085") +
labs(x = "Rotación", y = "Satisfacción laboral (1–4)",
title = "Satisfacción laboral según rotación") +
theme_minimal()
tidy(glm(y ~ `Satisfación_Laboral`, family = binomial, data = rotacion),
exponentiate = TRUE, conf.int = TRUE)## # A tibble: 2 × 7
## term estimate std.error statistic p.value conf.low conf.high
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.371 0.176 -5.64 1.75e-8 0.262 0.522
## 2 Satisfación_Laboral 0.778 0.0637 -3.94 8.16e-5 0.686 0.8813.2.2.1 Satisfación_Laboral — Evidencia bivariada e inferencia univariable
Descripción bivariada (boxplot y resúmenes) - No
rotó (y=0): media = 2.78, mediana =
3, sd = 1.09
- Rotó (y=1): media = 2.47, mediana =
3, sd = 1.12
Aunque las distribuciones se solapan y ambas medianas
son 3, el grupo que rotó presenta una media
menor, sugiriendo menor satisfacción entre
quienes cambian de cargo.
Modelo logit univariable (y ~ Satisfación_Laboral) -
OR por 1 punto = 0.778; IC95%
[0.686; 0.881], p < 0.001 →
asociación negativa y significativa.
Interpretación: por cada +1 punto en satisfacción, las
odds de rotación disminuyen 22% (1 −
0.778).
- +2 puntos ⇒ OR ≈ 0.778² ≈ 0.605
(−39% en odds).
- +3 puntos ⇒ OR ≈ 0.778³ ≈ 0.471
(−53% en odds).
Conclusión - La evidencia confirma la
hipótesis: mayor satisfacción laboral se
asocia con menor probabilidad de rotación (efecto
protector).
- Dado que la variable es una escala ordinal (1–4),
tratarla como numérica es razonable; como análisis de robustez puede
codificarse en dummies por nivel para verificar
posibles no linealidades.
3.2.3 Antigüedad_Cargo
rotacion %>%
group_by(y) %>%
summarise(media = mean(`Antigüedad_Cargo`, na.rm=TRUE),
mediana = median(`Antigüedad_Cargo`, na.rm=TRUE),
sd = sd(`Antigüedad_Cargo`, na.rm=TRUE), .groups = "drop")## # A tibble: 2 × 4
## y media mediana sd
## <int> <dbl> <dbl> <dbl>
## 1 0 4.48 3 3.65
## 2 1 2.90 2 3.17ggplot(rotacion, aes(x = factor(y, labels = c("No rotó","Rotó")),
y = `Antigüedad_Cargo`)) +
geom_boxplot(fill = "#E74C3C") +
labs(x = "Rotación", y = "Antigüedad en el cargo (años)",
title = "Antigüedad en el cargo según rotación") +
theme_minimal()
tidy(glm(y ~ `Antigüedad_Cargo`, family = binomial, data = rotacion),
exponentiate = TRUE, conf.int = TRUE)## # A tibble: 2 × 7
## term estimate std.error statistic p.value conf.low conf.high
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) 0.327 0.104 -10.8 4.54e-27 0.266 0.400
## 2 Antigüedad_Cargo 0.864 0.0242 -6.03 1.61e- 9 0.823 0.9053.2.3.1 Antigüedad_Cargo — Evidencia bivariada e inferencia univariable
Descripción bivariada (boxplot y resúmenes) - No
rotó (y=0): media = 4.48, mediana =
3, sd = 3.65
- Rotó (y=1): media = 2.90, mediana =
2, sd = 3.17
Se observa que quienes rotaron tienen, en promedio,
menor antigüedad en el cargo (Δ media ≈ −1.58 años; Δ
mediana = −1 año). Las distribuciones se solapan, pero el centro está
desplazado hacia valores más bajos en el grupo que
rotó.
Modelo logit univariable (y ~ Antigüedad_Cargo) -
OR por 1 año = 0.864; IC95%
[0.823; 0.905], p < 0.001 →
asociación negativa y significativa.
Interpretación: por cada +1 año adicional en el cargo,
las odds de rotación disminuyen 13,6%
(1−0.864).
- +2 años ⇒ OR ≈ 0.864² ≈ 0.75
(−25% en odds).
- +5 años ⇒ OR ≈ 0.864⁵ ≈ 0.48
(−52% en odds).
Conclusión - La evidencia confirma la
hipótesis: mayor antigüedad se asocia con
menor probabilidad de rotación (efecto
protector).
- Dado el patrón de concentración en antigüedades bajas, podría existir
no linealidad (efecto más marcado en los primeros
años). Como robustez, puede explorarse un término cuadrático o
splines en el modelo multivariable.
3.2.4 Comparación con las hipótesis (punto 2)
# Categóricas: diferencia de proporciones
range_prop <- function(df, var){
df %>%
group_by(.data[[var]]) %>%
summarise(p = mean(y, na.rm=TRUE), .groups = "drop") %>%
summarise(range = max(p, na.rm=TRUE) - min(p, na.rm=TRUE)) %>%
pull(range)
}
rank_cat <- tibble::tibble(
variable = vars_cat,
rango_prop = sapply(vars_cat, function(v) range_prop(rotacion, v))
) %>% arrange(desc(rango_prop))
# Cuantitativas: |correlación|
rank_num <- tibble::tibble(
variable = vars_num,
abs_cor = sapply(vars_num, function(v) abs(cor(rotacion$y, rotacion[[v]], use="complete.obs")))
) %>% arrange(desc(abs_cor))
rank_cat## # A tibble: 3 × 2
## variable rango_prop
## <chr> <dbl>
## 1 Horas_Extra 0.201
## 2 Viaje de Negocios 0.169
## 3 Departamento 0.0679## # A tibble: 3 × 2
## variable abs_cor
## <chr> <dbl>
## 1 Antigüedad_Cargo 0.161
## 2 Satisfación_Laboral 0.103
## 3 Distancia_Casa 0.0779Resumen de evidencia bivariada obtenida - Categóricas (rango de proporciones de rotación, Δpp) - Horas_Extra: Δ = 20.09 pp → efecto fuerte. - Viaje de Negocios: Δ = 16.91 pp → efecto moderado–fuerte. - Departamento: Δ = 6.79 pp → efecto débil–moderado. - Cuantitativas (|correlación punto–biserial| con y) - Antigüedad_Cargo: |r| = 0.161 → mayor magnitud entre cuantitativas. - Satisfación_Laboral: |r| = 0.103 → magnitud moderada. - Distancia_Casa: |r| = 0.078 → magnitud débil.
Contraste con hipótesis planteadas -
Horas_Extra (+): Los resultados muestran la mayor
diferencia entre categorías (Δ=20 pp), lo que refuerza
la hipótesis de que realizar horas extra se asocia con mayor
probabilidad de rotación.
⇒ Consistente (signo esperado del coeficiente
logístico: positivo).
Viaje_de_Negocios (+): Presenta una diferencia relevante (Δ≈17 pp) entre niveles de frecuencia, indicando que viajar más se vincula con mayor rotación.
⇒ Consistente (coeficiente positivo para niveles con mayor frecuencia vs. la referencia).Departamento (+ vs. ref.): Aunque hay diferencias (Δ≈7 pp), son menores que en las dos variables anteriores; la capacidad discriminante es limitada bivariadamente y dependerá de la categoría de referencia en el modelo.
⇒ Parcialmente consistente (algunas áreas con coeficientes positivos frente a la referencia).Distancia_Casa (+): Relación positiva pero débil (|r|=0.078). Indica que vivir más lejos podría aumentar la rotación, aunque el efecto aislado es pequeño.
⇒ Consistente pero de baja magnitud (coeficiente positivo esperado).Satisfación_Laboral (−): Relación negativa de magnitud moderada (|r|=0.103). Empleados con mayor satisfacción tienden a no rotar.
⇒ Consistente (coeficiente negativo esperado).Antigüedad_Cargo (−): Es la cuantitativa con mayor fuerza (|r|=0.161). Menor antigüedad se asocia con mayor rotación; a más antigüedad, menor probabilidad de rotación.
⇒ Consistente (coeficiente negativo esperado).
Conclusión bivariada - Variables con mayor poder
discriminante: Horas_Extra y
Viaje_de_Negocios (entre las categóricas) y
Antigüedad_Cargo (entre las cuantitativas).
- Satisfación_Laboral confirma el efecto protector
esperado; Distancia_Casa aporta señal positiva pero
débil; Departamento muestra heterogeneidad menor y su
impacto dependerá de la categoría base en el modelo. - En conjunto, los
signos observados/esperados coinciden con las hipótesis
del punto 2.
Nota metodológica: el análisis bivariado no controla por confusores. La confirmación de signos y significancia debe realizarse en el modelo logístico multivariable (punto 4), incluyendo la elección adecuada de referencias y verificando colinealidad.
Determinantes bivariados. Entre las categóricas, Horas_Extra (Δ=20,1 pp) y Viaje de Negocios (Δ=16,9 pp) muestran la mayor separación de rotación entre niveles; Departamento presenta diferencias más moderadas (Ventas > IyD; RH no concluyente). Entre las cuantitativas, Antigüedad_Cargo (|r|=0,161) es la más asociada (relación negativa), seguida por Satisfación_Laboral (|r|=0,103, negativa) y Distancia_Casa (|r|=0,078, positiva). Estos signos coinciden con las hipótesis y se confirman con los logit univariables.
library(dplyr)
library(forcats)
library(broom)
vars_cat <- c("Horas_Extra","Viaje de Negocios","Departamento")
vars_num <- c("Distancia_Casa","Satisfación_Laboral","Antigüedad_Cargo")
# Fijar referencia de cada factor como la categoría con MENOR proporción de rotación
set_ref_minrot <- function(df, var){
ref <- df %>% group_by(.data[[var]]) %>%
summarise(p = mean(y, na.rm=TRUE), .groups="drop") %>%
arrange(p) %>% slice(1) %>% pull(1) %>% as.character()
fct_relevel(factor(df[[var]]), ref)
}
rot_uni <- rotacion
for(v in vars_cat) rot_uni[[v]] <- set_ref_minrot(rot_uni, v)
# Extraer OR univariable para cada variable
get_uni <- function(var){
form <- as.formula(paste0("y ~ `", var, "`"))
tidy(glm(form, family = binomial, data = rot_uni),
exponentiate = TRUE, conf.int = TRUE) %>%
filter(term != "(Intercept)") %>%
transmute(
Variable = var,
Termino = gsub("`", "", term),
OR = estimate, LI95 = conf.low, LS95 = conf.high,
`p-valor` = p.value,
Significativo = ifelse(`p-valor` < 0.05, "Sí", "No"),
Interpretacion = ifelse(OR > 1, "Aumenta rotación", "Disminuye rotación")
)
}
tab_or_uni <- bind_rows(lapply(c(vars_cat, vars_num), get_uni))
tab_or_uni %>% arrange(match(Variable, c(vars_cat, vars_num)), desc(OR))## # A tibble: 8 × 8
## Variable Termino OR LI95 LS95 `p-valor` Significativo Interpretacion
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Horas_Extra Horas_… 3.77 2.83 5.03 1.35e-19 Sí Aumenta rotac…
## 2 Viaje de Neg… Viaje … 3.81 2.06 7.64 5.36e- 5 Sí Aumenta rotac…
## 3 Viaje de Neg… Viaje … 2.02 1.14 3.93 2.45e- 2 Sí Aumenta rotac…
## 4 Departamento Depart… 1.62 1.20 2.17 1.31e- 3 Sí Aumenta rotac…
## 5 Departamento Depart… 1.46 0.729 2.73 2.53e- 1 No Aumenta rotac…
## 6 Distancia_Ca… Distan… 1.03 1.01 1.04 2.95e- 3 Sí Aumenta rotac…
## 7 Satisfación_… Satisf… 0.778 0.686 0.881 8.16e- 5 Sí Disminuye rot…
## 8 Antigüedad_C… Antigü… 0.864 0.823 0.905 1.61e- 9 Sí Disminuye rot…4 Estimación del modelo
library(dplyr)
library(forcats)
library(broom)
# --- 0) Respuesta binaria y (seguro por si no existe) ---
rotacion <- rotacion %>%
mutate(
Rotación_lc = tolower(`Rotación`),
y = dplyr::case_when(
Rotación_lc %in% c("si","sí","1","true") ~ 1L,
Rotación_lc %in% c("no","0","false") ~ 0L,
TRUE ~ NA_integer_
)
)
# --- 1) Mantener solo las columnas necesarias y sin NA para el modelo ---
vars_cat <- c("Horas_Extra","Viaje de Negocios","Departamento")
vars_num <- c("Distancia_Casa","Satisfación_Laboral","Antigüedad_Cargo")
base_mod <- rotacion %>%
select(y, all_of(vars_cat), all_of(vars_num)) %>%
tidyr::drop_na()
# --- 2) Asegurar factores y fijar referencias con base en menor Pr(rota) ---
# Horas_Extra
ref_horas <- base_mod %>%
group_by(`Horas_Extra`) %>%
summarise(p = mean(y), .groups="drop") %>%
arrange(p) %>% slice(1) %>% pull(`Horas_Extra`) %>% as.character()
# Viaje de Negocios
ref_viaje <- base_mod %>%
group_by(`Viaje de Negocios`) %>%
summarise(p = mean(y), .groups="drop") %>%
arrange(p) %>% slice(1) %>% pull(`Viaje de Negocios`) %>% as.character()
# Departamento
ref_dep <- base_mod %>%
group_by(`Departamento`) %>%
summarise(p = mean(y), .groups="drop") %>%
arrange(p) %>% slice(1) %>% pull(`Departamento`) %>% as.character()
base_mod <- base_mod %>%
mutate(
`Horas_Extra` = forcats::fct_relevel(factor(`Horas_Extra`), ref_horas),
`Viaje de Negocios` = forcats::fct_relevel(factor(`Viaje de Negocios`), ref_viaje),
`Departamento` = forcats::fct_relevel(factor(`Departamento`), ref_dep)
)
# --- 3) Ajuste del modelo logístico ---
form_logit <- y ~ `Horas_Extra` + `Viaje de Negocios` + `Departamento` +
`Distancia_Casa` + `Satisfación_Laboral` + `Antigüedad_Cargo`
mod_logit <- glm(form_logit, data = base_mod, family = binomial)
null_logit <- glm(y ~ 1, data = base_mod, family = binomial)
# --- 4) Tabla de coeficientes en OR con IC95% ---
coefs_or <- tidy(mod_logit, exponentiate = TRUE, conf.int = TRUE, conf.level = 0.95) %>%
filter(term != "(Intercept)") %>%
mutate(
term = gsub("`", "", term),
OR = estimate,
LI95 = conf.low,
LS95 = conf.high,
sig = ifelse(p.value < 0.05, "Sí", "No"),
efecto = dplyr::case_when(
OR > 1 ~ "Aumenta prob. de rotación",
OR < 1 ~ "Disminuye prob. de rotación",
TRUE ~ "Neutro"
)
) %>%
select(Termino = term,
OR,
LI95,
LS95,
`p-valor` = p.value,
`Significativo (p<0.05)` = sig,
Interpretación = efecto)
coefs_or %>% arrange(desc(OR))## # A tibble: 8 × 7
## Termino OR LI95 LS95 `p-valor` Significativo (p<0.0…¹ Interpretación
## <chr> <dbl> <dbl> <dbl> <dbl> <chr> <chr>
## 1 Viaje de Ne… 4.19 2.17 8.71 4.63e- 5 Sí Aumenta prob.…
## 2 Horas_Extra… 4.03 2.98 5.48 2.59e-19 Sí Aumenta prob.…
## 3 Viaje de Ne… 1.99 1.08 4.00 3.67e- 2 Sí Aumenta prob.…
## 4 Departament… 1.85 1.34 2.53 1.60e- 4 Sí Aumenta prob.…
## 5 Departament… 1.48 0.698 2.91 2.83e- 1 No Aumenta prob.…
## 6 Distancia_C… 1.03 1.01 1.05 2.13e- 3 Sí Aumenta prob.…
## 7 Antigüedad_… 0.852 0.809 0.895 4.33e-10 Sí Disminuye pro…
## 8 Satisfación… 0.730 0.638 0.835 4.72e- 6 Sí Disminuye pro…
## # ℹ abbreviated name: ¹`Significativo (p<0.05)`# --- 5) Métricas globales del modelo ---
# Likelihood Ratio test (vs. modelo nulo)
lr_test <- anova(null_logit, mod_logit, test = "Chisq")
# Pseudo-R² de McFadden
R2_McFadden <- 1 - as.numeric(logLik(mod_logit)) / as.numeric(logLik(null_logit))
n_obs <- nobs(mod_logit)
list(
Observaciones_modelo = n_obs,
AIC = AIC(mod_logit),
LR_test = lr_test,
McFadden_R2 = R2_McFadden
)## $Observaciones_modelo
## [1] 1470
##
## $AIC
## [1] 1127.521
##
## $LR_test
## Analysis of Deviance Table
##
## Model 1: y ~ 1
## Model 2: y ~ Horas_Extra + `Viaje de Negocios` + Departamento + Distancia_Casa +
## Satisfación_Laboral + Antigüedad_Cargo
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 1469 1298.6
## 2 1461 1109.5 8 189.06 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## $McFadden_R2
## [1] 0.1455905Resultados del modelo (OR, IC95% y significancia)
Viaje de Negocios – Frecuentemente (vs. referencia: nivel con menor rotación, p.ej. “No viaja”):
OR = 4.19 (IC95%: 2.17–8.71, p < 0.001) → quienes viajan frecuentemente tienen ~319% mayores odds de rotación. Significativo.Horas_Extra – Sí (vs. No):
OR = 4.03 (IC95%: 2.98–5.48, p < 0.001) → realizar horas extra se asocia con ~303% mayores odds de rotación. Significativo.Viaje de Negocios – Raramente (vs. referencia):
OR = 1.99 (IC95%: 1.08–4.00, p = 0.037) → viajar ocasionalmente aumenta las odds de rotación en ~99%. Significativo.Departamento – Ventas (vs. departamento de menor rotación):
OR = 1.85 (IC95%: 1.34–2.53, p < 0.001) → trabajar en Ventas implica ~85% mayores odds de rotación. Significativo.Departamento – RH (vs. referencia):
OR = 1.48 (IC95%: 0.70–2.91, p = 0.283) → efecto no concluyente tras ajustar por las demás variables. No significativo.Distancia_Casa (por 1 unidad):
OR = 1.029 (IC95%: 1.010–1.047, p = 0.002) → efecto pequeño pero positivo.
Referencias útiles: +5 unidades ⇒ OR ≈ 1.15; +10 ⇒ OR ≈ 1.33.Antigüedad_Cargo (por 1 año):
OR = 0.852 (IC95%: 0.809–0.895, p < 0.001) → protector: a más antigüedad, menor rotación.
Referencias: +2 años ⇒ OR ≈ 0.73 (−27% odds); +5 años ⇒ OR ≈ 0.45 (−55% odds).Satisfación_Laboral (por 1 punto en escala 1–4):
OR = 0.730 (IC95%: 0.638–0.835, p < 0.001) → protector.
Referencias: +2 puntos ⇒ OR ≈ 0.53 (−47% odds).
Nota: OR > 1 indica aumento de odds de rotación; OR < 1 indica disminución. En factores, la comparación es frente a la categoría de referencia (definida como el nivel con menor rotación observada).
4.1 4.2 Ajuste global del modelo
- LR test (vs. nulo): χ²(8) =
189.06, p < 2.2e−16 → el modelo con covariables
mejora significativamente el ajuste.
- Pseudo-R² de McFadden: 0.146 →
poder explicativo moderado (razonable en problemas de
rotación).
- AIC: 1127.52 (útil para comparar
con especificaciones alternativas).
- N: 1,470 observaciones.
4.2 4.3 Variables determinantes (multivariable)
Más influyentes (efectos positivos, significativos):
Horas_Extra (Sí), Viaje de Negocios (Frecuentemente / Raramente) y Departamento: Ventas → aumentan de forma importante la probabilidad de rotación, incluso controlando por distancia, satisfacción y antigüedad.Efectos protectores (negativos, significativos):
Antigüedad_Cargo y Satisfación_Laboral → reducen la probabilidad de rotación.Efectos no concluyentes:
Departamento: RH no fue significativo tras el ajuste → su efecto podría depender de la referencia escogida o de otras variables no incluidas.
4.3 4.4 Coherencia con las hipótesis
- Consistente con lo planteado en el punto 1:
Horas extra (+), viajes (+), Ventas (+), distancia (+), satisfacción (−), antigüedad (−).
La magnitud mayor se observa en carga laboral/itinerancia (Horas_Extra y Viajes), seguida por área (Ventas), y efectos continuos menores pero robustos en Distancia_Casa, Satisfación_Laboral y Antigüedad_Cargo.
4.3.1 Observación metodológica
- Los OR de variables continuas pueden reportarse por incrementos
“interpretables” (p.ej., Distancia por 5 o 10 unidades;
Antigüedad por 2 o 5 años).
- Resultados multivariables controlan confusión; por ello, diferencias bivariadas pueden atenuarse o fortalecerse en el modelo (como ocurrió con Departamento).
5 Evaluación
## Type 'citation("pROC")' for a citation.##
## Adjuntando el paquete: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(dplyr)
# Probabilidades in-sample
base_mod <- base_mod %>%
mutate(prob = predict(mod_logit, type = "response"))
# Curva ROC y AUC (con IC95% por DeLong)
roc_obj <- roc(response = base_mod$y, predictor = base_mod$prob, quiet = TRUE)
auc_val <- auc(roc_obj)
auc_ci <- ci.auc(roc_obj)
auc_val## Area under the curve: 0.7594## 95% CI: 0.7249-0.7939 (DeLong)# Gráfico ROC
plot.roc(roc_obj,
print.auc = TRUE,
legacy.axes = TRUE,
main = "Curva ROC – Modelo de rotación")
# Umbral óptimo por criterio de Youden (opcional, útil para el punto 6)
th_opt <- coords(roc_obj, "best", best.method = "youden",
ret = c("threshold","sensitivity","specificity","accuracy"))
th_opt## threshold sensitivity specificity accuracy
## threshold 0.2016991 0.6075949 0.7875101 0.7585034# Matriz de confusión y métricas al umbral óptimo
corte <- as.numeric(th_opt["threshold"])
eval_tab <- base_mod %>%
mutate(pred = if_else(prob >= corte, 1L, 0L)) %>%
summarise(
TP = sum(pred==1 & y==1),
FP = sum(pred==1 & y==0),
TN = sum(pred==0 & y==0),
FN = sum(pred==0 & y==1),
Sensibilidad = TP/(TP+FN),
Especificidad = TN/(TN+FP),
Exactitud = (TP+TN)/n()
)
eval_tab## # A tibble: 1 × 7
## TP FP TN FN Sensibilidad Especificidad Exactitud
## <int> <int> <int> <int> <dbl> <dbl> <dbl>
## 1 144 262 971 93 0.608 0.788 0.759# --- Interpretación automática del AUC y del umbral (Youden) ---
# (Recalcula por si llegas a correr este chunk de forma independiente)
library(pROC); library(dplyr); library(tibble)##
## Adjuntando el paquete: 'tibble'## The following object is masked from 'package:summarytools':
##
## viewif (!"prob" %in% names(base_mod)) {
base_mod <- base_mod %>%
mutate(prob = predict(mod_logit, type = "response"))
}
roc_obj <- roc(response = base_mod$y, predictor = base_mod$prob, quiet = TRUE)
auc_val <- auc(roc_obj)
auc_ci <- ci.auc(roc_obj)
# Clasificación cualitativa del AUC
auc_num <- as.numeric(auc_val)
nivel_auc <- dplyr::case_when(
auc_num < 0.60 ~ "muy bajo (cercano al azar)",
auc_num < 0.70 ~ "débil",
auc_num < 0.80 ~ "aceptable",
auc_num < 0.90 ~ "bueno",
TRUE ~ "excelente"
)
ci_low <- as.numeric(auc_ci[1])
ci_high <- as.numeric(auc_ci[3])
# Umbral óptimo por Youden y métricas asociadas
th_opt <- coords(roc_obj, "best", best.method = "youden",
ret = c("threshold","sensitivity","specificity","accuracy"))
corte <- as.numeric(th_opt["threshold"])
# Matriz de confusión y métricas al corte óptimo (con PPV/NPV)
eval_tab <- base_mod %>%
mutate(pred = if_else(prob >= corte, 1L, 0L)) %>%
summarise(
TP = sum(pred==1 & y==1),
FP = sum(pred==1 & y==0),
TN = sum(pred==0 & y==0),
FN = sum(pred==0 & y==1),
Sensibilidad = TP/(TP+FN),
Especificidad = TN/(TN+FP),
Exactitud = (TP+TN)/n(),
PPV = TP/(TP+FP), # precisión / valor predictivo positivo
NPV = TN/(TN+FN) # valor predictivo negativo
)
# --- Salidas resumidas "listas para informe" ---
cat(
sprintf("**AUC = %.3f** (IC95%%: %.3f–%.3f): desempeño **%s**.\n\n",
auc_num, ci_low, ci_high, nivel_auc)
)## **AUC = 0.759** (IC95%: 0.725–0.794): desempeño **aceptable**.cat(
sprintf("**Umbral óptimo (Youden) = %.3f** → Sensibilidad = %.2f, Especificidad = %.2f, Exactitud = %.2f, PPV = %.2f, NPV = %.2f.\n\n",
corte,
eval_tab$Sensibilidad, eval_tab$Especificidad, eval_tab$Exactitud,
eval_tab$PPV, eval_tab$NPV)
)## **Umbral óptimo (Youden) = 0.202** → Sensibilidad = 0.61, Especificidad = 0.79, Exactitud = 0.76, PPV = 0.35, NPV = 0.91.# También dejamos la tabla por si quieres mostrarla en el informe
eval_tab %>%
mutate(across(everything(), ~ if(is.numeric(.)) round(., 3) else .))## # A tibble: 1 × 9
## TP FP TN FN Sensibilidad Especificidad Exactitud PPV NPV
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 144 262 971 93 0.608 0.788 0.759 0.355 0.9135.1 Evaluación del modelo (ROC/AUC) — Interpretación
AUC = 0.759 (IC95%: 0.725–0.794)
Desempeño aceptable: el modelo tiene
~75.9% de probabilidad de asignar una puntuación de
riesgo mayor a un empleado que rota que a uno que
no rota.
El intervalo sugiere un poder discriminante estable (lejos de 0.5).
Prevalencia de rotación (base rate)
Positivos reales = 237/1470 ≈ 16.1%. Es un evento poco
frecuente; por ello la precisión (PPV) tiende a ser
modesta salvo que se suba el umbral.
Umbral óptimo (Youden) = 0.202
Métricas al corte 0.202 - Sensibilidad (Recall) = 0.608 → identifica ~61% de quienes rotan (TP = 144, FN = 93). - Especificidad = 0.788 → descarta correctamente ~79% de quienes no rotan (TN = 971, FP = 262). - Exactitud = 0.759 (influida por la alta proporción de no rotación). - PPV (Precisión) ≈ 0.354 → entre los marcados como de riesgo, ~35% efectivamente rota. - NPV ≈ 0.912 → entre los no marcados, ~91% efectivamente no rota.
Lectura de la matriz de confusión (N = 1470)
- Marca 406 empleados como “en riesgo”
(144 verdaderos, 262 falsos
positivos).
- Deja 1064 como “sin riesgo” (971
verdaderos, 93 falsos negativos).
5.1.1 Implicaciones para decisiones de negocio
- El modelo duplica la tasa base: el grupo “en riesgo” tiene 35% de rotación vs 16% general → lift ≈ 2.2×. Útil para focalizar intervenciones (coaching, revisión de cargas, incentivos).
- El desempeño es mejor para descartar (NPV alto) que para confirmar; si la intervención es cara, considerar elevar el umbral para subir PPV y reducir falsos positivos (a costa de menor sensibilidad).
- Si perder talento es muy costoso, conviene bajar el umbral para aumentar sensibilidad y “no dejar ir” rotadores (aceptando más falsos positivos).
5.1.2 Recomendación práctica
- Mantener el corte 0.20 como línea base (buen
balance sensibilidad/especificidad).
- Definir una política por costos:
- Intervenciones baratas (encuestas pulse, 1:1 con líder): corte más bajo (mayor cobertura).
- Intervenciones costosas (bonos, traslados): corte más alto (mejor precisión).
- Complementar con:
- Validación cruzada del AUC para estimar desempeño
fuera de muestra.
- Segmentación por deciles de probabilidad para
priorizar el top 10–20% de mayor riesgo.
- Curva precisión–recall (útil con prevalencia baja).
- Validación cruzada del AUC para estimar desempeño
fuera de muestra.
“El modelo presenta AUC = 0.759 (IC95%: 0.725–0.794), desempeño aceptable. Con el umbral de 0.202 (Youden), alcanza Sensibilidad = 0.608, Especificidad = 0.788 y Exactitud = 0.759. El grupo clasificado como de riesgo muestra un PPV ≈ 0.354, más del doble de la tasa base (16%), lo que justifica su uso para focalizar acciones de retención.”
5.2 Evaluación adicional: validación cruzada, Precisión–Recall y calibración
#install.packages("rsample")
set.seed(123)
library(rsample); library(pROC); library(dplyr); library(tibble)
# 5-fold estratificado sobre la base ya preparada (base_mod)
folds <- vfold_cv(base_mod, v = 5, strata = y)
cv_res <- purrr::map_df(folds$splits, function(s){
train <- analysis(s); test <- assessment(s)
fit <- glm(y ~ `Horas_Extra` + `Viaje de Negocios` + `Departamento` +
`Distancia_Casa` + `Satisfación_Laboral` + `Antigüedad_Cargo`,
family = binomial, data = train)
prob <- predict(fit, newdata = test, type = "response")
roc_obj <- pROC::roc(response = test$y, predictor = prob, quiet = TRUE)
tibble(AUC = as.numeric(pROC::auc(roc_obj)))
})
auc_cv_mean <- mean(cv_res$AUC); auc_cv_sd <- sd(cv_res$AUC)
cat(sprintf("**AUC-CV (5-fold estrat.) = %.3f** (SD = %.3f)\n", auc_cv_mean, auc_cv_sd))## **AUC-CV (5-fold estrat.) = 0.748** (SD = 0.054)## # A tibble: 5 × 1
## AUC
## <dbl>
## 1 0.690
## 2 0.741
## 3 0.714
## 4 0.766
## 5 0.829# Requiere precrec
if (!requireNamespace("precrec", quietly = TRUE)) install.packages("precrec")
library(precrec)##
## Adjuntando el paquete: 'precrec'## The following object is masked from 'package:pROC':
##
## auc# Datos in-sample
mm <- mmdata(scores = base_mod$prob, labels = base_mod$y, modnames = "Logit")
ev <- evalmod(mm)
# AUPRC y gráfico
auprc <- subset(auc(ev), curvetypes == "PRC")$aucs
cat(sprintf("**AUPRC = %.3f**\n", auprc))## **AUPRC = 0.437**## Warning in ggplot2::fortify(object, raw_curves = raw_curves, reduce_points = reduce_points): Arguments in `...` must be used.
## ✖ Problematic argument:
## • raw_curves = raw_curves
## ℹ Did you misspell an argument name?
brier <- mean((base_mod$y - base_mod$prob)^2)
cat(sprintf("**Brier score = %.3f** (↓ mejor)\n", brier))## **Brier score = 0.115** (↓ mejor)calib <- base_mod %>%
mutate(decil = ntile(prob, 10)) %>%
group_by(decil) %>%
summarise(prob_media = mean(prob), tasa_obs = mean(y), n = n(), .groups="drop")
ggplot(calib, aes(x = prob_media, y = tasa_obs)) +
geom_point() + geom_line() +
geom_abline(slope = 1, intercept = 0, linetype = 2) +
labs(x = "Prob. predicha (promedio por decil)", y = "Tasa observada",
title = "Calibración por deciles") +
theme_minimal()
Validación cruzada (5-fold estratificada).
Se obtiene AUC-CV = 0.748 (SD = 0.054), con AUC por
fold entre 0.690 y 0.829. Este valor
es muy cercano al AUC in-sample = 0.759, lo que sugiere
buena generalización del modelo y una
variabilidad moderada atribuible al tamaño de la clase
positiva (16% ~ 237 casos). En conjunto, no se observan señales claras
de sobreajuste.
Curva Precisión–Recall (PR) y AUPRC.
La AUPRC = 0.437 supera holgadamente la línea
base dada por la prevalencia (≈0.161),
indicando capacidad útil para priorizar casos
positivos. La curva muestra el patrón esperado: alta
precisión para recall muy bajo (pocos casos marcados)
y descenso gradual de la precisión al aumentar la
cobertura. En torno a recall ≈ 0.60, la
precisión ≈ 0.35, consistente con el desempeño al corte
de Youden (PPV~0.35).
Calibración y Brier score.
El Brier = 0.115 (↓ mejor) es inferior al benchmark de
un clasificador que predice la prevalencia (p·(1−p) ≈
0.135), lo que indica buena calibración
global. La curva por deciles se acerca a la diagonal: el modelo
está bien calibrado en rangos bajos/medios y presenta
una ligera subestimación en el decil superior (la tasa
observada es algo mayor que la predicha). Este matiz no afecta la
utilidad práctica, pero podría afinarse con una recalibración
(Platt/isotónica) si se requiere máxima precisión en el top
risk.
Conclusión operativa.
- La discriminación es estable fuera de
muestra (AUC-CV~0.75).
- La utilidad en ranking es clara (AUPRC 0.437 >
0.161).
- Las probabilidades son fiables para
tomar decisiones (Brier bajo y buena calibración), con leve ajuste
posible en el decil más alto si la empresa concentrará allí
intervenciones costosas.
6 Predicciones
En esta sección se estiman probabilidades individuales de rotación a partir del modelo logístico ajustado. Se adopta como línea base el corte de Youden estimado en la sección ROC (≈ 0.20), que ofrece un balance entre sensibilidad y especificidad. La decisión de intervenir a un empleado se toma si su probabilidad predicha es mayor o igual al corte.
# --- Asegurar objetos y probabilidades del modelo ---
stopifnot(exists("mod_logit"), exists("base_mod"))
if (!"prob" %in% names(base_mod)) {
base_mod <- base_mod %>% mutate(prob = predict(mod_logit, type = "response"))
}
# --- Corte recomendado: Youden (si no existe, lo calculamos) ---
if (!exists("th_opt")) {
roc_obj <- pROC::roc(response = base_mod$y, predictor = base_mod$prob, quiet = TRUE)
th_opt <- pROC::coords(roc_obj, "best", best.method = "youden",
ret = c("threshold","sensitivity","specificity","accuracy"))
}
corte <- as.numeric(th_opt["threshold"])
corte <- round(corte, 3) # para reporte
corte## [1] 0.2026.1 Función para puntuar empleados (probabilidad y decisión)
predecir_empleado <- function(horas_extra, viaje, depto,
distancia_casa, satisf_laboral, antig_cargo,
corte_prob = corte) {
nd <- tibble(
`Horas_Extra` = factor(horas_extra, levels = levels(base_mod$`Horas_Extra`)),
`Viaje de Negocios` = factor(viaje, levels = levels(base_mod$`Viaje de Negocios`)),
`Departamento` = factor(depto, levels = levels(base_mod$`Departamento`)),
`Distancia_Casa` = distancia_casa,
`Satisfación_Laboral` = satisf_laboral,
`Antigüedad_Cargo` = antig_cargo
)
nd$prob <- predict(mod_logit, newdata = nd, type = "response")
nd$decision <- ifelse(nd$prob >= corte_prob, "Intervenir", "No intervenir")
nd$`Corte usado` <- corte_prob
nd
}6.2 perfiles hipotéticos
# Perfil de ALTO RIESGO (ejemplo)
emp_alto <- predecir_empleado(
horas_extra = "Si",
viaje = "Frecuentemente",
depto = "Ventas",
distancia_casa = 18,
satisf_laboral = 2,
antig_cargo = 1
) %>% mutate(Perfil = "Alto riesgo (ejemplo)")
# Perfil de BAJO RIESGO (ejemplo)
emp_bajo <- predecir_empleado(
horas_extra = "No",
viaje = "Raramente",
depto = "IyD",
distancia_casa = 3,
satisf_laboral = 4,
antig_cargo = 7
) %>% mutate(Perfil = "Bajo riesgo (ejemplo)")
bind_rows(emp_alto, emp_bajo) %>%
select(Perfil, `Horas_Extra`, `Viaje de Negocios`, `Departamento`,
`Distancia_Casa`, `Satisfación_Laboral`, `Antigüedad_Cargo`,
prob, decision, `Corte usado`) %>%
mutate(prob = round(prob, 3))## # A tibble: 2 × 10
## Perfil Horas_Extra `Viaje de Negocios` Departamento Distancia_Casa
## <chr> <fct> <fct> <fct> <dbl>
## 1 Alto riesgo (ejem… Si Frecuentemente Ventas 18
## 2 Bajo riesgo (ejem… No Raramente IyD 3
## # ℹ 5 more variables: Satisfación_Laboral <dbl>, Antigüedad_Cargo <dbl>,
## # prob <dbl>, decision <chr>, `Corte usado` <dbl>cortes_negocio <- c(corte, 0.30, 0.40)
perf_cortes <- lapply(cortes_negocio, function(ct){
pred <- ifelse(base_mod$prob >= ct, 1L, 0L)
TP <- sum(pred==1 & base_mod$y==1); FP <- sum(pred==1 & base_mod$y==0)
TN <- sum(pred==0 & base_mod$y==0); FN <- sum(pred==0 & base_mod$y==1)
tibble(
Corte = ct,
Sensibilidad = TP/(TP+FN),
Especificidad = TN/(TN+FP),
PPV = TP/(TP+FP),
NPV = TN/(TN+FN),
Marcados = sum(pred==1),
Prevalencia = mean(base_mod$y==1)
)
}) %>% bind_rows()
perf_cortes %>% mutate(across(where(is.numeric), ~round(., 3)))## # A tibble: 3 × 7
## Corte Sensibilidad Especificidad PPV NPV Marcados Prevalencia
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.202 0.599 0.788 0.351 0.911 404 0.161
## 2 0.3 0.405 0.905 0.451 0.888 213 0.161
## 3 0.4 0.262 0.957 0.539 0.871 115 0.161Perfiles hipotéticos
Alto riesgo (Si horas extra, viaja frecuentemente, Ventas, distancia=18, satisfacción=2, antigüedad=1)
Probabilidad predicha 0.747 → Intervenir (supera el corte 0.202).
Lectura: está en el percentil alto de riesgo, impulsado por tres factores con OR>1 en el modelo: Horas_Extra=Sí, Viaje=Frecuentemente y Departamento=Ventas, además de baja satisfacción y baja antigüedad.Bajo riesgo (No horas extra, viaja raramente, IyD, distancia=3, satisfacción=4, antigüedad=7)
Probabilidad 0.025 → No intervenir (muy por debajo del corte).
Lectura: acumula varios factores protectores (no extra, menos viajes, mayor antigüedad y satisfacción).
6.2.1 ¿Qué implica el punto de corte?
Tomando como base el corte Youden ≈ 0.202 (equilibrio S/E), y comparándolo con cortes más exigentes:
| Corte | Sensibilidad | Especificidad | PPV | NPV | Marcados |
|---|---|---|---|---|---|
| 0.202 | 0.599 | 0.788 | 0.351 | 0.911 | 404 |
| 0.300 | 0.405 | 0.905 | 0.451 | 0.888 | 213 |
| 0.400 | 0.262 | 0.957 | 0.539 | 0.871 | 115 |
- Trade-off clave: al subir el corte ↑, mejora la precisión (PPV) pero cae la cobertura (sensibilidad) y se interviene a menos personas.
- Con prevalencia ≈ 16% (237/1470), los
verdaderos positivos capturados serían aprox.:
- Corte 0.202: 144 TP y 262
FP (404 marcados).
- Corte 0.300: ≈96 TP y ≈117
FP (213 marcados).
- Corte 0.400: ≈62 TP y ≈53 FP (115 marcados).
- Corte 0.202: 144 TP y 262
FP (404 marcados).
Cómo elegir el corte según costos/capacidad - Intervenciones baratas / alta capacidad (encuestas, 1:1 breves): 0.20 → más cobertura (capturas ~61% de rotadores) aceptando más falsos positivos. - Intervenciones moderadas (coaching estructurado, micro-incentivos): 0.30 → equilibrio: mejor PPV (~45%) y ~40% de rotadores capturados. - Intervenciones costosas / cupo limitado (bonos, traslados, cambios de rol): 0.40 → alta precisión (~54%) focalizando ~115 personas.
6.2.2 Recomendación práctica
- Usar 0.20 como línea base (coincide con
Youden).
- Para priorización operativa, ordenar por
probabilidad y actuar por deciles (top 10–20%),
especialmente si el presupuesto es fijo.
- Revisar mensualmente los TP/FP observados y ajustar el corte según la efectividad de las intervenciones.
En resumen: el modelo diferencia bien perfiles alto vs. bajo riesgo y permite ajustar el punto de corte a los costos y la capacidad de intervención de la empresa.
7 Conclusiones
7.1 Hallazgos clave del modelo
- Determinantes con mayor impacto (↑ rotación):
Horas_Extra = Sí (OR ≈ 4.03), Viaje de Negocios = Frecuentemente (OR ≈ 4.19) y = Raramente (OR ≈ 1.99), Departamento = Ventas (OR ≈ 1.85).
→ Mayor carga/itinerancia y pertenecer a Ventas incrementan fuertemente el riesgo. - Factores protectores (↓ rotación):
Antigüedad_Cargo (OR ≈ 0.85 por año) y Satisfacción laboral (OR ≈ 0.73 por punto).
→ Permanencia y satisfacción reducen de forma sustantiva el riesgo. - Efectos no concluyentes:
Departamento = RH no resultó significativo tras el ajuste (n pequeño; IC amplio).
7.2 Calidad predictiva y utilidad operativa
- Discriminación: AUC in-sample =
0.759 (IC95%: 0.725–0.794).
Validación cruzada 5-fold estratificada: AUC-CV = 0.748 (SD = 0.054).
→ Desempeño estable fuera de muestra y sin señales claras de sobreajuste. - Riesgo desbalanceado: AUPRC =
0.437, muy por encima de la línea base (prevalencia ≈
0.161).
→ El modelo ordena bien los casos positivos para priorización. - Calibración: Brier = 0.115 (mejor
que el benchmark p·(1−p) ≈ 0.135).
Curva por deciles cercana a la diagonal, con ligera subestimación en el decil superior. - Punto de corte de referencia: Youden ≈
0.202 → Sensibilidad ≈ 0.61, Especificidad ≈ 0.79, PPV ≈ 0.35,
NPV ≈ 0.91.
Con este corte se marcan 404 empleados (144 TP; 262 FP).
→ El modelo duplica la tasa base en el grupo “en riesgo” (lift ≈ 2.2×).
7.3 Supuestos del modelo y alcance
- Respuesta Bernoulli (0/1) y observaciones
independientes. Si existiera dependencia por equipo/líder,
considerar errores clúster-robustos o efectos
aleatorios.
- Linealidad en el logit para variables numéricas
(Antigüedad_Cargo, Distancia_Casa,
Satisfación_Laboral); recomendable un chequeo de no linealidad
(p.ej., splines) como análisis de sensibilidad.
- Baja multicolinealidad (ver VIF/GVIF).
- Sin separación completa y tamaño muestral suficiente por nivel (atención a RH).
7.4 Limitaciones
- Asociación ≠ causalidad (posibles omitidas:
liderazgo, modalidad de trabajo, clima de equipo).
- No linealidades e interacciones potenciales no
modeladas (p.ej., Horas_Extra × Viaje de Negocios).
- Estabilidad temporal: el fenómeno puede cambiar con políticas de RR.HH. (drift).
7.5 Recomendaciones para disminuir la rotación
- Gestionar horas extra: límites por persona/semana,
redistribución de cargas, refuerzos de dotación en picos.
- Política de viajes: rotación equitativa de
comisiones, mayor planificación, alternativas virtuales y compensaciones
claras.
- Ventas (foco prioritario): planes de retención
(onboarding reforzado, mentoring, comisiones/bonos ligados a
permanencia, rutas de carrera).
- Primeros años en el cargo: programa “primeros 24
meses” con seguimiento, coaching y movilidad interna.
- Satisfacción: intervenciones sobre reconocimiento,
feedback, desarrollo y clima del equipo.
- Distancia: esquemas híbridos/teletrabajo y flexibilidad horaria para trayectos largos.
7.6 Próximos pasos analíticos
- Validación continua: seguimiento mensual de AUC,
PPV, sensibilidad y calibración; retrain si se degrada.
- Cortes por costos/capacidad: usar 0.20 como
línea base y elevar a 0.30–0.40 si la intervención es
costosa o el cupo es limitado; priorizar top
deciles.
- Robustez del modelo: probar splines en numéricas y
interacciones sustantivas; considerar regularización
(lasso/elastic-net) si se amplía el set de predictores.
- Equidad: monitorear desempeño por subgrupos (género/área) para evitar sesgos.