Actividad_3_ Rotacion
Carlos Preciado, Jefferson Martinez, Ricardo Vargas Murillo
2026-03-17
Problema: ROTACION DE CARGO
Mediante el siguiente problema se busca comprender y prever los factores que influyen en la rotación de empleados entre distintos cargos. La empresa ha recopilado datos históricos sobre el empleo de sus trabajadores, incluyendo variables como la antigüedad en el cargo actual, el nivel de satisfacción laboral, el salario actual, edad y otros factores relevantes. La gerencia planea desarrollar un modelo de regresión logística que permita estimar la probabilidad de que un empleado cambie de cargo en el próximo período y determinar cuales factores indicen en mayor proporción a estos cambios.
Para lograr identificar todo esto el markdown estará dividido en los siguientes pasos
- EDA basico sobre todo el data set para poder tener criterio tecnico
- Selección de variables
- Analisis Univariado
- Analisis Bivariado
- Estimacion del modelo
- Evaluacion del modelo
- Predicciones
- Conclusiones
rotacion <- rotacion %>% clean_names()0. EDA basico sobre todo el data set para poder tener criterio tecnico
En esta parte se busca entender el dataframe para tener el criterio tecnico de decision de tal forma que se puedan realizar las hipotesis con contexto
st_options(bootstrap.css = FALSE)
dfSummary(rotacion,
varnumbers = TRUE,
valid.col = TRUE,
na.col = TRUE,
graph.col = TRUE) %>%
print(method = "render",
table.classes = "table table-striped table-hover")Data Frame Summary
rotacion
Dimensions: 1470 x 24Duplicates: 0
| No | Variable | Stats / Values | Freqs (% of Valid) | Graph | Valid | Missing | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | rotacion [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 2 | edad [numeric] |
|
43 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 3 | viaje_de_negocios [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 4 | departamento [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 5 | distancia_casa [numeric] |
|
29 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 6 | educacion [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 7 | campo_educacion [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 8 | satisfaccion_ambiental [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 9 | genero [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 10 | cargo [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 11 | satisfacion_laboral [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 12 | estado_civil [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 13 | ingreso_mensual [numeric] |
|
1349 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 14 | trabajos_anteriores [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 15 | horas_extra [character] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 16 | porcentaje_aumento_salarial [numeric] |
|
15 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 17 | rendimiento_laboral [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 18 | anos_experiencia [numeric] |
|
40 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 19 | capacitaciones [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 20 | equilibrio_trabajo_vida [numeric] |
|
|
 |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 21 | antiguedad [numeric] |
|
37 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 22 | antiguedad_cargo [numeric] |
|
19 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 23 | anos_ultima_promocion [numeric] |
|
16 distinct values |  |
1470 (100.0%) | 0 (0.0%) | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| 24 | anos_acargo_con_mismo_jefe [numeric] |
|
18 distinct values |  |
1470 (100.0%) | 0 (0.0%) |
Generated by summarytools 1.1.5 (R version 4.5.1)
2026-04-01
Con la exploracion inicial nos podemos dar cuenta que el df debe ser transformado en lectura y en forma de representacion numerica, por lo tanto se ha creado la siguiente tabla con la variable su transformación y tipo.
diccionario_vars <- tribble(
~Variable, ~Transformacion, ~Tipo,
"rotacion", "Boolean", "Categórica nominal",
"edad", "Entero", "Cuantitativa",
"viaje_de_negocios", "Dummy (entero)", "Categórica nominal",
"departamento", "Dummy (entero)", "Categórica nominal",
"distancia_casa", "Numérico", "Cuantitativa",
"educacion", "Numérico ordinal", "Categórica ordinal",
"campo_educacion", "Dummy (entero)", "Categórica nominal",
"satisfaccion_ambiental", "Numérico ordinal", "Categórica ordinal",
"genero", "Dummy", "Categórica nominal",
"cargo", "One-hot encoding", "Categórica nominal",
"satisfaccion_laboral", "Numérico ordinal", "Categórica ordinal",
"estado_civil", "Dummy (entero)", "Categórica nominal",
"ingreso_mensual", "Numérico", "Cuantitativa",
"trabajos_anteriores", "Numérico", "Cuantitativa",
"horas_extra", "Boolean", "Categórica nominal",
"porcentaje_aumento_salarial", "Numérico; convertir a %", "Cuantitativa",
"rendimiento_laboral", "Numérico ordinal", "Categórica ordinal",
"anos_experiencia", "Numérico", "Cuantitativa",
"capacitaciones", "Numérico", "Cuantitativa",
"equilibrio_trabajo_vida", "Numérico ordinal", "Categórica ordinal",
"antiguedad", "Numérico", "Cuantitativa",
"antiguedad_cargo", "Numérico", "Cuantitativa",
"anos_ultima_promocion", "Numérico", "Cuantitativa",
"anos_acargo_con_mismo_jefe", "Numérico", "Cuantitativa"
)
datatable(
diccionario_vars,
rownames = FALSE,
filter = "top",
extensions = c("FixedHeader"),
options = list(
pageLength = 24,
paging = FALSE,
searching = TRUE,
ordering = TRUE,
info = FALSE,
scrollX = TRUE,
scrollY = "500px",
fixedHeader = FALSE,
dom = "ft"
),
caption = "Tabla 1: Diccionario de variables y transformación propuesta"
)%>%
formatStyle(
"Tipo",
target = "row",
fontWeight = "bold"
)Como parte final del filtrado queremos conocer si la satisfacción laboral, y años a cargo con el mismo jefe estan relacionados con la rotación que se pueden ver en la siguiente tabla, esta es una forma de exploración que se realiza para definir las variables que se usaran en el modelo.
df_filtrado <- rotacion %>%
filter(satisfacion_laboral < 3,
anos_acargo_con_mismo_jefe > 2,
rotacion=="Si")
datatable(df_filtrado,
options = list(
pageLength = 24,
paging = FALSE,
searching = TRUE,
ordering = TRUE,
info = FALSE,
scrollX = TRUE,
scrollY = "500px",
fixedHeader = FALSE,
dom = "ft"
),
filter = "top",
rownames = FALSE,
caption = "Tabla 2: Filtrado inicial data"
)1. Selección de variables
Seleccionaremos 3 variables cuantitativas para el estudio.
Distancia a la casa : se espera que la distancia entre la vivienda y el lugar de trabajo este positivamente relacionada con la rotacion, debido al desgaste asociado al tiempo de desplazamiento diario. Es decir, a mayor distancia, mayor probabilidad de rotacion.
Años de experiencia : se espera que los años de experiencia estén negativamente relacionados con la rotación, ya que los empleados con mayor trayectoria tienden a tener mayor estabilidad laboral. Es decir, a mayor experiencia, menor probabilidad de rotación.
Años a cargo con mismo jefe : se espera que el tiempo bajo el mismo jefe influya en la rotación, de modo que periodos cortos puedan asociarse con mayor probabilidad de rotación, mientras que una mayor permanencia podría indicar estabilidad laboral
Seleccionaremos 3 variables cualitativas para el estudio.
Departamento : se espera que el departamento esté asociado con la rotación, dado que las condiciones laborales, cargas de trabajo y niveles de presión pueden variar entre áreas
Satisfaccion laboral : se espera que niveles bajos de satisfacción laboral estén asociados con una mayor probabilidad de rotación.
Horas Extra : se espera que la realización frecuente de horas extra esté positivamente relacionada con la rotación, debido al desgaste físico y emocional que estas generan.
2. Analisis Univariado
Variables cuantitativas
Realizamos los siguientes graficos resumen en donde usamos el raincloudgraph para poder resumir rapidamente las variables cuantitativas
datos_long <- rotacion %>%
select(distancia_casa, anos_experiencia, anos_acargo_con_mismo_jefe) %>%
pivot_longer(
cols = everything(),
names_to = "variable",
values_to = "valor"
) %>%
mutate(
variable = case_when(
variable == "distancia_casa" ~ "Distancia a la casa",
variable == "anos_experiencia" ~ "Anos de experiencia",
variable == "anos_acargo_con_mismo_jefe" ~ "Anos con el mismo jefe"
)
)
ggplot(datos_long, aes(y = valor)) +
geom_violin(aes(x = 0), fill = "lightblue", alpha = 0.5, width = 0.8) +
geom_boxplot(aes(x = 0.08), width = 0.08, fill = "white", outlier.shape = NA) +
geom_jitter(aes(x = 0.18), width = 0.03, alpha = 0.30, size = 1, color = "darkblue") +
scale_x_continuous(breaks = NULL) +
facet_wrap(~ variable, scales = "free_y", nrow = 1) +
labs(
title = "Raincloud de variables cuantitativas",
x = "",
y = "Valor"
) +
theme_minimal()
Gráfico 1: Raincloud variables cuantitativas
En el grafico 1 se observa como las 3 variables presentan distribucion asimentrica con atipicos, especialmente en la distancia a la casa y años de experiencia. La concentracion esta en varoles bajos en la variable años con el mismo jefe lo cual sugiere baja permanencia con un mismo jefe que se verificara mas adelante.
ggbetweenstats(
data = rotacion,
x = rotacion,
y = distancia_casa,
type = "nonparametric",
pairwise.comparisons = FALSE,
centrality.plotting = TRUE,
bf.message = FALSE,
messages = FALSE,
point.args = list(
position = position_jitter(width = 0.15),
alpha = 0.25,
size = 1.2
),
violin.args = list(alpha = 0.4),
boxplot.args = list(width = 0.15, alpha = 0.6),
title = "Distancia a la casa segun rotacion",
xlab = "Rotacion",
ylab = "Valor"
)
Gráfico 2: Distancia a la casa segun rotacion
En el grafico 2, la mediana de distancia es 7 para el grupo No y 9 para el grupo Sí, esto sugiere que, en general, las personas que sí rotan viven un poco más lejos de la casa que las que no rotan. La prueba de Mann-Whitney evidenció diferencias estadísticamente significativas entre ambos grupos (p = 2.39e-03). No obstante, el tamaño del efecto fue pequeño (rango biserial = -0.12), lo que sugiere que, aunque la distancia a la casa se relaciona con la rotación, su influencia es limitada.
ggbetweenstats(
data = rotacion,
x = rotacion,
y = anos_experiencia,
type = "nonparametric",
pairwise.comparisons = FALSE,
centrality.plotting = TRUE,
bf.message = FALSE,
messages = FALSE,
point.args = list(
position = position_jitter(width = 0.15),
alpha = 0.25,
size = 1.2
),
violin.args = list(alpha = 0.4),
boxplot.args = list(width = 0.15, alpha = 0.6),
title = "Anos de experiencia segun rotacion",
xlab = "Rotacion",
ylab = "Valor"
)
Gráfico 3: Anos de experiencia segun rotacion
El gráfico evidencia que los empleados con rotación presentan una menor mediana de años de experiencia (7) en comparación con aquellos sin rotación (10). La prueba de Mann-Whitney mostró diferencias estadísticamente significativas entre ambos grupos (p = 2.40e-14). Además, el tamaño del efecto fue moderado (rango biserial = 0.31), lo que indica que los años de experiencia constituyen una variable importante asociada a la rotación del personal.
Los años de experiencia en general nos idican como a mayor cantidad de años hay menor rotacion, teniendo una relacion negativa entre años y rotacion
ggbetweenstats(
data = rotacion,
x = rotacion,
y = anos_acargo_con_mismo_jefe,
type = "nonparametric",
pairwise.comparisons = FALSE,
centrality.plotting = TRUE,
bf.message = FALSE,
messages = FALSE,
point.args = list(
position = position_jitter(width = 0.15),
alpha = 0.25,
size = 1.2
),
violin.args = list(alpha = 0.4),
boxplot.args = list(width = 0.15, alpha = 0.6),
title = "Anos con el mismo jefe segun rotacion",
xlab = "Rotacion",
ylab = "Valor"
)
Gráfico 4: Anos con el mismo jefe segun rotacion
Se puede ver que los años con el mismo jefe son muy importantes puesto que hay concentracion en valores bajos lo que quiere decir que los empleados no permanece mucho con un mismo jefe.
La variable distancia a la casas tiene alta asimetria y outliers por lo que puede afectar los supuestos del modelo logistico y sus estimadores, de tal forma que hay que considerar realizar una transofrmacion logaritmica para reducir la asimetria, bajar la influencia de outliers y asi mejorar la realacion lineal existente
El resumen de los datos descriptivos de la variable estan en la Tabla 3
# Función para contar atípicos con regla IQR
contar_atipicos <- function(x) {
x <- x[!is.na(x)]
Q1 <- quantile(x, 0.25)
Q3 <- quantile(x, 0.75)
IQR_val <- IQR(x)
limite_inf <- Q1 - 1.5 * IQR_val
limite_sup <- Q3 + 1.5 * IQR_val
sum(x < limite_inf | x > limite_sup)
}
tabla_desc <- data.frame(
Variable = c("distancia_casa", "años experiencia", "años mismo jefe"),
N = c(
sum(!is.na(rotacion$distancia_casa)),
sum(!is.na(rotacion$anos_experiencia)),
sum(!is.na(rotacion$anos_acargo_con_mismo_jefe))
),
Media = c(
mean(rotacion$distancia_casa, na.rm = TRUE),
mean(rotacion$anos_experiencia, na.rm = TRUE),
mean(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Mediana = c(
median(rotacion$distancia_casa, na.rm = TRUE),
median(rotacion$anos_experiencia, na.rm = TRUE),
median(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Desv_Est = c(
sd(rotacion$distancia_casa, na.rm = TRUE),
sd(rotacion$anos_experiencia, na.rm = TRUE),
sd(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Min = c(
min(rotacion$distancia_casa, na.rm = TRUE),
min(rotacion$anos_experiencia, na.rm = TRUE),
min(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Max = c(
max(rotacion$distancia_casa, na.rm = TRUE),
max(rotacion$anos_experiencia, na.rm = TRUE),
max(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Skewness = c(
skewness(rotacion$distancia_casa, na.rm = TRUE),
skewness(rotacion$anos_experiencia, na.rm = TRUE),
skewness(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Curtosis = c(
kurtosis(rotacion$distancia_casa, na.rm = TRUE),
kurtosis(rotacion$anos_experiencia, na.rm = TRUE),
kurtosis(rotacion$anos_acargo_con_mismo_jefe, na.rm = TRUE)
),
Atipicos = c(
contar_atipicos(rotacion$distancia_casa),
contar_atipicos(rotacion$anos_experiencia),
contar_atipicos(rotacion$anos_acargo_con_mismo_jefe)
)
)
tabla_desc[, -1] <- round(tabla_desc[, -1], 2)
kable(
tabla_desc,
caption = "Tabla 3. Estadísticos descriptivos de las variables cuantitativas seleccionadas",
align = "lccccccccc"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Variable | N | Media | Mediana | Desv_Est | Min | Max | Skewness | Curtosis | Atipicos |
|---|---|---|---|---|---|---|---|---|---|
| distancia_casa | 1470 | 9.19 | 7 | 8.11 | 1 | 29 | 0.96 | 2.77 | 0 |
| años experiencia | 1470 | 11.28 | 10 | 7.78 | 0 | 40 | 1.12 | 3.91 | 63 |
| años mismo jefe | 1470 | 4.12 | 3 | 3.57 | 0 | 17 | 0.83 | 3.17 | 14 |
En las Tablas 4, 5 y 6 se presentan las distribuciones de frecuencia y proporción de las variables categóricas seleccionadas. Estas permiten identificar la concentración de observaciones en cada categoría y posibles desequilibrios en la muestra. Estos datos pueden ser verificados en el EDA inicial, aun asi se decide incluirlo para continuar con el hilo del analisis planteado.
tabla_departamento <- rotacion %>%
count(departamento) %>%
mutate(Proporcion = n / sum(n)) %>%
rename(Categoria = departamento, Frecuencia = n)
kable(tabla_departamento,
caption = "Tabla 4. Distribucion de la variable Departamento",
align = "lcc") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Categoria | Frecuencia | Proporcion |
|---|---|---|
| IyD | 961 | 0.6537415 |
| RH | 63 | 0.0428571 |
| Ventas | 446 | 0.3034014 |
tabla_satisfaccion <- rotacion %>%
count(satisfacion_laboral) %>%
mutate(Proporcion = n / sum(n)) %>%
rename(Categoria = satisfacion_laboral, Frecuencia = n)
kable(tabla_satisfaccion,
caption = "Tabla 5. Distribucion de la variable Satisfaccion Laboral",
align = "lcc") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Categoria | Frecuencia | Proporcion |
|---|---|---|
| 1 | 289 | 0.1965986 |
| 2 | 280 | 0.1904762 |
| 3 | 442 | 0.3006803 |
| 4 | 459 | 0.3122449 |
tabla_horas <- rotacion %>%
count(horas_extra) %>%
mutate(Proporcion = n / sum(n)) %>%
rename(Categoria = horas_extra, Frecuencia = n)
kable(tabla_horas,
caption = "Tabla 6. Distribucion de la variable Horas Extra",
align = "lcc") %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Categoria | Frecuencia | Proporcion |
|---|---|---|
| No | 1054 | 0.7170068 |
| Si | 416 | 0.2829932 |
par(mfrow = c(1, 4))
barplot(table(rotacion$satisfacion_laboral),
main = "Satisfaccion laboral",
xlab = "Categorias",
ylab = "Frecuencia",
col = "lightblue")
barplot(table(rotacion$departamento),
main = "Departamento",
xlab = "Categorias",
ylab = "Frecuencia",
col = "lightgreen",
las = 2)
barplot(table(rotacion$horas_extra),
main = "Horas extra",
xlab = "Categorias",
ylab = "Frecuencia",
col = "lightpink")
barplot(table(rotacion$rotacion),
main = "rotacion",
xlab = "categorias",
ylab = "Frecuencia",
col = "lightyellow")
Gráfico 5: Grafico de barras para las variables categoricas
El gráfico evidencia que las categorías más frecuentes corresponden a niveles altos de satisfacción laboral, al departamento de IyD, a empleados que no realizan horas extra y, principalmente, a empleados que no rotan. En particular, la variable rotación presenta un claro desbalance entre clases, ya que la categoría “No” concentra la mayor parte de las observaciones. Esto sugiere que, aunque la rotación está presente, se trata de un evento menos frecuente dentro de la muestra analizada.
3. Analisis Bivariado
datos <- rotacion
datos$rotacion <- ifelse(datos$rotacion == "Si", 1, 0)
datos$rotacion <- factor(datos$rotacion)# Modelos
analisis1 <- glm(factor(rotacion) ~ distancia_casa, data = rotacion, family = binomial)
analisis2 <- glm(factor(rotacion) ~ anos_experiencia, data = rotacion, family = binomial)
analisis3 <- glm(factor(rotacion) ~ anos_acargo_con_mismo_jefe, data = rotacion, family = binomial)
analisis4 <- glm(factor(rotacion) ~ factor(satisfacion_laboral), data = rotacion, family = binomial)
analisis5 <- glm(factor(rotacion) ~ factor(departamento), data = rotacion, family = binomial)
analisis6 <- glm(factor(rotacion) ~ factor(horas_extra), data = rotacion, family = binomial)
# Lista de modelos
modelos <- list(
distancia_casa = analisis1,
anos_experiencia = analisis2,
anos_acargo_con_mismo_jefe = analisis3,
satisfacion_laboral = analisis4,
departamento = analisis5,
horas_extra = analisis6
)
# Tabla consolidada
tabla_modelos <- imap_dfr(modelos, ~{
tidy(.x) %>%
mutate(
modelo = .y,
OR = exp(estimate),
AIC = AIC(.x),
null_deviance = .x$null.deviance,
residual_deviance = .x$deviance
) %>%
select(modelo, term, estimate, std.error, statistic, p.value, OR,
null_deviance, residual_deviance, AIC)
})
# Quitar intercepto
tabla_modelos <- tabla_modelos %>%
filter(term != "(Intercept)")
# Formato en notación científica
tabla_modelos <- tabla_modelos %>%
mutate(across(where(is.numeric), ~ formatC(.x, format = "e", digits = 4)))
# Tabla bonita
kable(
tabla_modelos,
format = "html",
caption = "Tabla 7. Resultados de los modelos logisticos bivariados para la rotacion del personal",
col.names = c(
"Modelo", "Termino", "Coeficiente", "Error estandar", "Estadistico z",
"p-valor", "Odds Ratio", "Devianza nula", "Devianza residual", "AIC"
),
align = "l"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
) %>%
scroll_box(width = "100%", height = "400px")| Modelo | Termino | Coeficiente | Error estandar | Estadistico z | p-valor | Odds Ratio | Devianza nula | Devianza residual | AIC |
|---|---|---|---|---|---|---|---|---|---|
| distancia_casa | distancia_casa | 2.4710e-02 | 8.3123e-03 | 2.9727e+00 | 2.9517e-03 | 1.0250e+00 | 1.2986e+03 | 1.2900e+03 | 1.2940e+03 |
| anos_experiencia | anos_experiencia | -7.7731e-02 | 1.2170e-02 | -6.3872e+00 | 1.6900e-10 | 9.2521e-01 | 1.2986e+03 | 1.2481e+03 | 1.2521e+03 |
| anos_acargo_con_mismo_jefe | anos_acargo_con_mismo_jefe | -1.4138e-01 | 2.4069e-02 | -5.8737e+00 | 4.2605e-09 | 8.6816e-01 | 1.2986e+03 | 1.2587e+03 | 1.2627e+03 |
| satisfacion_laboral | factor(satisfacion_laboral)2 | -4.0916e-01 | 2.1365e-01 | -1.9151e+00 | 5.5484e-02 | 6.6421e-01 | 1.2986e+03 | 1.2812e+03 | 1.2892e+03 |
| satisfacion_laboral | factor(satisfacion_laboral)3 | -4.0282e-01 | 1.8985e-01 | -2.1217e+00 | 3.3860e-02 | 6.6843e-01 | 1.2986e+03 | 1.2812e+03 | 1.2892e+03 |
| satisfacion_laboral | factor(satisfacion_laboral)4 | -8.4005e-01 | 2.0328e-01 | -4.1325e+00 | 3.5886e-05 | 4.3169e-01 | 1.2986e+03 | 1.2812e+03 | 1.2892e+03 |
| departamento | factor(departamento)RH | 3.8175e-01 | 3.3417e-01 | 1.1424e+00 | 2.5330e-01 | 1.4648e+00 | 1.2986e+03 | 1.2881e+03 | 1.2941e+03 |
| departamento | factor(departamento)Ventas | 4.8116e-01 | 1.4974e-01 | 3.2134e+00 | 1.3119e-03 | 1.6179e+00 | 1.2986e+03 | 1.2881e+03 | 1.2941e+03 |
| horas_extra | factor(horas_extra)Si | 1.3274e+00 | 1.4657e-01 | 9.0563e+00 | 1.3491e-19 | 3.7712e+00 | 1.2986e+03 | 1.2172e+03 | 1.2212e+03 |
La tabla presenta los resultados de los modelos logísticos bivariados estimados para evaluar la relación individual entre cada covariable y la rotación del personal. En cada modelo se reportan el coeficiente estimado, el error estándar, el estadístico z, el p-valor, el odds ratio (OR), la devianza nula, la devianza residual y el AIC. En general, un coeficiente positivo indica que la variable incrementa la probabilidad de rotación, mientras que un coeficiente negativo sugiere una disminución en dicha probabilidad. De igual forma, un odds ratio mayor que 1 indica aumento en los odds de rotación, mientras que un valor menor que 1 indica reducción.
Para la variable distancia a la casa, el coeficiente fue positivo (0.0247) y estadísticamente significativo (p = 0.00295), con un odds ratio de 1.0250. Esto indica que, por cada unidad adicional en la distancia entre la casa y el trabajo, los odds de rotación aumentan aproximadamente en 2.5%. Por tanto, esta variable presenta una relación positiva y significativa con la rotación del personal.
En el caso de años de experiencia, el coeficiente fue negativo (-0.0777) y altamente significativo (p < 0.001), con un odds ratio de 0.9252. Esto sugiere que, por cada año adicional de experiencia, los odds de rotación disminuyen aproximadamente en 7.5%. En consecuencia, una mayor experiencia laboral se asocia con una menor probabilidad de rotación.
La variable años a cargo con el mismo jefe también presentó un coeficiente negativo (-0.1414) y significativo (p < 0.001), con un odds ratio de 0.8682. Esto indica que una mayor permanencia bajo el mismo jefe reduce los odds de rotación en aproximadamente 13.2% por cada unidad adicional, evidenciando una relación negativa entre estabilidad en la supervisión y rotación.
Respecto a satisfacción laboral, se observa que las categorías superiores presentan coeficientes negativos en comparación con la categoría de referencia. La categoría 2 no resultó significativa al 5% (p = 0.0555), aunque muestra una tendencia negativa. En cambio, las categorías 3 y 4 sí fueron estadísticamente significativas, con coeficientes de -0.4028 y -0.8401, respectivamente, y odds ratios menores que 1. Esto indica que niveles más altos de satisfacción laboral reducen la probabilidad de rotación, siendo el efecto más fuerte en la categoría 4. En términos sustantivos, a medida que aumenta la satisfacción laboral, disminuyen los odds de que el empleado presente rotación.
Para la variable departamento, la categoría RH no mostró una relación estadísticamente significativa con la rotación (p = 0.2533), por lo que no se encontró evidencia suficiente para afirmar diferencias frente a la categoría base. Por su parte, la categoría Ventas sí presentó un coeficiente positivo y significativo (0.4812; p = 0.00132), con un odds ratio de 1.6179. Esto sugiere que los empleados del área de ventas tienen odds de rotación aproximadamente 61.8% mayores que los del departamento de referencia.
Finalmente, la variable horas extra mostró uno de los efectos más fuertes del análisis bivariado. La categoría Sí presentó un coeficiente positivo de 1.3274, altamente significativo (p < 0.001), y un odds ratio de 3.7712. Esto indica que los empleados que realizan horas extra tienen aproximadamente 3.77 veces los odds de rotación en comparación con quienes no realizan horas extra. En consecuencia, las horas extra constituyen un factor fuertemente asociado con la rotación del personal.
En conjunto, los resultados bivariados evidencian que la rotación del personal aumenta con una mayor distancia a la casa, pertenecer al departamento de ventas y realizar horas extra. Por el contrario, una mayor experiencia laboral, más años con el mismo jefe y mayores niveles de satisfacción laboral se asocian con una menor probabilidad de rotación. Entre todas las variables analizadas, horas extra parece ser la de mayor impacto individual, seguida por años con el mismo jefe, años de experiencia y satisfacción laboral.
4. Estimacion del modelo
4.1 Estimacion del modelo con todas las variables elegidas
set.seed(123)
# Split 70/30
id_train <- sample(seq_len(nrow(rotacion)), size = 0.7 * nrow(rotacion))
train <- rotacion[id_train, ]
test <- rotacion[-id_train, ]
# Ajustar modelo
modelo <- glm(
factor(rotacion) ~ distancia_casa + anos_experiencia +
anos_acargo_con_mismo_jefe +
factor(departamento) + factor(satisfacion_laboral) + factor(horas_extra),
data = train,
family = "binomial"
)
# Tabla de coeficientes
tabla_modelo <- tidy(modelo, conf.int = TRUE) %>%
mutate(
OR = exp(estimate),
IC_inf_OR = exp(conf.low),
IC_sup_OR = exp(conf.high),
signif = case_when(
p.value < 0.001 ~ "***",
p.value < 0.01 ~ "**",
p.value < 0.05 ~ "*",
p.value < 0.1 ~ ".",
TRUE ~ ""
)
) %>%
filter(term != "(Intercept)") %>%
select(term, estimate, std.error, statistic, p.value, signif, OR, IC_inf_OR, IC_sup_OR) %>%
mutate(across(c(estimate, std.error, statistic, p.value, OR, IC_inf_OR, IC_sup_OR),
~ formatC(.x, format = "e", digits = 4)))
# Medidas de ajuste
aic_modelo <- formatC(AIC(modelo), format = "e", digits = 4)
null_dev <- formatC(modelo$null.deviance, format = "e", digits = 4)
resid_dev <- formatC(modelo$deviance, format = "e", digits = 4)
# Tabla bonita
kable(
tabla_modelo,
format = "html",
caption = paste0(
"Tabla 8. Resultados del modelo logístico múltiple para la rotación del personal. ",
"Devianza nula = ", null_dev,
", Devianza residual = ", resid_dev,
", AIC = ", aic_modelo, "."
),
col.names = c(
"Término", "Coeficiente", "Error estándar", "Estadístico z",
"p-valor", "Sig.", "Odds Ratio", "IC 95% inferior", "IC 95% superior"
),
align = "l"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
) %>%
scroll_box(width = "100%", height = "400px")| Término | Coeficiente | Error estándar | Estadístico z | p-valor | Sig. | Odds Ratio | IC 95% inferior | IC 95% superior |
|---|---|---|---|---|---|---|---|---|
| distancia_casa | 2.1662e-02 | 1.1212e-02 | 1.9320e+00 | 5.3366e-02 | . | 1.0219e+00 | 9.9946e-01 | 1.0444e+00 |
| anos_experiencia | -8.2474e-02 | 1.7283e-02 | -4.7720e+00 | 1.8238e-06 | *** | 9.2084e-01 | 8.8870e-01 | 9.5112e-01 |
| anos_acargo_con_mismo_jefe | -5.6590e-02 | 3.4101e-02 | -1.6595e+00 | 9.7016e-02 | . | 9.4498e-01 | 8.8330e-01 | 1.0099e+00 |
| factor(departamento)RH | 6.5995e-01 | 4.3293e-01 | 1.5244e+00 | 1.2741e-01 | 1.9347e+00 | 7.8831e-01 | 4.3702e+00 | |
| factor(departamento)Ventas | 5.0610e-01 | 1.9631e-01 | 2.5781e+00 | 9.9352e-03 | ** | 1.6588e+00 | 1.1263e+00 | 2.4344e+00 |
| factor(satisfacion_laboral)2 | -6.1648e-01 | 2.8445e-01 | -2.1673e+00 | 3.0213e-02 |
|
5.3984e-01 | 3.0638e-01 | 9.3717e-01 |
| factor(satisfacion_laboral)3 | -5.9468e-01 | 2.4743e-01 | -2.4034e+00 | 1.6242e-02 |
|
5.5174e-01 | 3.3908e-01 | 8.9619e-01 |
| factor(satisfacion_laboral)4 | -9.9183e-01 | 2.5693e-01 | -3.8603e+00 | 1.1324e-04 | *** | 3.7090e-01 | 2.2306e-01 | 6.1209e-01 |
| factor(horas_extra)Si | 1.3808e+00 | 1.8857e-01 | 7.3226e+00 | 2.4318e-13 | *** | 3.9782e+00 | 2.7534e+00 | 5.7721e+00 |
4.2 Interpretacion de los coeficientes del modelo e identificacion de las covariables significativas
Los resultados del modelo logístico múltiple muestran que las covariables estadísticamente significativas asociadas a la rotación fueron los años de experiencia, el departamento de Ventas, la satisfacción laboral y la realización de horas extra. En particular, los años de experiencia presentan un efecto negativo, indicando que a mayor experiencia disminuyen los odds de rotación. Por el contrario, pertenecer al departamento de Ventas y realizar horas extra incrementan significativamente los odds de rotación, siendo esta última la variable de mayor impacto en el modelo. Asimismo, mayores niveles de satisfacción laboral se asocian con menores odds de rotación. En cambio, la distancia a la casa y los años a cargo con el mismo jefe mostraron una significancia marginal, mientras que el departamento de RH no resultó significativo.
4.3 Modelo logístico múltiple con variables transformadas para la rotación del personal
# Ajustar modelo con variables transformadas
train <- train %>%
mutate(
log_distancia_casa = log1p(distancia_casa),
log_anos_experiencia = log1p(anos_experiencia),
log_anos_jefe = log1p(anos_acargo_con_mismo_jefe)
)
modelo_log <- glm(
factor(rotacion) ~ log_distancia_casa + log_anos_experiencia +
log_anos_jefe + factor(departamento) +
factor(satisfacion_laboral) + factor(horas_extra),
data = train,
family = "binomial"
)
# Tabla de coeficientes
tabla_modelo_log <- tidy(modelo_log, conf.int = TRUE) %>%
mutate(
OR = exp(estimate),
IC_inf_OR = exp(conf.low),
IC_sup_OR = exp(conf.high),
signif = case_when(
p.value < 0.001 ~ "***",
p.value < 0.01 ~ "**",
p.value < 0.05 ~ "*",
p.value < 0.1 ~ ".",
TRUE ~ ""
)
) %>%
filter(term != "(Intercept)") %>%
select(term, estimate, std.error, statistic, p.value, signif, OR, IC_inf_OR, IC_sup_OR) %>%
mutate(across(c(estimate, std.error, statistic, p.value, OR, IC_inf_OR, IC_sup_OR),
~ formatC(.x, format = "e", digits = 4)))
# Medidas de ajuste
aic_modelo <- formatC(AIC(modelo_log), format = "e", digits = 4)
null_dev <- formatC(modelo_log$null.deviance, format = "e", digits = 4)
resid_dev <- formatC(modelo_log$deviance, format = "e", digits = 4)
# Tabla bonita
kable(
tabla_modelo_log,
format = "html",
caption = paste0(
"Tabla 9. Resultados del modelo logístico múltiple con variables transformadas para la rotación del personal. ",
"Devianza nula = ", null_dev,
", Devianza residual = ", resid_dev,
", AIC = ", aic_modelo, "."
),
col.names = c(
"Término", "Coeficiente", "Error estándar", "Estadístico z",
"p-valor", "Sig.", "Odds Ratio", "IC 95% inferior", "IC 95% superior"
),
align = "l"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
) %>%
scroll_box(width = "100%", height = "400px")| Término | Coeficiente | Error estándar | Estadístico z | p-valor | Sig. | Odds Ratio | IC 95% inferior | IC 95% superior |
|---|---|---|---|---|---|---|---|---|
| log_distancia_casa | 1.5885e-01 | 1.1129e-01 | 1.4274e+00 | 1.5347e-01 | 1.1722e+00 | 9.4320e-01 | 1.4600e+00 | |
| log_anos_experiencia | -8.7446e-01 | 1.5072e-01 | -5.8020e+00 | 6.5518e-09 | *** | 4.1709e-01 | 3.0818e-01 | 5.5694e-01 |
| log_anos_jefe | -2.3118e-01 | 1.3912e-01 | -1.6617e+00 | 9.6573e-02 | . | 7.9360e-01 | 6.0611e-01 | 1.0469e+00 |
| factor(departamento)RH | 6.4248e-01 | 4.3519e-01 | 1.4763e+00 | 1.3986e-01 | 1.9012e+00 | 7.7121e-01 | 4.3117e+00 | |
| factor(departamento)Ventas | 5.2381e-01 | 1.9969e-01 | 2.6231e+00 | 8.7140e-03 | ** | 1.6885e+00 | 1.1389e+00 | 2.4948e+00 |
| factor(satisfacion_laboral)2 | -7.0295e-01 | 2.8966e-01 | -2.4268e+00 | 1.5232e-02 |
|
4.9512e-01 | 2.7790e-01 | 8.6765e-01 |
| factor(satisfacion_laboral)3 | -6.4393e-01 | 2.5102e-01 | -2.5653e+00 | 1.0309e-02 |
|
5.2523e-01 | 3.2040e-01 | 8.5886e-01 |
| factor(satisfacion_laboral)4 | -1.0548e+00 | 2.6163e-01 | -4.0317e+00 | 5.5368e-05 | *** | 3.4825e-01 | 2.0738e-01 | 5.7970e-01 |
| factor(horas_extra)Si | 1.4207e+00 | 1.9263e-01 | 7.3750e+00 | 1.6431e-13 | *** | 4.1399e+00 | 2.8442e+00 | 6.0589e+00 |
4.4 Interpretacion de los coeficientes del modelo e identificacion de las covariables significativas
Los resultados del modelo logístico múltiple con variables transformadas muestran que las covariables estadísticamente significativas asociadas a la rotación fueron los años de experiencia, el departamento de Ventas, la satisfacción laboral y la realización de horas extra. En particular, los años de experiencia presentan un efecto negativo sobre la rotación, lo que indica que a mayor experiencia disminuyen los odds de rotación. Por el contrario, pertenecer al departamento de Ventas y realizar horas extra incrementan significativamente los odds de rotación, siendo esta última la variable de mayor impacto en el modelo. Asimismo, mayores niveles de satisfacción laboral se asocian con menores odds de rotación. En cambio, la distancia a la casa y el departamento de RH no resultaron significativos al 5%, mientras que los años con el mismo jefe mostraron una significancia marginal.
5. Evaluacion del modelo
5.1 AIC
kable(
AIC(modelo, modelo_log),
format = "html",
caption = "Tabla 10. Comparacion del criterio de informacion de Akaike (AIC) entre el modelo original y el modelo con variables transformadas",
col.names = c("Modelo", "Grados de libertad", "AIC"),
align = "lcc"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Modelo | Grados de libertad | AIC |
|---|---|---|
| modelo | 10 | 789.4825 |
| modelo_log | 10 | 773.0598 |
La comparación mediante el criterio de información de Akaike (AIC) mostró que el modelo con variables transformadas (modelo_log) presenta un mejor ajuste que el modelo original. En particular, el modelo sin transformación obtuvo un AIC de 789.48, mientras que el modelo transformado alcanzó un AIC de 773.06. Dado que valores menores de AIC indican un mejor equilibrio entre ajuste y parsimonia, se concluye que el modelo con transformación logarítmica es preferible. Además, la diferencia entre ambos modelos fue de 16.42 unidades, lo que constituye evidencia muy fuerte a favor del modelo transformado.
5.2 Delta AIC y Delta BIC
# Calcular AIC y BIC de ambos modelos
aic_tab <- AIC(modelo, modelo_log)
bic_tab <- BIC(modelo, modelo_log)
# Calcular deltas (diferencias)
delta_AIC <- abs(aic_tab$AIC[1] - aic_tab$AIC[2])
delta_BIC <- abs(bic_tab$BIC[1] - bic_tab$BIC[2])
# Función de interpretación
interpretar_delta <- function(delta) {
if (delta >= 0 && delta < 2) {
return("Poca evidencia")
} else if (delta >= 2 && delta < 6) {
return("Evidencia positiva")
} else if (delta >= 6 && delta < 10) {
return("Evidencia fuerte")
} else {
return("Evidencia muy fuerte")
}
}
# Tabla final
resultado <- data.frame(
Criterio = c("Delta AIC", "Delta BIC"),
Valor = c(round(delta_AIC, 2), round(delta_BIC, 2)),
Interpretacion = c(
interpretar_delta(delta_AIC),
interpretar_delta(delta_BIC)
)
)
# Tabla bonita
kable(
resultado,
format = "html",
caption = "Tabla 11. Comparacion del modelo original y el modelo con variables transformadas mediante Delta AIC y Delta BIC",
col.names = c("Criterio", "Valor", "Interpretacion"),
align = "lcc"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Criterio | Valor | Interpretacion |
|---|---|---|
| Delta AIC | 16.42 | Evidencia muy fuerte |
| Delta BIC | 16.42 | Evidencia muy fuerte |
Los valores de Delta AIC y Delta BIC fueron de 16.42, lo que constituye evidencia muy fuerte a favor del modelo con variables transformadas. Por ello, se seleccionó modelo_log como modelo final.
5.3 Matriz de confunsion
# 1. Split 70/30
set.seed(123)
id_train <- sample(seq_len(nrow(rotacion)), size = 0.7 * nrow(rotacion))
train <- rotacion[id_train, ]
test <- rotacion[-id_train, ]
# 2. Crear variables log en train y test
train <- train %>%
mutate(
log_distancia_casa = log1p(distancia_casa),
log_anos_experiencia = log1p(anos_experiencia),
log_anos_jefe = log1p(anos_acargo_con_mismo_jefe)
)
test <- test %>%
mutate(
log_distancia_casa = log1p(distancia_casa),
log_anos_experiencia = log1p(anos_experiencia),
log_anos_jefe = log1p(anos_acargo_con_mismo_jefe)
)
# 3. Ajustar modelo
modelo_log <- glm(
factor(rotacion) ~ log_distancia_casa + log_anos_experiencia +
log_anos_jefe + factor(departamento) +
factor(satisfacion_laboral) + factor(horas_extra),
data = train,
family = "binomial"
)
# 4. Predicciones en test
test$prob <- predict(modelo_log, newdata = test, type = "response")
test$pred <- ifelse(test$prob > 0.35, "Si", "No")
# 5. Asegurar mismo orden de categorías
test$rotacion <- factor(test$rotacion, levels = c("No", "Si"))
test$pred <- factor(test$pred, levels = c("No", "Si"))
# 6. Matriz de confusión
mc <- table(Real = test$rotacion, Prediccion = test$pred)
# 7. Pasar matriz a data frame
mc_df <- as.data.frame(mc)
# 8. Etiquetas para cada celda
mc_df <- mc_df %>%
mutate(
tipo = case_when(
Real == "Si" & Prediccion == "Si" ~ "Verdaderos Positivos",
Real == "Si" & Prediccion == "No" ~ "Falsos Negativos",
Real == "No" & Prediccion == "Si" ~ "Falsos Positivos",
Real == "No" & Prediccion == "No" ~ "Verdaderos Negativos"
),
etiqueta = paste0(tipo, " = ", Freq)
)
# Opcional: cambiar etiquetas de ejes
mc_df$Real <- factor(mc_df$Real,
levels = c("No", "Si"),
labels = c("No Rotara", "Rotara"))
mc_df$Prediccion <- factor(mc_df$Prediccion,
levels = c("No", "Si"),
labels = c("No Rotara", "Rotara"))
# 9. Gráfico tipo matriz de confusión
ggplot(mc_df, aes(x = Prediccion, y = Real, fill = tipo)) +
geom_tile(color = "white", size = 1) +
geom_text(aes(label = etiqueta), size = 5) +
scale_fill_manual(
values = c(
"Falsos Negativos" = "#F79633",
"Falsos Positivos" = "#FF2D2D",
"Verdaderos Negativos" = "#00A000",
"Verdaderos Positivos" = "#3A90E5"
)
) +
labs(
title = "Grafico 6. Matriz de Confusion",
x = "Predicciones",
y = "Resultados Reales",
fill = "Clasificacion"
) +
theme_minimal(base_size = 13)
La matriz de confusión evidencia que el modelo logró una adecuada clasificación de la clase negativa, con 338 verdaderos negativos, mientras que para la clase positiva identificó correctamente 26 verdaderos positivos. No obstante, se observaron 49 falsos negativos y 28 falsos positivos, lo que indica que el modelo conserva una mejor capacidad de especificidad que de sensibilidad. En términos prácticos, el modelo es más eficaz para reconocer empleados sin riesgo de rotación que para detectar oportunamente a aquellos que efectivamente rotarán.
cutoffs <- seq(0.10, 0.50, by = 0.05)
tabla_cutoffs <- lapply(cutoffs, function(corte) {
pred <- ifelse(test$prob > corte, "Si", "No")
pred <- factor(pred, levels = c("No", "Si"))
real <- factor(test$rotacion, levels = c("No", "Si"))
mc <- table(Real = real, Pred = pred)
VP <- mc["Si", "Si"]
FN <- mc["Si", "No"]
VN <- mc["No", "No"]
FP <- mc["No", "Si"]
sensibilidad <- VP / (VP + FN)
especificidad <- VN / (VN + FP)
accuracy <- (VP + VN) / sum(mc)
precision <- ifelse((VP + FP) == 0, NA, VP / (VP + FP))
pct_intervenidos <- mean(pred == "Si")
data.frame(
cutoff = corte,
sensibilidad = round(sensibilidad, 4),
especificidad = round(especificidad, 4),
accuracy = round(accuracy, 4),
precision = round(precision, 4),
pct_intervenidos = round(pct_intervenidos * 100, 2)
)
})
tabla_cutoffs <- do.call(rbind, tabla_cutoffs)
kable(
tabla_cutoffs,
format = "html",
caption = "Tabla 12. Comparacion de metricas de desempeno del modelo para diferentes puntos de corte",
col.names = c(
"Cutoff",
"Sensibilidad",
"Especificidad",
"Accuracy",
"Precision",
"% intervenidos"
),
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
)| Cutoff | Sensibilidad | Especificidad | Accuracy | Precision | % intervenidos |
|---|---|---|---|---|---|
| 0.10 | 0.8533 | 0.4699 | 0.5351 | 0.2481 | 58.50 |
| 0.15 | 0.7733 | 0.6585 | 0.6780 | 0.3169 | 41.50 |
| 0.20 | 0.6267 | 0.7650 | 0.7415 | 0.3534 | 30.16 |
| 0.25 | 0.5333 | 0.8333 | 0.7823 | 0.3960 | 22.90 |
| 0.30 | 0.4400 | 0.8934 | 0.8163 | 0.4583 | 16.33 |
| 0.35 | 0.3467 | 0.9235 | 0.8254 | 0.4815 | 12.24 |
| 0.40 | 0.3067 | 0.9536 | 0.8435 | 0.5750 | 9.07 |
| 0.45 | 0.2533 | 0.9727 | 0.8503 | 0.6552 | 6.58 |
| 0.50 | 0.2267 | 0.9836 | 0.8549 | 0.7391 | 5.22 |
La tabla evidencia un compromiso entre sensibilidad y especificidad según el punto de corte seleccionado. Cutoffs bajos aumentan la sensibilidad y permiten detectar más empleados en riesgo, pero incrementan significativamente el porcentaje de intervención. Por el contrario, cutoffs altos mejoran la especificidad y la precisión, aunque reducen la capacidad del modelo para identificar casos reales de rotación. Considerando que el objetivo del análisis es detectar empleados en riesgo sin intervenir una proporción excesiva de la plantilla, el cutoff de 0.35 se considera el más adecuado, ya que ofrece un equilibrio razonable entre sensibilidad, especificidad, accuracy y porcentaje de empleados intervenidos.
El cutoff de la matriz de confusion se escogio teniendo en cuenta esta tabla debido a que tambien hay que tener en cuenta que los recursos en una empresa son limitados por lo que se escogio un cutoff razonable de 0.35.
5.4 Curva ROC
test <- test %>%
mutate(
log_distancia_casa = log1p(distancia_casa),
log_anos_experiencia = log1p(anos_experiencia),
log_anos_jefe = log1p(anos_acargo_con_mismo_jefe),
rotacion_bin = ifelse(rotacion == "Si", 1, 0)
)
test$prob_log <- predict(modelo_log, newdata = test, type = "response")
roc_log <- pROC::roc(
response = test$rotacion_bin,
predictor = test$prob_log,
levels = c(0, 1),
direction = "<"
)
auc_log <- pROC::auc(roc_log)
plot(
roc_log,
col = "red",
lwd = 2,
main = "Grafico 7. Curva ROC - Modelo logistico"
)
legend(
"bottomright",
legend = paste("AUC =", round(as.numeric(auc_log), 3)),
col = "red",
lwd = 2,
bty = "n"
)
La curva ROC muestra la capacidad del modelo para discriminar entre empleados que rotarán y empleados que no rotarán, considerando todos los posibles puntos de corte. En este caso, la curva se encuentra claramente por encima de la diagonal de referencia, lo que indica que el modelo tiene un desempeño superior al de una clasificación aleatoria.
El valor del área bajo la curva (AUC = 0.773) sugiere que el modelo posee una capacidad discriminante aceptable a buena. En términos prácticos, esto significa que, al comparar aleatoriamente un empleado que sí rotará con uno que no rotará, el modelo asignará una probabilidad más alta de rotación al empleado correcto en aproximadamente 77.3% de los casos.
Aunque el modelo no alcanza un nivel de discriminación excelente, el resultado obtenido indica que sí tiene utilidad predictiva para apoyar la identificación de empleados en riesgo de rotación. En consecuencia, la curva ROC respalda que el modelo final tiene un desempeño razonable para fines de clasificación, especialmente si se acompaña de una adecuada selección del punto de corte según los objetivos de intervención.
6. Predicciones
set.seed(123)
generar_individuo <- function() {
departamento_h <- c("IyD", "RH", "Ventas")
satisfacion_laboral_h <- c(1, 2, 3, 4)
horas_extra_h <- c("No", "Si")
distancia_casa_a <- sample(1:29, 1)
anos_experiencia_a <- sample(0:40, 1)
anos_acargo_con_mismo_jefe_a <- sample(0:17, 1)
departamento_a <- sample(departamento_h, 1)
satisfacion_laboral_a <- sample(satisfacion_laboral_h, 1)
horas_extra_a <- sample(horas_extra_h, 1)
nuevo <- data.frame(
distancia_casa = distancia_casa_a,
anos_experiencia = anos_experiencia_a,
anos_acargo_con_mismo_jefe = anos_acargo_con_mismo_jefe_a,
departamento = departamento_a,
satisfacion_laboral = satisfacion_laboral_a,
horas_extra = horas_extra_a
)
nuevo <- nuevo %>%
mutate(
log_distancia_casa = log1p(distancia_casa),
log_anos_experiencia = log1p(anos_experiencia),
log_anos_jefe = log1p(anos_acargo_con_mismo_jefe)
)
return(nuevo)
}
predecir_individuo <- function(modelo, cutoff = 0.35) {
nuevo <- generar_individuo()
prob_rotacion <- predict(modelo, newdata = nuevo, type = "response")
decision <- ifelse(prob_rotacion > cutoff,
"Intervenir",
"No intervenir")
conclusion <- ifelse(prob_rotacion > cutoff,
"Alta probabilidad de rotacion",
"Baja probabilidad de rotacion")
resultado <- nuevo %>%
mutate(
prob_rotacion = round(as.numeric(prob_rotacion), 4),
cutoff = cutoff,
decision = decision,
conclusion = conclusion
) %>%
select(
distancia_casa,
anos_experiencia,
anos_acargo_con_mismo_jefe,
departamento,
satisfacion_laboral,
horas_extra,
prob_rotacion,
cutoff,
decision,
conclusion
)
return(resultado)
}
resultados_pred <- bind_rows(lapply(1:10, function(i) {
predecir_individuo(modelo_log, cutoff = 0.35)
}))
kable(
resultados_pred,
format = "html",
caption = "Tabla 13. Predicciones de rotacion para empleados hipoteticos generados aleatoriamente",
col.names = c(
"Distancia a casa",
"Anos experiencia",
"Anos con mismo jefe",
"Departamento",
"Satisfaccion laboral",
"Horas extra",
"Prob. rotacion",
"Cutoff",
"Decision",
"Conclusion"
),
align = "c"
) %>%
kable_styling(
bootstrap_options = c("striped", "hover", "condensed", "responsive"),
full_width = FALSE,
position = "center"
) %>%
scroll_box(width = "100%", height = "400px")| Distancia a casa | Anos experiencia | Anos con mismo jefe | Departamento | Satisfaccion laboral | Horas extra | Prob. rotacion | Cutoff | Decision | Conclusion |
|---|---|---|---|---|---|---|---|---|---|
| 15 | 13 | 2 | RH | 2 | Si | 0.3362 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 11 | 36 | 13 | RH | 1 | Si | 0.2263 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 27 | 4 | 8 | IyD | 3 | Si | 0.3709 | 0.35 | Intervenir | Alta probabilidad de rotacion |
| 26 | 6 | 9 | IyD | 2 | No | 0.0885 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 4 | 13 | 16 | Ventas | 3 | No | 0.0603 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 12 | 14 | 9 | IyD | 3 | No | 0.0450 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 9 | 9 | 6 | IyD | 3 | Si | 0.2244 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 6 | 24 | 1 | IyD | 1 | Si | 0.2379 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 12 | 12 | 17 | IyD | 1 | No | 0.0814 | 0.35 | No intervenir | Baja probabilidad de rotacion |
| 25 | 37 | 14 | IyD | 3 | Si | 0.0808 | 0.35 | No intervenir | Baja probabilidad de rotacion |
Para la etapa de prediccion se genero un individuo hipotetico de manera aleatoria, asignando valores plausibles a las covariables incluidas en el modelo. Posteriormente, se calculo su probabilidad estimada de rotacion mediante el modelo logit ajustado. Finalmente, se definio un punto de corte de 0.5 para decidir si el empleado requiere intervencion preventiva. Si la probabilidad estimada supera dicho umbral, se recomienda intervenir; de lo contrario, no se considera necesaria una intervencion inmediata.
7. Conclusiones
En primer lugar, es fundamental mejorar el ambiente laboral, especialmente en áreas con mayor riesgo como Ventas. Esto implica fortalecer la comunicación entre jefes y empleados, promover liderazgo más cercano, brindar retroalimentación frecuente y desarrollar programas de bienestar organizacional. En segundo lugar, la empresa debería fortalecer los incentivos económicos y no económicos, ya sea mediante bonos de desempeño, reconocimientos, oportunidades de crecimiento, planes de carrera y mayor claridad en las posibilidades de promoción interna. Esto ayudaría a elevar la satisfacción laboral y, con ello, a reducir la intención de rotación.
Adicionalmente, dado que las horas extra fueron la variable con mayor impacto positivo sobre la rotación, la empresa debería implementar medidas orientadas a redistribuir la carga de trabajo. Entre estas acciones se recomienda reducir la dependencia de horas extra, reorganizar los turnos, contratar más personal en áreas críticas y revisar la asignación de tareas para evitar sobrecarga. Esta estrategia no solo disminuiría el desgaste físico y emocional de los trabajadores, sino que también podría mejorar el equilibrio entre vida personal y trabajo, reduciendo así la probabilidad de rotación.
Por ultimo, la empresa puede utilizar el modelo estimado como una herramienta de apoyo para identificar empleados en mayor riesgo de rotación y focalizar intervenciones preventivas. Sin embargo, más allá de la predicción, el hallazgo más importante es que la rotación parece responder a problemas de carga laboral, satisfacción y estabilidad organizacional. Por tanto, una política efectiva de reducción de rotación debe combinar analítica predictiva con acciones concretas sobre el clima laboral, la compensación y la distribución del trabajo.