Descripción de la Base

La base de datos contiene información sobre empleados de una empresa, con variables que abarcan aspectos demográficos, laborales y de desempeño. Su objetivo principal es analizar la rotación laboral, es decir, identificar factores que influyen en si un empleado deja o permanece en la organización. En resumen, esta base proporciona un panorama detallado del perfil de los empleados y sus condiciones laborales, permitiendo un análisis integral de la rotación y sus causas.

Descripción de las variables

library(readxl)
library(dplyr)   # 🔹 Necesario para usar el operador %>%
library(knitr)
library(kableExtra)

# 📥 Cargar los datos
df <- read_excel("D:/UNIVERSIDAD M/QUINTO SEMESTRE/Estadistica aplicada/Datos_Rotación.xlsx")

# 📌 Seleccionar las variables de interés
variables <- df %>%
  select(`Viaje de Negocios`, Genero, Estado_Civil, Ingreso_Mensual, 
         Horas_Extra, Años_Experiencia, Capacitaciones)

# 📌 Definir los nombres de las variables y sus descripciones
nombre_variables <- colnames(variables)
descripcion_variables <- c(  # 🔹 Corregí la tilde en "descripción_variables"
  "Frecuencia con la que el empleado viaja por negocios.",
  "Género del empleado (M/F).",
  "Estado civil del empleado (Soltero, Casado, Divorciado).",
  "Ingreso mensual del empleado en unidades monetarias.",
  "Indica si el empleado trabaja horas extra (Sí/No).",
  "Años de experiencia laboral del empleado.",
  "Número de capacitaciones que ha recibido el empleado."
)

# 📊 Clasificación de las variables
clasificacion_variables <- c(
  "Cualitativa nominal", 
  "Cualitativa nominal", 
  "Cualitativa nominal", 
  "Cuantitativa continua", 
  "Cualitativa nominal", 
  "Cuantitativa discreta", 
  "Cuantitativa discreta"
)

# 🔍 Verificación: asegurarnos de que los vectores tienen la misma longitud
stopifnot(length(nombre_variables) == length(descripcion_variables), 
          length(nombre_variables) == length(clasificacion_variables))

# 📋 Crear el data frame con la información estructurada
tabla_variables <- data.frame(
  Nombre = nombre_variables,
  Descripción = descripcion_variables,  # 🔹 Ahora sin errores
  Clasificación = clasificacion_variables
)



# 🖥 Generar la tabla con formato mejorado
kable(tabla_variables, format = "html") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "responsive"), full_width = FALSE)
Nombre Descripción Clasificación
Viaje de Negocios Frecuencia con la que el empleado viaja por negocios. Cualitativa nominal
Genero Género del empleado (M/F). Cualitativa nominal
Estado_Civil Estado civil del empleado (Soltero, Casado, Divorciado). Cualitativa nominal
Ingreso_Mensual Ingreso mensual del empleado en unidades monetarias. Cuantitativa continua
Horas_Extra Indica si el empleado trabaja horas extra (Sí/No). Cualitativa nominal
Años_Experiencia Años de experiencia laboral del empleado. Cuantitativa discreta
Capacitaciones Número de capacitaciones que ha recibido el empleado. Cuantitativa discreta

HIPÓTESIS

  • Viaje de negocios: Se espera que los empleados que viajan con frecuencia por negocios tengan una mayor tasa de rotación debido al impacto en su calidad de vida y tiempo con la familia. La hipótesis es que los empleados que viajan frecuentemente por negocios tienen mayor probabilidad de rotar que aquellos que no lo hacen.

  • Género: Se espera que el género influya en la rotación debido a diferencias en oportunidades laborales, expectativas sociales o responsabilidades personales. La hipótesis es que la tasa de rotación es mayor en un género específico en comparación con el otro.

  • Estado civil: Se espera que el estado civil influya en la rotación, ya que las personas casadas o con hijos pueden valorar más la estabilidad laboral, mientras que los solteros podrían buscar nuevas oportunidades con mayor facilidad. La hipótesis es que los empleados solteros tienen mayor probabilidad de rotar que los empleados casados.

  • Ingreso mensual: Se espera que un menor ingreso mensual incremente la rotación, ya que los empleados pueden buscar mejores oportunidades salariales en otras empresas. La hipótesis es que a menor ingreso mensual, mayor probabilidad de rotación.

  • Horas extra: Se espera que los empleados que trabajan más horas extra sientan una mayor carga laboral y menor satisfacción, lo que puede motivarlos a cambiar de empleo. La hipótesis es que los empleados que trabajan muchas horas extra presentan mayor insatisfacción y, por lo tanto, una mayor probabilidad de rotación.

  • Años de experiencia: Se espera que los empleados con más años de experiencia tengan menos probabilidad de rotar, ya que han desarrollado estabilidad laboral y mejores condiciones dentro de la empresa. La hipótesis es que a mayor cantidad de años de experiencia, menor probabilidad de rotación.

  • Capacitaciones: Se espera que los empleados que reciben más capacitaciones tengan una menor tasa de rotación, ya que la empresa les brinda oportunidades de crecimiento y desarrollo profesional. La hipótesis es que a mayor número de capacitaciones, menor probabilidad de rotación, debido a un mayor compromiso con la empresa y mejores perspectivas de carrera interna.

Análisis Univariado

library(ggplot2)
library(dplyr)
library(readxl)
library(knitr)
library(kableExtra)
library(scales)

# Cargar la base de datos
data <- read_excel("D:/UNIVERSIDAD M/QUINTO SEMESTRE/Estadistica aplicada/Datos_Rotación.xlsx")

# Crear el histograma con etiquetas y ejes mejorados
ggplot(data, aes(x = Ingreso_Mensual)) +
  geom_histogram(aes(y = ..count..), fill = "#2E86C1", color = "black", bins = 15, alpha = 0.7) +
  geom_text(stat = "bin", bins = 15, aes(y = ..count.., label = ..count..), vjust = -0.5, size = 4, color = "black") +
  labs(title = "Distribución de Ingreso Mensual", x = "Rango de Ingreso", y = "Número de Empleados") +
  scale_x_continuous(breaks = seq(0, max(data$Ingreso_Mensual, na.rm = TRUE), by = 2000),
                     labels = dollar_format(prefix = "$", big.mark = ".")) +
  scale_y_continuous(limits = c(0, 500), breaks = seq(0, 500, 50)) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12))

Distribución de Ingreso Mensual

  • La mayoría de los empleados tienen ingresos bajos, con un pico en el rango de $2,000 a $4,000, donde hay 401 empleados.

  • A medida que aumenta el ingreso, el número de empleados disminuye considerablemente.

  • Hay pocos empleados con ingresos superiores a $10,000.

# Histograma de Años de Experiencia con etiquetas y eje X ajustado
ggplot(data, aes(x = Años_Experiencia)) +
  geom_histogram(aes(y = ..count..), fill = "#2E86C1", color = "black", bins = 15, alpha = 0.7) +
  geom_text(stat = "bin", bins = 15, aes(y = ..count.., label = ..count..), vjust = -0.5, size = 4, color = "black") +
  labs(title = "Distribución de Años de Experiencia", x = "Años de Experiencia", y = "Número de Empleados") +
  scale_x_continuous(breaks = seq(0, max(data$Años_Experiencia, na.rm = TRUE), by = 5)) +
  scale_y_continuous(limits = c(0, 500), breaks = seq(0, 500, 50)) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 12))

Distribución de Años de Experiencia

  • La mayor cantidad de empleados tiene entre 5 y 10 años de experiencia, con un pico en los 10 años (401 empleados).

  • Después de los 10 años, la cantidad de empleados disminuye progresivamente.

  • Pocos empleados tienen más de 30 años de experiencia.

data$Capacitaciones <- factor(data$Capacitaciones, levels = 0:6)  # Asegura todas las categorías

ggplot(data, aes(x = Capacitaciones)) +
  geom_bar(fill = "#2E86C1", color = "black", alpha = 0.7) +
  geom_text(stat = "count", aes(label = ..count..), vjust = -0.5, size = 4, color = "black") +
  labs(title = "Distribución de Capacitaciones", x = "Capacitaciones", y = "Número de Empleados") +
  scale_y_continuous(limits = c(0, 600), breaks = seq(0, 600, 100)) +  # Ajusta límites del eje Y
  theme_minimal() +
  theme(axis.text.x = element_text(size = 12))

Distribución de Capacitaciones

  • La mayoría de los empleados han recibido entre 2 y 3 capacitaciones, con picos en 2 (547 empleados) y 3 (491 empleados).

  • Es menos común que los empleados tengan 0 o más de 4 capacitaciones.

# Tablas de frecuencia y porcentaje para variables cualitativas
## Viaje de Negocios
freq_table_viaje <- data %>%
  group_by(`Viaje de Negocios`) %>%
  summarise(n = n()) %>%
  mutate(Porcentaje = round((n / sum(n)) * 100, 1))
knitr::kable(freq_table_viaje, format = "html", caption = "Distribución de Viaje de Negocios") %>%
        kable_styling(full_width = F)
Distribución de Viaje de Negocios
Viaje de Negocios n Porcentaje
Frecuentemente 277 18.8
No_Viaja 150 10.2
Raramente 1043 71.0

Distribución de Viaje de Negocios

  • La mayoría de los empleados viajan raramente por negocios (71%).

  • Un 18.8% viaja frecuentemente y solo un 10.2% no viaja.

## Género
freq_table_genero <- data %>%
  group_by(Genero) %>%
  summarise(n = n()) %>%
  mutate(Porcentaje = round((n / sum(n)) * 100, 1))
knitr::kable(freq_table_genero, format = "html", caption = "Distribución de Género") %>%
        kable_styling(full_width = F)
Distribución de Género
Genero n Porcentaje
F 588 40
M 882 60

Distribución de Género

  • Hay más empleados hombres (60%) que mujeres (40%).
## Estado Civil
freq_table_estado <- data %>%
  group_by(Estado_Civil) %>%
  summarise(n = n()) %>%
  mutate(Porcentaje = round((n / sum(n)) * 100, 1))
knitr::kable(freq_table_estado, format = "html", caption = "Distribución de Estado Civil") %>%
        kable_styling(full_width = F)
Distribución de Estado Civil
Estado_Civil n Porcentaje
Casado 673 45.8
Divorciado 327 22.2
Soltero 470 32.0

Distribución de Estado Civil

  • La mayoría de los empleados están casados (45.8%).

  • Los solteros representan el 32% y los divorciados el 22.2%.

## Horas Extra
freq_table_horas <- data %>%
  group_by(Horas_Extra) %>%
  summarise(n = n()) %>%
  mutate(Porcentaje = round((n / sum(n)) * 100, 1))
knitr::kable(freq_table_horas, format = "html", caption = "Distribución de Horas Extra") %>%
        kable_styling(full_width = F)
Distribución de Horas Extra
Horas_Extra n Porcentaje
No 1054 71.7
Si 416 28.3

Distribución de Horas Extra

  • La mayoría de los empleados (71.7%) no trabajan horas extra.

  • Solo el 28.3% realiza horas extra.

Análisis Bivariado

# Cargar librerías necesarias
library(readxl)
library(ggplot2)
library(dplyr)

# Definir la ruta correcta
file_path <- "Datos_Rotación.xlsx"

# Cargar los datos
datos <- read_excel(file_path)

# Renombrar columnas: convertir a minúsculas, eliminar tildes y reemplazar espacios por "_"
colnames(datos) <- tolower(gsub(" ", "_", colnames(datos)))

# ------------------------
# GRÁFICOS DE VARIABLES CUALITATIVAS Y CUANTITATIVAS
# ------------------------

cualitativas <- c("viaje_de_negocios", "genero", "estado_civil", "horas_extra")
cuantitativas <- c("ingreso_mensual", "años_experiencia", "capacitaciones")

# Gráficos de variables cualitativas
for (var in cualitativas) {
  p1 <- ggplot(datos, aes(x = .data[[var]], fill = as.factor(rotación))) +
    geom_bar(position = "dodge") +
    labs(title = paste("Distribución de", var, "según Rotación"), x = var, y = "Frecuencia", fill = "Rotación") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  print(p1)
}

# Gráficos de variables cuantitativas
for (var in cuantitativas) {
  p2 <- ggplot(datos, aes(x = as.factor(rotación), y = .data[[var]], fill = as.factor(rotación))) +
    geom_boxplot() +
    labs(title = paste("Boxplot de", var, "según Rotación"), x = "Rotación", y = var, fill = "Rotación") +
    theme_minimal()
  
  print(p2)
}

# ⚙️ CONFIGURACIÓN INICIAL A PRUEBA DE ERRORES
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, results = "asis")

suppressMessages({
  library(readxl)
  library(dplyr)
  library(tidyr)
  library(gt)
  library(kableExtra)
  library(htmltools) # Para forzar la impresión correcta
})


# 📥 Cargar los datos
df <- read_excel("D:/UNIVERSIDAD M/QUINTO SEMESTRE/Estadistica aplicada/Datos_Rotación.xlsx")


# Cargar los datos
datos <- read_excel(file_path)
datos <- read_excel(file_path) %>%
  mutate(across(where(is.character), ~ iconv(.x, to = "ASCII//TRANSLIT")))

colnames(datos) <- tolower(gsub(" ", "_", iconv(colnames(datos), to = "ASCII//TRANSLIT")))

if (!"rotacion" %in% colnames(datos)) {
  stop("❌ ERROR: La columna 'rotacion' no existe en los datos.")
}

# ================================
# 📊 CUANTITATIVAS VS ROTACIÓN
# ================================
cuantitativas <- c("ingreso_mensual", "anos_experiencia", "capacitaciones")
tablas_cuantitativas <- list()

for (var in cuantitativas) {
  if (!var %in% colnames(datos)) next  

  tabla_cuant <- datos %>%
    group_by(rotacion) %>%
    summarise(
      Promedio = round(mean(.data[[var]], na.rm = TRUE), 2),
      Desviacion = round(sd(.data[[var]], na.rm = TRUE), 2),
      .groups = "drop"
    )

  promedio_no <- tabla_cuant$Promedio[tabla_cuant$rotacion == "No"]
  promedio_si <- tabla_cuant$Promedio[tabla_cuant$rotacion == "Si"]

  variacion <- ifelse(!is.na(promedio_no) & !is.na(promedio_si) & promedio_si != 0,
                      round(100 * (promedio_no - promedio_si) / promedio_si, 2), NA)

  tabla_cuant <- bind_rows(
    tabla_cuant,
    tibble(rotacion = "Variacion", Promedio = variacion, Desviacion = NA_real_)
  )

  # Guardar la tabla en la lista
  tablas_cuantitativas[[var]] <- gt(tabla_cuant) %>%
    tab_header(title = paste("Comparación de", var, "según Rotación")) %>%
    fmt_number(columns = 2:3, decimals = 2) %>%
    cols_label(
      rotacion = "Rotación",
      Promedio = "Promedio",
      Desviacion = "Desviación Estándar"
    ) %>%
    tab_options(table.border.top.color = "black",
                table.border.bottom.color = "black")
}

# ================================
# 📊 CUALITATIVAS VS ROTACIÓN
# ================================
cualitativas <- c("viaje_de_negocios", "genero", "estado_civil", "horas_extra")
tablas_cualitativas <- list()

for (var in cualitativas) {
  if (!var %in% colnames(datos)) next  

  tabla_cual <- datos %>%
    group_by(.data[[var]], rotacion) %>%
    summarise(Frecuencia = n(), .groups = "drop") %>%
    pivot_wider(names_from = rotacion, values_from = Frecuencia, values_fill = list(Frecuencia = 0)) %>%
    mutate(Total = rowSums(across(where(is.numeric)), na.rm = TRUE)) %>%
    mutate(across(-1, ~ round(.x / Total * 100, 2))) %>%
    rename(Categoria = 1)

  # Guardar la tabla en la lista
  tablas_cualitativas[[var]] <- gt(tabla_cual) %>%
    tab_header(title = paste("Distribución de", var, "según Rotación (%)")) %>%
    fmt_number(columns = 2:4, decimals = 2) %>%
    cols_label(
      Categoria = "Categoría",
      No = "No (%)",
      Si = "Sí (%)",
      Total = "Total (%)"
    ) %>%
    tab_options(table.border.top.color = "black",
                table.border.bottom.color = "black")
}

# 📌 FORZAR LA IMPRESIÓN CORRECTA
tagList(tablas_cuantitativas, tablas_cualitativas)
Comparación de ingreso_mensual según Rotación
Rotación Promedio Desviación Estándar
No 6,832.74 4,818.21
Si 4,787.09 3,640.21
Variacion 42.73 NA
Comparación de anos_experiencia según Rotación
Rotación Promedio Desviación Estándar
No 11.86 7.76
Si 8.24 7.17
Variacion 43.93 NA
Comparación de capacitaciones según Rotación
Rotación Promedio Desviación Estándar
No 2.83 1.29
Si 2.62 1.25
Variacion 8.02 NA
Distribución de viaje_de_negocios según Rotación (%)
Categoría No (%) Sí (%) Total (%)
Frecuentemente 75.09 24.91 100.00
No_Viaja 92.00 8.00 100.00
Raramente 85.04 14.96 100.00
Distribución de genero según Rotación (%)
Categoría No (%) Sí (%) Total (%)
F 85.20 14.80 100.00
M 82.99 17.01 100.00
Distribución de estado_civil según Rotación (%)
Categoría No (%) Sí (%) Total (%)
Casado 87.52 12.48 100.00
Divorciado 89.91 10.09 100.00
Soltero 74.47 25.53 100.00
Distribución de horas_extra según Rotación (%)
Categoría No (%) Sí (%) Total (%)
No 89.56 10.44 100.00
Si 69.47 30.53 100.00

Conclusiones:

Estrategia para Disminuir la Rotación 1. Incentivos económicos y salario competitivo + Los empleados con menores ingresos tienen mayor tendencia a la rotación.

  • Se recomienda mejorar los salarios y ofrecer incentivos económicos (bonos de desempeño, aumentos escalonados, beneficios adicionales como seguros o planes de retiro).
  1. Reducción de carga laboral y horas extra

  • La rotación es más alta en empleados con muchas horas extra.

  • Se sugiere redistribuir la carga laboral, contratar más personal para disminuir la necesidad de horas extra y promover un equilibrio entre la vida laboral y personal.

  1. Desarrollo y retención del talento joven

  • Los empleados con menos años de experiencia son más propensos a la rotación.

  • Se recomienda implementar programas de mentoría, oportunidades de crecimiento interno y capacitaciones enfocadas en desarrollo de carrera.

  1. Flexibilidad y equilibrio trabajo-vida

  • La rotación es mayor en empleados solteros, lo que sugiere que pueden estar buscando más flexibilidad o mejores oportunidades.

  • Se pueden implementar políticas de home office, horarios flexibles y beneficios como días libres adicionales.

Prompt para IA Generativa

  • Soy el encargado de Recursos Humanos en una empresa con alta rotación. Nuestro análisis muestra que los principales factores son bajos salarios, exceso de horas extra, menor experiencia y estado civil (los solteros rotan más). Para reducir la rotación, proponemos mejorar los incentivos económicos, reducir la carga laboral, ofrecer desarrollo profesional y fomentar un mejor ambiente laboral.

Modelo de Regresión Logística

# 📦 Cargar librerías necesarias
library(readxl)   # Asegurar que se pueda leer el archivo Excel
library(broom)
library(kableExtra)
library(dplyr)


Datos_Rotacion <- read_excel("D:/UNIVERSIDAD M/QUINTO SEMESTRE/Estadistica aplicada/Datos_Rotación.xlsx")





# 📊 Verificar que la columna "Rotación" existe antes de usarla
if (!"Rotación" %in% colnames(Datos_Rotacion)) {
  stop("⚠️ Error: La columna 'Rotación' no existe en el dataset. Verifica los nombres con colnames(Datos_Rotacion).")
}

# 📊 Convertir la variable "Rotación" en binaria (1 = Sí, 0 = No)
Datos_Rotacion$Rotacion_bin <- as.numeric(Datos_Rotacion$Rotación == "Si")

# 📊 Ajustar el modelo logístico
mod <- glm(Rotacion_bin ~ Genero + Ingreso_Mensual + `Viaje de Negocios` + Estado_Civil + 
             Capacitaciones + Años_Experiencia + Horas_Extra, 
           data = Datos_Rotacion, family = "binomial")

# 📊 Extraer los resultados y calcular OR e IC 95%
tabla_resultados <- tidy(mod) %>%
  mutate(OR = exp(estimate),  
         IC_Lower = exp(estimate - 1.96 * std.error),  
         IC_Upper = exp(estimate + 1.96 * std.error),
         Significancia = case_when(
           p.value < 0.001 ~ "***",
           p.value < 0.01 ~ "**",
           p.value < 0.05 ~ "*",
           p.value < 0.1 ~ ".",
           TRUE ~ ""
         ))

# 📌 Mostrar la tabla con formato bonito
tabla_resultados %>%
  select(term, estimate, std.error, OR, IC_Lower, IC_Upper, p.value, Significancia) %>%
  rename(Término = term, Coef = estimate, `Error Estándar` = std.error, 
         `Razón de Odds (OR)` = OR, `IC 95% Inferior` = IC_Lower, `IC 95% Superior` = IC_Upper, 
         `Valor p` = p.value, `Sig.` = Significancia) %>%
  kable("html", caption = "Resultados del Modelo de Regresión Logística") %>%
  kable_styling(full_width = F, bootstrap_options = c("striped", "hover", "condensed", "responsive"))
Resultados del Modelo de Regresión Logística
Término Coef Error Estándar Razón de Odds (OR) IC 95% Inferior IC 95% Superior Valor p Sig.
(Intercept) -0.8710524 0.3140999 0.4185109 0.2261203 0.7745937 0.0055513 **
GeneroM 0.2717303 0.1606028 1.3122331 0.9578623 1.7977068 0.0906575 .
Ingreso_Mensual -0.0000629 0.0000316 0.9999371 0.9998752 0.9999991 0.0466902
Viaje de NegociosNo_Viaja -1.3602262 0.3517313 0.2566027 0.1287839 0.5112826 0.0001101 ***
Viaje de NegociosRaramente -0.6342921 0.1800772 0.5303107 0.3726024 0.7547711 0.0004278 ***
Estado_CivilDivorciado -0.2747939 0.2293751 0.7597287 0.4846303 1.1909857 0.2309128
Estado_CivilSoltero 0.8859097 0.1705638 2.4251897 1.7360365 3.3879156 0.0000002 ***
Capacitaciones -0.1333584 0.0627860 0.8751514 0.7738178 0.9897550 0.0336688
Años_Experiencia -0.0521859 0.0176783 0.9491524 0.9168281 0.9826164 0.0031574 **
Horas_ExtraSi 1.4399164 0.1577995 4.2203430 3.0976055 5.7500203 0.0000000 ***

Matriz de confusión y Métricas

# 📦 Cargar librerías necesarias
library(caret)
library(dplyr)
library(knitr)
library(kableExtra)

# 📥 Cargar los datos
Datos_Rotacion <- read_excel("D:/UNIVERSIDAD M/QUINTO SEMESTRE/Estadistica aplicada/Datos_Rotación.xlsx")

# Ajustar el modelo logístico
Datos_Rotacion$Rotacion_bin <- as.numeric(Datos_Rotacion$Rotación == "Si")
mod <- glm(Rotacion_bin ~ Genero + Ingreso_Mensual + `Viaje de Negocios` + Estado_Civil + 
             Capacitaciones + Años_Experiencia + Horas_Extra, 
           data = Datos_Rotacion, family = "binomial")

# 📊 Obtener probabilidades de predicción
probas <- mod$fitted.values

# 🔍 Definir un umbral
umbral <- 0.5

# 🎯 Clasificar los empleados según el umbral
predicciones <- ifelse(probas > umbral, "Predicción: Rotó", "Predicción: No Rotó")
reales <- ifelse(Datos_Rotacion$Rotacion_bin == 1, "Rotó", "No Rotó")

# 📌 Matriz de Confusión con nombres personalizados
matriz_confusion <- table(Real = reales, Predicción = predicciones)

# 🎨 Mostrar la matriz de confusión en formato bonito
kable(matriz_confusion, format = "html", caption = "Matriz de Confusión con Etiquetas") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
Matriz de Confusión con Etiquetas
Predicción: No Rotó Predicción: Rotó
No Rotó 1207 26
Rotó 195 42 
library(purrr)
# Crear un data frame con diferentes umbrales
umbrales <- seq(0.05, 0.24, 0.01)

calc_metricas <- function(umbral) {
  pred <- probas > umbral
  matriz <- table(Datos_Rotacion$Rotación, pred)
  
  TN <- matriz[1,1]
  FP <- matriz[1,2]
  FN <- matriz[2,1]
  TP <- matriz[2,2]
  
  data.frame(
    Umbral = umbral,
    Desempeño = (TP + TN) / sum(matriz),
    Sensibilidad = TP / (TP + FN),
    Especificidad = TN / (TN + FP),
    Métrica_Compuesta = (TP / (TP + FN) + TN / (TN + FP)) / 2
  )
}

# Calcular métricas para cada umbral
metricas <- map_dfr(umbrales, calc_metricas)

# Gráficos individuales
g1 <- ggplot(metricas, aes(x = Umbral, y = Desempeño)) +
  geom_line(color = "cadetblue3", size = 1.2) +
  geom_point(color = "cadetblue3") +
  labs(title = "Desempeño vs Umbral", y = "Desempeño") +
  theme_minimal()

g2 <- ggplot(metricas, aes(x = Umbral, y = Sensibilidad)) +
  geom_line(color = "firebrick2", size = 1.2) +
  geom_point(color = "firebrick2") +
  labs(title = "Sensibilidad vs Umbral", y = "Sensibilidad") +
  theme_minimal()

g3 <- ggplot(metricas, aes(x = Umbral, y = Especificidad)) +
  geom_line(color = "forestgreen", size = 1.2) +
  geom_point(color = "forestgreen") +
  labs(title = "Especificidad vs Umbral", y = "Especificidad") +
  theme_minimal()

g4 <- ggplot(metricas, aes(x = Umbral, y = Métrica_Compuesta)) +
  geom_line(color = "purple", size = 1.2) +
  geom_point(color = "purple") +
  labs(title = "Métrica Compuesta vs Umbral", y = "Métrica Compuesta") +
  theme_minimal()

# Juntar los gráficos en una sola visualización
library(gridExtra)
grid.arrange(g1, g2, g3, g4, ncol = 2)

El mejor umbral parece estar alrededor de 0.15, donde la métrica compuesta alcanza su valor máximo (~0.72)

  • Desempeño y especificidad aumentan con el umbral.

  • Sensibilidad disminuye al aumentar el umbral, lo que indica que se detectan menos casos de rotación.

  • A umbrales muy altos, la especificidad es mayor, pero se sacrifica la detección de empleados que rotan.

    Un umbral de 0.15 equilibra mejor la sensibilidad y la especificidad, optimizando la predicción de la rotación sin perder demasiados casos positivos.

Escenarios

# Cargar librerías necesarias
library(ggplot2)
library(dplyr)
library(readxl)
library(flextable)

# Definir la ruta correcta
file_path <- "Datos_Rotación.xlsx"

# Cargar los datos
datos <- read_excel(file_path)

# 🔹 Asegurar que los nombres de las columnas sean consistentes
colnames(datos) <- gsub(" ", "_", colnames(datos))  # Reemplaza espacios por guion bajo

# 🔹 Convertir variables categóricas en factores
datos$Rotación <- as.factor(datos$Rotación)  
datos$Horas_Extra <- as.factor(datos$Horas_Extra)  
datos$Estado_Civil <- as.factor(datos$Estado_Civil)  
datos$Viaje_de_Negocios <- as.factor(datos$Viaje_de_Negocios)  # ✅ Se incluye

# 🔹 Entrenar modelo de regresión logística
modelo_rotacion <- glm(Rotación ~ Estado_Civil + Horas_Extra + Ingreso_Mensual + Años_Experiencia + Viaje_de_Negocios, 
                       data = datos, family = binomial)

# 🔹 Crear los 3 escenarios con nivel Bajo, Medio y Alto de riesgo
escenarios <- data.frame(
  Estado_Civil = factor(c("Soltero", "Casado", "Divorciado"), levels = levels(datos$Estado_Civil)),  
  Horas_Extra = factor(c("No", "Si", "Si"), levels = levels(datos$Horas_Extra)),  
  Viaje_de_Negocios = factor(c("No_Viaja", "Raramente", "Frecuentemente"), levels = levels(datos$Viaje_de_Negocios)),  
  Ingreso_Mensual = c(5000, 2500, 500),  # 🔥 Se baja aún más en el último
  Años_Experiencia = c(15, 5, 1)  # 🔥 Menos experiencia en el último caso
)

# 🔹 Predecir la probabilidad de rotación
escenarios$Probabilidad_Rotación <- predict(modelo_rotacion, newdata = escenarios, type = "response")

# 🔹 Clasificar el nivel de riesgo
escenarios$Riesgo <- case_when(
  escenarios$Probabilidad_Rotación < 0.2 ~ "Bajo",
  escenarios$Probabilidad_Rotación >= 0.2 & escenarios$Probabilidad_Rotación < 0.5 ~ "Medio",
  escenarios$Probabilidad_Rotación >= 0.5 ~ "Alto"  # 🚨 Se busca que el último sea "Alto"
)

# 🔹 Definir colores según el nivel de riesgo
colores_riesgo <- c("Bajo" = "lightgreen", "Medio" = "yellow", "Alto" = "red")

# 🔹 Crear la tabla con `flextable`
tabla_flex <- flextable(escenarios) %>%
  set_caption("📊 Escenarios de Predicción de Rotación") %>%
  colformat_num(j = "Probabilidad_Rotación", digits = 2) %>%
  color(j = "Riesgo", color = "black", part = "body") %>%
  bg(j = "Riesgo", bg = colores_riesgo[escenarios$Riesgo]) %>%
  set_table_properties(width = 1, layout = "autofit")

# 🔹 Mostrar la tabla
tabla_flex
📊 Escenarios de Predicción de Rotación

Estado_Civil

Horas_Extra

Viaje_de_Negocios

Ingreso_Mensual

Años_Experiencia

Probabilidad_Rotación

Riesgo

Soltero

No

No_Viaja

5,000

15

0.06843696

Bajo

Casado

Si

Raramente

2,500

5

0.33949226

Medio

Divorciado

Si

Frecuentemente

500

1

0.50408553

Alto

Utilidad del modelo predictivo en la Gestión de Personal

Este modelo permite predecir el riesgo de rotación y tomar medidas para retener talento.

  • Identificación temprana: Detecta empleados con alta probabilidad de renunciar, permitiendo intervenir a tiempo.

  • Estrategias personalizadas: Según el nivel de riesgo, la empresa puede ofrecer incentivos, mejorar condiciones laborales o implementar planes de crecimiento.

  • Decisiones basadas en datos: Permite identificar patrones y ajustar políticas para mejorar la retención.

  • Conclusión: Es una herramienta clave para gestionar el talento, mejorar la satisfacción laboral y reducir costos.