Actividad 3 - Modelos Lineales Generalizados
Cristian Ríos Hernández
2025-09-29
Objetivo. Estimar un modelo logístico para explicar y predecir la rotación (y=1) a partir de variables laborales y demográficas, y proponer acciones de gestión sustentadas en evidencia.
1. Selección de variables e hipótesis
Variables categóricas (3):
Horas_Extra (
Si/No).
Hipótesis H1: quienes hacen horas extra tienen mayor probabilidad de rotar (fatiga y desgaste).Viaje de Negocios (
Raramente/Frecuentemente/Nunca).
H2: viajes frecuentes aumentan la rotación (costo personal) frente a raramente/nunca.Estado_Civil (
Soltero/Casado/Divorciado).
H3: personas solteras rotan más (menos restricciones familiares) que casadas.
Variables cuantitativas (3):
Antigüedad_Cargo (años en el cargo actual).
H4: mayor antigüedad en el cargo disminuye la rotación (mayor arraigo).Satisfación_Laboral (1–4).
H5: mayor satisfacción disminuye la rotación.Ingreso_Mensual (numérico).
H6: mayor ingreso disminuye la rotación (costo de oportunidad de irse).
vars_cat <- c("Horas_Extra", "Viaje de Negocios", "Estado_Civil")
vars_num <- c("Antigüedad_Cargo", "Satisfación_Laboral", "Ingreso_Mensual")
df_use <- df %>%
mutate(
across(all_of(vars_cat), as.factor),
y = factor(y, levels = c(0,1), labels = c("No rota","Sí rota"))
) %>%
select(y, all_of(vars_cat), all_of(vars_num))2. Análisis univariado (según tipo de variable)
A continuación se caracteriza la respuesta y los predictores por tipo.
2.1. Variable respuesta y (rotación)
df_use %>%
count(y) %>%
mutate(prop = n / sum(n)) %>%
gt() %>% fmt_percent(columns = prop, decimals = 1)| y | n | prop |
|---|---|---|
| No rota | 1233 | 83.9% |
| Sí rota | 237 | 16.1% |
ggplot(df_use, aes(x = y)) +
geom_bar() +
labs(title = "Distribución de la rotación", x = NULL, y = "Frecuencia")
La base presenta 16.1% de Sí rota, lo cual condiciona
el umbral de decisión más adelante.
2.2. Categóricas
for (v in vars_cat) {
p <- ggplot(df_use, aes(x = .data[[v]])) +
geom_bar() + labs(title = paste("Distribución de", v), x = NULL, y = "Frecuencia")
print(p)
}
2.3. Cuantitativas
df_use %>%
select(all_of(vars_num)) %>%
summary() %>%
capture.output() %>% cat(sep = "\n")## Antigüedad_Cargo Satisfación_Laboral Ingreso_Mensual
## Min. : 0.000 Min. :1.000 Min. : 1009
## 1st Qu.: 2.000 1st Qu.:2.000 1st Qu.: 2911
## Median : 3.000 Median :3.000 Median : 4919
## Mean : 4.229 Mean :2.729 Mean : 6503
## 3rd Qu.: 7.000 3rd Qu.:4.000 3rd Qu.: 8379
## Max. :18.000 Max. :4.000 Max. :19999# Histogramas
for (v in vars_num) {
p <- ggplot(df_use, aes(x = .data[[v]])) +
geom_histogram(bins = 30) +
labs(title = paste("Histograma de", v))
print(p)
}
# Boxplots por rotación
for (v in vars_num) {
p <- ggplot(df_use, aes(x = y, y = .data[[v]])) +
geom_boxplot() +
labs(title = paste(v, "por rotación"), x = NULL)
print(p)
}
3. Análisis bivariado (y ~ covariable)
Para cada variable se ajusta una regresión logística simple y reporta Odds Ratios (OR) con IC95%. OR>1 implica mayor probabilidad de rotar y OR<1 efecto protector.
3.1. Tablas y pruebas simples
# Categóricas: proporciones por rotación
for (v in vars_cat) {
cat("\n\n###", v, "\n")
tab <- table(df_use[[v]], df_use$y)
print(tab)
print(prop.table(tab, margin = 1))
}##
##
## ### Horas_Extra
##
## No rota Sí rota
## No 944 110
## Si 289 127
##
## No rota Sí rota
## No 0.8956357 0.1043643
## Si 0.6947115 0.3052885
##
##
## ### Viaje de Negocios
##
## No rota Sí rota
## Frecuentemente 208 69
## No_Viaja 138 12
## Raramente 887 156
##
## No rota Sí rota
## Frecuentemente 0.7509025 0.2490975
## No_Viaja 0.9200000 0.0800000
## Raramente 0.8504314 0.1495686
##
##
## ### Estado_Civil
##
## No rota Sí rota
## Casado 589 84
## Divorciado 294 33
## Soltero 350 120
##
## No rota Sí rota
## Casado 0.8751857 0.1248143
## Divorciado 0.8990826 0.1009174
## Soltero 0.7446809 0.25531913.2. Regresiones logísticas univariadas (odds ratio)
univars <- c(vars_cat, vars_num)
res_uni <- map_dfr(univars, function(v){
term <- if (make.names(v) != v) sprintf("`%s`", v) else v
f <- as.formula(paste("y ~", term))
m <- glm(f, data = df_use, family = binomial)
tidy(m, conf.int = TRUE, exponentiate = TRUE) %>%
mutate(variable = v)
})
res_uni %>%
mutate(term = gsub("`", "", term)) %>%
select(variable, term, estimate, conf.low, conf.high, p.value) %>%
arrange(variable, desc(abs(log(estimate)))) %>%
gt::gt() %>%
gt::fmt_number(columns = c(estimate, conf.low, conf.high), decimals = 3) %>%
gt::fmt_scientific(columns = p.value, decimals = 2) %>%
gt::cols_label(estimate="OR", conf.low="IC95% inf", conf.high="IC95% sup", p.value="p-valor"
)| variable | term | OR | IC95% inf | IC95% sup | p-valor |
|---|---|---|---|---|---|
| Antigüedad_Cargo | (Intercept) | 0.327 | 0.266 | 0.400 | 4.54 × 10−27 |
| Antigüedad_Cargo | Antigüedad_Cargo | 0.864 | 0.823 | 0.905 | 1.61 × 10−9 |
| Estado_Civil | (Intercept) | 0.143 | 0.113 | 0.178 | 1.33 × 10−62 |
| Estado_Civil | Estado_CivilSoltero | 2.404 | 1.769 | 3.281 | 2.54 × 10−8 |
| Estado_Civil | Estado_CivilDivorciado | 0.787 | 0.508 | 1.194 | 2.71 × 10−1 |
| Horas_Extra | (Intercept) | 0.117 | 0.095 | 0.141 | 5.05 × 10−101 |
| Horas_Extra | Horas_ExtraSi | 3.771 | 2.832 | 5.032 | 1.35 × 10−19 |
| Ingreso_Mensual | (Intercept) | 0.395 | 0.307 | 0.509 | 6.43 × 10−13 |
| Ingreso_Mensual | Ingreso_Mensual | 1.000 | 1.000 | 1.000 | 4.12 × 10−9 |
| Satisfación_Laboral | (Intercept) | 0.371 | 0.262 | 0.522 | 1.75 × 10−8 |
| Satisfación_Laboral | Satisfación_Laboral | 0.778 | 0.686 | 0.881 | 8.16 × 10−5 |
| Viaje de Negocios | Viaje de NegociosNo_Viaja | 0.262 | 0.131 | 0.485 | 5.36 × 10−5 |
| Viaje de Negocios | (Intercept) | 0.332 | 0.251 | 0.433 | 1.98 × 10−15 |
| Viaje de Negocios | Viaje de NegociosRaramente | 0.530 | 0.386 | 0.734 | 1.07 × 10−4 |
Interpretación del signo (en términos de OR):
- OR > 1: el nivel/valor se asocia con mayor probabilidad de rotar (apoya H1–H3 si positivo).
- OR < 1: el nivel/valor se asocia con menor probabilidad de rotar (apoya H4–H6 si negativo).
4. Estimación del modelo logístico multivariable
Se ajusta GLM con las 6 variables seleccionadas. Se codifican las categóricas con un nivel de referencia explícito (el primero alfabético salvo reordenación).
df_fit <- df_use %>%
mutate(
`Viaje de Negocios` = fct_relevel(`Viaje de Negocios`, "Nunca", "Raramente", "Frecuentemente"),
Estado_Civil = fct_relevel(Estado_Civil, "Casado"),
Horas_Extra = fct_relevel(Horas_Extra, "No")
)
form <- y ~ Horas_Extra + `Viaje de Negocios` + Estado_Civil +
Antigüedad_Cargo + Satisfación_Laboral + Ingreso_Mensual
m_glm <- glm(form, data = df_fit, family = binomial)
summary(m_glm)##
## Call:
## glm(formula = form, family = binomial, data = df_fit)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.528e-01 2.604e-01 -2.891 0.003839 **
## Horas_ExtraSi 1.480e+00 1.597e-01 9.269 < 2e-16 ***
## `Viaje de Negocios`Frecuentemente 6.932e-01 1.819e-01 3.811 0.000139 ***
## `Viaje de Negocios`No_Viaja -6.178e-01 3.342e-01 -1.848 0.064543 .
## Estado_CivilDivorciado -3.472e-01 2.322e-01 -1.495 0.134789
## Estado_CivilSoltero 8.615e-01 1.716e-01 5.021 5.13e-07 ***
## Antigüedad_Cargo -1.081e-01 2.730e-02 -3.959 7.52e-05 ***
## Satisfación_Laboral -3.342e-01 7.015e-02 -4.765 1.89e-06 ***
## Ingreso_Mensual -1.004e-04 2.316e-05 -4.335 1.46e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1298.6 on 1469 degrees of freedom
## Residual deviance: 1067.9 on 1461 degrees of freedom
## AIC: 1085.9
##
## Number of Fisher Scoring iterations: 54.1. Coeficientes, OR e importancia
coefs <- tidy(m_glm, conf.int = TRUE, exponentiate = TRUE) %>%
filter(term != "(Intercept)") %>%
arrange(desc(abs(log(estimate))))
coefs %>%
select(term, estimate, conf.low, conf.high, p.value) %>%
gt() %>%
fmt_number(columns = c(estimate, conf.low, conf.high), decimals = 3) %>%
fmt_scientific(columns = p.value, decimals = 2) %>%
cols_label(
term="Termino", estimate="OR", conf.low="IC95% inf", conf.high="IC95% sup", p.value="p-valor"
)| Termino | OR | IC95% inf | IC95% sup | p-valor |
|---|---|---|---|---|
| Horas_ExtraSi | 4.393 | 3.218 | 6.021 | 1.87 × 10−20 |
| Estado_CivilSoltero | 2.367 | 1.694 | 3.321 | 5.13 × 10−7 |
| `Viaje de Negocios`Frecuentemente | 2.000 | 1.396 | 2.851 | 1.39 × 10−4 |
| `Viaje de Negocios`No_Viaja | 0.539 | 0.267 | 1.000 | 6.45 × 10−2 |
| Estado_CivilDivorciado | 0.707 | 0.443 | 1.104 | 1.35 × 10−1 |
| Satisfación_Laboral | 0.716 | 0.623 | 0.821 | 1.89 × 10−6 |
| Antigüedad_Cargo | 0.898 | 0.850 | 0.946 | 7.52 × 10−5 |
| Ingreso_Mensual | 1.000 | 1.000 | 1.000 | 1.46 × 10−5 |
- OR > 1 implica aumento de odds de rotar por unidad (numéricas) o
frente al nivel de referencia (categóricas).
- Significancia: p-valor < 0.05 (o < 0.1 según criterio) indica evidencia de asociación, manteniendo control por las demás covariables.
5. Evaluación predictiva (ROC y AUC)
Se realiza un holdout 70/30 estratificado para evaluar AUC fuera de muestra.
# Split estratificado con caret
set.seed(123)
idx <- createDataPartition(df_fit$y, p = 0.7, list = FALSE)
train <- df_fit[idx, ]
test <- df_fit[-idx, ]
m_glm_cv <- glm(form, data = train, family = binomial)
# Predicciones prob en test
test$prob <- predict(m_glm_cv, newdata = test, type = "response")
# ROC/AUC
roc_obj <- pROC::roc(
response = test$y, # factor con niveles "No rota","Sí rota"
predictor = test$prob,
levels = c("No rota", "Sí rota"), # ← verifica que estén así
direction = "<"
)
auc_val <- pROC::auc(roc_obj)
plot(roc_obj, main = paste0("ROC en test (AUC = ", round(auc_val, 3), ")"))
6. Umbral de decisión y predicción para individuo hipotético
Se define el corte óptimo por Youden J y se evalúa matriz de confusión. Luego se predice un caso hipotético.
coords_best <- pROC::coords(
roc_obj, "best",
ret = c("threshold","sensitivity","specificity"),
best.method = "youden"
)
threshold <- as.numeric(coords_best["threshold"])
test$pred <- factor(
ifelse(test$prob >= threshold, "Sí rota", "No rota"),
levels = levels(test$y) # ← mismo orden que test$y
)
caret::confusionMatrix(test$pred, test$y, positive = "Sí rota")## Confusion Matrix and Statistics
##
## Reference
## Prediction No rota Sí rota
## No rota 267 20
## Sí rota 102 51
##
## Accuracy : 0.7227
## 95% CI : (0.6784, 0.7641)
## No Information Rate : 0.8386
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.3014
##
## Mcnemar's Test P-Value : 2.244e-13
##
## Sensitivity : 0.7183
## Specificity : 0.7236
## Pos Pred Value : 0.3333
## Neg Pred Value : 0.9303
## Prevalence : 0.1614
## Detection Rate : 0.1159
## Detection Prevalence : 0.3477
## Balanced Accuracy : 0.7209
##
## 'Positive' Class : Sí rota
## # Individuo hipotético
nuevo <- tibble(
Horas_Extra = factor("Si", levels = levels(df_fit$Horas_Extra)),
`Viaje de Negocios` = factor("Frecuentemente", levels = levels(df_fit$`Viaje de Negocios`)),
Estado_Civil = factor("Soltero", levels = levels(df_fit$Estado_Civil)),
Antigüedad_Cargo = 1,
Satisfación_Laboral = 2,
Ingreso_Mensual = 3500
)
prob_nuevo <- predict(m_glm_cv, newdata = nuevo, type = "response")
decision <- ifelse(prob_nuevo >= threshold, "Intervenir (alto riesgo)", "No intervenir (bajo/moderado riesgo)")
gt::gt(data.frame(Probabilidad = prob_nuevo, Umbral = threshold, Decision = decision))| Probabilidad | Umbral | Decision |
|---|---|---|
| 0.7914376 | 0.1634485 | Intervenir (alto riesgo) |
Criterio de intervención. Usaré la regla de decisión: intervenir cuando la probabilidad estimada sea mayor o igual que el umbral obtenido con el índice de Youden (punto que maximiza sensibilidad + especificidad).
Si a la empresa le preocupa más no detectar a alguien que va a rotar (alto costo de falsos negativos), baje el umbral para aumentar la sensibilidad.
Si le preocupa más intervenir innecesariamente (alto costo de falsos positivos), suba el umbral para aumentar la especificidad.
7. Conclusiones
Los resultados confirman que la probabilidad de rotación aumenta con Horas_Extra = “Sí”, Viaje de Negocios “Frecuentemente” y Estado_Civil “Soltero”, y disminuye con mayor Antigüedad_Cargo, Satisfación_Laboral e Ingreso_Mensual. El modelo multivariable mantiene estos efectos (OR e IC95% significativos), y su poder predictivo es aceptable (AUC = 0.77). Para la toma de decisiones utilizo la regla: intervenir si probabilidad ≥ umbral de Youden (ajustable según costos de falsos negativos/positivos). Como estrategia, propongo redistribuir horas extra, alternar/compensar viajes, fortalecer clima y reconocimiento y revisar bandas salariales, focalizando acciones en los perfiles de mayor riesgo según el modelo.