Natalia Zartha Suarez
Sara Isabela Salinas Gómez
Victor Hugo Perilla Martinez
Profesora: Delia Ortega Lenis
La rotación de empleados es un fenómeno de clasificación binaria: para cada trabajador interesa estimar la probabilidad de que ocurra el evento rotación frente a la alternativa no rotación. En este informe se utiliza un modelo de regresión logística binomial para estudiar seis covariables seleccionadas a priori, cuantificar su asociación con la rotación y evaluar la capacidad predictiva del modelo.
El análisis se diseñó con dos propósitos complementarios:
Un aspecto central del informe será diferenciar cuidadosamente tres escalas de interpretación del modelo logístico:
data("rotacion", package = "paqueteMODELOS")
datosOriginales <- rotacion
datos <- datosOriginales |>
janitor::clean_names()
dimensiones <- tibble(
Registros = nrow(datos),
Variables = ncol(datos)
)
tablaHtml(dimensiones, "Dimensiones de la base de datos", digitos = 0)
| Registros | Variables |
|---|---|
| 1470 | 24 |
diccionarioInicial <- tibble(
Variable = names(datos),
Clase_R = vapply(datos, function(x) class(x)[1], character(1)),
Faltantes = vapply(datos, function(x) sum(is.na(x)), numeric(1)),
PorcentajeFaltantes = vapply(
datos,
function(x) mean(is.na(x)),
numeric(1)
)
)
tablaHtml(
diccionarioInicial,
"Estructura de variables y valores faltantes",
digitos = 3
)
| Variable | Clase_R | Faltantes | PorcentajeFaltantes |
|---|---|---|---|
| rotacion | character | 0 | 0 |
| edad | numeric | 0 | 0 |
| viaje_de_negocios | character | 0 | 0 |
| departamento | character | 0 | 0 |
| distancia_casa | numeric | 0 | 0 |
| educacion | numeric | 0 | 0 |
| campo_educacion | character | 0 | 0 |
| satisfaccion_ambiental | numeric | 0 | 0 |
| genero | character | 0 | 0 |
| cargo | character | 0 | 0 |
| satisfacion_laboral | numeric | 0 | 0 |
| estado_civil | character | 0 | 0 |
| ingreso_mensual | numeric | 0 | 0 |
| trabajos_anteriores | numeric | 0 | 0 |
| horas_extra | character | 0 | 0 |
| porcentaje_aumento_salarial | numeric | 0 | 0 |
| rendimiento_laboral | numeric | 0 | 0 |
| anos_experiencia | numeric | 0 | 0 |
| capacitaciones | numeric | 0 | 0 |
| equilibrio_trabajo_vida | numeric | 0 | 0 |
| antiguedad | numeric | 0 | 0 |
| antiguedad_cargo | numeric | 0 | 0 |
| anos_ultima_promocion | numeric | 0 | 0 |
| anos_acargo_con_mismo_jefe | numeric | 0 | 0 |
La actividad define el evento de interés como \(Y=1\) cuando existe rotación y \(Y=0\) cuando no existe rotación. Se conserva esta codificación durante todo el análisis.
Las demás variables categóricas se especifican a continuación y para conocer por qué se seleccionaron se crearon las hipótesis expuestas en la sección [3.2 Variables categóricas seleccionadas].
# Verificación de nombres requeridos
variablesRequeridas <- c(
"rotacion",
"horas_extra",
"viaje_de_negocios",
"estado_civil",
"edad",
"ingreso_mensual",
"antiguedad_cargo"
)
faltantesNombres <- setdiff(variablesRequeridas, names(datos))
if (length(faltantesNombres) > 0) {
stop(
paste0(
"No se encontraron las siguientes variables después de clean_names(): ",
paste(faltantesNombres, collapse = ", "),
". Revise names(datos)."
)
)
}
# Codificación robusta de la respuesta binaria
rotacionTexto <- stringr::str_to_lower(
stringr::str_squish(as.character(datos$rotacion))
)
datos <- datos |>
mutate(
rotacion = case_when(
rotacionTexto %in% c("si", "sí", "yes", "1", "true") ~ 1L,
rotacionTexto %in% c("no", "0", "false") ~ 0L,
TRUE ~ NA_integer_
)
)
if (any(is.na(datos$rotacion))) {
stop("Existen valores de rotación que no pudieron codificarse como 0/1.")
}
# Factores seleccionados
datos <- datos |>
mutate(
horas_extra = relevelPatron(horas_extra, c("^no$", "no")),
viaje_de_negocios = relevelPatron(
viaje_de_negocios,
c("no.*via", "sin.*via", "non.*travel")
),
estado_civil = relevelPatron(
estado_civil,
c("^casad", "married")
),
rotacion_f = factor(
ifelse(rotacion == 1, "Sí", "No"),
levels = c("No", "Sí")
)
)
variablesCategoricas <- c(
"horas_extra",
"viaje_de_negocios",
"estado_civil"
)
variablesCuantitativas <- c(
"edad",
"ingreso_mensual",
"antiguedad_cargo"
)
variablesSeleccionadas <- c(
variablesCategoricas,
variablesCuantitativas
)
tablaNiveles <- purrr::map_dfr(
variablesCategoricas,
function(v) {
tibble(
Variable = nombreBonito(v),
Nivel = levels(datos[[v]]),
Referencia = levels(datos[[v]])[1]
)
}
)
tablaHtml(
tablaNiveles,
"Niveles de las variables categóricas y categorías de referencia",
digitos = 0
)
| Variable | Nivel | Referencia |
|---|---|---|
| Horas extra | No | No |
| Horas extra | Si | No |
| Viaje de negocios | No_Viaja | No_Viaja |
| Viaje de negocios | Frecuentemente | No_Viaja |
| Viaje de negocios | Raramente | No_Viaja |
| Estado civil | Casado | Casado |
| Estado civil | Divorciado | Casado |
| Estado civil | Soltero | Casado |
Antes de estimar cualquier modelo se revisan los aspectos que podrían comprometer la calidad del análisis: valores faltantes, duplicados, tipos de variables, categorías poco representadas, valores imposibles y observaciones extremas. Esta etapa es especialmente importante porque una regresión logística puede ser sensible a errores de codificación, categorías escasas y observaciones con alta influencia.
La auditoría se separa de las decisiones de modelado. Detectar una observación extrema no implica eliminarla. Solo se modificaría o excluiría un registro si existiera evidencia de error de captura o si estuviera fuera de la población objetivo. De igual forma, cualquier transformación aprendida a partir de los datos —por ejemplo, una imputación o un escalamiento— debería estimarse únicamente en entrenamiento y aplicarse después a prueba para evitar data leakage.
auditoriaSeleccionadas <- tibble(
Variable = c("Rotación", sapply(variablesSeleccionadas, nombreBonito)),
Faltantes = c(
sum(is.na(datos$rotacion)),
sapply(variablesSeleccionadas, function(v) sum(is.na(datos[[v]])))
),
PorcentajeFaltantes = c(
mean(is.na(datos$rotacion)),
sapply(variablesSeleccionadas, function(v) mean(is.na(datos[[v]])))
),
ValoresUnicos = c(
dplyr::n_distinct(datos$rotacion),
sapply(variablesSeleccionadas, function(v) dplyr::n_distinct(datos[[v]]))
)
)
duplicadosCompletos <- sum(duplicated(datos))
tablaHtml(
auditoriaSeleccionadas,
"Auditoría de faltantes y cardinalidad de las variables utilizadas",
digitos = 4
)
| Variable | Faltantes | PorcentajeFaltantes | ValoresUnicos |
|---|---|---|---|
| Rotación | 0 | 0 | 2 |
| Horas extra | 0 | 0 | 2 |
| Viaje de negocios | 0 | 0 | 3 |
| Estado civil | 0 | 0 | 3 |
| Edad | 0 | 0 | 43 |
| Ingreso mensual | 0 | 0 | 1349 |
| Antigüedad en el cargo | 0 | 0 | 19 |
cat(
"\n\nLa base contiene **", duplicadosCompletos,
"** filas completamente duplicadas. ",
ifelse(
duplicadosCompletos == 0,
"No se requiere ninguna acción por duplicados completos.",
"Los duplicados se reportan para revisión y no se eliminan automáticamente sin verificar si representan empleados diferentes."
),
"\n",
sep = ""
)
##
##
## La base contiene **0** filas completamente duplicadas. No se requiere ninguna acción por duplicados completos.
totalFaltantesModelo <- sum(auditoriaSeleccionadas$Faltantes)
if (totalFaltantesModelo == 0) {
cat(
"**Decisión de preprocesamiento:** las siete variables que intervienen en el modelo ",
"no presentan valores faltantes. Por tanto, **no se realiza imputación** y no se pierde ",
"ningún registro por ausencia de información. Esta es la opción metodológicamente más limpia: ",
"no existe razón para introducir valores estimados cuando los datos requeridos están completos.\n"
)
} else {
cat(
"**Decisión de preprocesamiento:** se identifican ", totalFaltantesModelo,
" valores faltantes en las variables del modelo. Cualquier estrategia de imputación deberá ",
"estimarse únicamente con entrenamiento y posteriormente aplicarse a prueba para evitar fuga de información.\n",
sep = ""
)
}
Decisión de preprocesamiento: las siete variables que intervienen en el modelo no presentan valores faltantes. Por tanto, no se realiza imputación y no se pierde ningún registro por ausencia de información. Esta es la opción metodológicamente más limpia: no existe razón para introducir valores estimados cuando los datos requeridos están completos.
Además de buscar NA, se verifican reglas básicas de
plausibilidad. Un dato puede no estar ausente y aun así ser inválido;
por ejemplo, una edad no positiva o un ingreso mensual menor o igual a
cero.
tablaRangosLogicos <- auditarRangosLogicos(datos)
tablaHtml(
tablaRangosLogicos,
"Validaciones de coherencia lógica",
digitos = 0
)
| Regla | Incumplimientos |
|---|---|
| Edad > 0 | 0 |
| Ingreso mensual > 0 | 0 |
| Antigüedad en el cargo >= 0 | 0 |
| Antigüedad en el cargo <= edad | 0 |
cat(
"\n\nEn total se detectan **",
sum(tablaRangosLogicos$Incumplimientos),
"** incumplimientos de las reglas lógicas evaluadas. ",
"Si este número es cero, no se requiere corrección por valores imposibles en las variables seleccionadas.\n",
sep = ""
)
##
##
## En total se detectan **0** incumplimientos de las reglas lógicas evaluadas. Si este número es cero, no se requiere corrección por valores imposibles en las variables seleccionadas.
Las categorías con muy pocos registros pueden producir coeficientes inestables y errores estándar grandes. Por ello se revisa la frecuencia absoluta y relativa de cada nivel antes de ajustar el modelo.
frecuenciaNiveles <- tablaNivelesMinimos(
datos,
variablesCategoricas
)
tablaHtml(
frecuenciaNiveles,
"Frecuencia y proporción de cada nivel categórico",
digitos = 4
)
| Variable | Nivel | N | Porcentaje |
|---|---|---|---|
| Horas extra | No | 1054 | 0.7170 |
| Horas extra | Si | 416 | 0.2830 |
| Viaje de negocios | No_Viaja | 150 | 0.1020 |
| Viaje de negocios | Frecuentemente | 277 | 0.1884 |
| Viaje de negocios | Raramente | 1043 | 0.7095 |
| Estado civil | Casado | 673 | 0.4578 |
| Estado civil | Divorciado | 327 | 0.2224 |
| Estado civil | Soltero | 470 | 0.3197 |
nivelesEscasos <- frecuenciaNiveles |>
filter(N < 30 | Porcentaje < 0.02)
if (nrow(nivelesEscasos) == 0) {
cat(
"\n\nNo se identifican niveles con menos de 30 observaciones ni con una frecuencia inferior al 2%. ",
"Por tanto, no se agrupan categorías únicamente por escasez muestral.\n"
)
} else {
cat(
"\n\nSe identifican niveles potencialmente escasos. Deben revisarse antes de interpretar ",
"sus coeficientes, pero no se agrupan automáticamente porque hacerlo modificaría el significado de la variable.\n"
)
}
##
##
## No se identifican niveles con menos de 30 observaciones ni con una frecuencia inferior al 2%. Por tanto, no se agrupan categorías únicamente por escasez muestral.
Para las variables cuantitativas se emplea la regla de Tukey \(1.5\times IQR\). Esta regla sirve para detectar valores alejados de la parte central de la distribución, no para demostrar que sean errores. En variables como ingreso o antigüedad es perfectamente posible encontrar valores extremos válidos.
atipicosIQRCompleto <- auditarAtipicosIQR(
datos,
variablesCuantitativas
)
tablaHtml(
atipicosIQRCompleto,
"Detección descriptiva de valores atípicos mediante 1,5 × IQR",
digitos = 3
)
| Variable | Q1 | Q3 | IQR | LimiteInferior | LimiteSuperior | N_Atipicos_IQR | Porcentaje_Atipicos_IQR |
|---|---|---|---|---|---|---|---|
| Edad | 30 | 43 | 13 | 10.5 | 62.5 | 0 | 0.000 |
| Ingreso mensual | 2911 | 8379 | 5468 | -5291.0 | 16581.0 | 114 | 0.078 |
| Antigüedad en el cargo | 2 | 7 | 5 | -5.5 | 14.5 | 21 | 0.014 |
cat(
"La regla IQR identifica valores extremos potenciales, pero **no se elimina ninguna observación en esta etapa**. ",
"La decisión se complementará posteriormente con residuales, leverage y distancia de Cook del modelo logístico. ",
"Eliminar observaciones únicamente por estar fuera de los bigotes de un boxplot podría sesgar la muestra y reducir ",
"la capacidad del modelo para representar empleados reales con perfiles poco frecuentes.\n"
)
La regla IQR identifica valores extremos potenciales, pero no se elimina ninguna observación en esta etapa. La decisión se complementará posteriormente con residuales, leverage y distancia de Cook del modelo logístico. Eliminar observaciones únicamente por estar fuera de los bigotes de un boxplot podría sesgar la muestra y reducir la capacidad del modelo para representar empleados reales con perfiles poco frecuentes.
cat("**Interpretación de la auditoría de valores extremos.** ")
Interpretación de la auditoría de valores extremos.
for (i in seq_len(nrow(atipicosIQRCompleto))) {
f <- atipicosIQRCompleto[i, ]
cat(
"**", f$Variable, "** presenta **",
f$N_Atipicos_IQR, "** observaciones (",
formatearPorcentaje(f$Porcentaje_Atipicos_IQR, 1),
") fuera de los límites de Tukey; ",
sep = ""
)
}
Edad presenta 0 observaciones (0,0%) fuera de los límites de Tukey; Ingreso mensual presenta 114 observaciones (7,8%) fuera de los límites de Tukey; Antigüedad en el cargo presenta 21 observaciones (1,4%) fuera de los límites de Tukey;
cat(
"estos registros se conservan porque no incumplen las reglas lógicas definidas y pueden representar ",
"empleados reales. En particular, un ingreso alto o una antigüedad elevada no constituyen errores por sí mismos. ",
"La decisión se completa más adelante con medidas de influencia del modelo.\\n"
)
estos registros se conservan porque no incumplen las reglas lógicas definidas y pueden representar empleados reales. En particular, un ingreso alto o una antigüedad elevada no constituyen errores por sí mismos. La decisión se completa más adelante con medidas de influencia del modelo.
A partir de la auditoría anterior, el flujo de preparación queda definido de la siguiente manera:
rotacion como 0
= No y 1 = Sí.La selección se realiza antes de observar la significancia estadística, con el fin de evitar escoger predictores únicamente porque producen valores \(p\) pequeños. Se eligen tres variables categóricas y tres cuantitativas por su plausibilidad sustantiva y por su posible relación con desgaste laboral, movilidad, estabilidad y permanencia en el cargo.
hipotesis <- tribble(
~Tipo, ~Variable, ~Justificacion, ~Hipotesis,
"Categórica", "Horas extra",
"Trabajar horas adicionales puede aumentar la carga y el desgaste, reduciendo el equilibrio entre vida personal y trabajo.",
"Se espera una mayor probabilidad de rotación entre quienes realizan horas extra frente a quienes no las realizan.",
"Categórica", "Viaje de negocios",
"Una mayor frecuencia de viajes puede aumentar las exigencias del cargo y alterar rutinas personales y familiares.",
"Se espera que los niveles de viaje más frecuentes presenten mayor probabilidad de rotación que la categoría de menor movilidad.",
"Categórica", "Estado civil",
"El estado civil puede estar relacionado con restricciones de movilidad, redes de apoyo y decisiones de estabilidad laboral.",
"Se plantea que la probabilidad de rotación puede diferir entre los estados civiles; de manera exploratoria se espera mayor movilidad en empleados solteros.",
"Cuantitativa", "Edad",
"La edad puede aproximar etapa de carrera y estabilidad laboral acumulada.",
"Se espera que, al aumentar la edad, disminuya la probabilidad de rotación.",
"Cuantitativa", "Ingreso mensual",
"Una mayor remuneración puede aumentar el costo de oportunidad de abandonar el cargo actual.",
"Se espera que mayores ingresos mensuales se asocien con menor probabilidad de rotación.",
"Cuantitativa", "Antigüedad en el cargo",
"Una mayor permanencia en el cargo puede reflejar estabilidad, adaptación y acumulación de capital específico dentro de la organización.",
"Se espera que una mayor antigüedad en el cargo se asocie con menor probabilidad de rotación."
)
tablaHtml(
hipotesis,
"Variables seleccionadas, justificación e hipótesis",
digitos = 0,
alto = "560px"
)
| Tipo | Variable | Justificacion | Hipotesis |
|---|---|---|---|
| Categórica | Horas extra | Trabajar horas adicionales puede aumentar la carga y el desgaste, reduciendo el equilibrio entre vida personal y trabajo. | Se espera una mayor probabilidad de rotación entre quienes realizan horas extra frente a quienes no las realizan. |
| Categórica | Viaje de negocios | Una mayor frecuencia de viajes puede aumentar las exigencias del cargo y alterar rutinas personales y familiares. | Se espera que los niveles de viaje más frecuentes presenten mayor probabilidad de rotación que la categoría de menor movilidad. |
| Categórica | Estado civil | El estado civil puede estar relacionado con restricciones de movilidad, redes de apoyo y decisiones de estabilidad laboral. | Se plantea que la probabilidad de rotación puede diferir entre los estados civiles; de manera exploratoria se espera mayor movilidad en empleados solteros. |
| Cuantitativa | Edad | La edad puede aproximar etapa de carrera y estabilidad laboral acumulada. | Se espera que, al aumentar la edad, disminuya la probabilidad de rotación. |
| Cuantitativa | Ingreso mensual | Una mayor remuneración puede aumentar el costo de oportunidad de abandonar el cargo actual. | Se espera que mayores ingresos mensuales se asocien con menor probabilidad de rotación. |
| Cuantitativa | Antigüedad en el cargo | Una mayor permanencia en el cargo puede reflejar estabilidad, adaptación y acumulación de capital específico dentro de la organización. | Se espera que una mayor antigüedad en el cargo se asocie con menor probabilidad de rotación. |
tablaRotacion <- datos |>
count(rotacion_f, name = "Frecuencia") |>
mutate(
Porcentaje = Frecuencia / sum(Frecuencia)
)
tablaHtml(
tablaRotacion,
"Distribución de la variable respuesta",
digitos = 3
)
| rotacion_f | Frecuencia | Porcentaje |
|---|---|---|
| No | 1233 | 0.839 |
| Sí | 237 | 0.161 |
ggplot(tablaRotacion, aes(x = rotacion_f, y = Frecuencia)) +
geom_col() +
geom_text(
aes(label = paste0(Frecuencia, "\n", scales::percent(Porcentaje, accuracy = 0.1))),
vjust = -0.25
) +
labs(
title = "Distribución de la rotación de empleados",
x = "Rotación",
y = "Número de empleados"
) +
theme_minimal(base_size = 12) +
expand_limits(y = max(tablaRotacion$Frecuencia) * 1.10)
tasaRotacion <- mean(datos$rotacion == 1)
cat(
"La proporción observada de empleados con rotación es **",
formatearPorcentaje(tasaRotacion, 1),
"**. Esta prevalencia debe tenerse presente al interpretar la exactitud: ",
"si la clase positiva es minoritaria, un modelo puede alcanzar una exactitud aparentemente alta ",
"prediciendo con mucha frecuencia la clase mayoritaria. Por esta razón, más adelante se reportan ",
"sensibilidad, especificidad, precisión, VPN, F1, balanced accuracy y AUC.\n",
sep = ""
)
La proporción observada de empleados con rotación es 16,1%. Esta prevalencia debe tenerse presente al interpretar la exactitud: si la clase positiva es minoritaria, un modelo puede alcanzar una exactitud aparentemente alta prediciendo con mucha frecuencia la clase mayoritaria. Por esta razón, más adelante se reportan sensibilidad, especificidad, precisión, VPN, F1, balanced accuracy y AUC.
tablaCatUni <- purrr::map_dfr(
variablesCategoricas,
function(v) {
datos |>
count(.data[[v]], name = "Frecuencia") |>
mutate(
Porcentaje = Frecuencia / sum(Frecuencia),
Variable = nombreBonito(v),
Nivel = as.character(.data[[v]])
) |>
select(Variable, Nivel, Frecuencia, Porcentaje)
}
)
tablaHtml(
tablaCatUni,
"Distribución de las variables categóricas seleccionadas",
digitos = 3
)
| Variable | Nivel | Frecuencia | Porcentaje |
|---|---|---|---|
| Horas extra | No | 1054 | 0.717 |
| Horas extra | Si | 416 | 0.283 |
| Viaje de negocios | No_Viaja | 150 | 0.102 |
| Viaje de negocios | Frecuentemente | 277 | 0.188 |
| Viaje de negocios | Raramente | 1043 | 0.710 |
| Estado civil | Casado | 673 | 0.458 |
| Estado civil | Divorciado | 327 | 0.222 |
| Estado civil | Soltero | 470 | 0.320 |
for (v in variablesCategoricas) {
grafico <- datos |>
count(.data[[v]]) |>
mutate(Porcentaje = n / sum(n)) |>
ggplot(aes(x = .data[[v]], y = n)) +
geom_col() +
geom_text(
aes(label = scales::percent(Porcentaje, accuracy = 0.1)),
vjust = -0.25
) +
labs(
title = paste("Distribución de", nombreBonito(v)),
x = nombreBonito(v),
y = "Frecuencia"
) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 20, hjust = 1)) +
expand_limits(y = max(table(datos[[v]])) * 1.12)
print(grafico)
}
cat("**Lectura de las variables categóricas.**\n\n")
Lectura de las variables categóricas.
for (v in variablesCategoricas) {
frec <- datos |>
count(.data[[v]], name = "N") |>
mutate(Porcentaje = N / sum(N)) |>
arrange(desc(N))
cat(
"- **", nombreBonito(v), ":** el nivel más frecuente es **",
as.character(frec[[v]][1]), "** con **",
frec$N[1], "** empleados (",
formatearPorcentaje(frec$Porcentaje[1], 1),
"). Se observan **", nrow(frec),
"** categorías. Esta composición es relevante porque los niveles con menor frecuencia ",
"tendrán estimaciones menos precisas que los niveles muy representados.\n",
sep = ""
)
}
tablaCuantUni <- purrr::map_dfr(
variablesCuantitativas,
function(v) {
x <- datos[[v]]
tibble(
Variable = nombreBonito(v),
N = sum(!is.na(x)),
Media = mean(x, na.rm = TRUE),
Desviacion = sd(x, na.rm = TRUE),
Minimo = min(x, na.rm = TRUE),
Q1 = quantile(x, 0.25, na.rm = TRUE),
Mediana = median(x, na.rm = TRUE),
Q3 = quantile(x, 0.75, na.rm = TRUE),
Maximo = max(x, na.rm = TRUE),
IQR = IQR(x, na.rm = TRUE)
)
}
)
tablaHtml(
tablaCuantUni,
"Resumen descriptivo de las variables cuantitativas",
digitos = 2
)
| Variable | N | Media | Desviacion | Minimo | Q1 | Mediana | Q3 | Maximo | IQR |
|---|---|---|---|---|---|---|---|---|---|
| Edad | 1470 | 36.92 | 9.14 | 18 | 30 | 36 | 43 | 60 | 13 |
| Ingreso mensual | 1470 | 6502.93 | 4707.96 | 1009 | 2911 | 4919 | 8379 | 19999 | 5468 |
| Antigüedad en el cargo | 1470 | 4.23 | 3.62 | 0 | 2 | 3 | 7 | 18 | 5 |
for (v in variablesCuantitativas) {
g1 <- ggplot(datos, aes(x = .data[[v]])) +
geom_histogram(bins = 30) +
labs(
title = paste("Histograma de", nombreBonito(v)),
x = nombreBonito(v),
y = "Frecuencia"
) +
theme_minimal(base_size = 12)
g2 <- ggplot(datos, aes(y = .data[[v]])) +
geom_boxplot() +
labs(
title = paste("Boxplot de", nombreBonito(v)),
x = NULL,
y = nombreBonito(v)
) +
theme_minimal(base_size = 12)
print(g1)
print(g2)
}
cat("**Lectura de las variables cuantitativas.**\n\n")
Lectura de las variables cuantitativas.
for (i in seq_len(nrow(tablaCuantUni))) {
f <- tablaCuantUni[i, ]
forma <- ifelse(
f$Media > f$Mediana * 1.05,
"la media supera a la mediana, lo que sugiere una cola hacia valores altos",
ifelse(
f$Media < f$Mediana * 0.95,
"la media es inferior a la mediana, lo que sugiere una cola hacia valores bajos",
"media y mediana son cercanas y no se aprecia una asimetría marcada mediante este criterio descriptivo"
)
)
cat(
"- **", f$Variable, ":** mediana = **",
formatearNumero(f$Mediana, 1), "**, IQR = **",
formatearNumero(f$IQR, 1), "** y rango [",
formatearNumero(f$Minimo, 1), ", ",
formatearNumero(f$Maximo, 1), "]. ",
forma, ".\n",
sep = ""
)
}
Para evitar evaluar el modelo con los mismos datos utilizados para estimar los coeficientes, se realiza una división estratificada 70% entrenamiento y 30% prueba. La selección de las seis variables ya fue fijada por hipótesis antes de esta separación; por tanto, los resultados de prueba no se utilizan para seleccionar predictores ni para escoger el punto de corte.
datosModelo <- datos |>
select(
rotacion, rotacion_f,
all_of(variablesSeleccionadas)
) |>
tidyr::drop_na()
set.seed(SEMILLA)
indiceTrain <- caret::createDataPartition(
datosModelo$rotacion_f,
p = 0.70,
list = FALSE
)
train <- datosModelo[indiceTrain, , drop = FALSE]
test <- datosModelo[-indiceTrain, , drop = FALSE]
resumenParticion <- tibble(
Muestra = c("Total utilizable", "Entrenamiento", "Prueba"),
N = c(nrow(datosModelo), nrow(train), nrow(test)),
TasaRotacion = c(
mean(datosModelo$rotacion),
mean(train$rotacion),
mean(test$rotacion)
)
)
tablaHtml(
resumenParticion,
"Tamaño y prevalencia por partición",
digitos = 3
)
| Muestra | N | TasaRotacion |
|---|---|---|
| Total utilizable | 1470 | 0.161 |
| Entrenamiento | 1030 | 0.161 |
| Prueba | 440 | 0.161 |
La partición es estratificada para mantener aproximadamente la misma proporción de rotación en entrenamiento y prueba. A partir de este momento, la muestra de prueba no se utiliza para seleccionar variables, ajustar coeficientes, estudiar significancia ni escoger el punto de corte.
Como control adicional, los límites de valores extremos se calculan en entrenamiento y se verifica cuántos registros de prueba quedan fuera de esos límites. No se recortan ni winsorizan valores; esta tabla solo documenta la estabilidad de los rangos.
limitesTrain <- purrr::map_dfr(
variablesCuantitativas,
function(v) {
x <- train[[v]]
q1 <- quantile(x, 0.25, na.rm = TRUE)
q3 <- quantile(x, 0.75, na.rm = TRUE)
iqr <- IQR(x, na.rm = TRUE)
li <- q1 - 1.5 * iqr
ls <- q3 + 1.5 * iqr
tibble(
Variable = nombreBonito(v),
LimiteInferiorTrain = as.numeric(li),
LimiteSuperiorTrain = as.numeric(ls),
AtipicosTrain = sum(x < li | x > ls, na.rm = TRUE),
AtipicosTestSegunTrain = sum(
test[[v]] < li | test[[v]] > ls,
na.rm = TRUE
)
)
}
)
tablaHtml(
limitesTrain,
"Valores extremos usando límites aprendidos exclusivamente en entrenamiento",
digitos = 3
)
| Variable | LimiteInferiorTrain | LimiteSuperiorTrain | AtipicosTrain | AtipicosTestSegunTrain |
|---|---|---|---|---|
| Edad | 10.50 | 62.50 | 0 | 0 |
| Ingreso mensual | -4732.75 | 15801.25 | 92 | 36 |
| Antigüedad en el cargo | -5.50 | 14.50 | 18 | 3 |
cat(
"La tasa de rotación es **",
formatearPorcentaje(mean(train$rotacion), 1),
"** en entrenamiento y **",
formatearPorcentaje(mean(test$rotacion), 1),
"** en prueba. La cercanía entre ambas proporciones confirma que la partición estratificada ",
"preserva adecuadamente la composición de la variable respuesta. ",
"Como no existen faltantes en las variables seleccionadas, no fue necesario ajustar imputadores. ",
"Tampoco se estandarizan las variables porque se desea conservar interpretaciones en unidades originales.\n",
sep = ""
)
La tasa de rotación es 16,1% en entrenamiento y 16,1% en prueba. La cercanía entre ambas proporciones confirma que la partición estratificada preserva adecuadamente la composición de la variable respuesta. Como no existen faltantes en las variables seleccionadas, no fue necesario ajustar imputadores. Tampoco se estandarizan las variables porque se desea conservar interpretaciones en unidades originales.
El análisis bivariado se realiza solo con la muestra de entrenamiento, porque sus resultados forman parte de la etapa de comprensión y estimación del modelo. La muestra de prueba se reserva para evaluar el poder predictivo final.
## <table class="table table-striped table-hover table-condensed table-responsive" style="width: auto !important; margin-left: auto; margin-right: auto;">
## <caption>Rotación según Horas extra</caption>
## <thead>
## <tr>
## <th style="text-align:center;"> Nivel </th>
## <th style="text-align:center;"> rotacion_f </th>
## <th style="text-align:center;"> Frecuencia </th>
## <th style="text-align:center;"> PorcentajeDentroNivel </th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 661 </td>
## <td style="text-align:center;"> 0.897 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 76 </td>
## <td style="text-align:center;"> 0.103 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Si </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 203 </td>
## <td style="text-align:center;"> 0.693 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Si </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 90 </td>
## <td style="text-align:center;"> 0.307 </td>
## </tr>
## </tbody>
## </table><table class="table table-striped table-hover table-condensed table-responsive" style="width: auto !important; margin-left: auto; margin-right: auto;">
## <caption>Rotación según Viaje de negocios</caption>
## <thead>
## <tr>
## <th style="text-align:center;"> Nivel </th>
## <th style="text-align:center;"> rotacion_f </th>
## <th style="text-align:center;"> Frecuencia </th>
## <th style="text-align:center;"> PorcentajeDentroNivel </th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td style="text-align:center;"> No_Viaja </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 94 </td>
## <td style="text-align:center;"> 0.913 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> No_Viaja </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 9 </td>
## <td style="text-align:center;"> 0.087 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Frecuentemente </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 152 </td>
## <td style="text-align:center;"> 0.749 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Frecuentemente </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 51 </td>
## <td style="text-align:center;"> 0.251 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Raramente </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 618 </td>
## <td style="text-align:center;"> 0.854 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Raramente </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 106 </td>
## <td style="text-align:center;"> 0.146 </td>
## </tr>
## </tbody>
## </table><table class="table table-striped table-hover table-condensed table-responsive" style="width: auto !important; margin-left: auto; margin-right: auto;">
## <caption>Rotación según Estado civil</caption>
## <thead>
## <tr>
## <th style="text-align:center;"> Nivel </th>
## <th style="text-align:center;"> rotacion_f </th>
## <th style="text-align:center;"> Frecuencia </th>
## <th style="text-align:center;"> PorcentajeDentroNivel </th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td style="text-align:center;"> Casado </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 403 </td>
## <td style="text-align:center;"> 0.876 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Casado </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 57 </td>
## <td style="text-align:center;"> 0.124 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Divorciado </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 213 </td>
## <td style="text-align:center;"> 0.906 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Divorciado </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 22 </td>
## <td style="text-align:center;"> 0.094 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Soltero </td>
## <td style="text-align:center;"> No </td>
## <td style="text-align:center;"> 248 </td>
## <td style="text-align:center;"> 0.740 </td>
## </tr>
## <tr>
## <td style="text-align:center;"> Soltero </td>
## <td style="text-align:center;"> Sí </td>
## <td style="text-align:center;"> 87 </td>
## <td style="text-align:center;"> 0.260 </td>
## </tr>
## </tbody>
## </table>
for (v in variablesCategoricas) {
grafico <- train |>
group_by(.data[[v]]) |>
summarise(
TasaRotacion = mean(rotacion),
N = n(),
.groups = "drop"
) |>
ggplot(aes(x = .data[[v]], y = TasaRotacion)) +
geom_col() +
geom_text(
aes(label = scales::percent(TasaRotacion, accuracy = 0.1)),
vjust = -0.25
) +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(
title = paste("Tasa observada de rotación según", nombreBonito(v)),
x = nombreBonito(v),
y = "Tasa de rotación"
) +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 20, hjust = 1))
print(grafico)
}
resultadosCat <- purrr::map_dfr(
variablesCategoricas,
~ pruebaCategorica(train, .x)
)
tablaHtml(
resultadosCat,
"Pruebas bivariadas para variables categóricas",
digitos = 4
)
| Variable | Prueba | ValorP | CramersV | MinFrecuenciaEsperada |
|---|---|---|---|---|
| Horas extra | Chi-cuadrado de independencia | 0.0000 | 0.2504 | 47.2214 |
| Viaje de negocios | Chi-cuadrado de independencia | 0.0002 | 0.1303 | 16.6000 |
| Estado civil | Chi-cuadrado de independencia | 0.0000 | 0.1888 | 37.8738 |
La hipótesis de independencia para cada variable categórica es:
\[ H_0: \text{la variable categórica y la rotación son independientes} \]
\[ H_1: \text{existe asociación entre la variable categórica y la rotación} \]
Además del valor \(p\), se reporta V de Cramér como medida de intensidad de asociación. La significancia estadística no debe confundirse con magnitud del efecto. se obtienen p-valores cercanos a 0, lo que indica que se rechaza la hipótesis nula de independencia.
Las categorías analizadas no son independientes de rotación, validando así las hipótesis planteadas previamente y se justifica su inclusión en el modelo de regresión logística como variables explicativas relevantes.
tablaCuantPorGrupo <- purrr::map_dfr(
variablesCuantitativas,
function(v) {
train |>
group_by(rotacion_f) |>
summarise(
N = n(),
Media = mean(.data[[v]], na.rm = TRUE),
Desviacion = sd(.data[[v]], na.rm = TRUE),
Mediana = median(.data[[v]], na.rm = TRUE),
Q1 = quantile(.data[[v]], 0.25, na.rm = TRUE),
Q3 = quantile(.data[[v]], 0.75, na.rm = TRUE),
.groups = "drop"
) |>
mutate(Variable = nombreBonito(v)) |>
select(Variable, rotacion_f, everything())
}
)
tablaHtml(
tablaCuantPorGrupo,
"Resumen de variables cuantitativas según rotación",
digitos = 2
)
| Variable | rotacion_f | N | Media | Desviacion | Mediana | Q1 | Q3 |
|---|---|---|---|---|---|---|---|
| Edad | No | 864 | 37.52 | 8.95 | 36 | 31.00 | 43.00 |
| Edad | Sí | 166 | 34.28 | 10.41 | 32 | 28.00 | 40.00 |
| Ingreso mensual | No | 864 | 6795.74 | 4784.65 | 5141 | 3303.25 | 8620.25 |
| Ingreso mensual | Sí | 166 | 4791.82 | 3632.15 | 3424 | 2405.00 | 5824.25 |
| Antigüedad en el cargo | No | 864 | 4.51 | 3.70 | 3 | 2.00 | 7.00 |
| Antigüedad en el cargo | Sí | 166 | 2.89 | 3.15 | 2 | 0.00 | 4.00 |
for (v in variablesCuantitativas) {
grafico <- ggplot(
train,
aes(x = rotacion_f, y = .data[[v]])
) +
geom_boxplot(outlier.alpha = 0.35) +
labs(
title = paste(nombreBonito(v), "según rotación"),
x = "Rotación",
y = nombreBonito(v)
) +
theme_minimal(base_size = 12)
print(grafico)
}
resultadosCuant <- purrr::map_dfr(
variablesCuantitativas,
~ pruebaCuantitativa(train, .x)
)
tablaHtml(
resultadosCuant,
"Pruebas bivariadas para variables cuantitativas",
digitos = 4
)
| Variable | BetaLogitSimple | ORporUnidad | ValorP_LRT | ValorP_Welch | ValorP_Wilcoxon |
|---|---|---|---|---|---|
| Edad | -0.0406 | 0.9602 | 0 | 0.0002 | 0 |
| Ingreso mensual | -0.0001 | 0.9999 | 0 | 0.0000 | 0 |
| Antigüedad en el cargo | -0.1502 | 0.8605 | 0 | 0.0000 | 0 |
Para cada predictor cuantitativo se presenta como prueba principal la razón de verosimilitud (LRT) de un modelo logístico simple frente al modelo nulo. También se muestran, como contraste descriptivo complementario, la prueba \(t\) de Welch y la prueba de Wilcoxon para comparar las distribuciones entre los grupos con y sin rotación.
resultadosLogitSimple <- purrr::map_dfr(
variablesSeleccionadas,
function(v) {
f <- as.formula(paste("rotacion ~", v))
m <- glm(f, family = binomial(link = "logit"), data = train)
broom::tidy(m, conf.int = TRUE) |>
filter(term != "(Intercept)") |>
mutate(
VariableBase = nombreBonito(v),
OR = exp(estimate),
OR_IC95_Inferior = exp(conf.low),
OR_IC95_Superior = exp(conf.high),
CambioPorcentualOdds = 100 * (OR - 1)
) |>
select(
VariableBase, term, estimate, std.error,
statistic, p.value,
OR, OR_IC95_Inferior, OR_IC95_Superior,
CambioPorcentualOdds
)
}
)
tablaHtml(
resultadosLogitSimple,
"Regresiones logísticas bivariadas: coeficientes y odds ratios",
digitos = 4
)
| VariableBase | term | estimate | std.error | statistic | p.value | OR | OR_IC95_Inferior | OR_IC95_Superior | CambioPorcentualOdds |
|---|---|---|---|---|---|---|---|---|---|
| Horas extra | horas_extraSi | 1.3496 | 0.1752 | 7.7019 | 0.0000 | 3.8560 | 2.7380 | 5.4467 | 285.5976 |
| Viaje de negocios | viaje_de_negociosFrecuentemente | 1.2540 | 0.3845 | 3.2611 | 0.0011 | 3.5044 | 1.7233 | 7.9127 | 250.4385 |
| Viaje de negocios | viaje_de_negociosRaramente | 0.5830 | 0.3643 | 1.6003 | 0.1095 | 1.7914 | 0.9230 | 3.9154 | 79.1442 |
| Estado civil | estado_civilDivorciado | -0.3144 | 0.2649 | -1.1868 | 0.2353 | 0.7303 | 0.4266 | 1.2107 | -26.9747 |
| Estado civil | estado_civilSoltero | 0.9084 | 0.1886 | 4.8176 | 0.0000 | 2.4803 | 1.7187 | 3.6034 | 148.0263 |
| Edad | edad | -0.0406 | 0.0099 | -4.0894 | 0.0000 | 0.9602 | 0.9413 | 0.9787 | -3.9825 |
| Ingreso mensual | ingreso_mensual | -0.0001 | 0.0000 | -4.8516 | 0.0000 | 0.9999 | 0.9998 | 0.9999 | -0.0127 |
| Antigüedad en el cargo | antiguedad_cargo | -0.1502 | 0.0293 | -5.1304 | 0.0000 | 0.8605 | 0.8109 | 0.9097 | -13.9477 |
cat("### Lectura de los resultados bivariados\n\n")
for (i in seq_len(nrow(resultadosCat))) {
fila <- resultadosCat[i, ]
conclusion <- ifelse(
fila$ValorP < 0.05,
"se encuentra evidencia estadística de asociación",
"no se encuentra evidencia estadística suficiente de asociación"
)
cat(
"- **", fila$Variable, ":** ", conclusion,
" con la rotación al 5% (", fila$Prueba,
", ", formatearP(fila$ValorP),
"; V de Cramér = ", formatearNumero(fila$CramersV, 3), ").\n",
sep = ""
)
}
for (i in seq_len(nrow(resultadosCuant))) {
fila <- resultadosCuant[i, ]
conclusion <- ifelse(
fila$ValorP_LRT < 0.05,
"presenta evidencia estadística de asociación",
"no presenta evidencia estadística suficiente de asociación"
)
direccion <- textoDireccion(fila$BetaLogitSimple)
cat(
"- **", fila$Variable, ":** ", conclusion,
" en el modelo logístico simple (LRT, ",
formatearP(fila$ValorP_LRT), "). El coeficiente es ",
ifelse(fila$BetaLogitSimple >= 0, "positivo", "negativo"),
", por lo que al aumentar la variable, los odds estimados de rotación ",
direccion, "n en el análisis no ajustado.\n",
sep = ""
)
}
Las hipótesis se plantearon antes de estimar el modelo. Por eso se comparan ahora con los resultados bivariados sin reformularlas a posteriori. La dirección observada puede coincidir con la expectativa inicial y, aun así, no presentar suficiente evidencia estadística.
nivelFrecuente <- nivelPorPatron(
train$viaje_de_negocios,
c("frecu", "frequent"),
fallback = levels(train$viaje_de_negocios)[2]
)
nivelSoltero <- nivelPorPatron(
train$estado_civil,
c("solter", "single"),
fallback = tail(levels(train$estado_civil), 1)
)
betaEdadBi <- resultadosCuant$BetaLogitSimple[resultadosCuant$Variable == "Edad"]
betaIngresoBi <- resultadosCuant$BetaLogitSimple[resultadosCuant$Variable == "Ingreso mensual"]
betaAntigBi <- resultadosCuant$BetaLogitSimple[resultadosCuant$Variable == "Antigüedad en el cargo"]
comparacionHipotesis <- tibble(
Variable = c(
"Horas extra", "Viaje de negocios", "Estado civil",
"Edad", "Ingreso mensual", "Antigüedad en el cargo"
),
HipotesisEsperada = c(
"Mayor rotación con horas extra",
"Mayor rotación con viajes frecuentes",
"Mayor rotación en solteros frente a casados",
"Menor rotación a mayor edad",
"Menor rotación a mayor ingreso",
"Menor rotación a mayor antigüedad"
),
DireccionObservada = c(
mean(train$rotacion[train$horas_extra == levels(train$horas_extra)[2]]) >
mean(train$rotacion[train$horas_extra == levels(train$horas_extra)[1]]),
mean(train$rotacion[train$viaje_de_negocios == nivelFrecuente]) >
mean(train$rotacion[train$viaje_de_negocios == levels(train$viaje_de_negocios)[1]]),
mean(train$rotacion[train$estado_civil == nivelSoltero]) >
mean(train$rotacion[train$estado_civil == levels(train$estado_civil)[1]]),
betaEdadBi < 0,
betaIngresoBi < 0,
betaAntigBi < 0
),
EvidenciaBivariada5pct = c(
resultadosCat$ValorP[resultadosCat$Variable == "Horas extra"] < 0.05,
resultadosCat$ValorP[resultadosCat$Variable == "Viaje de negocios"] < 0.05,
resultadosCat$ValorP[resultadosCat$Variable == "Estado civil"] < 0.05,
resultadosCuant$ValorP_LRT[resultadosCuant$Variable == "Edad"] < 0.05,
resultadosCuant$ValorP_LRT[resultadosCuant$Variable == "Ingreso mensual"] < 0.05,
resultadosCuant$ValorP_LRT[resultadosCuant$Variable == "Antigüedad en el cargo"] < 0.05
)
) |>
mutate(
Conclusion = case_when(
DireccionObservada & EvidenciaBivariada5pct ~
"Coherente con la hipótesis y con evidencia al 5%",
DireccionObservada & !EvidenciaBivariada5pct ~
"Dirección coherente, pero evidencia insuficiente",
TRUE ~
"Dirección no coherente con la hipótesis inicial"
)
)
tablaHtml(
comparacionHipotesis,
"Contraste entre hipótesis y resultados bivariados",
digitos = 4
)
| Variable | HipotesisEsperada | DireccionObservada | EvidenciaBivariada5pct | Conclusion |
|---|---|---|---|---|
| Horas extra | Mayor rotación con horas extra | TRUE | TRUE | Coherente con la hipótesis y con evidencia al 5% |
| Viaje de negocios | Mayor rotación con viajes frecuentes | TRUE | TRUE | Coherente con la hipótesis y con evidencia al 5% |
| Estado civil | Mayor rotación en solteros frente a casados | TRUE | TRUE | Coherente con la hipótesis y con evidencia al 5% |
| Edad | Menor rotación a mayor edad | TRUE | TRUE | Coherente con la hipótesis y con evidencia al 5% |
| Ingreso mensual | Menor rotación a mayor ingreso | TRUE | TRUE | Coherente con la hipótesis y con evidencia al 5% |
| Antigüedad en el cargo | Menor rotación a mayor antigüedad | TRUE | TRUE | Coherente con la hipótesis y con evidencia al 5% |
Las seis variables seleccionadas presentan asociación estadísticamente significativa con la rotación al 5%, por lo que todas se identifican como determinantes en el análisis sin ajuste. Los signos de los coeficientes coinciden con las hipótesis planteadas: tienen mayor riesgo de rotar quienes hacen horas extra (OR = 3,86), quienes viajan frecuentemente (OR = 3,50) y los solteros frente a los casados (OR = 2,48); y menor riesgo a mayor edad (OR = 0,96 por año), ingreso mensual y antigüedad en el cargo (OR = 0,86 por año). En viaje de negocios y estado civil, no todos los niveles difieren de su referencia: “Raramente” (p = 0,11) y “Divorciado” (p = 0,24) no son significativos.
El análisis bivariado sirve para explorar asociaciones sin ajuste. Edad, ingreso y antigüedad están correlacionadas entre sí, por eso una variable puede cambiar de magnitud o perder significancia al controlar por las demás,por lo que parte del efecto de cada una es compartido, por lo que el modelo múltiple es el paso decisivo para la inferencia ajustada.
El modelo propuesto es:
\[ \log\left(\frac{p_i}{1-p_i}\right) = \beta_0 + \boldsymbol{\beta}_1(\text{Horas extra}) + \boldsymbol{\beta}_2(\text{Viaje}) + \boldsymbol{\beta}_3(\text{Estado civil}) + \beta_4(\text{Edad}) + \beta_5(\text{Ingreso mensual}) + \beta_6(\text{Antigüedad en el cargo}) \]
donde \(p_i=P(Y_i=1\mid X_i)\) es la probabilidad de rotación del empleado \(i\).
formulaModelo <- rotacion ~
horas_extra +
viaje_de_negocios +
estado_civil +
edad +
ingreso_mensual +
antiguedad_cargo
modeloLogit <- glm(
formulaModelo,
family = binomial(link = "logit"),
data = train
)
summary(modeloLogit)
##
## Call:
## glm(formula = formulaModelo, family = binomial(link = "logit"),
## data = train)
##
## Coefficients:
## Estimate Std. Error z value
## (Intercept) -1.71310344 0.53371359 -3.210
## horas_extraSi 1.46298610 0.18876960 7.750
## viaje_de_negociosFrecuentemente 1.17092872 0.40991866 2.856
## viaje_de_negociosRaramente 0.54507976 0.38498826 1.416
## estado_civilDivorciado -0.42615768 0.27924441 -1.526
## estado_civilSoltero 0.78011688 0.20447907 3.815
## edad -0.01502332 0.01141046 -1.317
## ingreso_mensual -0.00008021 0.00003043 -2.636
## antiguedad_cargo -0.10458981 0.03310213 -3.160
## Pr(>|z|)
## (Intercept) 0.001328 **
## horas_extraSi 0.00000000000000918 ***
## viaje_de_negociosFrecuentemente 0.004284 **
## viaje_de_negociosRaramente 0.156824
## estado_civilDivorciado 0.126982
## estado_civilSoltero 0.000136 ***
## edad 0.187963
## ingreso_mensual 0.008379 **
## antiguedad_cargo 0.001580 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 909.69 on 1029 degrees of freedom
## Residual deviance: 758.92 on 1021 degrees of freedom
## AIC: 776.92
##
## Number of Fisher Scoring iterations: 5
nEventosTrain <- sum(train$rotacion == 1)
nNoEventosTrain <- sum(train$rotacion == 0)
nParametros <- length(coef(modeloLogit))
eventosPorParametro <- nEventosTrain / nParametros
tablaEstabilidad <- tibble(
Indicador = c(
"Convergencia del algoritmo",
"Iteraciones de Fisher scoring",
"Eventos de rotación en train",
"No eventos en train",
"Parámetros estimados",
"Eventos por parámetro",
"Probabilidad ajustada mínima",
"Probabilidad ajustada máxima"
),
Valor = c(
as.character(modeloLogit$converged),
as.character(modeloLogit$iter),
as.character(nEventosTrain),
as.character(nNoEventosTrain),
as.character(nParametros),
formatearNumero(eventosPorParametro, 2),
formatearNumero(min(fitted(modeloLogit)), 5),
formatearNumero(max(fitted(modeloLogit)), 5)
)
)
tablaHtml(
tablaEstabilidad,
"Chequeos de estabilidad numérica del ajuste",
digitos = 4
)
| Indicador | Valor |
|---|---|
| Convergencia del algoritmo | TRUE |
| Iteraciones de Fisher scoring | 5 |
| Eventos de rotación en train | 166 |
| No eventos en train | 864 |
| Parámetros estimados | 9 |
| Eventos por parámetro | 18,44 |
| Probabilidad ajustada mínima | 0,00434 |
| Probabilidad ajustada máxima | 0,78662 |
cat(
"El algoritmo de máxima verosimilitud **",
ifelse(modeloLogit$converged, "converge correctamente", "no converge correctamente"),
"** después de **", modeloLogit$iter, "** iteraciones. ",
"En entrenamiento hay **", nEventosTrain, "** eventos para **",
nParametros, "** parámetros, equivalentes a aproximadamente **",
formatearNumero(eventosPorParametro, 1),
" eventos por parámetro**. Junto con errores estándar finitos y probabilidades ajustadas no degeneradas, ",
"esto no muestra señales evidentes de inestabilidad numérica severa. ",
"La revisión de separación completa se complementa de forma práctica con la convergencia, magnitud de los coeficientes e intervalos de confianza.\\n",
sep = ""
)
El algoritmo de máxima verosimilitud converge correctamente después de 5 iteraciones. En entrenamiento hay 166 eventos para 9 parámetros, equivalentes a aproximadamente 18,4 eventos por parámetro. Junto con errores estándar finitos y probabilidades ajustadas no degeneradas, esto no muestra señales evidentes de inestabilidad numérica severa. La revisión de separación completa se complementa de forma práctica con la convergencia, magnitud de los coeficientes e intervalos de confianza.
Se contrasta:
\[ H_0:\beta_1=\beta_2=\cdots=\beta_k=0 \]
\[ H_1:\text{al menos un coeficiente es diferente de cero} \]
modeloNulo <- glm(
rotacion ~ 1,
family = binomial(link = "logit"),
data = train
)
lrtGlobal <- anova(modeloNulo, modeloLogit, test = "Chisq")
chiGlobal <- lrtGlobal$Deviance[2]
glGlobal <- lrtGlobal$Df[2]
pGlobal <- lrtGlobal$`Pr(>Chi)`[2]
logLikModelo <- as.numeric(logLik(modeloLogit))
logLikNulo <- as.numeric(logLik(modeloNulo))
r2McFadden <- 1 - (logLikModelo / logLikNulo)
tablaAjuste <- tibble(
Indicador = c(
"Deviance nula",
"Deviance residual",
"AIC",
"Chi-cuadrado LRT global",
"Grados de libertad LRT",
"Valor p LRT global",
"Pseudo-R2 de McFadden"
),
Valor = c(
modeloLogit$null.deviance,
modeloLogit$deviance,
AIC(modeloLogit),
chiGlobal,
glGlobal,
pGlobal,
r2McFadden
)
)
tablaHtml(
tablaAjuste,
"Ajuste y significancia global del modelo",
digitos = 5
)
| Indicador | Valor |
|---|---|
| Deviance nula | 909.68932 |
| Deviance residual | 758.91737 |
| AIC | 776.91737 |
| Chi-cuadrado LRT global | 150.77195 |
| Grados de libertad LRT | 8.00000 |
| Valor p LRT global | 0.00000 |
| Pseudo-R2 de McFadden | 0.16574 |
if (pGlobal < 0.05) {
cat(
"La prueba global de razón de verosimilitud produce **p = ",
formatearP(pGlobal),
"**, por lo que se rechaza H0 al 5%. En conjunto, las covariables ",
"aportan información estadísticamente significativa para explicar la probabilidad de rotación.\n",
sep = ""
)
} else {
cat(
"La prueba global de razón de verosimilitud produce **p = ",
formatearP(pGlobal),
"**. Con un nivel de significancia del 5% no se rechaza H0; ",
"el conjunto de covariables no muestra evidencia suficiente de mejora frente al modelo nulo.\n",
sep = ""
)
}
La prueba global de razón de verosimilitud produce p = p < 0,001, por lo que se rechaza H0 al 5%. En conjunto, las covariables aportan información estadísticamente significativa para explicar la probabilidad de rotación.
coeficientesModelo <- tablaCoeficientesLogit(modeloLogit)
tablaHtml(
coeficientesModelo,
"Coeficientes del modelo logístico múltiple",
digitos = 5,
alto = "520px"
)
| Termino | Beta | ErrorEstandar | EstadisticoZ | ValorP | OR | OR_IC95_Inferior | OR_IC95_Superior | CambioPorcentualOdds | Significativo5pct |
|---|---|---|---|---|---|---|---|---|---|
| (Intercept) | -1.71310 | 0.53371 | -3.20978 | 0.00133 | 0.18031 | 0.06117 | 0.50070 | -81.96946 | TRUE |
| horas_extraSi | 1.46299 | 0.18877 | 7.75011 | 0.00000 | 4.31884 | 2.98970 | 6.27228 | 331.88368 | TRUE |
| viaje_de_negociosFrecuentemente | 1.17093 | 0.40992 | 2.85649 | 0.00428 | 3.22499 | 1.50311 | 7.61090 | 222.49864 | TRUE |
| viaje_de_negociosRaramente | 0.54508 | 0.38499 | 1.41583 | 0.15682 | 1.72475 | 0.85000 | 3.90481 | 72.47460 | FALSE |
| estado_civilDivorciado | -0.42616 | 0.27924 | -1.52611 | 0.12698 | 0.65301 | 0.37123 | 1.11410 | -34.69866 | FALSE |
| estado_civilSoltero | 0.78012 | 0.20448 | 3.81514 | 0.00014 | 2.18173 | 1.46466 | 3.26891 | 118.17272 | TRUE |
| edad | -0.01502 | 0.01141 | -1.31663 | 0.18796 | 0.98509 | 0.96292 | 1.00704 | -1.49110 | FALSE |
| ingreso_mensual | -0.00008 | 0.00003 | -2.63641 | 0.00838 | 0.99992 | 0.99986 | 0.99998 | -0.00802 | TRUE |
| antiguedad_cargo | -0.10459 | 0.03310 | -3.15961 | 0.00158 | 0.90069 | 0.84268 | 0.95966 | -9.93061 | TRUE |
La columna CambioPorcentualOdds se obtiene mediante:
\[ 100\left(e^\beta-1\right) \]
y representa el cambio porcentual en los odds de rotación, manteniendo constantes las demás covariables. Este porcentaje no debe interpretarse directamente como cambio porcentual de la probabilidad. La probabilidad se interpreta más adelante mediante efectos marginales/discretos.
En factores con más de dos niveles, no es suficiente observar por
separado cada dummy. Por ello se aplica una prueba de razón de
verosimilitud mediante drop1() para evaluar el aporte
global de cada covariable al modelo.
significanciaVariables <- drop1(modeloLogit, test = "Chisq") |>
as.data.frame() |>
tibble::rownames_to_column("Variable") |>
filter(Variable != "<none>") |>
transmute(
Variable = sapply(Variable, nombreBonito),
Df = Df,
AIC = AIC,
LRT = LRT,
ValorP = `Pr(>Chi)`,
Significativa5pct = ValorP < 0.05
)
tablaHtml(
significanciaVariables,
"Prueba global de cada covariable en el modelo múltiple",
digitos = 5
)
| Variable | Df | AIC | LRT | ValorP | Significativa5pct |
|---|---|---|---|---|---|
| Horas extra | 1 | 835.8926 | 60.97518 | 0.00000 | TRUE |
| Viaje de negocios | 2 | 785.1890 | 12.27167 | 0.00216 | TRUE |
| Estado civil | 2 | 798.8628 | 25.94539 | 0.00000 | TRUE |
| Edad | 1 | 776.6866 | 1.76928 | 0.18347 | FALSE |
| Ingreso mensual | 1 | 782.6087 | 7.69130 | 0.00555 | TRUE |
| Antigüedad en el cargo | 1 | 785.6549 | 10.73757 | 0.00105 | TRUE |
Esta sección constituye el núcleo interpretativo del modelo. En regresión logística hay que distinguir tres escalas:
\[ \eta = \log\left(\frac{p}{1-p}\right) \]
es el logit; el coeficiente \(\beta_j\) mide el cambio en esa escala. Al exponenciarlo,
\[ OR_j = e^{\beta_j}, \]
se obtiene el odds ratio. Finalmente, la probabilidad se recupera mediante
\[ p = \frac{e^\eta}{1+e^\eta}. \]
Por ello, un coeficiente no equivale directamente a un cambio fijo en probabilidad. El OR sí tiene una interpretación multiplicativa constante en los odds bajo el modelo lineal, mientras que el cambio absoluto de probabilidad depende del punto de partida del empleado.
coefInterpretacion <- coeficientesModelo |>
filter(Termino != "(Intercept)") |>
mutate(
LecturaOR = case_when(
OR > 1 ~ paste0(
"Los odds aumentan ",
formatearNumero(100 * (OR - 1), 2),
"%"
),
OR < 1 ~ paste0(
"Los odds disminuyen ",
formatearNumero(100 * (1 - OR), 2),
"%"
),
TRUE ~ "Sin cambio en odds"
),
Evidencia = ifelse(
ValorP < 0.05,
"Evidencia estadística al 5%",
"Sin evidencia estadística suficiente al 5%"
)
) |>
select(
Termino, Beta, ValorP, OR,
OR_IC95_Inferior, OR_IC95_Superior,
CambioPorcentualOdds, LecturaOR, Evidencia
)
tablaHtml(
coefInterpretacion,
"Interpretación de los coeficientes ajustados y odds ratios",
digitos = 4,
alto = "620px"
)
| Termino | Beta | ValorP | OR | OR_IC95_Inferior | OR_IC95_Superior | CambioPorcentualOdds | LecturaOR | Evidencia |
|---|---|---|---|---|---|---|---|---|
| horas_extraSi | 1.4630 | 0.0000 | 4.3188 | 2.9897 | 6.2723 | 331.8837 | Los odds aumentan 331,88% | Evidencia estadística al 5% |
| viaje_de_negociosFrecuentemente | 1.1709 | 0.0043 | 3.2250 | 1.5031 | 7.6109 | 222.4986 | Los odds aumentan 222,50% | Evidencia estadística al 5% |
| viaje_de_negociosRaramente | 0.5451 | 0.1568 | 1.7247 | 0.8500 | 3.9048 | 72.4746 | Los odds aumentan 72,47% | Sin evidencia estadística suficiente al 5% |
| estado_civilDivorciado | -0.4262 | 0.1270 | 0.6530 | 0.3712 | 1.1141 | -34.6987 | Los odds disminuyen 34,70% | Sin evidencia estadística suficiente al 5% |
| estado_civilSoltero | 0.7801 | 0.0001 | 2.1817 | 1.4647 | 3.2689 | 118.1727 | Los odds aumentan 118,17% | Evidencia estadística al 5% |
| edad | -0.0150 | 0.1880 | 0.9851 | 0.9629 | 1.0070 | -1.4911 | Los odds disminuyen 1,49% | Sin evidencia estadística suficiente al 5% |
| ingreso_mensual | -0.0001 | 0.0084 | 0.9999 | 0.9999 | 1.0000 | -0.0080 | Los odds disminuyen 0,01% | Evidencia estadística al 5% |
| antiguedad_cargo | -0.1046 | 0.0016 | 0.9007 | 0.8427 | 0.9597 | -9.9306 | Los odds disminuyen 9,93% | Evidencia estadística al 5% |
Un OR debe leerse siempre manteniendo constantes las demás covariables. Además, cuando el intervalo de confianza del OR incluye 1 o el valor \(p\) es mayor a 0,05, la dirección estimada puede describirse, pero no debe presentarse como una diferencia estadísticamente estable.
Para una variable categórica, el coeficiente representa el cambio
frente a una categoría de referencia. En este modelo
las referencias son Horas extra = No,
Viaje de negocios = No_Viaja y
Estado civil = Casado.
efectosCategoricos <- bind_rows(
efectoFactorVsReferencia(modeloLogit, train, "horas_extra"),
efectoFactorVsReferencia(modeloLogit, train, "viaje_de_negocios"),
efectoFactorVsReferencia(modeloLogit, train, "estado_civil")
)
mapaP <- coeficientesModelo |>
select(Termino, ValorP)
tablaEfectosCat <- efectosCategoricos |>
mutate(
TerminoEsperado = case_when(
Variable == "Horas extra" ~ paste0("horas_extra", NivelComparado),
Variable == "Viaje de negocios" ~ paste0("viaje_de_negocios", NivelComparado),
Variable == "Estado civil" ~ paste0("estado_civil", NivelComparado),
TRUE ~ NA_character_
)
) |>
left_join(
mapaP,
by = c("TerminoEsperado" = "Termino")
) |>
mutate(
Evidencia = ifelse(
ValorP < 0.05,
"Significativo",
"No significativo"
)
) |>
select(
Variable, Referencia, NivelComparado,
OR_vs_Referencia, CambioPorcentualOdds,
CambioPromedioPuntosPorcentuales,
ValorP, Evidencia
)
tablaHtml(
tablaEfectosCat,
"Efecto de cambiar el nivel de una variable categórica",
digitos = 4,
alto = "560px"
)
| Variable | Referencia | NivelComparado | OR_vs_Referencia | CambioPorcentualOdds | CambioPromedioPuntosPorcentuales | ValorP | Evidencia |
|---|---|---|---|---|---|---|---|
| Horas extra | No | Si | 4.3188 | 331.8837 | 19.7725 | 0.0000 | Significativo |
| Viaje de negocios | No_Viaja | Frecuentemente | 3.2250 | 222.4986 | 13.1077 | 0.0043 | Significativo |
| Viaje de negocios | No_Viaja | Raramente | 1.7247 | 72.4746 | 5.0996 | 0.1568 | No significativo |
| Estado civil | Casado | Divorciado | 0.6530 | -34.6987 | -3.8727 | 0.1270 | No significativo |
| Estado civil | Casado | Soltero | 2.1817 | 118.1727 | 9.9530 | 0.0001 | Significativo |
cat("### Lectura explicativa de cada cambio categórico\n\n")
for (i in seq_len(nrow(tablaEfectosCat))) {
f <- tablaEfectosCat[i, ]
dirOdds <- ifelse(
f$CambioPorcentualOdds > 0,
"aumentan",
"disminuyen"
)
dirProb <- ifelse(
f$CambioPromedioPuntosPorcentuales > 0,
"aumenta",
"disminuye"
)
cat(
"- **", f$Variable, ": ", f$Referencia, " → ", f$NivelComparado, ".** ",
"Manteniendo constantes las demás variables, los odds de rotación se multiplican por **",
formatearNumero(f$OR_vs_Referencia, 3), "**; esto equivale a que ",
dirOdds, " aproximadamente **",
formatearNumero(abs(f$CambioPorcentualOdds), 1), "%**. ",
"En la escala de probabilidad, el cambio promedio estimado es de **",
formatearNumero(abs(f$CambioPromedioPuntosPorcentuales), 2),
" puntos porcentuales** y la probabilidad ", dirProb, ". ",
"El contraste presenta **p = ", formatearP(f$ValorP), "**, por lo que ",
ifelse(
!is.na(f$ValorP) && f$ValorP < 0.05,
"existe evidencia estadística de una diferencia frente a la categoría de referencia.",
"la dirección estimada debe interpretarse con cautela porque no existe evidencia estadística suficiente al 5%."
),
"\n",
sep = ""
)
}
Interpretación sustantiva. En
Horas extra, un OR mayor que 1 indica que pasar de No a Sí
aumenta los odds de rotación para empleados comparables en las demás
variables. En Viaje de negocios, cada nivel se compara con
No_Viaja; es importante distinguir la significancia global
del factor de la significancia individual de cada contraste. En
Estado civil, cualquier asociación debe entenderse como
predictiva y no como una base legítima para decisiones
discriminatorias.
Para las variables continuas, interpretar una sola unidad puede ser poco informativo. En particular, una unidad monetaria de ingreso es demasiado pequeña. Por ello se reportan cambios de magnitud comprensible: +5 años de edad, +1.000 unidades monetarias de ingreso y +1 año de antigüedad en el cargo.
efectosNumericos <- bind_rows(
efectoNumericoDiscreto(modeloLogit, train, "edad", 5, "años"),
efectoNumericoDiscreto(modeloLogit, train, "ingreso_mensual", 1000, "unidades monetarias"),
efectoNumericoDiscreto(modeloLogit, train, "antiguedad_cargo", 1, "año")
)
pNumericas <- coeficientesModelo |>
filter(Termino %in% variablesCuantitativas) |>
select(Termino, ValorP)
tablaEfectosNum <- efectosNumericos |>
mutate(
Termino = case_when(
Variable == "Edad" ~ "edad",
Variable == "Ingreso mensual" ~ "ingreso_mensual",
Variable == "Antigüedad en el cargo" ~ "antiguedad_cargo"
)
) |>
left_join(pNumericas, by = "Termino") |>
mutate(
Evidencia = ifelse(
ValorP < 0.05,
"Significativo",
"No significativo"
)
) |>
select(
Variable, CambioEvaluado, ORporCambio,
CambioPorcentualOdds,
CambioPromedioPuntosPorcentuales,
ValorP, Evidencia
)
tablaHtml(
tablaEfectosNum,
"Efecto de cambios sustantivos en las variables cuantitativas",
digitos = 4
)
| Variable | CambioEvaluado | ORporCambio | CambioPorcentualOdds | CambioPromedioPuntosPorcentuales | ValorP | Evidencia |
|---|---|---|---|---|---|---|
| Edad | +5 años | 0.9276 | -7.2365 | -0.8430 | 0.1880 | No significativo |
| Ingreso mensual | +1.000 unidades monetarias | 0.9229 | -7.7082 | -0.9093 | 0.0084 | Significativo |
| Antigüedad en el cargo | +1 año | 0.9007 | -9.9306 | -1.1537 | 0.0016 | Significativo |
cat("### Lectura explicativa de cada cambio cuantitativo\n\n")
for (i in seq_len(nrow(tablaEfectosNum))) {
f <- tablaEfectosNum[i, ]
dirOdds <- ifelse(
f$CambioPorcentualOdds > 0,
"aumentan",
"disminuyen"
)
dirProb <- ifelse(
f$CambioPromedioPuntosPorcentuales > 0,
"aumenta",
"disminuye"
)
cat(
"- **", f$Variable, " (", f$CambioEvaluado, ").** ",
"Manteniendo constantes las demás variables, los odds se multiplican por **",
formatearNumero(f$ORporCambio, 3), "** y, por tanto, ",
dirOdds, " aproximadamente **",
formatearNumero(abs(f$CambioPorcentualOdds), 2), "%**. ",
"En promedio, la probabilidad predicha ", dirProb, " en **",
formatearNumero(abs(f$CambioPromedioPuntosPorcentuales), 2),
" puntos porcentuales**. El coeficiente presenta **p = ",
formatearP(f$ValorP), "**; ",
ifelse(
!is.na(f$ValorP) && f$ValorP < 0.05,
"el efecto ajustado cuenta con evidencia estadística al 5%.",
"no existe evidencia estadística suficiente para afirmar un efecto ajustado distinto de cero al 5%."
),
"\n",
sep = ""
)
}
Los efectos promedio resumen lo que ocurre en toda la muestra. Para entender directamente el funcionamiento del clasificador se construye un perfil base y se modifica una sola variable a la vez. De esta forma, todas las demás características permanecen iguales.
perfilBase <- tibble(
horas_extra = factor(
levels(train$horas_extra)[1],
levels = levels(train$horas_extra)
),
viaje_de_negocios = factor(
levels(train$viaje_de_negocios)[1],
levels = levels(train$viaje_de_negocios)
),
estado_civil = factor(
levels(train$estado_civil)[1],
levels = levels(train$estado_civil)
),
edad = median(train$edad, na.rm = TRUE),
ingreso_mensual = median(train$ingreso_mensual, na.rm = TRUE),
antiguedad_cargo = median(train$antiguedad_cargo, na.rm = TRUE)
)
probPerfilBase <- as.numeric(
predict(modeloLogit, newdata = perfilBase, type = "response")
)
escenariosPrediccion <- bind_rows(
crearEscenarioPerfil(
modeloLogit, perfilBase,
paste0(
"Horas extra: ",
levels(train$horas_extra)[1],
" → ",
levels(train$horas_extra)[2]
),
function(x) {
x$horas_extra <- factor(
levels(train$horas_extra)[2],
levels = levels(train$horas_extra)
)
x
}
),
crearEscenarioPerfil(
modeloLogit, perfilBase,
"Viaje: referencia → Frecuentemente",
function(x) {
nivel <- nivelPorPatron(
train$viaje_de_negocios,
c("frecu", "frequent"),
fallback = levels(train$viaje_de_negocios)[2]
)
x$viaje_de_negocios <- factor(
nivel,
levels = levels(train$viaje_de_negocios)
)
x
}
),
crearEscenarioPerfil(
modeloLogit, perfilBase,
"Viaje: referencia → Raramente",
function(x) {
nivel <- nivelPorPatron(
train$viaje_de_negocios,
c("rara", "rare"),
fallback = tail(levels(train$viaje_de_negocios), 1)
)
x$viaje_de_negocios <- factor(
nivel,
levels = levels(train$viaje_de_negocios)
)
x
}
),
crearEscenarioPerfil(
modeloLogit, perfilBase,
"Estado civil: referencia → Soltero",
function(x) {
nivel <- nivelPorPatron(
train$estado_civil,
c("solter", "single"),
fallback = tail(levels(train$estado_civil), 1)
)
x$estado_civil <- factor(
nivel,
levels = levels(train$estado_civil)
)
x
}
),
crearEscenarioPerfil(
modeloLogit, perfilBase,
"Edad: +5 años",
function(x) {
x$edad <- x$edad + 5
x
}
),
crearEscenarioPerfil(
modeloLogit, perfilBase,
"Ingreso mensual: +1000",
function(x) {
x$ingreso_mensual <- x$ingreso_mensual + 1000
x
}
),
crearEscenarioPerfil(
modeloLogit, perfilBase,
"Antigüedad en el cargo: +1 año",
function(x) {
x$antiguedad_cargo <- x$antiguedad_cargo + 1
x
}
)
)
tablaHtml(
perfilBase |>
mutate(ProbabilidadBase = probPerfilBase),
"Perfil de referencia para interpretar cambios en la predicción",
digitos = 4
)
| horas_extra | viaje_de_negocios | estado_civil | edad | ingreso_mensual | antiguedad_cargo | ProbabilidadBase |
|---|---|---|---|---|---|---|
| No | No_Viaja | Casado | 36 | 4899 | 3 | 0.0492 |
tablaHtml(
escenariosPrediccion,
"Cambio en la predicción del mismo empleado al modificar una sola entrada",
digitos = 4,
alto = "620px"
)
| Escenario | ProbabilidadBase | ProbabilidadNueva | CambioPuntosPorcentuales | CambioRelativoProbabilidad | OddsBase | OddsNuevos | OR_Escenario | CambioPorcentualOdds |
|---|---|---|---|---|---|---|---|---|
| Horas extra: No → Si | 0.0492 | 0.1828 | 13.3535 | 271.2257 | 0.0518 | 0.2236 | 4.3188 | 331.8837 |
| Viaje: referencia → Frecuentemente | 0.0492 | 0.1431 | 9.3869 | 190.6585 | 0.0518 | 0.1670 | 3.2250 | 222.4986 |
| Viaje: referencia → Raramente | 0.0492 | 0.0820 | 3.2756 | 66.5324 | 0.0518 | 0.0893 | 1.7247 | 72.4746 |
| Estado civil: referencia → Soltero | 0.0492 | 0.1015 | 5.2275 | 106.1771 | 0.0518 | 0.1130 | 2.1817 | 118.1727 |
| Edad: +5 años | 0.0492 | 0.0458 | -0.3399 | -6.9048 | 0.0518 | 0.0480 | 0.9276 | -7.2365 |
| Ingreso mensual: +1000 | 0.0492 | 0.0456 | -0.3622 | -7.3566 | 0.0518 | 0.0478 | 0.9229 | -7.7082 |
| Antigüedad en el cargo: +1 año | 0.0492 | 0.0446 | -0.4671 | -9.4881 | 0.0518 | 0.0466 | 0.9007 | -9.9306 |
cat(
"La probabilidad estimada para el perfil base es **",
formatearPorcentaje(probPerfilBase, 1),
"**. A partir de ese mismo empleado:\n\n",
sep = ""
)
La probabilidad estimada para el perfil base es 4,9%. A partir de ese mismo empleado:
for (i in seq_len(nrow(escenariosPrediccion))) {
f <- escenariosPrediccion[i, ]
direccion <- ifelse(
f$CambioPuntosPorcentuales > 0,
"aumenta",
"disminuye"
)
cat(
"- **", f$Escenario, ":** la probabilidad pasa de **",
formatearPorcentaje(f$ProbabilidadBase, 1), "** a **",
formatearPorcentaje(f$ProbabilidadNueva, 1), "**; es decir, ",
direccion, " **",
formatearNumero(abs(f$CambioPuntosPorcentuales), 2),
" puntos porcentuales**. En odds, el mismo cambio equivale a **",
ifelse(
f$CambioPorcentualOdds >= 0,
paste0("+", formatearNumero(f$CambioPorcentualOdds, 1), "%"),
paste0("-", formatearNumero(abs(f$CambioPorcentualOdds), 1), "%")
),
"**.\n",
sep = ""
)
}
Esta tabla responde directamente a la pregunta “¿qué pasa con la predicción del mismo empleado si modifico una sola entrada?” y complementa los efectos promedio de las secciones anteriores.
Un OR de 2 no significa que la probabilidad se duplique. Un aumento de 100% en los odds tampoco equivale a un aumento de 100 puntos porcentuales. El cambio absoluto de probabilidad depende de la probabilidad inicial. Por esta razón, el informe presenta simultáneamente OR, cambio porcentual en odds y cambio en puntos porcentuales de probabilidad.
La regresión logística requiere que la información de los predictores no sea excesivamente redundante. Se revisa VIF/GVIF.
vifRaw <- car::vif(modeloLogit)
if (is.matrix(vifRaw)) {
tablaVif <- as.data.frame(vifRaw) |>
tibble::rownames_to_column("Variable")
if ("GVIF^(1/(2*Df))" %in% names(tablaVif)) {
tablaVif <- tablaVif |>
mutate(
VIF_Equivalente = (`GVIF^(1/(2*Df))`)^2
)
}
} else {
tablaVif <- tibble(
Variable = names(vifRaw),
VIF = as.numeric(vifRaw)
)
}
tablaHtml(
tablaVif,
"Diagnóstico de multicolinealidad",
digitos = 4
)
| Variable | GVIF | Df | GVIF^(1/(2*Df)) | VIF_Equivalente |
|---|---|---|---|---|
| horas_extra | 1.0287 | 1 | 1.0142 | 1.0287 |
| viaje_de_negocios | 1.0099 | 2 | 1.0025 | 1.0049 |
| estado_civil | 1.0365 | 2 | 1.0090 | 1.0181 |
| edad | 1.2498 | 1 | 1.1179 | 1.2498 |
| ingreso_mensual | 1.3200 | 1 | 1.1489 | 1.3200 |
| antiguedad_cargo | 1.0909 | 1 | 1.0445 | 1.0909 |
Como regla práctica, valores de VIF equivalentes claramente superiores a 5 merecen revisión. El VIF no determina causalidad ni importancia sustantiva; solo informa sobre inflación de varianza asociada a dependencia lineal entre predictores.
El VIF equivalente más alto es 1,32 (Ingreso mensual), muy por debajo del umbral práctico de 5. No hay evidencia de multicolinealidad problemática; la dependencia moderada entre edad, ingreso y antigüedad no infla de forma relevante los errores estándar.
En regresión logística no se exige una relación lineal entre \(X\) y la probabilidad, pero sí se asume linealidad entre las variables cuantitativas y el logit. Se compara el término lineal con una especificación flexible mediante splines naturales de 3 grados de libertad.
evaluarNoLinealidad <- function(variable) {
otros <- setdiff(variablesSeleccionadas, variable)
formulaLineal <- as.formula(
paste("rotacion ~", paste(c(otros, variable), collapse = " + "))
)
formulaSpline <- as.formula(
paste(
"rotacion ~",
paste(
c(
otros,
paste0("splines::ns(", variable, ", df = 3)")
),
collapse = " + "
)
)
)
modeloLineal <- glm(
formulaLineal,
family = binomial(link = "logit"),
data = train
)
modeloSpline <- glm(
formulaSpline,
family = binomial(link = "logit"),
data = train
)
comp <- anova(modeloLineal, modeloSpline, test = "Chisq")
tibble(
Variable = nombreBonito(variable),
DeltaDeviance = comp$Deviance[2],
DeltaDf = comp$Df[2],
ValorP_NoLinealidad = comp$`Pr(>Chi)`[2],
EvidenciaNoLinealidad5pct = comp$`Pr(>Chi)`[2] < 0.05
)
}
tablaLinealidad <- purrr::map_dfr(
variablesCuantitativas,
evaluarNoLinealidad
)
tablaHtml(
tablaLinealidad,
"Prueba exploratoria de no linealidad del logit",
digitos = 5
)
| Variable | DeltaDeviance | DeltaDf | ValorP_NoLinealidad | EvidenciaNoLinealidad5pct |
|---|---|---|---|---|
| Edad | 14.84696 | 2 | 0.00060 | TRUE |
| Ingreso mensual | 15.63791 | 2 | 0.00040 | TRUE |
| Antigüedad en el cargo | 7.46176 | 2 | 0.02397 | TRUE |
Un valor \(p<0.05\) sugiere que una forma no lineal podría representar mejor la asociación. Dado que la actividad solicita un modelo logístico interpretable con las seis covariables seleccionadas, el modelo lineal en el logit se conserva como especificación principal y cualquier señal de no linealidad se reporta como limitación o posibilidad de mejora.
nTrain <- nrow(train)
pParametros <- length(coef(modeloLogit))
diagnosticoInfluencia <- tibble(
FilaTrain = seq_len(nTrain),
ResidualStudent = rstudent(modeloLogit),
Leverage = hatvalues(modeloLogit),
Cook = cooks.distance(modeloLogit)
) |>
mutate(
AlertaResidual = abs(ResidualStudent) > 3,
AlertaLeverage = Leverage > (2 * pParametros / nTrain),
AlertaCook = Cook > (4 / nTrain),
NumeroAlertas = AlertaResidual + AlertaLeverage + AlertaCook
)
topInfluencia <- diagnosticoInfluencia |>
arrange(desc(NumeroAlertas), desc(Cook), desc(abs(ResidualStudent))) |>
slice_head(n = 10)
tablaHtml(
topInfluencia,
"Observaciones con mayor señal de influencia",
digitos = 5
)
| FilaTrain | ResidualStudent | Leverage | Cook | AlertaResidual | AlertaLeverage | AlertaCook | NumeroAlertas |
|---|---|---|---|---|---|---|---|
| 30 | 3.18283 | 0.00200 | 0.03057 | TRUE | FALSE | TRUE | 2 |
| 509 | 3.20496 | 0.00166 | 0.02757 | TRUE | FALSE | TRUE | 2 |
| 480 | 1.71868 | 0.04184 | 0.01566 | FALSE | TRUE | TRUE | 2 |
| 568 | 1.81244 | 0.02858 | 0.01306 | FALSE | TRUE | TRUE | 2 |
| 476 | 1.85027 | 0.02026 | 0.01008 | FALSE | TRUE | TRUE | 2 |
| 451 | 1.45198 | 0.04070 | 0.00867 | FALSE | TRUE | TRUE | 2 |
| 265 | 1.47114 | 0.03610 | 0.00799 | FALSE | TRUE | TRUE | 2 |
| 715 | 1.35187 | 0.04238 | 0.00727 | FALSE | TRUE | TRUE | 2 |
| 302 | 1.65041 | 0.02212 | 0.00715 | FALSE | TRUE | TRUE | 2 |
| 309 | 1.57177 | 0.02570 | 0.00702 | FALSE | TRUE | TRUE | 2 |
Estas observaciones no se eliminan automáticamente. Un valor alto de Cook o leverage indica que el caso merece inspección, pero la exclusión requiere una justificación relacionada con error de medición, población objetivo o diseño del estudio.
nResidual <- sum(diagnosticoInfluencia$AlertaResidual)
nLeverage <- sum(diagnosticoInfluencia$AlertaLeverage)
nCook <- sum(diagnosticoInfluencia$AlertaCook)
nMultiples <- sum(diagnosticoInfluencia$NumeroAlertas >= 2)
cat(
"En entrenamiento se identifican **", nResidual,
"** observaciones con residuales studentizados mayores a 3 en valor absoluto, **",
nLeverage, "** con leverage por encima del umbral usado y **",
nCook, "** con distancia de Cook superior a 4/n. ",
"De ellas, **", nMultiples,
"** activan al menos dos criterios simultáneamente. ",
"Estas alertas indican casos que merecen inspección, no errores automáticos. ",
"Como la auditoría previa no encontró valores imposibles, se conservan para evitar modificar la población analizada sin evidencia sustantiva.\\n",
sep = ""
)
En entrenamiento se identifican 2 observaciones con residuales studentizados mayores a 3 en valor absoluto, 75 con leverage por encima del umbral usado y 77 con distancia de Cook superior a 4/n. De ellas, 17 activan al menos dos criterios simultáneamente. Estas alertas indican casos que merecen inspección, no errores automáticos. Como la auditoría previa no encontró valores imposibles, se conservan para evitar modificar la población analizada sin evidencia sustantiva.
Las pruebas anteriores muestran evidencia de que la relación de edad, ingreso y antigüedad con el logit puede no ser estrictamente lineal. Esto no invalida el modelo principal, pero sí obliga a ser prudentes con frases del tipo “cada unidad tiene siempre exactamente el mismo efecto”.
Para evaluar la relevancia práctica de esa señal se ajusta una segunda especificación con splines naturales de tres grados de libertad. La comparación se realiza únicamente con los datos de entrenamiento mediante razón de verosimilitud, AIC y validación cruzada. De esta forma, el conjunto de prueba continúa reservado para la evaluación final del modelo principal y no participa en decisiones de especificación.
formulaFlexible <- rotacion ~
horas_extra +
viaje_de_negocios +
estado_civil +
splines::ns(edad, df = 3) +
splines::ns(ingreso_mensual, df = 3) +
splines::ns(antiguedad_cargo, df = 3)
modeloFlexible <- glm(
formulaFlexible,
family = binomial(link = "logit"),
data = train
)
comparacionLinealFlexible <- anova(
modeloLogit,
modeloFlexible,
test = "Chisq"
)
cvLinealSens <- validacionCruzadaAUC(
train,
formulaModelo = formulaModelo,
k = 10,
semilla = SEMILLA
)
cvFlexibleSens <- validacionCruzadaAUC(
train,
formulaModelo = formulaFlexible,
k = 10,
semilla = SEMILLA
)
tablaSensibilidadForma <- tibble(
Modelo = c(
"Logit lineal e interpretable",
"Logit flexible con splines"
),
AIC_Train = c(
AIC(modeloLogit),
AIC(modeloFlexible)
),
AUC_CV_Promedio = c(
mean(cvLinealSens$AUC),
mean(cvFlexibleSens$AUC)
),
SD_AUC_CV = c(
sd(cvLinealSens$AUC),
sd(cvFlexibleSens$AUC)
)
)
tablaHtml(
as.data.frame(comparacionLinealFlexible),
"Razón de verosimilitud: forma lineal frente a forma flexible",
digitos = 5
)
| Resid. Df | Resid. Dev | Df | Deviance | Pr(>Chi) |
|---|---|---|---|---|
| 1021 | 758.9174 |
|
|
|
| 1015 | 727.8487 | 6 | 31.06866 | 0.00002 |
tablaHtml(
tablaSensibilidadForma,
"Comparación interna de especificaciones sin utilizar la muestra de prueba",
digitos = 4
)
| Modelo | AIC_Train | AUC_CV_Promedio | SD_AUC_CV |
|---|---|---|---|
| Logit lineal e interpretable | 776.9174 | 0.7660 | 0.0538 |
| Logit flexible con splines | 757.8487 | 0.7728 | 0.0570 |
pFlexible <- comparacionLinealFlexible$`Pr(>Chi)`[2]
deltaAUCcv <- mean(cvFlexibleSens$AUC) - mean(cvLinealSens$AUC)
cat(
"La prueba de razón de verosimilitud produce **p = ",
formatearP(pFlexible), "**. ",
ifelse(
!is.na(pFlexible) && pFlexible < 0.05,
"La especificación flexible mejora significativamente el ajuste dentro de entrenamiento. ",
"No se encuentra evidencia suficiente de una mejora global del ajuste con la forma flexible. "
),
"En validación cruzada, la diferencia de AUC promedio (flexible - lineal) es de **",
formatearNumero(deltaAUCcv, 3), "**. ",
"El modelo lineal se conserva como modelo principal porque la actividad exige interpretar coeficientes y odds ratios de las seis covariables y porque ofrece una lectura directa para negocio. ",
"Sin embargo, la evidencia de curvatura se mantiene como una limitación importante: los OR de las variables cuantitativas deben leerse como resúmenes promedio y no como efectos constantes en todo su rango.\\n",
sep = ""
)
La prueba de razón de verosimilitud produce p = p < 0,001. La especificación flexible mejora significativamente el ajuste dentro de entrenamiento. En validación cruzada, la diferencia de AUC promedio (flexible - lineal) es de 0,007. El modelo lineal se conserva como modelo principal porque la actividad exige interpretar coeficientes y odds ratios de las seis covariables y porque ofrece una lectura directa para negocio. Sin embargo, la evidencia de curvatura se mantiene como una limitación importante: los OR de las variables cuantitativas deben leerse como resúmenes promedio y no como efectos constantes en todo su rango.
Antes de evaluar el conjunto de prueba, se realiza validación cruzada estratificada de 10 particiones sobre los datos de entrenamiento. Se reporta la distribución del AUC para valorar la estabilidad interna del modelo.
cvAUC <- validacionCruzadaAUC(
train,
formulaModelo = formulaModelo,
k = 10,
semilla = SEMILLA
)
resumenCV <- cvAUC |>
summarise(
AUC_Promedio = mean(AUC),
Desviacion_AUC = sd(AUC),
AUC_Minimo = min(AUC),
AUC_Maximo = max(AUC)
)
tablaHtml(
cvAUC,
"AUC por partición de validación cruzada",
digitos = 4
)
| Fold | AUC |
|---|---|
| 1 | 0.7505 |
| 2 | 0.8276 |
| 3 | 0.6599 |
| 4 | 0.7264 |
| 5 | 0.7830 |
| 6 | 0.7780 |
| 7 | 0.7100 |
| 8 | 0.8037 |
| 9 | 0.8222 |
| 10 | 0.7982 |
tablaHtml(
resumenCV,
"Resumen de validación cruzada",
digitos = 4
)
| AUC_Promedio | Desviacion_AUC | AUC_Minimo | AUC_Maximo |
|---|---|---|---|
| 0.766 | 0.0538 | 0.6599 | 0.8276 |
cat(
"El AUC promedio de validación cruzada es **",
formatearNumero(mean(cvAUC$AUC), 3),
"** con desviación estándar **",
formatearNumero(sd(cvAUC$AUC), 3),
"**. El rango entre particiones va de **",
formatearNumero(min(cvAUC$AUC), 3), "** a **",
formatearNumero(max(cvAUC$AUC), 3),
"**. Esto muestra que la capacidad de discriminación es razonablemente estable, ",
"aunque existe variabilidad entre particiones; por tanto, el AUC no debe tratarse como una constante exacta del proceso.\\n",
sep = ""
)
El AUC promedio de validación cruzada es 0,766 con desviación estándar 0,054. El rango entre particiones va de 0,660 a 0,828. Esto muestra que la capacidad de discriminación es razonablemente estable, aunque existe variabilidad entre particiones; por tanto, el AUC no debe tratarse como una constante exacta del proceso.
ggplot(cvAUC, aes(x = factor(Fold), y = AUC)) +
geom_col() +
geom_hline(
yintercept = mean(cvAUC$AUC),
linetype = "dashed"
) +
coord_cartesian(ylim = c(0, 1)) +
labs(
title = "AUC en validación cruzada de 10 particiones",
x = "Fold",
y = "AUC"
) +
theme_minimal(base_size = 12)
El umbral 0.50 no es obligatorio. Cambiarlo modifica el compromiso entre sensibilidad y especificidad. Para evitar utilizar la muestra de prueba en la selección del umbral, el corte se elige exclusivamente con entrenamiento.
Se utiliza el criterio de Youden:
\[ J = Sensibilidad + Especificidad - 1 \]
probTrain <- predict(modeloLogit, newdata = train, type = "response")
rocTrain <- pROC::roc(
response = train$rotacion,
predictor = probTrain,
levels = c(0, 1),
direction = "<",
quiet = TRUE
)
coordYouden <- pROC::coords(
rocTrain,
x = "best",
best.method = "youden",
ret = c("threshold", "sensitivity", "specificity"),
transpose = FALSE
)
umbralYouden <- as.numeric(coordYouden$threshold)
tablaUmbralesTrain <- purrr::map_dfr(
seq(0.05, 0.90, by = 0.05),
~ metricasUmbral(train$rotacion, probTrain, .x)
)
tablaHtml(
tablaUmbralesTrain,
"Sensibilidad del desempeño al punto de corte en entrenamiento",
digitos = 4,
alto = "520px"
)
| Umbral | VP | FN | FP | VN | Exactitud | Sensibilidad | Especificidad | Precision | VPN | F1 | BalancedAccuracy |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 0.05 | 155 | 11 | 659 | 205 | 0.3495 | 0.9337 | 0.2373 | 0.1904 | 0.9491 | 0.3163 | 0.5855 |
| 0.10 | 135 | 31 | 413 | 451 | 0.5689 | 0.8133 | 0.5220 | 0.2464 | 0.9357 | 0.3782 | 0.6676 |
| 0.15 | 126 | 40 | 277 | 587 | 0.6922 | 0.7590 | 0.6794 | 0.3127 | 0.9362 | 0.4429 | 0.7192 |
| 0.20 | 109 | 57 | 190 | 674 | 0.7602 | 0.6566 | 0.7801 | 0.3645 | 0.9220 | 0.4688 | 0.7184 |
| 0.25 | 94 | 72 | 108 | 756 | 0.8252 | 0.5663 | 0.8750 | 0.4653 | 0.9130 | 0.5109 | 0.7206 |
| 0.30 | 76 | 90 | 84 | 780 | 0.8311 | 0.4578 | 0.9028 | 0.4750 | 0.8966 | 0.4663 | 0.6803 |
| 0.35 | 61 | 105 | 47 | 817 | 0.8524 | 0.3675 | 0.9456 | 0.5648 | 0.8861 | 0.4453 | 0.6565 |
| 0.40 | 47 | 119 | 38 | 826 | 0.8476 | 0.2831 | 0.9560 | 0.5529 | 0.8741 | 0.3745 | 0.6196 |
| 0.45 | 37 | 129 | 30 | 834 | 0.8456 | 0.2229 | 0.9653 | 0.5522 | 0.8660 | 0.3176 | 0.5941 |
| 0.50 | 27 | 139 | 16 | 848 | 0.8495 | 0.1627 | 0.9815 | 0.6279 | 0.8592 | 0.2584 | 0.5721 |
| 0.55 | 20 | 146 | 10 | 854 | 0.8485 | 0.1205 | 0.9884 | 0.6667 | 0.8540 | 0.2041 | 0.5545 |
| 0.60 | 17 | 149 | 6 | 858 | 0.8495 | 0.1024 | 0.9931 | 0.7391 | 0.8520 | 0.1799 | 0.5477 |
| 0.65 | 13 | 153 | 4 | 860 | 0.8476 | 0.0783 | 0.9954 | 0.7647 | 0.8490 | 0.1421 | 0.5368 |
| 0.70 | 9 | 157 | 1 | 863 | 0.8466 | 0.0542 | 0.9988 | 0.9000 | 0.8461 | 0.1023 | 0.5265 |
| 0.75 | 4 | 162 | 0 | 864 | 0.8427 | 0.0241 | 1.0000 | 1.0000 | 0.8421 | 0.0471 | 0.5120 |
| 0.80 | 0 | 166 | 0 | 864 | 0.8388 | 0.0000 | 1.0000 |
|
0.8388 |
|
0.5000 |
| 0.85 | 0 | 166 | 0 | 864 | 0.8388 | 0.0000 | 1.0000 |
|
0.8388 |
|
0.5000 |
| 0.90 | 0 | 166 | 0 | 864 | 0.8388 | 0.0000 | 1.0000 |
|
0.8388 |
|
0.5000 |
tablaYouden <- tibble(
Criterio = "Youden",
Umbral = umbralYouden,
SensibilidadTrain = as.numeric(coordYouden$sensitivity),
EspecificidadTrain = as.numeric(coordYouden$specificity)
)
tablaHtml(
tablaYouden,
"Punto de corte seleccionado en entrenamiento",
digitos = 4
)
| Criterio | Umbral | SensibilidadTrain | EspecificidadTrain |
|---|---|---|---|
| Youden | 0.2352 | 0.6084 | 0.8588 |
tablaUmbralesLarga <- tablaUmbralesTrain |>
select(
Umbral,
Sensibilidad,
Especificidad,
Precision,
F1,
BalancedAccuracy
) |>
pivot_longer(
-Umbral,
names_to = "Metrica",
values_to = "Valor"
)
ggplot(
tablaUmbralesLarga,
aes(x = Umbral, y = Valor, linetype = Metrica)
) +
geom_line(linewidth = 0.9) +
geom_point(size = 1.7) +
geom_vline(
xintercept = umbralYouden,
linetype = "dashed"
) +
scale_y_continuous(
limits = c(0, 1),
labels = scales::percent_format(accuracy = 1)
) +
labs(
title = "Sensibilidad de las métricas al punto de corte",
subtitle = "La línea vertical corresponde al umbral de Youden seleccionado en entrenamiento",
x = "Punto de corte",
y = "Valor de la métrica",
linetype = "Métrica"
) +
theme_minimal(base_size = 12)
Un umbral más bajo clasifica como positivos a más empleados. Esto normalmente aumenta la sensibilidad —detecta más casos reales de rotación—, pero reduce la especificidad y genera más falsos positivos. Un umbral más alto hace lo contrario.
En un problema de retención, el umbral debe vincularse con el costo de los errores:
El criterio de Youden se adopta como referencia estadística porque busca equilibrio entre sensibilidad y especificidad. No se presenta como una regla universal: si la organización considera mucho más costoso un falso negativo que un falso positivo, podría justificarse un umbral todavía menor.
probTest <- predict(
modeloLogit,
newdata = test,
type = "response"
)
rocTest <- pROC::roc(
response = test$rotacion,
predictor = probTest,
levels = c(0, 1),
direction = "<",
quiet = TRUE
)
aucTest <- as.numeric(pROC::auc(rocTest))
icAUC <- as.numeric(pROC::ci.auc(rocTest))
tablaAUC <- tibble(
AUC = aucTest,
IC95_Inferior = icAUC[1],
IC95_Central = icAUC[2],
IC95_Superior = icAUC[3]
)
tablaHtml(
tablaAUC,
"AUC en la muestra de prueba",
digitos = 4
)
| AUC | IC95_Inferior | IC95_Central | IC95_Superior |
|---|---|---|---|
| 0.7708 | 0.7075 | 0.7708 | 0.8341 |
rocData <- tibble(
Especificidad = rocTest$specificities,
Sensibilidad = rocTest$sensitivities,
FPR = 1 - Especificidad
)
ggplot(rocData, aes(x = FPR, y = Sensibilidad)) +
geom_line(linewidth = 1) +
geom_abline(
intercept = 0,
slope = 1,
linetype = "dashed"
) +
coord_equal() +
labs(
title = paste0(
"Curva ROC en prueba (AUC = ",
formatearNumero(aucTest, 3),
")"
),
x = "Tasa de falsos positivos (1 - especificidad)",
y = "Sensibilidad"
) +
theme_minimal(base_size = 12)
metricasTestYouden <- metricasUmbral(
real = test$rotacion,
prob = probTest,
umbral = umbralYouden
)
metricasTest05 <- metricasUmbral(
real = test$rotacion,
prob = probTest,
umbral = 0.50
)
comparacionCortes <- bind_rows(
metricasTest05 |>
mutate(Corte = "0,50"),
metricasTestYouden |>
mutate(Corte = "Youden (seleccionado en train)")
) |>
select(
Corte, Umbral, VP, FN, FP, VN,
Exactitud, Sensibilidad, Especificidad,
Precision, VPN, F1, BalancedAccuracy
)
tablaHtml(
comparacionCortes,
"Desempeño en prueba: corte 0,50 vs. corte seleccionado",
digitos = 4
)
| Corte | Umbral | VP | FN | FP | VN | Exactitud | Sensibilidad | Especificidad | Precision | VPN | F1 | BalancedAccuracy |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0,50 | 0.5000 | 11 | 60 | 6 | 363 | 0.8500 | 0.1549 | 0.9837 | 0.6471 | 0.8582 | 0.2500 | 0.5693 |
| Youden (seleccionado en train) | 0.2352 | 41 | 30 | 57 | 312 | 0.8023 | 0.5775 | 0.8455 | 0.4184 | 0.9123 | 0.4852 | 0.7115 |
m05 <- metricasTest05
mY <- metricasTestYouden
cat(
"Con el corte convencional de **0,50**, la sensibilidad es **",
formatearPorcentaje(m05$Sensibilidad, 1),
"** y la especificidad **",
formatearPorcentaje(m05$Especificidad, 1),
"**. Esto significa que se dejan sin detectar **",
m05$FN,
"** de los casos reales de rotación y se generan **",
m05$FP,
"** falsos positivos. ",
"Con el umbral de Youden (**",
formatearNumero(umbralYouden, 3),
"**), la sensibilidad cambia a **",
formatearPorcentaje(mY$Sensibilidad, 1),
"** y la especificidad a **",
formatearPorcentaje(mY$Especificidad, 1),
"**; los falsos negativos se reducen a **",
mY$FN,
"** y los falsos positivos aumentan a **",
mY$FP,
"**. ",
"La balanced accuracy pasa de **",
formatearPorcentaje(m05$BalancedAccuracy, 1),
"** a **",
formatearPorcentaje(mY$BalancedAccuracy, 1),
"**. ",
"Por tanto, el umbral de 0,50 favorece fuertemente la clase mayoritaria, mientras que el corte seleccionado ofrece un equilibrio mucho más útil para detectar rotación.\n",
sep = ""
)
Con el corte convencional de 0,50, la sensibilidad es 15,5% y la especificidad 98,4%. Esto significa que se dejan sin detectar 60 de los casos reales de rotación y se generan 6 falsos positivos. Con el umbral de Youden (0,235), la sensibilidad cambia a 57,7% y la especificidad a 84,6%; los falsos negativos se reducen a 30 y los falsos positivos aumentan a 57. La balanced accuracy pasa de 56,9% a 71,1%. Por tanto, el umbral de 0,50 favorece fuertemente la clase mayoritaria, mientras que el corte seleccionado ofrece un equilibrio mucho más útil para detectar rotación.
predTest <- ifelse(probTest >= umbralYouden, 1L, 0L)
matrizTest <- table(
Observado = factor(test$rotacion, levels = c(0, 1), labels = c("No", "Sí")),
Predicho = factor(predTest, levels = c(0, 1), labels = c("No", "Sí"))
)
tablaHtml(
as.data.frame.matrix(matrizTest),
"Matriz de confusión en prueba con el punto de corte seleccionado",
digitos = 0
)
| No | Sí | |
|---|---|---|
| No | 312 | 57 |
| Sí | 30 | 41 |
accuracyBaseline <- max(
mean(test$rotacion == 0),
mean(test$rotacion == 1)
)
comparacionBaseline <- tibble(
Modelo = c("Clase mayoritaria", "Regresión logística"),
Exactitud = c(
accuracyBaseline,
metricasTestYouden$Exactitud
),
BalancedAccuracy = c(
0.50,
metricasTestYouden$BalancedAccuracy
)
)
tablaHtml(
comparacionBaseline,
"Comparación con una línea base simple",
digitos = 4
)
| Modelo | Exactitud | BalancedAccuracy |
|---|---|---|
| Clase mayoritaria | 0.8386 | 0.5000 |
| Regresión logística | 0.8023 | 0.7115 |
cat(
"La exactitud del clasificador que siempre predice la clase mayoritaria es **",
formatearPorcentaje(accuracyBaseline, 1),
"**, mientras que la regresión logística con el umbral seleccionado alcanza **",
formatearPorcentaje(metricasTestYouden$Exactitud, 1),
"**. Una exactitud menor que la línea base **no implica por sí sola que el modelo sea inútil**: ",
"el clasificador mayoritario obtiene esa exactitud a costa de no detectar ningún caso positivo. ",
"La regresión logística, en cambio, alcanza una balanced accuracy de **",
formatearPorcentaje(metricasTestYouden$BalancedAccuracy, 1),
"** y una sensibilidad de **",
formatearPorcentaje(metricasTestYouden$Sensibilidad, 1),
"**. En un problema desbalanceado, esta comparación muestra por qué la exactitud debe interpretarse junto con sensibilidad, especificidad, F1, balanced accuracy y AUC.\n",
sep = ""
)
La exactitud del clasificador que siempre predice la clase mayoritaria es 83,9%, mientras que la regresión logística con el umbral seleccionado alcanza 80,2%. Una exactitud menor que la línea base no implica por sí sola que el modelo sea inútil: el clasificador mayoritario obtiene esa exactitud a costa de no detectar ningún caso positivo. La regresión logística, en cambio, alcanza una balanced accuracy de 71,1% y una sensibilidad de 57,7%. En un problema desbalanceado, esta comparación muestra por qué la exactitud debe interpretarse junto con sensibilidad, especificidad, F1, balanced accuracy y AUC.
Además de discriminar entre empleados con y sin rotación, interesa que las probabilidades tengan una escala razonable. El Brier score es el error cuadrático medio entre la probabilidad predicha y el resultado observado; valores menores indican mejor calibración global.
brierTest <- mean((probTest - test$rotacion)^2)
calibracionTest <- tibble(
Observado = test$rotacion,
Probabilidad = probTest
) |>
mutate(
Decil = dplyr::ntile(Probabilidad, 10)
) |>
group_by(Decil) |>
summarise(
N = n(),
ProbabilidadMedia = mean(Probabilidad),
TasaObservada = mean(Observado),
.groups = "drop"
)
tablaHtml(
calibracionTest,
"Calibración por deciles de riesgo en prueba",
digitos = 4
)
| Decil | N | ProbabilidadMedia | TasaObservada |
|---|---|---|---|
| 1 | 44 | 0.0187 | 0.0227 |
| 2 | 44 | 0.0385 | 0.0682 |
| 3 | 44 | 0.0573 | 0.0909 |
| 4 | 44 | 0.0750 | 0.0682 |
| 5 | 44 | 0.0942 | 0.0455 |
| 6 | 44 | 0.1191 | 0.0909 |
| 7 | 44 | 0.1572 | 0.2045 |
| 8 | 44 | 0.2162 | 0.1136 |
| 9 | 44 | 0.3028 | 0.3636 |
| 10 | 44 | 0.4731 | 0.5455 |
tablaHtml(
tibble(BrierScore = brierTest),
"Brier score en prueba",
digitos = 5
)
| BrierScore |
|---|
| 0.11233 |
probTestAcotada <- pmin(pmax(probTest, 1e-6), 1 - 1e-6)
logitPredTest <- qlogis(probTestAcotada)
modeloCalibracion <- glm(
test$rotacion ~ logitPredTest,
family = binomial(link = "logit")
)
coefCalibracion <- coef(modeloCalibracion)
tablaCalibracionGlobal <- tibble(
Indicador = c(
"Intercepto de calibración",
"Pendiente de calibración"
),
Valor = c(
unname(coefCalibracion[1]),
unname(coefCalibracion[2])
),
ReferenciaIdeal = c(0, 1)
)
tablaHtml(
tablaCalibracionGlobal,
"Calibración global de las probabilidades en prueba",
digitos = 4
)
| Indicador | Valor | ReferenciaIdeal |
|---|---|---|
| Intercepto de calibración | 0.1079 | 0 |
| Pendiente de calibración | 1.0386 | 1 |
cat(
"Una calibración ideal tendría intercepto **0** y pendiente **1**. ",
"El intercepto obtenido es **",
formatearNumero(coefCalibracion[1], 3),
"** y la pendiente **",
formatearNumero(coefCalibracion[2], 3),
"**. El intercepto informa si el modelo tiende globalmente a sobreestimar o subestimar el riesgo, ",
"mientras que la pendiente resume si las probabilidades son demasiado extremas o demasiado moderadas. ",
"Estos indicadores complementan el Brier score y la gráfica por deciles; ninguno debe interpretarse de forma aislada.\\n",
sep = ""
)
Una calibración ideal tendría intercepto 0 y pendiente 1. El intercepto obtenido es 0,108 y la pendiente 1,039. El intercepto informa si el modelo tiende globalmente a sobreestimar o subestimar el riesgo, mientras que la pendiente resume si las probabilidades son demasiado extremas o demasiado moderadas. Estos indicadores complementan el Brier score y la gráfica por deciles; ninguno debe interpretarse de forma aislada.
ggplot(
calibracionTest,
aes(x = ProbabilidadMedia, y = TasaObservada)
) +
geom_point(size = 2.5) +
geom_line() +
geom_abline(
intercept = 0,
slope = 1,
linetype = "dashed"
) +
coord_equal(xlim = c(0, 1), ylim = c(0, 1)) +
labs(
title = "Calibración de probabilidades en la muestra de prueba",
x = "Probabilidad predicha media",
y = "Proporción observada de rotación"
) +
theme_minimal(base_size = 12)
Se construye un perfil hipotético utilizando valores dentro del rango observado en entrenamiento. Para las variables categóricas se intentan seleccionar los niveles coherentes con el escenario planteado en las hipótesis; para las cuantitativas se usan cuantiles de la muestra para evitar valores artificiales.
perfil <- tibble(
horas_extra = factor(
nivelPorPatron(train$horas_extra, c("^si$", "yes")),
levels = levels(train$horas_extra)
),
viaje_de_negocios = factor(
nivelPorPatron(
train$viaje_de_negocios,
c("frecu", "frequent"),
fallback = tail(levels(train$viaje_de_negocios), 1)
),
levels = levels(train$viaje_de_negocios)
),
estado_civil = factor(
nivelPorPatron(
train$estado_civil,
c("solter", "single"),
fallback = tail(levels(train$estado_civil), 1)
),
levels = levels(train$estado_civil)
),
edad = as.numeric(quantile(train$edad, 0.25, na.rm = TRUE)),
ingreso_mensual = as.numeric(
quantile(train$ingreso_mensual, 0.25, na.rm = TRUE)
),
antiguedad_cargo = as.numeric(
quantile(train$antiguedad_cargo, 0.25, na.rm = TRUE)
)
)
probPerfil <- predict(
modeloLogit,
newdata = perfil,
type = "response"
)
decisionPerfil <- ifelse(
probPerfil >= umbralYouden,
"Intervenir / priorizar seguimiento",
"No priorizar intervención con este criterio"
)
perfilMostrable <- perfil |>
mutate(
ProbabilidadEstimadaRotacion = as.numeric(probPerfil),
PuntoCorte = umbralYouden,
Decision = decisionPerfil
)
tablaHtml(
perfilMostrable,
"Predicción para un empleado hipotético",
digitos = 4
)
| horas_extra | viaje_de_negocios | estado_civil | edad | ingreso_mensual | antiguedad_cargo | ProbabilidadEstimadaRotacion | PuntoCorte | Decision |
|---|---|---|---|---|---|---|---|---|
| Si | Frecuentemente | Soltero | 30 | 2967.5 | 2 | 0.6906 | 0.2352 | Intervenir / priorizar seguimiento |
cat(
"Para el perfil hipotético, el modelo estima una probabilidad de rotación de **",
formatearPorcentaje(probPerfil, 1),
"**. El punto de corte seleccionado en entrenamiento es **",
formatearNumero(umbralYouden, 3),
"**; por tanto, la decisión derivada de esta regla es: **",
decisionPerfil,
"**.\n\n",
sep = ""
)
Para el perfil hipotético, el modelo estima una probabilidad de rotación de 69,1%. El punto de corte seleccionado en entrenamiento es 0,235; por tanto, la decisión derivada de esta regla es: Intervenir / priorizar seguimiento.
cat(
"Esta decisión no debe interpretarse como certeza sobre el comportamiento individual. ",
"La regresión logística estima una probabilidad condicionada a las variables incluidas ",
"y debe emplearse como apoyo a una política de retención, no como sustituto del juicio humano.\n",
sep = ""
)
Esta decisión no debe interpretarse como certeza sobre el comportamiento individual. La regresión logística estima una probabilidad condicionada a las variables incluidas y debe emplearse como apoyo a una política de retención, no como sustituto del juicio humano.
Para comprender por qué el perfil alcanza su probabilidad final, se reconstruye la predicción de forma acumulativa desde un perfil de referencia. El orden de incorporación es únicamente expositivo: en un modelo aditivo sin interacciones el logit final es la suma de las contribuciones, aunque el cambio en probabilidad observado en cada paso sí depende del punto de partida.
perfilRefHip <- perfil
perfilRefHip$horas_extra <- factor(
levels(train$horas_extra)[1],
levels = levels(train$horas_extra)
)
perfilRefHip$viaje_de_negocios <- factor(
levels(train$viaje_de_negocios)[1],
levels = levels(train$viaje_de_negocios)
)
perfilRefHip$estado_civil <- factor(
levels(train$estado_civil)[1],
levels = levels(train$estado_civil)
)
pRefHip <- as.numeric(
predict(modeloLogit, newdata = perfilRefHip, type = "response")
)
actual <- perfilRefHip
pAnterior <- pRefHip
pasos <- list()
agregarPaso <- function(nombre, objeto, pAnterior) {
pNuevo <- as.numeric(
predict(modeloLogit, newdata = objeto, type = "response")
)
tibble(
Paso = nombre,
ProbabilidadAntes = pAnterior,
ProbabilidadDespues = pNuevo,
CambioPP = 100 * (pNuevo - pAnterior)
)
}
actual$horas_extra <- perfil$horas_extra
pasos[[1]] <- agregarPaso(
"Activar horas extra",
actual,
pAnterior
)
pAnterior <- pasos[[1]]$ProbabilidadDespues
actual$viaje_de_negocios <- perfil$viaje_de_negocios
pasos[[2]] <- agregarPaso(
"Cambiar viaje de negocios al nivel del perfil",
actual,
pAnterior
)
pAnterior <- pasos[[2]]$ProbabilidadDespues
actual$estado_civil <- perfil$estado_civil
pasos[[3]] <- agregarPaso(
"Cambiar estado civil al nivel del perfil",
actual,
pAnterior
)
tablaDescomposicion <- bind_rows(pasos)
tablaHtml(
tablaDescomposicion,
"Construcción acumulativa de la probabilidad del perfil hipotético",
digitos = 4
)
| Paso | ProbabilidadAntes | ProbabilidadDespues | CambioPP |
|---|---|---|---|
| Activar horas extra | 0.0684 | 0.2408 | 17.2416 |
| Cambiar viaje de negocios al nivel del perfil | 0.2408 | 0.5057 | 26.4875 |
| Cambiar estado civil al nivel del perfil | 0.5057 | 0.6906 | 18.4895 |
cat(
"Con la edad, ingreso y antigüedad del perfil hipotético, pero manteniendo las categorías de referencia, ",
"la probabilidad inicial es **",
formatearPorcentaje(pRefHip, 1),
"**. Al incorporar sucesivamente las características categóricas del perfil, la probabilidad se desplaza hasta **",
formatearPorcentaje(probPerfil, 1),
"**. Esta descomposición permite visualizar qué cambios categóricos empujan la predicción hacia arriba o hacia abajo, ",
"sin interpretar ninguno de ellos como causa determinante de la rotación.\n",
sep = ""
)
Con la edad, ingreso y antigüedad del perfil hipotético, pero manteniendo las categorías de referencia, la probabilidad inicial es 6,8%. Al incorporar sucesivamente las características categóricas del perfil, la probabilidad se desplaza hasta 69,1%. Esta descomposición permite visualizar qué cambios categóricos empujan la predicción hacia arriba o hacia abajo, sin interpretar ninguno de ellos como causa determinante de la rotación.
variablesSignificativas <- significanciaVariables |>
filter(Significativa5pct) |>
pull(Variable)
if (length(variablesSignificativas) == 0) {
textoSignificativas <- "ninguna de las seis covariables presenta significancia global al 5% en el modelo ajustado"
} else {
textoSignificativas <- paste(variablesSignificativas, collapse = ", ")
}
tablaEstrategia <- significanciaVariables |>
mutate(
Implicacion = case_when(
Variable == "Horas extra" & Significativa5pct ~
"Revisar distribución de cargas, jornadas extendidas y compensación de horas extra.",
Variable == "Viaje de negocios" & Significativa5pct ~
"Revisar frecuencia de desplazamientos, rotación de viajes y medidas de conciliación.",
Variable == "Estado civil" & Significativa5pct ~
"No intervenir por estado civil; usar el hallazgo únicamente como señal descriptiva y revisar variables laborales subyacentes.",
Variable == "Edad" & Significativa5pct ~
"Evitar decisiones por edad; investigar etapas de carrera, movilidad y oportunidades de desarrollo que puedan explicar la asociación.",
Variable == "Ingreso mensual" & Significativa5pct ~
"Revisar competitividad salarial, equidad interna y progresión de compensación.",
Variable == "Antigüedad en el cargo" & Significativa5pct ~
"Revisar movilidad interna, planes de carrera, promoción y enriquecimiento del cargo.",
TRUE ~
"No se propone una acción específica basada únicamente en esta variable porque no presenta significancia global al 5% en el modelo ajustado."
)
)
tablaHtml(
tablaEstrategia,
"Traducción de resultados a posibles acciones de gestión",
digitos = 4,
alto = "520px"
)
| Variable | Df | AIC | LRT | ValorP | Significativa5pct | Implicacion |
|---|---|---|---|---|---|---|
| Horas extra | 1 | 835.8926 | 60.9752 | 0.0000 | TRUE | Revisar distribución de cargas, jornadas extendidas y compensación de horas extra. |
| Viaje de negocios | 2 | 785.1890 | 12.2717 | 0.0022 | TRUE | Revisar frecuencia de desplazamientos, rotación de viajes y medidas de conciliación. |
| Estado civil | 2 | 798.8628 | 25.9454 | 0.0000 | TRUE | No intervenir por estado civil; usar el hallazgo únicamente como señal descriptiva y revisar variables laborales subyacentes. |
| Edad | 1 | 776.6867 | 1.7693 | 0.1835 | FALSE | No se propone una acción específica basada únicamente en esta variable porque no presenta significancia global al 5% en el modelo ajustado. |
| Ingreso mensual | 1 | 782.6087 | 7.6913 | 0.0055 | TRUE | Revisar competitividad salarial, equidad interna y progresión de compensación. |
| Antigüedad en el cargo | 1 | 785.6549 | 10.7376 | 0.0010 | TRUE | Revisar movilidad interna, planes de carrera, promoción y enriquecimiento del cargo. |
Precaución ética: aunque algunas variables personales puedan mostrar asociación estadística, una estrategia de recursos humanos no debería discriminar a empleados por características personales. La intervención debe orientarse, siempre que sea posible, hacia condiciones laborales modificables: cargas, compensación, movilidad, desarrollo y diseño del trabajo.
El modelo permite separar dos preguntas que suelen confundirse:
Para gestión de talento, la prioridad no debería ser actuar sobre la variable con el valor p más pequeño, sino combinar magnitud del efecto, evidencia estadística, posibilidad real de intervención y costo operativo. Horas extra, frecuencia de viajes, compensación y permanencia en el cargo son variables sobre las cuales la organización puede revisar políticas. Edad y estado civil, aun cuando aporten señal predictiva, no son variables sobre las cuales deba definirse una intervención individual.
cat(
"La base analizada contiene **", nrow(datos), "** empleados y **", ncol(datosOriginales),
"** variables. Para las siete variables utilizadas por el modelo se identificaron **",
sum(auditoriaSeleccionadas$Faltantes), "** valores faltantes y **",
duplicadosCompletos, "** filas completamente duplicadas. ",
"Por esta razón, el análisis no requirió imputación ni eliminación de duplicados. ",
"Las variables categóricas fueron codificadas como factores con referencias explícitas y las variables cuantitativas se conservaron en sus unidades originales. ",
"Los valores extremos detectados mediante IQR se mantuvieron porque un valor extremo no constituye por sí mismo un error; su posible influencia se evaluó posteriormente con residuales, leverage y distancia de Cook. ",
"Tampoco se aplicó escalamiento ni remuestreo de clases, con el propósito de conservar interpretabilidad y probabilidades compatibles con la prevalencia observada.\n",
sep = ""
)
La base analizada contiene 1470 empleados y 24 variables. Para las siete variables utilizadas por el modelo se identificaron 0 valores faltantes y 0 filas completamente duplicadas. Por esta razón, el análisis no requirió imputación ni eliminación de duplicados. Las variables categóricas fueron codificadas como factores con referencias explícitas y las variables cuantitativas se conservaron en sus unidades originales. Los valores extremos detectados mediante IQR se mantuvieron porque un valor extremo no constituye por sí mismo un error; su posible influencia se evaluó posteriormente con residuales, leverage y distancia de Cook. Tampoco se aplicó escalamiento ni remuestreo de clases, con el propósito de conservar interpretabilidad y probabilidades compatibles con la prevalencia observada.
cat(
"La prueba global de razón de verosimilitud produce **p = ",
formatearP(pGlobal),
"** y el pseudo-R2 de McFadden es **",
formatearNumero(r2McFadden, 3),
"**. ",
ifelse(
pGlobal < 0.05,
"En conjunto, las covariables mejoran significativamente el ajuste frente a un modelo sin predictores.",
"No se observa evidencia suficiente de una mejora global frente al modelo nulo."
),
" Las pruebas globales por covariable indican que las variables con evidencia al 5% son: **",
textoSignificativas,
"**. La significancia debe interpretarse junto con el tamaño del efecto y su intervalo de confianza, no como un criterio único de importancia.\n",
sep = ""
)
La prueba global de razón de verosimilitud produce p = p < 0,001 y el pseudo-R2 de McFadden es 0,166. En conjunto, las covariables mejoran significativamente el ajuste frente a un modelo sin predictores. Las pruebas globales por covariable indican que las variables con evidencia al 5% son: Horas extra, Viaje de negocios, Estado civil, Ingreso mensual, Antigüedad en el cargo. La significancia debe interpretarse junto con el tamaño del efecto y su intervalo de confianza, no como un criterio único de importancia.
resumenImpactos <- bind_rows(
tablaEfectosCat |>
transmute(
Cambio = paste0(
Variable, ": ", Referencia, " → ", NivelComparado
),
CambioPP = CambioPromedioPuntosPorcentuales,
CambioOddsPct = CambioPorcentualOdds,
ValorP = ValorP
),
tablaEfectosNum |>
transmute(
Cambio = paste0(
Variable, ": ", CambioEvaluado
),
CambioPP = CambioPromedioPuntosPorcentuales,
CambioOddsPct = CambioPorcentualOdds,
ValorP = ValorP
)
) |>
arrange(desc(abs(CambioPP)))
topImpactos <- resumenImpactos |>
slice_head(n = 4)
cat(
"La interpretación de odds y probabilidades muestra que no todas las entradas modifican la predicción con la misma magnitud. ",
"Los cambios con mayor variación absoluta de probabilidad promedio son:\n\n"
)
La interpretación de odds y probabilidades muestra que no todas las entradas modifican la predicción con la misma magnitud. Los cambios con mayor variación absoluta de probabilidad promedio son:
for (i in seq_len(nrow(topImpactos))) {
f <- topImpactos[i, ]
cat(
"- **", f$Cambio, ":** ",
ifelse(f$CambioPP >= 0, "aumenta", "disminuye"),
" la probabilidad promedio en **",
formatearNumero(abs(f$CambioPP), 2),
" puntos porcentuales** y modifica los odds en **",
ifelse(
f$CambioOddsPct >= 0,
paste0("+", formatearNumero(f$CambioOddsPct, 1), "%"),
paste0("-", formatearNumero(abs(f$CambioOddsPct), 1), "%")
),
"**. ",
ifelse(
!is.na(f$ValorP) && f$ValorP < 0.05,
"El contraste cuenta con evidencia estadística al 5%.",
"El contraste no cuenta con evidencia estadística suficiente al 5%, por lo que su dirección no debe presentarse como concluyente."
),
"\n",
sep = ""
)
}
cat(
"\nLos porcentajes anteriores corresponden a **odds**, mientras que los cambios en puntos porcentuales corresponden a la **probabilidad predicha**. ",
"Esta distinción es esencial: un aumento grande en odds no implica el mismo aumento porcentual en probabilidad.\n"
)
Los porcentajes anteriores corresponden a odds, mientras que los cambios en puntos porcentuales corresponden a la probabilidad predicha. Esta distinción es esencial: un aumento grande en odds no implica el mismo aumento porcentual en probabilidad.
nNoLineales <- sum(
tablaLinealidad$EvidenciaNoLinealidad5pct,
na.rm = TRUE
)
cat(
"La evaluación de linealidad del logit detecta evidencia de no linealidad en **",
nNoLineales, "** de las **", nrow(tablaLinealidad),
"** variables cuantitativas evaluadas. ",
ifelse(
nNoLineales > 0,
"Por ello, los OR lineales de edad, ingreso mensual y antigüedad deben entenderse como resúmenes promedio dentro de la especificación principal, no como efectos necesariamente constantes en todo el rango de cada predictor.",
"No se identificó evidencia importante contra la especificación lineal en el logit."
),
" El modelo flexible con splines se utiliza como análisis de sensibilidad y se compara únicamente dentro de entrenamiento, evitando utilizar la muestra de prueba para seleccionar especificaciones.\n",
sep = ""
)
La evaluación de linealidad del logit detecta evidencia de no linealidad en 3 de las 3 variables cuantitativas evaluadas. Por ello, los OR lineales de edad, ingreso mensual y antigüedad deben entenderse como resúmenes promedio dentro de la especificación principal, no como efectos necesariamente constantes en todo el rango de cada predictor. El modelo flexible con splines se utiliza como análisis de sensibilidad y se compara únicamente dentro de entrenamiento, evitando utilizar la muestra de prueba para seleccionar especificaciones.
cat(
"En la muestra de prueba el modelo alcanza un **AUC de ",
formatearNumero(aucTest, 3),
"** con IC95% [",
formatearNumero(icAUC[1], 3), "; ",
formatearNumero(icAUC[3], 3),
"]. La validación cruzada interna obtiene un AUC promedio de **",
formatearNumero(mean(cvAUC$AUC), 3),
"**, lo que permite comparar la discriminación interna con la obtenida en datos no utilizados para el ajuste. ",
"El Brier score en prueba es **",
formatearNumero(brierTest, 4),
"** y la curva de calibración permite evaluar si las probabilidades predichas se aproximan a las frecuencias observadas.\n",
sep = ""
)
En la muestra de prueba el modelo alcanza un AUC de 0,771 con IC95% [0,708; 0,834]. La validación cruzada interna obtiene un AUC promedio de 0,766, lo que permite comparar la discriminación interna con la obtenida en datos no utilizados para el ajuste. El Brier score en prueba es 0,1123 y la curva de calibración permite evaluar si las probabilidades predichas se aproximan a las frecuencias observadas.
cat(
"El umbral de **0,50** no resulta especialmente apropiado para detectar la clase minoritaria: su sensibilidad en prueba es **",
formatearPorcentaje(metricasTest05$Sensibilidad, 1),
"**. El punto de corte seleccionado con Youden en entrenamiento es **",
formatearNumero(umbralYouden, 3),
"** y eleva la sensibilidad en prueba a **",
formatearPorcentaje(metricasTestYouden$Sensibilidad, 1),
"**, mientras la especificidad queda en **",
formatearPorcentaje(metricasTestYouden$Especificidad, 1),
"**. Los falsos negativos cambian de **",
metricasTest05$FN, "** a **", metricasTestYouden$FN,
"** y los falsos positivos de **",
metricasTest05$FP, "** a **", metricasTestYouden$FP,
"**. Esto muestra que el punto de corte debe decidirse según el costo organizacional de omitir un caso de rotación frente al costo de intervenir a un empleado que finalmente permanece.\n",
sep = ""
)
El umbral de 0,50 no resulta especialmente apropiado para detectar la clase minoritaria: su sensibilidad en prueba es 15,5%. El punto de corte seleccionado con Youden en entrenamiento es 0,235 y eleva la sensibilidad en prueba a 57,7%, mientras la especificidad queda en 84,6%. Los falsos negativos cambian de 60 a 30 y los falsos positivos de 6 a 57. Esto muestra que el punto de corte debe decidirse según el costo organizacional de omitir un caso de rotación frente al costo de intervenir a un empleado que finalmente permanece.
La utilidad principal del modelo no es etiquetar de forma determinista a un empleado, sino ordenar y cuantificar riesgo. Las acciones deberían concentrarse en factores laborales modificables que muestren asociación y magnitud relevantes —por ejemplo, carga de horas extra, frecuencia de viajes, compensación y oportunidades de permanencia o movilidad interna—. Las características personales, aun cuando resulten asociadas estadísticamente, no deben utilizarse como base para decisiones discriminatorias.
El análisis también muestra que una estrategia de retención no debería apoyarse únicamente en un umbral binario. La probabilidad predicha puede utilizarse para definir niveles de seguimiento y, posteriormente, evaluar si las intervenciones realmente reducen la rotación mediante diseños prospectivos.
Desde una perspectiva de negocio, el modelo es más útil como sistema de priorización que como regla automática. Un empleado con probabilidad superior al umbral debería entrar a una revisión de contexto —carga, viajes, compensación, desarrollo y movilidad— antes de decidir cualquier acción. Además, el impacto de una intervención debe medirse posteriormente; el modelo actual identifica asociaciones y riesgo, pero no demuestra que modificar una variable cause por sí solo una reducción de la rotación.
La semilla utilizada en todo el flujo es 20260922. La partición de entrenamiento/prueba y la validación cruzada vuelven a utilizar explícitamente esta misma semilla. Por tanto, al ejecutar el documento completo en un mismo entorno de R y con las mismas versiones de paquetes, los resultados aleatorios deben reproducirse.
Para auditoría técnica se registra la información de la sesión:
sessionInfo()
## R version 4.5.3 (2026-03-11 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
##
## Matrix products: default
## LAPACK version 3.12.1
##
## locale:
## [1] LC_COLLATE=Spanish_Colombia.utf8 LC_CTYPE=Spanish_Colombia.utf8
## [3] LC_MONETARY=Spanish_Colombia.utf8 LC_NUMERIC=C
## [5] LC_TIME=Spanish_Colombia.utf8
##
## time zone: America/Bogota
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] paqueteMODELOS_0.1.0 summarytools_1.1.5 gridExtra_2.3
## [4] GGally_2.4.0 boot_1.3-32 caret_7.0-1
## [7] lattice_0.22-9 pROC_1.19.1 car_3.1-5
## [10] carData_3.0-6 broom_1.0.13 janitor_2.2.1
## [13] kableExtra_1.4.0 knitr_1.51 scales_1.4.0
## [16] ggplot2_4.0.2 tibble_3.3.1 forcats_1.0.1
## [19] stringr_1.6.0 purrr_1.2.2 tidyr_1.3.2
## [22] dplyr_1.2.1
##
## loaded via a namespace (and not attached):
## [1] tcltk_4.5.3 rlang_1.3.0 magrittr_2.0.5
## [4] snakecase_0.11.1 otel_0.2.0 matrixStats_1.5.0
## [7] compiler_4.5.3 systemfonts_1.3.2 vctrs_0.7.3
## [10] reshape2_1.4.5 pkgconfig_2.0.3 fastmap_1.2.0
## [13] backports_1.5.1 magick_2.9.1 labeling_0.4.3
## [16] pander_0.6.6 rmarkdown_2.31 prodlim_2026.03.11
## [19] xfun_0.60 cachem_1.1.0 jsonlite_2.0.0
## [22] recipes_1.4.0 parallel_4.5.3 R6_2.6.1
## [25] bslib_0.10.0 stringi_1.8.7 RColorBrewer_1.1-3
## [28] parallelly_1.48.0 rpart_4.1.24 lubridate_1.9.5
## [31] jquerylib_0.1.4 Rcpp_1.1.2 iterators_1.0.14
## [34] future.apply_1.20.2 base64enc_0.1-6 pacman_0.5.1
## [37] Matrix_1.7-4 splines_4.5.3 nnet_7.3-20
## [40] timechange_0.4.0 tidyselect_1.2.1 rstudioapi_0.18.0
## [43] abind_1.4-8 yaml_2.3.12 timeDate_4052.112
## [46] codetools_0.2-20 listenv_1.0.0 plyr_1.8.9
## [49] withr_3.0.2 S7_0.2.1 evaluate_1.0.5
## [52] future_1.75.0 survival_3.8-6 ggstats_0.13.0
## [55] xml2_1.5.2 pillar_1.11.1 checkmate_2.3.4
## [58] foreach_1.5.2 stats4_4.5.3 generics_0.1.4
## [61] globals_0.19.1 class_7.3-23 glue_1.8.0
## [64] tools_4.5.3 data.table_1.18.4 ModelMetrics_1.2.2.2
## [67] gower_1.0.2 rapportools_1.2 grid_4.5.3
## [70] ipred_0.9-16 nlme_3.1-168 Formula_1.2-6
## [73] cli_3.6.6 textshaping_1.0.5 viridisLite_0.4.3
## [76] svglite_2.2.2 lava_1.9.3 gtable_0.3.6
## [79] sass_0.4.10 digest_0.6.39 farver_2.1.2
## [82] htmltools_0.5.9 lifecycle_1.0.5 hardhat_1.4.3
## [85] MASS_7.3-65