Modelos_Unidad3
AlejandroPosada
2024-09-29
#install.packages("devtools") # solo la primera vez
#devtools::install_github("centromagis/paqueteMODELOS", force =TRUE)
library(paqueteMODELOS)## Loading required package: boot## Loading required package: broom## Loading required package: GGally## Loading required package: ggplot2## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2## Loading required package: gridExtra## Loading required package: knitr## Loading required package: summarytoolsdata("rotacion")
library(paqueteMODELOS)
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:gridExtra':
##
## combine## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondata("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, …str(rotacion)## 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 ...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.000sum(is.na(rotacion))## [1] 01. Selección de variables e hipótesis
Categoricas:
Genero: Las mujeres podrían tener tasas de rotación ligeramente más altas debido a factores como la maternidad y las responsabilidades de cuidado.
Estado Civil: Los empleados solteros podrían tener una mayor probabilidad de rotar debido a una menor estabilidad en sus vidas personales.
Horas_Extra: La sobrecarga laboral asociada a las horas extra puede generar estrés, agotamiento y una disminución de la satisfacción laboral, lo que a su vez puede aumentar la rotación de la empresa.
Cuantitativas:
Satisfacción Laboral: Los empleados con baja satisfacción laboral tienen una mayor probabilidad de rotar.
Años de Experiencia: Tanto los empleados con poca experiencia (buscando mejores oportunidades) como los empleados con mucha experiencia (buscando nuevos desafíos) podrían tener mayores tasas de rotación.
Antigüedad: Los empleados con menor antigüedad tienen una mayor probabilidad de rotar, ya que aún no han desarrollado un fuerte vínculo con la empresa.
2. Análisis univariado
#install.packages("tidyverse")
#install.packages("ggplot2")
# Variables categoricas:
# Diagrama de barras para Género y Rotación
ggplot(rotacion, aes(x = Genero, fill = Rotación)) +
geom_bar(position = "fill") +
labs(title = "Proporción de rotación por género",
x = "Género",
y = "Proporción")
# Diagrama de barras para Estado Civil y Rotación
ggplot(rotacion, aes(x = Estado_Civil, fill = Rotación)) +
geom_bar(position = "fill") +
labs(title = "Proporción de rotación por estado civil",
x = "Estado Civil",
y = "Proporción")
# Diagrama de barras para Horas_Extra y Rotación
ggplot(rotacion, aes(x = Horas_Extra, fill = Rotación)) +
geom_bar(position = "fill") +
labs(title = "Proporción de rotación por horas extra",
x = "Horas Extra",
y = "Proporción")
# variables cuantitativas
# Histograma para Satisfacción Laboral
ggplot(rotacion, aes(x = Satisfación_Laboral)) +
geom_histogram(binwidth = 5) +
labs(title = "Distribución de la satisfacción laboral",
x = "Satisfacción Laboral")
# Histograma para Años de Experiencia
ggplot(rotacion, aes(x = Años_Experiencia)) +
geom_histogram(binwidth = 5) +
labs(title = "Distribución de los años de experiencia",
x = "Años de experiencia")
# Histograma para Antigüedad
ggplot(rotacion, aes(x = Antigüedad)) +
geom_histogram(binwidth = 5) +
labs(title = "Distribución de la antigüedad",
x = "Años de antigüedad")
Analisis
Diagrama de barras para Género y Rotación
El género masculino, tiene un poco más de proporción de rotación
Diagrama de barras para Estado Civil y Rotación
Los solteros son los únicos que superan el 25% de proporción de rotación
Diagrama de barras para Horas_Extra y Rotación
La diferencia entre las personas que tienen horas extras y las que no, versus la rotación es mucho más marcada, los que si tienen horas extras tienen una mayor proporción de rotación
Histograma para Satisfacción Laboral
Se evidencia una distribución bimodal.
Bloque 1 (0-2.5): Este bloque indica que aproximadamente un tercio de empleados reportaron un nivel de satisfacción laboral muy bajo, entre 0 y 2.5.
Bloque 2 (2.5-7.5): Este bloque, aún más alto que el primero, indica que los dos tercios restantes de los empleados se encuentra en un rango de satisfacción laboral que va desde moderado a alto (2.5 a 7.5).
Histograma para Años de Experiencia
- Concentración inicial: Las primeras tres barras, que representan los empleados con menor experiencia (0-11 años), muestran un aumento significativo en la frecuencia. Esto indica que hay un número considerable de empleados relativamente inexpertos.
Histograma para Antigüedad
Concentración inicial: Las primeras dos barras, que representan los empleados con menor antigüedad (0-9 años), muestran un aumento significativo en la frecuencia. Esto indica que hay un número considerable de empleados relativamente nuevos en la empresa.
Es interesante notar que la tercera barra tiene una frecuencia similar a la primera, lo cual podría indicar algún evento específico en ese período (por ejemplo, una ronda de contrataciones o despidos).
3. Análisis bivariado
# Cargamos las librerías necesarias
# library(tidyverse)
# library(tableone)
# Codificamos las variables categóricas como factores
rotacion$Genero <- factor(rotacion$Genero, levels = c("M", "F"))
rotacion$Estado_Civil <- factor(rotacion$Estado_Civil, levels = c("Soltero", "Casado", "Divorciado"))
# Codificamos la variable Rotación como binaria (0 = No, 1 = Si)
rotacion$Rotación <- ifelse(rotacion$Rotación == "Si", 1, 0)library(tableone)
# Creamos una tabla de frecuencias estratificada por la variable de rotación
table1 <- CreateTableOne(data = rotacion,
vars = c("Genero", "Estado_Civil", "horas_extra"),
strata = "Rotación",
test = TRUE)
print(table1, quote = FALSE)## Stratified by Rotación
## 0 1 p test
## n 1233 237
## Genero = F (%) 501 (40.6) 87 (36.7) 0.291
## Estado_Civil (%) <0.001
## Soltero 350 (28.4) 120 (50.6)
## Casado 589 (47.8) 84 (35.4)
## Divorciado 294 (23.8) 33 (13.9)# Tabla de contingencia entre Rotacion y Estado_Civil
tabla_contingencia <- table(rotacion$Rotación, rotacion$Estado_Civil)
print(tabla_contingencia)##
## Soltero Casado Divorciado
## 0 350 589 294
## 1 120 84 33# Prueba de chi-cuadrado
chisq.test(tabla_contingencia)##
## Pearson's Chi-squared test
##
## data: tabla_contingencia
## X-squared = 46.164, df = 2, p-value = 9.456e-11Analisis
tabla de frecuencias estratificada por la variable de rotación
Género:
No hay una diferencia estadísticamente significativa en la proporción de rotación entre hombres y mujeres (p = 0.291). Esto sugiere que el género no es un factor determinante para la rotación en este caso.
Estado Civil:
Sí hay una diferencia estadísticamente significativa en la proporción de rotación entre los diferentes estados civiles (p < 0.001). Esto indica que el estado civil está relacionado con la rotación. - Solteros: Tienen una proporción significativamente mayor de rotación en comparación con los otros grupos. - Casados: Tienen una proporción de rotación menor en comparación con los solteros. - Divorciados: Tienen la proporción de rotación más baja.
Tabla de contingencia entre Rotacion y Estado_Civil
350 empleados solteros no se rotaron. 120 empleados solteros sí se rotaron. 589 empleados casados no se rotaron. 84 empleados casados sí se rotaron. 294 empleados divorciados no se rotaron. 33 empleados divorciados sí se rotaron. - Prueba de Chi-Cuadrado: Confirma lo que se vio en la tabla estratificada: existe una asociación estadísticamente significativa entre el estado civil y la rotación (p-value = 9.456e-11, mucho menor que el nivel de significancia típico de 0.05).
4. Modelo de Regresión Lineal
library(caret)## Loading required package: lattice##
## Attaching package: 'lattice'## The following object is masked from 'package:boot':
##
## melanoma# Ajustamos el modelo de regresión logística
modelo_logistico <- glm(Rotación ~ Genero + Estado_Civil + Horas_Extra + Satisfación_Laboral + Años_Experiencia + Antigüedad,
data = rotacion, family = binomial)
# Resumen del modelo
summary(modelo_logistico)##
## Call:
## glm(formula = Rotación ~ Genero + Estado_Civil + Horas_Extra +
## Satisfación_Laboral + Años_Experiencia + Antigüedad, family = binomial,
## data = rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.18820 0.25545 0.737 0.4613
## GeneroF -0.29255 0.16045 -1.823 0.0683 .
## Estado_CivilCasado -0.90955 0.17015 -5.346 9.01e-08 ***
## Estado_CivilDivorciado -1.22784 0.22692 -5.411 6.27e-08 ***
## Horas_ExtraSi 1.52339 0.15860 9.605 < 2e-16 ***
## Satisfación_Laboral -0.33342 0.06908 -4.826 1.39e-06 ***
## Años_Experiencia -0.06841 0.01580 -4.331 1.49e-05 ***
## Antigüedad -0.02199 0.02063 -1.066 0.2864
## ---
## 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: 1094.5 on 1462 degrees of freedom
## AIC: 1110.5
##
## Number of Fisher Scoring iterations: 5Analisis
GéneroF:
Compara el grupo femenino (F) con el grupo masculino (el grupo de referencia). Un coeficiente negativo indica que las mujeres tienen menos probabilidades de rotar, pero el valor de p (0.0683) sugiere que esta diferencia no es estadísticamente significativa al nivel de 0.05.
Estado_CivilCasado y Estado_CivilDivorciado:
Comparan estos estados civiles con el estado civil de referencia soltero. Los coeficientes negativos indican que tanto los casados como los divorciados tienen menos probabilidades de rotar que los solteros, y esta diferencia es estadísticamente significativa (p < 0.001).
Horas_ExtraSi:
Un coeficiente positivo indica que a mayor cantidad de horas extra, mayor probabilidad de rotación. Y esta relación es altamente significativa (p < 2e-16).
Satisfación_Laboral:
Un coeficiente negativo indica que a mayor satisfacción laboral, menor probabilidad de rotación. Esta relación también es altamente significativa.
Años_Experiencia:
Un coeficiente negativo indica que a mayor experiencia, menor probabilidad de rotación. Nuevamente, esta relación es altamente significativa.
Antigüedad:
Un coeficiente negativo sugiere que a mayor antigüedad en la empresa, menor probabilidad de rotación. Sin embargo, esta relación no es estadísticamente significativa al nivel de 0.05.
5. Evaluación
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, var# Obtener las probabilidades predichas para la clase positiva (rotación)
probabilidades <- predict(modelo_logistico, type = "response")
# Crear la curva ROC
roc_obj <- roc(rotacion$Rotación, probabilidades)## Setting levels: control = 0, case = 1## Setting direction: controls < cases# Visualizar la curva ROC
plot(roc_obj, print.auc = TRUE)
# Obtener el valor del AUC
auc(roc_obj)## Area under the curve: 0.7748Analisis
sensibilidad: capacidad de identificar correctamente los casos positivos) especificidad: capacidad de identificar correctamente los casos negativos
El AUC de 0.775:
indica que el modelo tiene una capacidad razonable para distinguir entre las dos clases.
Una compensación entre sensibilidad y especificidad:
A medida que aumenta la sensibilidad, la especificidad tiende a disminuir, y viceversa. La curva muestra cómo se produce esta compensación a diferentes puntos de corte.
La línea diagonal:
Representa el rendimiento de un clasificador aleatorio. Cualquier curva ROC que esté por encima de esta línea indica que el modelo está realizando predicciones mejores que al azar.
6. Predicciones
# Nuevo data frame con la codificación correcta (ejemplo)
nuevo_empleado <- data.frame(
Genero = "M",
Estado_Civil = "Soltero",
Horas_Extra = "Si",
Satisfación_Laboral = 2.5,
Años_Experiencia = 3,
Antigüedad = 3
)
# Suponiendo que tu data frame se llama "nuevo_empleado"
nuevo_empleado$Genero <- factor(nuevo_empleado$Genero, levels = c("M", "F"))
nuevo_empleado$Estado_Civil <- factor(nuevo_empleado$Estado_Civil, levels = c("Soltero", "Casado"))
nuevo_empleado$Horas_Extra <- factor(nuevo_empleado$Horas_Extra, levels = c("No", "Si"))
# Realizar la predicción
probabilidad_rotacion <- predict(modelo_logistico, newdata = nuevo_empleado, type = "response")
# Definir un corte (ejemplo)
corte <- 0.6
if (probabilidad_rotacion > corte) {
print(paste("El empleado tiene un alto riesgo de rotación. Se recomienda intervenir. La probabilidad de rotación es:", probabilidad_rotacion))
} else {
print(paste("El empleado no tiene un alto riesgo de rotación. La probabilidad de rotación es:", probabilidad_rotacion))
}## [1] "El empleado tiene un alto riesgo de rotación. Se recomienda intervenir. La probabilidad de rotación es: 0.647219565484337"7. Concluciones
Estado Civil como factor determinante:
El estado civil es el factor que más influye en la rotación de los empleados. Los solteros tienen una probabilidad significativamente mayor de abandonar la empresa en comparación con los casados y divorciados. Esto sugiere que la estabilidad personal y los compromisos familiares pueden influir en la decisión de permanecer en un empleo.
Horas extras y satisfacción laboral:
Las horas extras y la baja satisfacción laboral son factores que aumentan significativamente la probabilidad de rotación. La sobrecarga laboral y la falta de satisfacción en el trabajo son factores estresantes que pueden llevar a los empleados a buscar nuevas oportunidades.
Experiencia y antigüedad:
Aunque existe una tendencia a que los empleados con más experiencia y antigüedad tengan menos probabilidades de rotación, esta relación no siempre es estadísticamente significativa en todos los casos. Sin embargo, en general, los empleados más nuevos y con menos experiencia son más propensos a rotar.
Género:
Aunque se planteó la hipótesis de que las mujeres podrían tener tasas de rotación más altas, el análisis no encontró evidencia estadísticamente significativa para respaldar esta hipótesis.
Modelo de regresión logística:
El modelo de regresión logística desarrollado proporciona una herramienta útil para predecir la probabilidad de rotación de un empleado en función de las variables analizadas. El modelo tiene una capacidad razonable para distinguir entre los empleados que se quedan y los que se van, como lo demuestra el valor del AUC.
8. Recomendaciones
Programas de desarrollo profesional:
Implementar programas de desarrollo profesional dirigidos especialmente a los empleados solteros y a aquellos con menor experiencia, con el objetivo de aumentar su compromiso con la empresa y reducir la probabilidad de rotación.
Gestión de la carga de trabajo:
Evaluar la distribución de la carga de trabajo y tomar medidas para reducir las horas extras excesivas.
Mejorar la satisfacción laboral:
Implementar programas y políticas que promuevan un ambiente de trabajo positivo y que aumenten la satisfacción laboral de los empleados, como programas de reconocimiento, oportunidades de desarrollo y canales de comunicación abiertos.