Rotación de cargo - Tarea 3
Laura Rojas Prado y Sebastian Ortiz Florez
2025-09-26
Rotación de cargo
Base de datos
Se crea copia de la base de datos como buena práctica y su respectiva visualización
data = rotacion
head(data)## # A tibble: 6 × 24
## Rotación Edad `Viaje de Negocios` Departamento Distancia_Casa Educación
## <chr> <dbl> <chr> <chr> <dbl> <dbl>
## 1 Si 41 Raramente Ventas 1 2
## 2 No 49 Frecuentemente IyD 8 1
## 3 Si 37 Raramente IyD 2 2
## 4 No 33 Frecuentemente IyD 3 4
## 5 No 27 Raramente IyD 2 1
## 6 No 32 Frecuentemente IyD 2 2
## # ℹ 18 more variables: Campo_Educación <chr>, Satisfacción_Ambiental <dbl>,
## # Genero <chr>, Cargo <chr>, Satisfación_Laboral <dbl>, Estado_Civil <chr>,
## # Ingreso_Mensual <dbl>, Trabajos_Anteriores <dbl>, Horas_Extra <chr>,
## # Porcentaje_aumento_salarial <dbl>, Rendimiento_Laboral <dbl>,
## # Años_Experiencia <dbl>, Capacitaciones <dbl>,
## # Equilibrio_Trabajo_Vida <dbl>, Antigüedad <dbl>, Antigüedad_Cargo <dbl>,
## # Años_ultima_promoción <dbl>, Años_acargo_con_mismo_jefe <dbl>Tamaño del dataset
# Ver tamaño del dataset
nrow(data) # Número de filas## [1] 1470ncol(data) # Número de columnas## [1] 24El dataset original cuenta con 1470 registros con 24 columnas.
summary(data)## Rotación Edad Viaje de Negocios Departamento
## Length:1470 Min. :18.00 Length:1470 Length:1470
## Class :character 1st Qu.:30.00 Class :character Class :character
## Mode :character Median :36.00 Mode :character Mode :character
## Mean :36.92
## 3rd Qu.:43.00
## Max. :60.00
## Distancia_Casa Educación Campo_Educación Satisfacción_Ambiental
## Min. : 1.000 Min. :1.000 Length:1470 Min. :1.000
## 1st Qu.: 2.000 1st Qu.:2.000 Class :character 1st Qu.:2.000
## Median : 7.000 Median :3.000 Mode :character Median :3.000
## Mean : 9.193 Mean :2.913 Mean :2.722
## 3rd Qu.:14.000 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :29.000 Max. :5.000 Max. :4.000
## Genero Cargo Satisfación_Laboral Estado_Civil
## Length:1470 Length:1470 Min. :1.000 Length:1470
## Class :character Class :character 1st Qu.:2.000 Class :character
## Mode :character Mode :character Median :3.000 Mode :character
## Mean :2.729
## 3rd Qu.:4.000
## Max. :4.000
## Ingreso_Mensual Trabajos_Anteriores Horas_Extra
## Min. : 1009 Min. :0.000 Length:1470
## 1st Qu.: 2911 1st Qu.:1.000 Class :character
## Median : 4919 Median :2.000 Mode :character
## Mean : 6503 Mean :2.693
## 3rd Qu.: 8379 3rd Qu.:4.000
## Max. :19999 Max. :9.000
## Porcentaje_aumento_salarial Rendimiento_Laboral Años_Experiencia
## Min. :11.00 Min. :3.000 Min. : 0.00
## 1st Qu.:12.00 1st Qu.:3.000 1st Qu.: 6.00
## Median :14.00 Median :3.000 Median :10.00
## Mean :15.21 Mean :3.154 Mean :11.28
## 3rd Qu.:18.00 3rd Qu.:3.000 3rd Qu.:15.00
## Max. :25.00 Max. :4.000 Max. :40.00
## Capacitaciones Equilibrio_Trabajo_Vida Antigüedad Antigüedad_Cargo
## Min. :0.000 Min. :1.000 Min. : 0.000 Min. : 0.000
## 1st Qu.:2.000 1st Qu.:2.000 1st Qu.: 3.000 1st Qu.: 2.000
## Median :3.000 Median :3.000 Median : 5.000 Median : 3.000
## Mean :2.799 Mean :2.761 Mean : 7.008 Mean : 4.229
## 3rd Qu.:3.000 3rd Qu.:3.000 3rd Qu.: 9.000 3rd Qu.: 7.000
## Max. :6.000 Max. :4.000 Max. :40.000 Max. :18.000
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## Min. : 0.000 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 2.000
## Median : 1.000 Median : 3.000
## Mean : 2.188 Mean : 4.123
## 3rd Qu.: 3.000 3rd Qu.: 7.000
## Max. :15.000 Max. :17.000Tipo de datos de cada variable sobre el dataset original
str(data) # Muestra estructura y tipo de cada variable## tibble [1,470 × 24] (S3: tbl_df/tbl/data.frame)
## $ Rotación : chr [1:1470] "Si" "No" "Si" "No" ...
## $ Edad : num [1:1470] 41 49 37 33 27 32 59 30 38 36 ...
## $ Viaje de Negocios : chr [1:1470] "Raramente" "Frecuentemente" "Raramente" "Frecuentemente" ...
## $ Departamento : chr [1:1470] "Ventas" "IyD" "IyD" "IyD" ...
## $ Distancia_Casa : num [1:1470] 1 8 2 3 2 2 3 24 23 27 ...
## $ Educación : num [1:1470] 2 1 2 4 1 2 3 1 3 3 ...
## $ Campo_Educación : chr [1:1470] "Ciencias" "Ciencias" "Otra" "Ciencias" ...
## $ Satisfacción_Ambiental : num [1:1470] 2 3 4 4 1 4 3 4 4 3 ...
## $ Genero : chr [1:1470] "F" "M" "M" "F" ...
## $ Cargo : chr [1:1470] "Ejecutivo_Ventas" "Investigador_Cientifico" "Tecnico_Laboratorio" "Investigador_Cientifico" ...
## $ Satisfación_Laboral : num [1:1470] 4 2 3 3 2 4 1 3 3 3 ...
## $ Estado_Civil : chr [1:1470] "Soltero" "Casado" "Soltero" "Casado" ...
## $ Ingreso_Mensual : num [1:1470] 5993 5130 2090 2909 3468 ...
## $ Trabajos_Anteriores : num [1:1470] 8 1 6 1 9 0 4 1 0 6 ...
## $ Horas_Extra : chr [1:1470] "Si" "No" "Si" "Si" ...
## $ Porcentaje_aumento_salarial: num [1:1470] 11 23 15 11 12 13 20 22 21 13 ...
## $ Rendimiento_Laboral : num [1:1470] 3 4 3 3 3 3 4 4 4 3 ...
## $ Años_Experiencia : num [1:1470] 8 10 7 8 6 8 12 1 10 17 ...
## $ Capacitaciones : num [1:1470] 0 3 3 3 3 2 3 2 2 3 ...
## $ Equilibrio_Trabajo_Vida : num [1:1470] 1 3 3 3 3 2 2 3 3 2 ...
## $ Antigüedad : num [1:1470] 6 10 0 8 2 7 1 1 9 7 ...
## $ Antigüedad_Cargo : num [1:1470] 4 7 0 7 2 7 0 0 7 7 ...
## $ Años_ultima_promoción : num [1:1470] 0 1 0 3 2 3 0 0 1 7 ...
## $ Años_acargo_con_mismo_jefe : num [1:1470] 5 7 0 0 2 6 0 0 8 7 ...Revisión de valores faltantes
colSums(is.na(data))## Rotación Edad
## 0 0
## Viaje de Negocios Departamento
## 0 0
## Distancia_Casa Educación
## 0 0
## Campo_Educación Satisfacción_Ambiental
## 0 0
## Genero Cargo
## 0 0
## Satisfación_Laboral Estado_Civil
## 0 0
## Ingreso_Mensual Trabajos_Anteriores
## 0 0
## Horas_Extra Porcentaje_aumento_salarial
## 0 0
## Rendimiento_Laboral Años_Experiencia
## 0 0
## Capacitaciones Equilibrio_Trabajo_Vida
## 0 0
## Antigüedad Antigüedad_Cargo
## 0 0
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## 0 0El dataset no cuenta con valores faltantes
Distribución de las variables
numeric_vars <- names(data)[sapply(data, is.numeric)]
for (var in numeric_vars) {
print(
ggplot(data, aes_string(x = var)) +
geom_histogram(bins = 30, fill = "steelblue", color = "white") +
ggtitle(paste("Distribución de", var)) +
theme_minimal()
)
}## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Punto 1 - Selección de variables
Para la etapa de selección de variables, se consideró pertinente realizar un análisis exploratorio utilizando una matriz de correlación, complementada con su respectiva visualización gráfica. El objetivo fue identificar las variables que presentan una mayor asociación con la variable objetivo “Rotación”, y así orientar la inclusión de aquellas con mayor capacidad explicativa en el modelo de regresión logística.
Gráfico de correlación
# Visualización
corrplot(corr_matrix,
method = "color", # Colores en lugar de números
type = "upper", # Solo triángulo superior
tl.col = "black", # Etiquetas negras
tl.srt = 90, # Rotar etiquetas
tl.cex = 0.5, # Tamaño de texto
number.cex = 0.05, # Tamaño de números
addCoef.col = NA) # Quitar números dentro de las celdas
# Ordenar correlaciones con Rotación
corr_rotacion <- sort(corr_matrix[,"Rotación"], decreasing = TRUE)
print(corr_rotacion)## Rotación Horas_Extra
## 1.0000000000 0.2461179942
## Estado_Civil_Soltero Cargo_Representante_Ventas
## 0.1754185536 0.1572342701
## Viaje de Negocios_Frecuentemente Cargo_Tecnico_Laboratorio
## 0.1151427655 0.0982904855
## Departamento_Ventas Distancia_Casa
## 0.0808552021 0.0779235830
## Campo_Educación_Tecnicos Campo_Educación_Mercadeo
## 0.0693545948 0.0557806657
## Trabajos_Anteriores Campo_Educación_Humanidades
## 0.0434937391 0.0364661968
## Cargo_Recursos_Humanos Genero_M
## 0.0362150821 0.0294532532
## Cargo_Ejecutivo_Ventas Departamento_RH
## 0.0197743685 0.0168320096
## Rendimiento_Laboral Cargo_Investigador_Cientifico
## 0.0028887517 -0.0003595713
## Porcentaje_aumento_salarial Campo_Educación_Otra
## -0.0134782021 -0.0178975168
## Genero_F Educación
## -0.0294532532 -0.0313728196
## Campo_Educación_Ciencias Años_ultima_promoción
## -0.0327031477 -0.0330187751
## Campo_Educación_Salud Viaje de Negocios_Raramente
## -0.0469987159 -0.0495378384
## Capacitaciones Equilibrio_Trabajo_Vida
## -0.0594777986 -0.0639390472
## Viaje de Negocios_No_Viaja Cargo_Representante_Salud
## -0.0744572993 -0.0786960496
## Cargo_Director_Manofactura Cargo_Gerente
## -0.0829939241 -0.0833163842
## Departamento_IyD Estado_Civil_Divorciado
## -0.0852929276 -0.0877163459
## Cargo_Director_Investigación Estado_Civil_Casado
## -0.0888698417 -0.0909836512
## Satisfacción_Ambiental Satisfación_Laboral
## -0.1033689783 -0.1034811261
## Antigüedad Años_acargo_con_mismo_jefe
## -0.1343922140 -0.1561993159
## Edad Ingreso_Mensual
## -0.1592278261 -0.1598395824
## Antigüedad_Cargo Años_Experiencia
## -0.1605450043 -0.1710632461Matriz de correlación
# Convertir todas las columnas numéricas a integer
data1 <- data1 %>%
mutate(across(where(is.numeric), as.integer))
# Selecciona variables
data1 <- data1[, sapply(data1, is.numeric)]
# Calcular matriz de correlación
corr_matrix <- cor(data1, use = "pairwise.complete.obs", method = "pearson")
# Extraer correlaciones con Rotacion
corr_rotacion <- corr_matrix[, "Rotación"]
# Ordenar de mayor a menor (valor absoluto)
corr_rotacion_sorted <- sort(abs(corr_rotacion), decreasing = TRUE)
# Crear data frame con correlaciones respecto a Rotacion
corr_df <- data.frame(
Variable = names(corr_rotacion),
Correlacion = corr_rotacion
)
# Excluir la propia variable Rotacion_bin
corr_df <- corr_df[corr_df$Variable != "Rotacion", ]
# Ordenar por valor absoluto (de mayor a menor)
corr_df <- corr_df[order(abs(corr_df$Correlacion), decreasing = TRUE), ]
# Mostrar top 10
head(corr_df, 10)## Variable Correlacion
## Rotación Rotación 1.0000000
## Horas_Extra Horas_Extra 0.2461180
## Estado_Civil_Soltero Estado_Civil_Soltero 0.1754186
## Años_Experiencia Años_Experiencia -0.1710632
## Antigüedad_Cargo Antigüedad_Cargo -0.1605450
## Ingreso_Mensual Ingreso_Mensual -0.1598396
## Edad Edad -0.1592278
## Cargo_Representante_Ventas Cargo_Representante_Ventas 0.1572343
## Años_acargo_con_mismo_jefe Años_acargo_con_mismo_jefe -0.1561993
## Antigüedad Antigüedad -0.1343922De acuerdo con la matriz de correlación de todas las variables que tiene el dataset se determina que las 3 variable categóricas (distintas de rotación) y 3 variables cuantitativas a seleccionar son:
- “Años_Experiencia”
- “Antigüedad_Cargo”
- “Ingreso_Mensual”
- “Horas_Extra”
- “Estado_Civil”
- “Cargo”
Las anteriores fueron seleccionadas con base en los valores obtenidos en la matriz de correlación acorde con la variable de estudio “Rotación”, la cual se pasa a caracter numérico.
Punto 2 - Análisis univariado
Se realiza interpretación de las variables antes seleccionadas.
# === 1. Años de Experiencia ===
summary(data2$Años_Experiencia)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 6.00 10.00 11.28 15.00 40.00sd(data2$Años_Experiencia, na.rm = TRUE)## [1] 7.780782ggplot(data2, aes(x = Años_Experiencia)) +
geom_histogram(binwidth = 1, fill = "steelblue", color = "white") +
geom_vline(aes(xintercept = mean(Años_Experiencia, na.rm=TRUE)), color="red", linetype="dashed") +
labs(title = "Gráfico 1. Distribución de años de experiencia")
ggplot(data2, aes(y = Años_Experiencia)) +
geom_boxplot(fill = "orange") +
labs(title = "Gráfico 2. Boxplot años de experiencia")
ggplot(data1, aes(x = as.factor(Rotación), y = Años_Experiencia, fill = as.factor(Rotación))) +
geom_boxplot(alpha = 0.7) +
labs(title = "Gráfico 3. Años de experiencia según rotación",
x = "Rotación (0 = No, 1 = Sí)",
y = "Años de Experiencia",
fill = "Rotación") +
theme_minimal()
# === 2. Antigüedad en el Cargo ===
summary(data2$Antigüedad_Cargo)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.000 3.000 4.229 7.000 18.000sd(data2$Antigüedad_Cargo, na.rm = TRUE)## [1] 3.623137ggplot(data2, aes(x = Antigüedad_Cargo)) +
geom_histogram(binwidth = 1, fill = "steelblue", color = "white") +
geom_vline(aes(xintercept = mean(Antigüedad_Cargo, na.rm=TRUE)), color="red", linetype="dashed") +
labs(title = "Gráfico 4. Distribución de antigüedad en el cargo")
ggplot(data2, aes(y = Antigüedad_Cargo)) +
geom_boxplot(fill = "orange") +
labs(title = "Gráfico 5. Boxplot antigüedad en el cargo")
ggplot(data1, aes(x = as.factor(Rotación), y = Antigüedad_Cargo, fill = as.factor(Rotación))) +
geom_boxplot(alpha = 0.7) +
labs(title = "Gráfico 6. Antigüedad en el cargo según rotación",
x = "Rotación (0 = No, 1 = Sí)",
y = "Antigüedad en el cargo",
fill = "Rotación") +
theme_minimal()
# === 3. Ingreso Mensual ===
summary(data2$Ingreso_Mensual)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1009 2911 4919 6503 8379 19999sd(data2$Ingreso_Mensual, na.rm = TRUE)## [1] 4707.957ggplot(data2, aes(x = Ingreso_Mensual)) +
geom_histogram(binwidth = 500, fill = "steelblue", color = "white") +
geom_vline(aes(xintercept = mean(Ingreso_Mensual, na.rm=TRUE)), color="red", linetype="dashed") +
labs(title = "Gráfico 7. Distribución de ingreso mensual")
ggplot(data2, aes(y = Ingreso_Mensual)) +
geom_boxplot(fill = "orange") +
labs(title = "Gráfico 8. Boxplot Ingreso Mensual")
ggplot(data1, aes(x = as.factor(Rotación), y = Ingreso_Mensual, fill = as.factor(Rotación))) +
geom_boxplot(alpha = 0.7) +
labs(title = "Gráfico 9. Ingreso mensual según rotación",
x = "Rotación (0 = No, 1 = Sí)",
y = "Ingreso mensual",
fill = "Rotación") +
theme_minimal()
# === 4. Horas Extra ===
summary(data1$Horas_Extra)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.000 0.000 0.283 1.000 1.000sd(data1$Horas_Extra, na.rm = TRUE)## [1] 0.4506065ggplot(data1, aes(x = Horas_Extra)) +
geom_histogram(binwidth = 1, fill = "steelblue", color = "white") +
labs(title = "Gráfico 10. Distribución de horas extra",
x = "Gráfico 11. Rotación (0 = No, 1 = Sí)", y = "Frecuencia")
ggplot(data1, aes(x = Horas_Extra, color = as.factor(Rotación), fill = as.factor(Rotación))) +
geom_density(alpha = 0.4) +
labs(title = "Gráfico 12. Distribución de horas extra según rotación",
x = "Horas Extra",
y = "Densidad",
color = "Rotación", fill = "Rotación") +
theme_minimal()
# === 5. Estado Civil ===
table(data2$Estado_Civil)##
## Casado Divorciado Soltero
## 673 327 470prop.table(table(data2$Estado_Civil))##
## Casado Divorciado Soltero
## 0.4578231 0.2224490 0.3197279ggplot(data2, aes(x = Estado_Civil)) +
geom_bar(fill = "skyblue") +
labs(title = "Gráfico 13. Distribución de Estado Civil") +
theme(axis.text.x = element_text(angle=45, hjust=1))
ggplot(data2, aes(x = Estado_Civil, fill = as.factor(Rotación))) +
geom_bar(position = "fill") +
labs(title = "Gráfico 14. Proporción de rotación según estado civil",
x = "Estado Civil",
y = "Proporción",
fill = "Rotación") +
theme_minimal()
# === 6. Cargo ===
table(data2$Cargo)##
## Director_Investigación Director_Manofactura Ejecutivo_Ventas
## 80 145 326
## Gerente Investigador_Cientifico Recursos_Humanos
## 102 292 52
## Representante_Salud Representante_Ventas Tecnico_Laboratorio
## 131 83 259prop.table(table(data2$Cargo))##
## Director_Investigación Director_Manofactura Ejecutivo_Ventas
## 0.05442177 0.09863946 0.22176871
## Gerente Investigador_Cientifico Recursos_Humanos
## 0.06938776 0.19863946 0.03537415
## Representante_Salud Representante_Ventas Tecnico_Laboratorio
## 0.08911565 0.05646259 0.17619048ggplot(data2, aes(x = Cargo)) +
geom_bar(fill = "skyblue") +
labs(title = "Gráfico 15. Distribución de cargos") +
theme(axis.text.x = element_text(angle=45, hjust=1))
ggplot(data2, aes(x = Cargo, fill = as.factor(Rotación))) +
geom_bar(position = "fill") +
labs(title = "Gráfico 16. Proporción de rotación por cargo",
x = "Cargo",
y = "Proporción",
fill = "Rotación") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
# === 7. Variable Objetivo: Rotación ===
table(data1$Rotación)##
## 0 1
## 1233 237prop.table(table(data1$Rotación))##
## 0 1
## 0.8387755 0.1612245ggplot(data1, aes(x = factor(Rotación))) +
geom_bar(fill = "tomato") +
labs(title = "Gráfico 17. Distribución de rotación",
x = "Rotación (0 = No, 1 = Sí)", y = "Frecuencia")
Conclusiones análisis univariado
Años de Experiencia
La distribución muestra que la mayoría de empleados tienen pocos años de experiencia, es decir el 50 % de los datos tienen menos de 10 ños de experiencia.
Los que presentan menor experiencia tienden a mostrar mayor rotación, lo que sugiere que los empleados más nuevos abandonan antes la organización.
Antigüedad en el Cargo
Se observa concentración en los primeros años de permanencia, es decir, el 50% de las personas duran 3 años en sus cargos.
La rotación es más alta en empleados con antigüedad baja y que rotan, indicando dificultad en retenerlos en fases iniciales. Cuando el empleado no rota su permanenecia en el cargo aumenta.
Ingreso Mensual
Los ingresos más bajos están más asociados con rotación.
Los empleados con mayores ingresos muestran menos rotación, sugiriendo que el salario es un factor de retención.
El 50% de los empleados ganan 5000 pesos o menos mensualmente.
Horas Extra
La mayoría de empleados no realizan horas extra o realizan pocas.
Quienes acumulan muchas horas extra tienden a rotar más, lo que indica que la sobrecarga laboral puede ser una causa de salida.
Estado Civil
Los solteros presentan mayor proporción de rotación en comparación con casados u otros estados civiles.Esto puede deberse a que los solteros tienen mayor flexibilidad y movilidad laboral.
El estado civil mayoritario son las pesonas casadas, seguido por los solteros y por último estan los divorciados.
Cargo
Algunos cargos operativos muestran alta rotación, mientras que los cargos gerenciales o especializados tienden a ser más estables.
La rotación parece concentrarse en roles de menor nivel jerárquico.
Punto 3 - Análisis bivariado
# Variables candidatas (según tu análisis univariado previo)
vars <- c("Años_Experiencia", "Antigüedad_Cargo", "Ingreso_Mensual",
"Horas_Extra", "Estado_Civil_Casado", "Estado_Civil_Divorciado",
"Estado_Civil_Soltero", "Cargo_Director_Investigación",
"Cargo_Director_Manofactura", "Cargo_Ejecutivo_Ventas",
"Cargo_Gerente","Cargo_Investigador_Cientifico",
"Cargo_Recursos_Humanos", "Cargo_Representante_Salud",
"Cargo_Representante_Ventas", "Cargo_Tecnico_Laboratorio")
# Guardar resultados
resultados <- list()
for (v in vars) {
modelo <- glm(Rotación ~ get(v), data = data1, family = binomial)
resumen <- summary(modelo)
resultados[[v]] <- resumen$coefficients
}
# Mostrar resultados
resultados## $Años_Experiencia
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.88306065 0.12744097 -6.929174 4.233056e-12
## get(v) -0.07773067 0.01216984 -6.387158 1.689970e-10
##
## $Antigüedad_Cargo
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.1184142 0.1038017 -10.774523 4.541295e-27
## get(v) -0.1462777 0.0242450 -6.033316 1.606285e-09
##
## $Ingreso_Mensual
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.9291087486 0.1292021393 -7.191125 6.425956e-13
## get(v) -0.0001271042 0.0000216188 -5.879336 4.119147e-09
##
## $Horas_Extra
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.149646 0.1007431 -21.337888 5.052603e-101
## get(v) 1.327406 0.1465721 9.056333 1.349094e-19
##
## $Estado_Civil_Casado
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.4372608 0.08993743 -15.980675 1.742479e-57
## get(v) -0.5103486 0.14727928 -3.465176 5.298851e-04
##
## $Estado_Civil_Divorciado
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.5266955 0.07724586 -19.764107 6.066239e-87
## get(v) -0.6603767 0.19916392 -3.315745 9.139930e-04
##
## $Estado_Civil_Soltero
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.0211513 0.09838336 -20.543630 8.775213e-94
## get(v) 0.9507099 0.14446363 6.580963 4.674104e-11
##
## $Cargo_Director_Investigación
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.592270 0.0715620 -22.250218 1.122465e-109
## get(v) -2.071292 0.7196741 -2.878096 4.000828e-03
##
## $Cargo_Director_Manofactura
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.576296 0.07291113 -21.619409 1.179775e-103
## get(v) -1.026394 0.33574241 -3.057088 2.234987e-03
##
## $Cargo_Ejecutivo_Ventas
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.6781344 0.08119542 -20.6678451 6.746168e-95
## get(v) 0.1264744 0.16688308 0.7578621 4.485335e-01
##
## $Cargo_Gerente
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.588531 0.0720460 -22.048846 9.799043e-108
## get(v) -1.376742 0.4641923 -2.965887 3.018114e-03
##
## $Cargo_Investigador_Cientifico
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.648658626 0.0792168 -20.81198191 3.371162e-96
## get(v) -0.002451983 0.1778581 -0.01378618 9.890006e-01
##
## $Cargo_Recursos_Humanos
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.6681260 0.07268196 -22.951032 1.438913e-116
## get(v) 0.4641532 0.33706949 1.377025 1.685044e-01
##
## $Cargo_Representante_Salud
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.583670 0.07270526 -21.782057 3.433045e-105
## get(v) -1.023126 0.35297782 -2.898557 3.748842e-03
##
## $Cargo_Representante_Ventas
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.757689 0.07581074 -23.185221 6.418748e-119
## get(v) 1.342173 0.23674944 5.669172 1.434889e-08
##
## $Cargo_Tecnico_Laboratorio
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.7783364 0.08172843 -21.759094 5.665723e-105
## get(v) 0.6222671 0.16698705 3.726439 1.942038e-04Años de Experiencia
Coeficiente (β1): -0.0777, p < 0.001 (muy significativo)
Cada año adicional de experiencia reduce la probabilidad de rotación. Esto confirma la hipótesis: empleados con menos experiencia tienden a abandonar más.
Antigüedad en el Cargo
Coeficiente (β1): -0.1463, p < 0.001 (muy significativo)
Mayor antigüedad en el cargo disminuye la rotación. Refuerza la idea de que los empleados más estables en un rol permanecen más tiempo.
Ingreso Mensual
Coeficiente (β1): -0.000127, p < 0.001 (muy significativo)
Mayor salario, la probabilidad de rotación disminuye ligeramente. El signo negativo es consistente con la hipótesis de que un mejor pago retiene talento.
Horas Extra
Coeficiente (β1): +1.327, p < 0.001 (muy significativo)
Trabajar más horas extra incrementa fuertemente la probabilidad de rotación. Esto respalda la hipótesis de que la sobrecarga laboral motiva la salida de empleados.
Estado civil
Coeficiente (β1): +0.951, p < 0.001 (muy significativo) - Soltero
Coeficiente (β1): -0.5103, p < 0.01 (significativo) - Casado
Los casados tienen menor probabilidad de rotación en comparación con los solteros u otros estados civiles. Esto coincide con tu hipótesis de que los solteros rotan más.
Cargo
Director de Investigación (β = -2.071, p < 0.01):
Ocupando este cargo, la probabilidad de rotación disminuye mucho. Posiblemente estos empleados tienen más estabilidad y mejores condiciones.Representante de Ventas (β = +1.342, p < 0.001):
Los representantes de ventas muestran una mayor propensión a rotar.
Punto 4 - Estimación del modelo
data3 <- data
# Dataset: seleccionar variables
data_modelo <- data3 %>%
select(Rotación, Horas_Extra, Cargo, Estado_Civil,
Años_Experiencia, Ingreso_Mensual, Antigüedad_Cargo)
str(data_modelo)## tibble [1,470 × 7] (S3: tbl_df/tbl/data.frame)
## $ Rotación : chr [1:1470] "Si" "No" "Si" "No" ...
## $ Horas_Extra : chr [1:1470] "Si" "No" "Si" "Si" ...
## $ Cargo : chr [1:1470] "Ejecutivo_Ventas" "Investigador_Cientifico" "Tecnico_Laboratorio" "Investigador_Cientifico" ...
## $ Estado_Civil : chr [1:1470] "Soltero" "Casado" "Soltero" "Casado" ...
## $ Años_Experiencia: num [1:1470] 8 10 7 8 6 8 12 1 10 17 ...
## $ Ingreso_Mensual : num [1:1470] 5993 5130 2090 2909 3468 ...
## $ Antigüedad_Cargo: num [1:1470] 4 7 0 7 2 7 0 0 7 7 ...# PRUEBA CON VALIDACIÓN CRUZADA OPC 1
# 1. Preparación de los datos
data_modelo <- data3 %>%
select(Rotación, Horas_Extra, Cargo, Estado_Civil,
Años_Experiencia, Ingreso_Mensual, Antigüedad_Cargo)
# Asegurar que las categóricas sean factores
data_modelo$Cargo <- as.factor(data_modelo$Cargo)
data_modelo$Estado_Civil <- as.factor(data_modelo$Estado_Civil)
data_modelo$Horas_Extra <- as.factor(data_modelo$Horas_Extra)
data_modelo$Rotación <- as.factor(data_modelo$Rotación)
# 2. División Train / Test
set.seed(123)
split <- initial_split(data_modelo, prop = 0.8, strata = Rotación)
train_data <- training(split)
test_data <- testing(split)
# 3. Balanceo con ROSE (solo en train)
set.seed(123)
train_balanced <- ROSE(Rotación ~ ., data = train_data, seed = 123)$data
# 4. Validación cruzada estratificada
set.seed(123)
cv_folds <- vfold_cv(train_balanced, v = 10, repeats = 3, strata = Rotación)
# 5. Receta de preprocesamiento
receta <- recipe(Rotación ~ ., data = train_balanced) %>%
step_dummy(all_nominal_predictors()) %>% # One-hot encoding para factores
step_normalize(all_numeric_predictors()) # Escalamiento para numéricas
# 6. Modelo de regresión logística
modelo_logit2 <- logistic_reg() %>%
set_engine("glm") %>%
set_mode("classification")
# 7. Workflow
workflow_modelo <- workflow() %>%
add_recipe(receta) %>%
add_model(modelo_logit2)
# 8. Entrenamiento con validación cruzada
set.seed(123)
resultados_cv <- fit_resamples(
workflow_modelo,
resamples = cv_folds,
metrics = metric_set(roc_auc, accuracy, sens, spec)
)
# Métricas promedio en CV
collect_metrics(resultados_cv)## # A tibble: 4 × 6
## .metric .estimator mean n std_err .config
## <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 accuracy binary 0.708 30 0.00569 pre0_mod0_post0
## 2 roc_auc binary 0.766 30 0.00682 pre0_mod0_post0
## 3 sens binary 0.716 30 0.0120 pre0_mod0_post0
## 4 spec binary 0.699 30 0.0121 pre0_mod0_post0# 9. Entrenamiento final con todos los datos de train balanceados
modelo_final <- fit(workflow_modelo, data = train_balanced)
# 10. Evaluación en el conjunto de test
predicciones <- predict(modelo_final, test_data, type = "prob") %>%
bind_cols(test_data %>% select(Rotación))
# AUC en test
roc_auc(predicciones, truth = Rotación, .pred_No)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 roc_auc binary 0.770# Matriz de confusión en test (con corte 0.5)
pred_clases <- ifelse(predicciones$.pred_Si >= 0.5, "Si", "No") %>%
factor(levels = levels(test_data$Rotación))
# Crear data frame adecuado
df_resultados <- data.frame(
truth = test_data$Rotación,
estimate = pred_clases
)
# Calcular matriz de confusión
conf_mat(df_resultados, truth = truth, estimate = estimate)## Truth
## Prediction No Si
## No 172 14
## Si 75 34# --- IMPORTANTE ---
# Para obtener coeficientes, OR e IC, extraemos el modelo glm final
modelo_glm <- extract_fit_parsnip(modelo_final)$fit
# Resumen del modelo
summary(modelo_glm)##
## Call:
## stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.06759 0.06720 -1.006 0.314510
## Años_Experiencia 0.11917 0.10178 1.171 0.241660
## Ingreso_Mensual 0.25207 0.13759 1.832 0.066953 .
## Antigüedad_Cargo -0.24559 0.08147 -3.014 0.002576 **
## Horas_Extra_Si 0.66471 0.06929 9.593 < 2e-16 ***
## Cargo_Director_Manofactura 0.28910 0.14437 2.002 0.045240 *
## Cargo_Ejecutivo_Ventas 0.93662 0.21312 4.395 1.11e-05 ***
## Cargo_Gerente -0.08376 0.12283 -0.682 0.495260
## Cargo_Investigador_Cientifico 0.78728 0.23208 3.392 0.000693 ***
## Cargo_Recursos_Humanos 0.61537 0.13036 4.721 2.35e-06 ***
## Cargo_Representante_Salud 0.24359 0.14144 1.722 0.085040 .
## Cargo_Representante_Ventas 0.76105 0.16904 4.502 6.72e-06 ***
## Cargo_Tecnico_Laboratorio 1.06615 0.24352 4.378 1.20e-05 ***
## Estado_Civil_Divorciado -0.27547 0.07559 -3.644 0.000268 ***
## Estado_Civil_Soltero 0.43845 0.07296 6.010 1.86e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1628.6 on 1174 degrees of freedom
## Residual deviance: 1336.8 on 1160 degrees of freedom
## AIC: 1366.8
##
## Number of Fisher Scoring iterations: 4# Odds Ratios
exp(coef(modelo_glm))## (Intercept) Años_Experiencia
## 0.9346450 1.1265609
## Ingreso_Mensual Antigüedad_Cargo
## 1.2866889 0.7822445
## Horas_Extra_Si Cargo_Director_Manofactura
## 1.9439346 1.3352198
## Cargo_Ejecutivo_Ventas Cargo_Gerente
## 2.5513509 0.9196474
## Cargo_Investigador_Cientifico Cargo_Recursos_Humanos
## 2.1974134 1.8503322
## Cargo_Representante_Salud Cargo_Representante_Ventas
## 1.2758167 2.1405293
## Cargo_Tecnico_Laboratorio Estado_Civil_Divorciado
## 2.9041701 0.7592123
## Estado_Civil_Soltero
## 1.5503076# Intervalos de confianza
exp(confint(modelo_glm))## Waiting for profiling to be done...## 2.5 % 97.5 %
## (Intercept) 0.8189955 1.0659867
## Años_Experiencia 0.9228649 1.3759448
## Ingreso_Mensual 0.9831966 1.6870270
## Antigüedad_Cargo 0.6660554 0.9169426
## Horas_Extra_Si 1.6994888 2.2302675
## Cargo_Director_Manofactura 1.0136546 1.7911066
## Cargo_Ejecutivo_Ventas 1.7078466 3.9577848
## Cargo_Gerente 0.7246236 1.1776967
## Cargo_Investigador_Cientifico 1.4126109 3.5226569
## Cargo_Recursos_Humanos 1.4433566 2.4104881
## Cargo_Representante_Salud 0.9733179 1.7003346
## Cargo_Representante_Ventas 1.5501249 3.0141092
## Cargo_Tecnico_Laboratorio 1.8286092 4.7702632
## Estado_Civil_Divorciado 0.6535464 0.8792007
## Estado_Civil_Soltero 1.3447240 1.7902380# Verificar que los niveles esten alineados
identical(levels(df_resultados$truth), levels(df_resultados$estimate))## [1] TRUE# Métricas promedio en validación cruzada
collect_metrics(resultados_cv)## # A tibble: 4 × 6
## .metric .estimator mean n std_err .config
## <chr> <chr> <dbl> <int> <dbl> <chr>
## 1 accuracy binary 0.708 30 0.00569 pre0_mod0_post0
## 2 roc_auc binary 0.766 30 0.00682 pre0_mod0_post0
## 3 sens binary 0.716 30 0.0120 pre0_mod0_post0
## 4 spec binary 0.699 30 0.0121 pre0_mod0_post0# Asegurarse de alinear niveles
df_resultados <- data.frame(
truth = factor(test_data$Rotación, levels = c("No", "Si")),
estimate = factor(pred_clases, levels = c("No", "Si"))
)
# Accuracy en conjunto test
accuracy(df_resultados, truth = truth, estimate = estimate)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.698# Matriz de confusión en test
conf_mat(df_resultados, truth = truth, estimate = estimate)## Truth
## Prediction No Si
## No 172 14
## Si 75 34# F1 Score
f1_res <- f_meas(df_resultados, truth = truth, estimate = estimate)
print(f1_res)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 f_meas binary 0.794# Recall (que es lo mismo que sensibilidad)
recall_res <- recall(df_resultados, truth = truth, estimate = estimate)
print(recall_res)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 recall binary 0.696# Precision (precisión)
precision_res <- precision(df_resultados, truth = truth, estimate = estimate)
print(precision_res)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 precision binary 0.925# También puedes ver un resumen de varias métricas
metrics(df_resultados, truth = truth, estimate = estimate)## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.698
## 2 kap binary 0.268# PRUEBA SIN VALIDACIÓN CRUZADA OPC 2
# 1. Se seleccionan las 6 variables de interes
data_modelo <- data3 %>%
select(Rotación, Horas_Extra, Cargo, Estado_Civil,
Años_Experiencia, Ingreso_Mensual, Antigüedad_Cargo)
# 2. Asegurar que las categóricas son factores
data_modelo$Estado_Civil <- as.factor(data_modelo$Estado_Civil)
data_modelo$Cargo <- as.factor(data_modelo$Cargo)
set.seed(123) # Semilla para reproducibilidad
# 3. Se divide el dataset en los dats de train y test para el modelo
split <- sample.split(data_modelo$Rotación, SplitRatio = 0.8)
train_data <- subset(data_modelo, split == TRUE)
test_data <- subset(data_modelo, split == FALSE)
# 3. Separar clases
train_0 <- train_data %>% filter(Rotación == 0)
train_1 <- train_data %>% filter(Rotación == 1)
# 4. Calcular oversampling para la clase 1 (solo si hace falta)
n_total <- nrow(train_data)
n_target_1 <- round(n_total * 0.5) # balanceado
n_actual_1 <- nrow(train_1)
n_extra <- n_target_1 - n_actual_1
if (n_actual_1 > 0 && n_extra > 0) {
set.seed(123)
train_1_oversampled <- train_1 %>%
sample_n(size = n_extra, replace = TRUE)
train_data_balanced <- bind_rows(train_data, train_1_oversampled)
} else {
message("No se requiere oversampling (o no hay suficientes casos en clase 1).")
train_data_balanced <- train_data
}## No se requiere oversampling (o no hay suficientes casos en clase 1).# Verificar nueva distribución
table(train_data_balanced$Rotación)##
## No Si
## 986 190prop.table(table(train_data_balanced$Rotación))##
## No Si
## 0.8384354 0.1615646# Definir el control de entrenamiento
ctrl <- trainControl(
method = "repeatedcv",
number = 10,
repeats = 3,
classProbs = TRUE,
summaryFunction = twoClassSummary
)
# Ajustar el modelo logístico con caret
modelo_logit <- train(
factor(Rotación) ~ Años_Experiencia + Antigüedad_Cargo + Ingreso_Mensual +
Horas_Extra + Estado_Civil + Cargo,
data = train_data_balanced,
method = "glm",
family = "binomial",
trControl = ctrl,
metric = "ROC"
)
# Resultados
print(modelo_logit)## Generalized Linear Model
##
## 1176 samples
## 6 predictor
## 2 classes: 'No', 'Si'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 1059, 1059, 1059, 1058, 1058, 1058, ...
## Resampling results:
##
## ROC Sens Spec
## 0.7661535 0.9827699 0.145614# 6. Resultados
summary(modelo_logit)##
## Call:
## NULL
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.590e+00 1.271e+00 -3.611 0.000306 ***
## Años_Experiencia -1.665e-02 2.091e-02 -0.796 0.425894
## Antigüedad_Cargo -7.911e-02 3.207e-02 -2.467 0.013636 *
## Ingreso_Mensual 3.102e-05 5.806e-05 0.534 0.593109
## Horas_ExtraSi 1.420e+00 1.807e-01 7.859 3.88e-15 ***
## Estado_CivilDivorciado -3.143e-01 2.601e-01 -1.208 0.226912
## Estado_CivilSoltero 8.199e-01 1.915e-01 4.282 1.85e-05 ***
## CargoDirector_Manofactura 1.461e+00 1.154e+00 1.266 0.205687
## CargoEjecutivo_Ventas 2.590e+00 1.115e+00 2.323 0.020193 *
## CargoGerente 1.110e+00 1.142e+00 0.971 0.331432
## CargoInvestigador_Cientifico 2.191e+00 1.201e+00 1.825 0.068028 .
## CargoRecursos_Humanos 2.952e+00 1.225e+00 2.409 0.015981 *
## CargoRepresentante_Salud 1.487e+00 1.166e+00 1.276 0.202127
## CargoRepresentante_Ventas 3.597e+00 1.226e+00 2.935 0.003335 **
## CargoTecnico_Laboratorio 3.138e+00 1.198e+00 2.621 0.008779 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1040.18 on 1175 degrees of freedom
## Residual deviance: 855.59 on 1161 degrees of freedom
## AIC: 885.59
##
## Number of Fisher Scoring iterations: 6modelo_glm <- modelo_logit$finalModel
# Odds Ratios
exp(coef(modelo_glm))## (Intercept) Años_Experiencia
## 0.01014861 0.98348879
## Antigüedad_Cargo Ingreso_Mensual
## 0.92393449 1.00003102
## Horas_ExtraSi Estado_CivilDivorciado
## 4.13634232 0.73028416
## Estado_CivilSoltero CargoDirector_Manofactura
## 2.27032155 4.31033895
## CargoEjecutivo_Ventas CargoGerente
## 13.33606432 3.03288622
## CargoInvestigador_Cientifico CargoRecursos_Humanos
## 8.94666344 19.13536524
## CargoRepresentante_Salud CargoRepresentante_Ventas
## 4.42394292 36.49115337
## CargoTecnico_Laboratorio
## 23.06543996# Intervalos de confianza
exp(confint(modelo_glm))## Waiting for profiling to be done...## 2.5 % 97.5 %
## (Intercept) 0.0004328002 0.09320375
## Años_Experiencia 0.9431659586 1.02390506
## Antigüedad_Cargo 0.8668565346 0.98321547
## Ingreso_Mensual 0.9999165956 1.00014462
## Horas_ExtraSi 2.9092538802 5.91209708
## Estado_CivilDivorciado 0.4323169829 1.20253268
## Estado_CivilSoltero 1.5628223605 3.31357418
## CargoDirector_Manofactura 0.6137776160 88.20113390
## CargoEjecutivo_Ventas 2.1452247586 262.46499770
## CargoGerente 0.4227369663 60.90806287
## CargoInvestigador_Cientifico 1.1538906019 193.15898911
## CargoRecursos_Humanos 2.3009902143 423.92334631
## CargoRepresentante_Salud 0.6095922427 91.58369112
## CargoRepresentante_Ventas 4.4313602601 810.65490327
## CargoTecnico_Laboratorio 3.0047424913 496.33491522# Predicción probabilística en test (para obtener probabilidades)
prob_test <- predict(modelo_logit, newdata = test_data, type = "prob")
# Extraer probabilidad para clase "Si"
prob_si <- prob_test$Si
# Convertir a factor con cutoff 0.5
pred_clases <- factor(ifelse(prob_si >= 0.5, "Si", "No"), levels = c("No", "Si"))
# Variable real en test, con niveles bien ordenados
truth <- factor(test_data$Rotación, levels = c("No", "Si"))
# Verifica que tengan la misma longitud
length(truth) # debe ser igual a length(pred_clases)## [1] 294# Crear data frame para yardstick
df_resultados <- data.frame(truth = truth, estimate = pred_clases)
# Calcular accuracy
accuracy(df_resultados, truth = truth, estimate = estimate)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.864# Calcular matriz de confusión
conf_mat(df_resultados, truth = truth, estimate = estimate)## Truth
## Prediction No Si
## No 245 38
## Si 2 9# F1 Score
f1_res <- f_meas(df_resultados, truth = truth, estimate = estimate)
print(f1_res)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 f_meas binary 0.925# Recall (que es lo mismo que sensibilidad)
recall_res <- recall(df_resultados, truth = truth, estimate = estimate)
print(recall_res)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 recall binary 0.992# Precision (precisión)
precision_res <- precision(df_resultados, truth = truth, estimate = estimate)
print(precision_res)## # A tibble: 1 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 precision binary 0.866# También puedes ver un resumen de varias métricas
metrics(df_resultados, truth = truth, estimate = estimate)## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy binary 0.864
## 2 kap binary 0.266¿Cuál es mejor?
Opción 2 parece tener mejores métricas globales (accuracy, recall, F1), pero:
No tiene validación cruzada, por lo que puede estar sobreajustado (overfitting) al conjunto de entrenamiento.
Muy alto recall + menor precisión puede significar que está clasificando demasiados positivos, incluso algunos incorrectamente.
Opción 1 es más robusta estadísticamente, ya que:
Tiene validación cruzada estratificada repetida.
Es más conservador pero más confiable para generalizar a datos nuevos.
Sacrifica algo de recall, pero tiene mayor precisión y un F1 score aceptable.
Debido a lo expuesto anteriorente, se selecciona el modelo con validación cruzada para el desarrollo de la actividad.
Variables significativas (p < 0.05) con el modelo de validación cruzada
Antigüedad_Cargo (β = -0.2456 OR = 0.782, p =
0.003)
Cada año adicional en el cargo reduce la probabilidad de rotación en
aproximadamente 7%. Confirma la hipótesis de que mayor estabilidad en el
cargo disminuye la rotación.
Horas_ExtraSi (β = 0.664 OR = 1.94 p =
<0.001)
Los empleados que hacen horas extra tienen 1.96 veces más probabilidad
de rotar que los que no. Evidencia fuerte de que la sobrecarga laboral
aumenta la salida.
Estado_Civil Soltero / Divorciado (β = 0.438 /
-0.25, OR = 1.55 / 0.76, p = ambos < 0.001)
Los solteros tienen el doble de probabilidad de rotar en comparación con
divorsiados. Confirma la hipótesis planteada.
Director de manufactura / ejecutivo de ventas / investigador científico / Recursos humanos / Representante de ventas / Tecnico de laboratorio: Significativo con respecto a la rotación en estos cargos. El mayor de todos es el Tecnico de laboratorio, pues presenta mucha probabilidad de rotar(2.9, veces más riesgo de rotar).
Variables no significativas (p > 0.05) con el modelo de validación cruzada
Años_Experiencia: No tiene un efecto sobre la rotación
Ingreso_Mensual: No tiene un efecto sobre la rotación
Cargo gerente / Representante salud: No tiene un efecto sobre la rotación
Conclusiones principales
Determinantes de la rotación:
Hacer horas extra.
Ser soltero.
Ocupación (Representante_Venta, Tecnico_Laboratorio, Ejecutivo de ventas).
Menor antigüedad en el cargo.
Interpretación del signo:
Coeficientes positivos: aumentan la probabilidad de rotación (ej: Horas Extra, Soltero, cargos específicos).
Coeficientes negativos → reducen la probabilidad (ej: Antigüedad en el cargo).
Comparación con hipótesis iniciales (punto 2):
1. Se confirma que empleados más nuevos rotan más.
2. Se confirma que la sobrecarga de horas extra incrementa la rotación.
3. Se confirma que los solteros tienen más riesgo de rotar.
Punto 5 - Evaluación
# 1. Probabilidades predichas de "Si" (rotación)
pred_probs <- predict(modelo_final, test_data, type = "prob") %>%
pull(.pred_Si)
# 2. Curva ROC (aseguramos que el nivel positivo sea "Si")
roc_obj <- pROC::roc(response = test_data$Rotación,
predictor = pred_probs,
levels = c("No", "Si"), # orden correcto
direction = "<")
# 3. AUC (forzando a usar pROC)
auc_value <- pROC::auc(roc_obj)
print(paste("AUC:", round(auc_value, 3)))## [1] "AUC: 0.784"# 4. Graficar curva ROC
plot(roc_obj, col = "blue", lwd = 2,
main = paste("Curva ROC (AUC =", round(auc_value, 3), ")"))
abline(a = 0, b = 1, lty = 2, col = "red")
La curva ROC fue calculada para evaluar la capacidad predictiva del modelo. La curva AUC fue de 0.784, lo que indica que el modelo de regresión logística posee un poder predictivo aceptable para distinguir entre empleados que rotan y los que no rotan. En términos prácticos, el modelo tiene un 78,0% de probabilidad de asignar una puntuación más alta de rotación a un empleado que efectivamente rota frente a uno que no rota, lo cual lo hace claramente mejor que el azar. Aunque no alcanza un nivel de predicción excelente, el desempeño es adecuado y puede servir como base confiable para la toma de decisiones, con posibilidad de mejorar mediante ajustes o inclusión de nuevas variables.
Punto 6 - Predicciones
Se le da al modelo el siguiente caso de un trabajador:
# Caso 1
# 1. Definir un empleado hipotético
empleado_nuevo <- data.frame(
Años_Experiencia = 12,
Antigüedad_Cargo = 10,
Ingreso_Mensual = 10000,
Horas_Extra = "No",
Estado_Civil = factor("Casado", levels = levels(train_data_balanced$Estado_Civil)),
Cargo = factor("Gerente", levels = levels(train_data_balanced$Cargo))
)
# 2. Predecir probabilidad de rotación con tidymodels (workflow)
prob_rotacion <- predict(modelo_final, new_data = empleado_nuevo, type = "prob")
# 3. Extraer la probabilidad de "Si"
prob_rotacion <- prob_rotacion$.pred_Si
print(prob_rotacion)## [1] 0.0358247De acuerdo con el modelo de validación cruzada la probabilidad de rotación del trabajador expesto anteriormente es del 3,6%, lo cual es congruente con la base de datos, puesto que,las variables de cargo de gerencia, estado civil casado, con un salario moderadamente alto, sin horas extras su probabilidad es baja.
Caso contrario paso con el siguiente caso:
# Caso 2
# 1. Definir un empleado hipotético
empleado_nuevo <- data.frame(
Años_Experiencia = 8,
Antigüedad_Cargo = 5,
Ingreso_Mensual = 5000,
Horas_Extra = "Si",
Estado_Civil = factor("Casado", levels = levels(train_data_balanced$Estado_Civil)),
Cargo = factor("Tecnico_Laboratorio", levels = levels(train_data_balanced$Cargo))
)
# 2. Predecir probabilidad de rotación con tidymodels (workflow)
prob_rotacion <- predict(modelo_final, new_data = empleado_nuevo, type = "prob")
# 3. Extraer la probabilidad de "Si"
prob_rotacion <- prob_rotacion$.pred_Si
print(prob_rotacion)## [1] 0.7263504Al ser una persona con el cargo más bajo en la piramide laboral, que sí realiza horas extra, su salario está dentro de la media y, tiene una antiguedad moderadamente por encima de la media, su probabilidad es alta para la variable rotación sin embargo es casado, esto hace que su probabilidad de rotación disminuya considerablemente como se oberva en el caso 3, cerca del 10%.
# Caso 3
# 1. Definir un empleado hipotético
empleado_nuevo <- data.frame(
Años_Experiencia = 8,
Antigüedad_Cargo = 5,
Ingreso_Mensual = 5000,
Horas_Extra = "Si",
Estado_Civil = factor("Soltero", levels = levels(train_data_balanced$Estado_Civil)),
Cargo = factor("Tecnico_Laboratorio", levels = levels(train_data_balanced$Cargo))
)
# 2. Predecir probabilidad de rotación con tidymodels (workflow)
prob_rotacion <- predict(modelo_final, new_data = empleado_nuevo, type = "prob")
# 3. Extraer la probabilidad de "Si"
prob_rotacion <- prob_rotacion$.pred_Si
print(prob_rotacion)## [1] 0.8670561Punto 7 - Conclusiones
Entre las estrategia para disminuir la rotación en la empresa se podria considerar
- Para el personal de bajo rango en la piramide laboral disminuir las horas extra.
- Evaluar la posibilidad de brindar ayudas económicas por los años de antiguedad en los cargos, lo que incentivaría la permanencia y disminución de rotación.
- Evaluar la posibilidad de brindarle al trabajador días hábiles por el cambio de estado civil a casado.
- Priorizar la contratación de personas con estado civil casado.
- Diseñar mecanismos o campañas que permitan el desarrollo profesional para que los colaboradores puedan ejercer cargos de liderazgo.