Actividad 3 - Modelos estadisticos para la toma de decisiones

knitr::opts_chunk$set(message = FALSE, warning = FALSE)

library(paqueteMODELOS)
library(tidyverse)
library(FactoMineR)
library(factoextra)
library(cluster)
library(dplyr)
library(knitr) 
library(kableExtra)
library(tibble)
library(tidyr)

data("rotacion")
head(rotacion)

## # 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>

1. Seleccion de variables cuantitativas y cualitativas

Variables cuantitativas

Antigüedad en el cargo actual (AntigüedadCargo)

Hipótesis: empleados con poca antigüedad tienen mayor probabilidad de rotación porque aún están explorando opciones.

Relación esperada: negativa, a mayor antigüedad, menor rotación.

Edad (Edad)

Hipótesis: empleados jóvenes suelen tener mayor movilidad laboral, mientras que los mayores buscan estabilidad.

Relación esperada: negativa, a mayor edad, menor rotación.

Salario actual (Salario)

Hipótesis: salarios bajos pueden incentivar la rotación hacia cargos mejor remunerados.

Relación esperada: negativa, a mayor salario, menor rotación.

Variables Cualitativas

Nivel de satisfacción laboral (Satisfacción)

Hipótesis: empleados con baja satisfacción tienen mayor probabilidad de rotación.

Relación esperada: negativa → a menor satisfacción, mayor rotación.

Área o departamento (Área)

Hipótesis: ciertos departamentos pueden tener más rotación por condiciones de trabajo, presión o falta de oportunidades de crecimiento.

Relación esperada: algunos departamentos muestran mayor riesgo de rotación que otros.

Estado civil (EstadoCivil)

Hipótesis: empleados solteros podrían tener mayor movilidad laboral, mientras que casados tienden a buscar estabilidad.

Relación esperada: el estado civil influye en la disposición a cambiar de cargo.

2. Analisis univariado

Distribución de variable objetivo

library(plotly)
table(rotacion$Rotación)

## 
##   No   Si 
## 1233  237

rotacion %>%
  group_by(Rotación) %>%
  summarise(Promedad = n(), na.rm = TRUE) %>%
  plot_ly(x = ~Rotación, y = ~Promedad, type = "bar") %>%
  layout(
    title = "Recuento de Rotación en empleados",
    xaxis = list(title = "Rotación"),
    yaxis = list(title = "Recuento")
  )

Analisis de variables cuantitativas

rotacion %>%
  group_by(Rotación) %>%
  summarise(Promedad = mean(Edad, na.rm = TRUE)) %>%
  plot_ly(x = ~Rotación, y = ~Promedad, type = "bar") %>%
  layout(
    title = "Promedio de edad x rotación",
    xaxis = list(title = "Rotación"),
    yaxis = list(title = "Promedio edad")
  )

Las personas con edades menores en promedio 33,6 suelen tener mayor rotación, y los de mayores edades suelen tener menor rotación con una media de edad de 37,5.

rotacion %>%
  group_by(Rotación) %>%
  summarise(PromAnti = mean(Antigüedad_Cargo, na.rm = TRUE)) %>%
  plot_ly(x = ~Rotación, y = ~PromAnti, type = "bar") %>%
  layout(
    title = "Promedio de antiguedad x rotación",
    xaxis = list(title = "Rotación"),
    yaxis = list(title = "Promedio Antiguedad")
  )

Como se evidencia en los graficos, las personas con menor antiguedad suelen ser los que más rotan frente a los que tienen un mayor tiempo.

rotacion %>%
  group_by(Rotación) %>%
  summarise(PromSal = mean(Ingreso_Mensual, na.rm = TRUE)) %>%
  plot_ly(x = ~Rotación, y = ~PromSal, type = "bar") %>%
  layout(
    title = "Promedio de salario x rotación",
    xaxis = list(title = "Rotación"),
    yaxis = list(title = "Promedio Salario")
  )

Como se ve en la grafica, las personas con mayor rotación suelen tener un salario menor en comparación con las que no rotan, 4,787 vs 6,832

Analisis univariado de variables cualitativas

tabla <- rotacion %>%
  count(Estado_Civil, Rotación) %>%
  group_by(Estado_Civil) %>%
  mutate(Porcentaje = n / sum(n) * 100)



kable(tabla, caption = "Rotación por estado civil") %>%
kable_styling(bootstrap_options = c("striped"))

Rotación por estado civil

Estado_Civil	Rotación	n	Porcentaje
Casado	No	589	87.51857
Casado	Si	84	12.48143
Divorciado	No	294	89.90826
Divorciado	Si	33	10.09174
Soltero	No	350	74.46809
Soltero	Si	120	25.53191

tabla %>%
  plot_ly(
    data = ., 
    x = ~Estado_Civil, 
    y = ~Porcentaje, 
    color = ~Rotación, 
    type = "bar"
  ) %>%
  plotly::layout(
    title = "Rotación por estado civil",
    xaxis = list(title = "Estado civil"),
    yaxis = list(title = "Porcentaje dentro del grupo")
  )

Como se en el grafico, haciendo un analisis sobre la variable cualitativa de estado Civil, se evidencia que las personas del grupo soltero presentan una mayor proporción promedio de rotación con un 25,5% frente a un 74,46 % que no rota, seguido de los casados y divorciados, que rotan en una proporción del 12,48% y 10,09% respectivamente.

tabla <- rotacion %>%
  count(Departamento, Rotación) %>%
  group_by(Departamento) %>%
  mutate(Porcentaje = n / sum(n) * 100)

kable(tabla, caption = "Rotación por departamentos") %>%
kable_styling(bootstrap_options = c("striped"))

Rotación por departamentos

Departamento	Rotación	n	Porcentaje
IyD	No	828	86.16025
IyD	Si	133	13.83975
RH	No	51	80.95238
RH	Si	12	19.04762
Ventas	No	354	79.37220
Ventas	Si	92	20.62780

tabla %>%
  plot_ly(
    data = ., 
    x = ~Departamento, 
    y = ~Porcentaje, 
    color = ~Rotación, 
    type = "bar"
  ) %>%
  plotly::layout(
    title = "Rotación por departamentos",
    xaxis = list(title = "Departamento"),
    yaxis = list(title = "Porcentaje dentro del grupo")
  )

Como se aprecia en la grafica, las personas pertenecientes al departamento de Ventas presentan la mayor proporción promedio de rotación con un 20,63% frente a 79,37% que no rotan, le siguen los departamento de RH y lyD con un 19,04% y 13,83% respectivamente.

tabla <- rotacion %>%
  count(Satisfación_Laboral, Rotación) %>%
  group_by(Satisfación_Laboral) %>%
  mutate(Porcentaje = n / sum(n) * 100)

kable(tabla, caption = "Rotación por Satisfacción laboral") %>%
kable_styling(bootstrap_options = c("striped"))

Rotación por Satisfacción laboral

Satisfación_Laboral	Rotación	n	Porcentaje
1	No	223	77.16263
1	Si	66	22.83737
2	No	234	83.57143
2	Si	46	16.42857
3	No	369	83.48416
3	Si	73	16.51584
4	No	407	88.67102
4	Si	52	11.32898

tabla %>%
  plot_ly(
    data = ., 
    x = ~Satisfación_Laboral, 
    y = ~Porcentaje, 
    color = ~Rotación, 
    type = "bar"
  ) %>%
  plotly::layout(
    title = "Rotación por Satisfacción laboral",
    xaxis = list(title = "Satifacción laboral"),
    yaxis = list(title = "Porcentaje dentro del grupo")
  )

Como se en el grafico, en las escalas de satisfación laboral, las personas del grupo 1, representan una mayor proporción con un 22,83% frente a un 77,16% que no rotan, les siguen los del grupo 3 con 16,51%, el grupo 2 con 16,42, y el grupo 4 con 11,32%. Parece existir una tendecia entre menor sea la satifacción laboral, mayor es la rotación.

3. Análisis bivariado

# Se codifica la variable respuesta rotación en un Si:1, y no:0 

rotacion <- rotacion %>%
  mutate(y = ifelse(Rotación == "Si", 1, 0))

#Se realiza una función para organizar un tabla con los summary de cada uno de las variables 

variables <- c(
  "Edad",
  "Ingreso_Mensual",
  "Antigüedad_Cargo",
  "Departamento",
  "Satisfación_Laboral",
  "Estado_Civil"
)

resultados_bivariados <- lapply(variables, function(variable) {

  formula <- as.formula(
    paste("y ~", variable)
  )

  modelo <- glm(
    formula,
    data = rotacion,
    family = binomial
  )

  tidy(modelo) %>%
    filter(term != "(Intercept)") %>%
    mutate(
      Variable = variable,
      OR = exp(estimate)
    )
})

resultados_bivariados <- bind_rows(resultados_bivariados)



kable(resultados_bivariados, caption = "Tabla resumen analisis bivariado") %>%
kable_styling(bootstrap_options = c("striped"))

Tabla resumen analisis bivariado

term	estimate	std.error	statistic	p.value	Variable	OR
Edad	-0.0522544	0.0086999	-6.006339	0.0000000	Edad	0.9490874
Ingreso_Mensual	-0.0001271	0.0000216	-5.879336	0.0000000	Ingreso_Mensual	0.9998729
Antigüedad_Cargo	-0.1462777	0.0242450	-6.033316	0.0000000	Antigüedad_Cargo	0.8639177
DepartamentoRH	0.3817450	0.3341671	1.142378	0.2532971	Departamento	1.4648386
DepartamentoVentas	0.4811557	0.1497362	3.213356	0.0013119	Departamento	1.6179432
Satisfación_Laboral	-0.2509761	0.0637041	-3.939715	0.0000816	Satisfación_Laboral	0.7780409
Estado_CivilDivorciado	-0.2394628	0.2174897	-1.101030	0.2708835	Estado_Civil	0.7870505
Estado_CivilSoltero	0.8771680	0.1574576	5.570819	0.0000000	Estado_Civil	2.4040816

Edad

Estimate: -0.052 → negativo. A mayor edad menor probabilidad de rotación

OR: 0.95 → cada año adicional reduce la probabilidad de rotación en ~5%.

Significativa (p < 0.001). Los jóvenes rotan más, confirma la hipótesis.

Ingreso_Mensual

Estimate: -0.000127 → negativo. A mayores ingresos, hay menor probabilidad de rotación

OR: 0.9999 → efecto pequeño pero significativo.

Significativa (p < 0.001). A mayor salario, menor rotación.

Antigüedad_Cargo

Estimate: -0.146 → negativo. A mayores años de antiguedad en cargo, hay menor probabilidad de rotación.

OR: 0.86 → cada año adicional en el cargo reduce la probabilidad de rotación en ~14%.

Significativa (p < 0.001). La estabilidad en el cargo protege contra la rotación.

DepartamentoRH

Estimate: 0.38 → positivo.

OR: 1.46 → empleados de Recursos Humanos tienen 1.46 veces más probabilidad de rotar que los de referencia (IyD).

No significativa (p = 0.25). No se puede concluir relación clara.

DepartamentoVentas

Estimate: 0.48 → positivo.

OR: 1.62 → empleados de Ventas tienen 1.6 veces más probabilidad de rotar.

Significativa (p = 0.001). Ventas es un área con mayor riesgo de rotación.

Satisfacción_Laboral

Estimate: -0.25 → negativo.

OR: 0.78 → cada punto adicional de satisfacción reduce la probabilidad de rotación en ~22%.

Significativa (p < 0.001). La satisfacción laboral es un factor protector.

Estado_CivilDivorciado

Estimate: -0.23 → negativo.

OR: 0.78 → divorciados rotan menos que casados (categoría base).

No significativa (p = 0.27). No se puede afirmar relación clara.

Estado_CivilSoltero

Estimate: 0.87 → positivo.

OR: 2.40 → solteros tienen 2.4 veces más probabilidad de rotar que casados.

Significativa (p < 0.001). Ser soltero aumenta fuertemente el riesgo de rotación.

Factores protectores (disminuyen rotación): Edad, Ingreso, Antigüedad_Cargo, Satisfacción_Laboral.

Factores de riesgo (aumentan rotación): Departamento Ventas, Estado Civil Soltero.

Factores no concluyentes: Departamento RH, Estado Civil Divorciado.

4. Analisis multivariado

modelo_logit <- glm(
  y ~ Edad + Antigüedad_Cargo + Ingreso_Mensual + Estado_Civil + Departamento + Satisfación_Laboral,
  data = rotacion,
  family = binomial(link = "logit")
)

summary(modelo_logit)

## 
## Call:
## glm(formula = y ~ Edad + Antigüedad_Cargo + Ingreso_Mensual + 
##     Estado_Civil + Departamento + Satisfación_Laboral, family = binomial(link = "logit"), 
##     data = rotacion)
## 
## Coefficients:
##                          Estimate Std. Error z value Pr(>|z|)    
## (Intercept)             2.208e-01  3.788e-01   0.583 0.559885    
## Edad                   -2.168e-02  9.669e-03  -2.242 0.024951 *  
## Antigüedad_Cargo       -1.044e-01  2.668e-02  -3.912 9.14e-05 ***
## Ingreso_Mensual        -7.898e-05  2.534e-05  -3.117 0.001827 ** 
## Estado_CivilDivorciado -2.600e-01  2.235e-01  -1.163 0.244661    
## Estado_CivilSoltero     7.810e-01  1.650e-01   4.734 2.20e-06 ***
## DepartamentoRH          5.052e-01  3.492e-01   1.447 0.148017    
## DepartamentoVentas      5.962e-01  1.609e-01   3.705 0.000211 ***
## Satisfación_Laboral    -2.879e-01  6.715e-02  -4.287 1.81e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1298.6  on 1469  degrees of freedom
## Residual deviance: 1158.3  on 1461  degrees of freedom
## AIC: 1176.3
## 
## Number of Fisher Scoring iterations: 5

exp(coef(modelo_logit))

##            (Intercept)                   Edad       Antigüedad_Cargo 
##              1.2471151              0.9785544              0.9008955 
##        Ingreso_Mensual Estado_CivilDivorciado    Estado_CivilSoltero 
##              0.9999210              0.7710361              2.1837342 
##         DepartamentoRH     DepartamentoVentas    Satisfación_Laboral 
##              1.6572582              1.8151689              0.7498314

Edad (–0.021, p = 0.025, OR= 0.97)
A mayor edad, menor probabilidad de rotación. Confirma la hipótesis: los jóvenes rotan más. OR= 0.97, cada año adicional dismniuye la probabilidad de rotación en un 3%

Antigüedad en el cargo (–0.104, p < 0.001, OR=0.90)
A mayor antigüedad, menor probabilidad de rotación. También confirma la hipótesis: quienes llevan poco tiempo son más propensos a cambiar. Cada año adicional de antiguedad en el cargo disminuye la probabilidad de rotación en un 10%

Ingreso mensual (–0.000079, p = 0.0018, OR=0,99)
A mayor salario, menor probabilidad de rotación. Coincide con lo esperado: salarios bajos incentivan la salida. Cada peso adicional de salario disminuye la probabilidad de rotación en un 1% (No es mucho al tratarse de una medida pequeña)

Estado civil

Soltero (+0.781, p < 0.001, OR=2,1 ) Los solteros tienen mayor probabilidad de rotación que los casados (categoría de referencia). OR= 2,1 los Solteros tienen hasta 2.1 de probabilidad de rotar más que los casados

Divorciado (–0.260, p = 0.245) P No es significativo, no podemos concluir un efecto claro.

Departamento

Ventas (+0.596, p < 0.001, OR=1,8) Trabajar en ventas aumenta la probabilidad de rotación. empleados de Ventas tienen 1.8 veces más probabilidad de rotar.

Recursos Humanos (+0.505, p = 0.148) No significativo, no se puede afirmar un efecto.

Satisfacción laboral (–0.288, p < 0.001, OR= 0,74)
A mayor satisfacción, menor probabilidad de rotación. Confirma la hipótesis: insatisfacción impulsa la salida. cada punto adicional de satisfacción reduce la probabilidad de rotación en ~26%.

Jóvenes rotan más → confirmado.

Baja antigüedad → mayor rotación → confirmado.

Salarios bajos → mayor rotación → confirmado.

Baja satisfacción → mayor rotación → confirmado.

Estado civil influye → confirmado: solteros rotan más.

Departamento puede influir → confirmado: ventas muestra mayor rotación.

5. Evaluación del modelo

#Antes de calcular las curvas, se ajustará el modelo separando el 70% para entrenamiento y el 30% para prueba. Para ello se usará la libreriá caret para simplificar el paso.

library(caret)

set.seed(123)
train_idx <- createDataPartition(rotacion$y, p = 0.7, list = FALSE)

train <- rotacion[train_idx, ]
test  <- rotacion[-train_idx, ]

#restimamos el modelo utilizando unicamente el de entrenamiento


modelo_train <- glm(
  y ~ Edad + Antigüedad_Cargo + Ingreso_Mensual + Estado_Civil + Departamento + Satisfación_Laboral,
  data = train,
  family = binomial(link = "logit")
)

prob_test <- predict(
  modelo_train,
  newdata = test,
  type = "response"
)

#Calculamos ROC Y AUC

library(pROC)
roc_obj <- roc(test$y, prob_test)
plot(roc_obj, col = "blue", main = "Curva ROC - Datos de prueba")

auc(roc_obj)

## Area under the curve: 0.6626

El modelo presenta un AUC de 0,66, lo que indica una capacidad discriminatoria modesta. Esto significa que el modelo logra diferenciar moderadamente entre empleados que presentan rotación y empleados que permanecen en la empresa, aunque existe todavía margen para mejorar su capacidad predictiva.

Se deben revisar variables predictoras como departamento y estado civil las cuales pueden afectar el modelo y no tener suficiente poder explicativo.

6. Predicción de un empleado

empleado <- data.frame(
  Edad = 25, 
  Antigüedad_Cargo=4, 
  Ingreso_Mensual= 2000, 
  Estado_Civil= "Soltero",
  Departamento= "Ventas",
  Satisfación_Laboral =3)


prob_empleado <- predict(
  modelo_train,
  newdata = empleado,
  type = "response"
)

prob_empleado

##         1 
## 0.4458756

De acuerdo con el modelo estimado, el empleado presenta una probabilidad aproximada del 44 % de rotación.

Le empresa podría definir un corte de probabilidad de 0.5 para decidir si intervenir o no a un empleado con posibles estrategias para motivarlo y que decline su decisión de rotar.

7. Conclusiones

El análisis realizado permitió identificar diferentes factores asociados con la rotación de los empleados. En primera instancia, los modelos bivariados permitieron estudiar individualmente la relación entre cada una de las variables seleccionadas y la probabilidad de rotación. Posteriormente, mediante un modelo de regresión logística múltiple fue posible estimar el efecto de cada variable controlando simultáneamente por los demás factores considerados.

El ingreso mensual presentó una asociación negativa con la rotación, indicando una menor propensión a abandonar la organización entre los trabajadores de mayores ingresos. Esto sugiere evaluar la competitividad de los salarios, especialmente en los cargos donde las remuneraciones se encuentren por debajo del mercado.

La antigüedad en el cargo presentó una relación negativa con la rotación, evidenciando una mayor vulnerabilidad entre los empleados que llevan poco tiempo desempeñando su función. Una posible estrategia sería fortalecer los programas de acompañamiento, integración y desarrollo profesional durante los primeros años del trabajador en su cargo.

La satisfacción laboral presenta también una relación negativa con la rotación, indicando en cuanto a mayor sea la satisfacción, menor es la probabilidad de rotación. Para ello una estrategia podría ser la realización de charlas y de espacios que permitan conocer las problematicas que presentan cada uno de los empleados que pueden provocar insatisfacción.

Los empleados del departamento de ventas muestran mayor probabilidad de rotación, se debe analizar bien el caso para conocer las condiciones por las cuales provoque tal nivel de insatisfacción.

En términos generales, los resultados muestran que la rotación laboral no depende de un único factor, sino de una combinación de características personales y condiciones del empleo. El modelo de regresión logística permite identificar qué variables presentan una asociación estadísticamente significativa con la rotación y estimar la probabilidad de salida de cada trabajador. Esta información puede utilizarse como un mecanismo preventivo para identificar empleados con mayor riesgo y orientar acciones de retención. Sin embargo, las probabilidades estimadas deben utilizarse como una herramienta de apoyo a la gestión y no como una decisión automática sobre los trabajadores, debido a que existen factores individuales y organizacionales que no están contenidos en la base de datos.