# Cargar los datos
# install.packages("devtools") # solo la primera vez
# devtools::install_github("dgonxalex80/paqueteMODELOS", force =TRUE)
library(paqueteMODELOS)
data("rotacion")
#Data
library(paqueteMODELOS)
library(dplyr)
data("rotacion")
glimpse(rotacion)
## Rows: 1,470
## Columns: 24
## $ Rotación <chr> "Si", "No", "Si", "No", "No", "No", "No", …
## $ Edad <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35…
## $ `Viaje de Negocios` <chr> "Raramente", "Frecuentemente", "Raramente"…
## $ Departamento <chr> "Ventas", "IyD", "IyD", "IyD", "IyD", "IyD…
## $ Distancia_Casa <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 2…
## $ Educación <dbl> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, …
## $ Campo_Educación <chr> "Ciencias", "Ciencias", "Otra", "Ciencias"…
## $ Satisfacción_Ambiental <dbl> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, …
## $ Genero <chr> "F", "M", "M", "F", "M", "M", "F", "M", "M…
## $ Cargo <chr> "Ejecutivo_Ventas", "Investigador_Cientifi…
## $ Satisfación_Laboral <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, …
## $ Estado_Civil <chr> "Soltero", "Casado", "Soltero", "Casado", …
## $ Ingreso_Mensual <dbl> 5993, 5130, 2090, 2909, 3468, 3068, 2670, …
## $ Trabajos_Anteriores <dbl> 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1, 0, …
## $ Horas_Extra <chr> "Si", "No", "Si", "Si", "No", "No", "Si", …
## $ Porcentaje_aumento_salarial <dbl> 11, 23, 15, 11, 12, 13, 20, 22, 21, 13, 13…
## $ Rendimiento_Laboral <dbl> 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3, 3, …
## $ Años_Experiencia <dbl> 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, 10, 5…
## $ Capacitaciones <dbl> 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1, 2, …
## $ Equilibrio_Trabajo_Vida <dbl> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, …
## $ Antigüedad <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2,…
## $ Antigüedad_Cargo <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, …
## $ Años_ultima_promoción <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, …
## $ Años_acargo_con_mismo_jefe <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, …
Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación.
Variables Categóricas:
“Estado_Civil”: Esta variable categórica podría estar relacionada con la rotación, ya que el estado civil y si tiene o no familia podría influir en la decisión de rotar.
“Departamento”: El departamento en el que trabaja un empleado podría influir en su rotación, ya que algunos departamentos pueden tener tasas de rotación más altas que otros.
“Genero”: El género podría ser una variable relevante, ya que algunas investigaciones sugieren que existen diferencias en la rotación entre géneros.
Variables Cuantitativas:
“Edad”: La edad de un empleado podría estar relacionada con la rotación, ya que los empleados más jóvenes o más viejos podrían tener diferentes tasas de rotación.
“Ingreso_Mensual”: El ingreso mensual del empleado podría estar relacionado con la rotación, ya que las ofertas de salario más altas podrían reducir la probabilidad de rotación.
“Distancia_Casa”: La distancia entre la casa del empleado y el lugar de trabajo podría influir en su decisión de rotar.
# Resumen del DataFrame
summary(rotacion)
## 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.000
# Gráfico de barras para la variable "Rotación"
rotacion %>%
ggplot(aes(x = Rotación)) +
geom_bar() +
labs(title = "Distribución de Rotación",
x = "Rotación",
y = "Frecuencia")
# Histograma para la variable "Edad"
rotacion %>%
ggplot(aes(x = Edad)) +
geom_histogram(binwidth = 5, fill = "blue", color = "black") +
labs(title = "Distribución de Edad",
x = "Edad",
y = "Frecuencia")
# Histograma para la variable "Ingreso Mensual"
rotacion %>%
ggplot(aes(x = Ingreso_Mensual)) +
geom_histogram(binwidth = 5, fill = "black", color = "orange") +
labs(title = "Distribución de Ingreso Mensual",
x = "Ingreso Mensual",
y = "Frecuencia")
# Histograma para la variable "Distancia Casa"
rotacion %>%
ggplot(aes(x = Distancia_Casa)) +
geom_histogram(binwidth = 5, fill = "red", color = "black") +
labs(title = "Distribución de Distancia Casa",
x = "Distancia Casa",
y = "Frecuencia")
# Reemplazar "No" por 0 y "Si" por 1 en Rotación
rotacion$Rotación <- ifelse(rotacion$Rotación == "No", 0, 1)
# Distribución de Rotación
tabla_frecuencias <- table(rotacion$Rotación)
# Tabla de frecuencias
print(tabla_frecuencias)
##
## 0 1
## 1233 237
# Modelo de regresión logística
modelo_logistico <- glm(Rotación ~ Edad + Estado_Civil + Departamento + Distancia_Casa + Genero + Ingreso_Mensual,
data = rotacion, family = binomial)
# Resumen modelo logístico
summary(modelo_logistico)
##
## Call:
## glm(formula = Rotación ~ Edad + Estado_Civil + Departamento +
## Distancia_Casa + Genero + Ingreso_Mensual, family = binomial,
## data = rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.058e+00 3.629e-01 -2.915 0.003551 **
## Edad -2.465e-02 9.679e-03 -2.547 0.010871 *
## Estado_CivilDivorciado -2.308e-01 2.218e-01 -1.040 0.298115
## Estado_CivilSoltero 8.151e-01 1.633e-01 4.991 5.99e-07 ***
## DepartamentoRH 5.807e-01 3.489e-01 1.664 0.096039 .
## DepartamentoVentas 5.799e-01 1.595e-01 3.636 0.000277 ***
## Distancia_Casa 2.892e-02 8.770e-03 3.298 0.000975 ***
## GeneroM 1.820e-01 1.534e-01 1.186 0.235562
## Ingreso_Mensual -1.081e-04 2.543e-05 -4.249 2.14e-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: 1181.1 on 1461 degrees of freedom
## AIC: 1199.1
##
## Number of Fisher Scoring iterations: 5
# Probabilidades predichas por el modelo
predicciones <- predict(modelo_logistico, type = "response")
# Objeto "roc" para calcular ROC y AUC
roc_objeto <- roc(rotacion$Rotación, predicciones)
# Dibujar curva ROC
plot(roc_objeto, main = "Curva ROC")
abline(a = 0, b = 1, lty = 2)
# Calcular AUC
auc_resultado <- auc(roc_objeto)
cat("AUC (Área bajo la curva ROC):", auc_resultado, "\n")
## AUC (Área bajo la curva ROC): 0.7115676
# DF empleado hipotético
empleado_hipotetico <- data.frame(
Edad = 35,
Estado_Civil = "Casado",
Departamento = "Ventas",
Distancia_Casa = 5,
Genero = "F",
Ingreso_Mensual = 6000
)
# Predicción probabilidad
probabilidad_rotacion <- predict(modelo_logistico, newdata = empleado_hipotetico, type = "response")
# Probabilidad de rotación
cat("Probabilidad de rotación para el empleado hipotético:", probabilidad_rotacion, "\n")
## Probabilidad de rotación para el empleado hipotético: 0.1365086
Estrategia de Retención Basada en la Edad:
Conclusión: La edad de los empleados parece estar relacionada con la rotación, con una tendencia a una mayor rotación entre los empleados más jóvenes.
Estrategia: Implementar programas de desarrollo profesional y oportunidades de crecimiento para los empleados más jóvenes. Esto puede incluir capacitación, mentoría y asignación de proyectos desafiantes para aumentar su compromiso y lealtad hacia la empresa.
Estrategia de Retención Basada en el Ingreso Mensual:
Conclusión: El ingreso mensual de los empleados también influye en la rotación, con una tendencia a una menor rotación entre aquellos con ingresos más altos.
Estrategia: Realizar revisiones salariales periódicas y asegurarse de que los empleados estén siendo recompensados de manera competitiva en comparación con el mercado. Ofrecer incentivos y bonificaciones basados en el desempeño para aumentar la satisfacción y la retención.
Estrategia de Retención Basada en la Distancia Casa-Trabajo: