M1Act3_Estadística
Andrés Barrios | Jesus Olier
2024-04-07
Objetivos:
Desarrollar un modelo de regresión logística que permita estimar la probabilidad de que un empleado cambie de cargo en el próximo período y;
Determinar cuales factores indicen en mayor proporción a estos cambios.
Librerias a usar
suppressMessages(library(tidyverse)) # Manejo de data
suppressMessages(library(table1))
suppressMessages(library(gt))
suppressMessages(library(fastDummies))
suppressMessages(library(caret))
suppressMessages(library(vcd))
suppressMessages(library(ROCR))Importar la base
#install.packages("devtools") # solo la primera vez
#devtools::install_github("dgonxalex80/paqueteMODELOS", force =TRUE)
#library(paqueteMODELOS)
data <- paqueteMODELOS::rotacion
data <- as.data.frame(data)Analisis exploratorio
# Conocer la dimension de la base
dimension <- dim(data)
paste("filas:",dimension[1], "columnas:", dimension[2])## [1] "filas: 1470 columnas: 24"sapply(data, function(x) class(x)) # identificacion de tipos por variables## Rotación Edad
## "character" "numeric"
## Viaje de Negocios Departamento
## "character" "character"
## Distancia_Casa Educación
## "numeric" "numeric"
## Campo_Educación Satisfacción_Ambiental
## "character" "numeric"
## Genero Cargo
## "character" "character"
## Satisfación_Laboral Estado_Civil
## "numeric" "character"
## Ingreso_Mensual Trabajos_Anteriores
## "numeric" "numeric"
## Horas_Extra Porcentaje_aumento_salarial
## "character" "numeric"
## Rendimiento_Laboral Años_Experiencia
## "numeric" "numeric"
## Capacitaciones Equilibrio_Trabajo_Vida
## "numeric" "numeric"
## Antigüedad Antigüedad_Cargo
## "numeric" "numeric"
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## "numeric" "numeric"sapply(data, function(x) sum(is.na(x))) # Identificacion de NA's## 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 0No se presenta ninguna variable con registro vacío
1.Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación. Nota: Debes justificar porque estas variables están relacionadas y que tipo de relación se espera entre ellas (Hipótesis).
Variables Cuantitativas
Distancia_Casa: Se espera que esta variable este relacionada con rotación dado que el trayecto entre ambos puntos (Empresa / Casa), supone un desgaste en calidad de vida para el empleado con respecto a tiempo y gastos. En este sentido, se esperaría que entre mayor sea la distancia, más posibilidades hay de que el empleado decida salir de la empresa.
Ingreso_Mensual: Se espera que esta variable este relacionada con rotación dado que entre mayores sean los ingresos generados por el trabajo, menor será la disposición a cambiar de empleo. Se esperaría que entre mayor ingreso, menor probabilidad de que el empleado decida salir de la empresa.
Edad: Se espera que esta variable este relacionada con rotacion dado que entre más edad tenga el empleado, menor será su deseo de salir de la compañía; esto es en parte, dado a factores externos que convierten hipoteticamente la búsqueda de una nueva oportunidad laboral en algo de mayor dificultad. Se esperaría que entre mayor edad, menos posibilidades hay de que el empleado decida salir de la empresa.
Variables Cualitativas
Estado_Civil: Se espera de que una persona con un estado civil cualquiera este relacionada con la rotación, dada una responsabilidad inmediata que sugiere el contraer una responsabilidad formal con otra persona ante la sociedad, ya que, es de mucho más cuidado el decidir cambiar o no de un puesto laboral. En este sentido, se esperaría, que las personas que no tengan dicha responsabilidad posean un nivel de rotación más elevado.
Horas_Extras: Se espera que las Horas_Extras estén relacionada con rotación, dado que las personas con propensas a tener más horas extras, tendrán mayor carga laboral. En este sentido, se esperaría que entre mayor horas extras mayor posibilidad de rotación.
Genero: Se espera que el genero sea una de las determinantes de rotación laboral, ya que los hombres son más propensos en la búsqueda de nuevas oportunidades laborales, mientras que las mujeres dado a factores externos como discriminación laboral, buscan una mayor estabilidad en sus empleos. En este sentido, se esperan que los hombres tiendan a tener mayor nivel de rotación.
2. Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion.
Variabes Cuantitativas
ggplot(data, aes(x = Distancia_Casa))+
geom_histogram(color = "black", fill = "darkgoldenrod3")+
labs(x = "Distancia a Casa", y = "Empleados", title = "Distancia del trabajo a la casa de los trabajadores", subtitle = "En Kilometros")+
theme_minimal()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
summary(data$Distancia_Casa)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 7.000 9.193 14.000 29.000En relación a los datos de distancia, tenemos que en media, el personal vive 7 km de distancia del empleo a la casa.
ggplot(data, aes(x = Ingreso_Mensual))+
geom_histogram(color = "black", fill = "aquamarine3")+
labs(x = "Ingreso mensual", y = "Empleados", title = "Ingreso Mensual de los trabajadores")+
theme_minimal()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
En primera instancia se puede observar que la mayoría del personal gana
menos de 5000, lo que sugeriría un punto de rotación de personal dado a
bajos ingresos.
# Resumen de ingresos mensuales
summary(data$Ingreso_Mensual)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1009 2911 4919 6503 8379 19999En este sentido se observa que el el menor salario es de 1009, que el 25% del personal gana menos de 2911, el 50% gana menos de 4919 y el 75% menos a 8379.
ggplot(data, aes(x = Edad))+
geom_histogram(color = "black", fill = "red")+
labs(x = "Edad", y = "Empleados", title = "Edad de los trabajadores")+
theme_minimal()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
summary(data$Edad)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.00 30.00 36.00 36.92 43.00 60.00Se observa que el 25% de los empleados no supera los 30 años, y el 75% los 43 años, lo que segmenta a la población trabajadora en el período de adultez.
Variables Cualitativas
ggplot(data, aes(x = Estado_Civil))+
geom_bar(color = "black", fill = "darkblue")+
labs(x = "Estado civil", y = "Empleados", title = "Estado civil de los trabajadores")+
theme_minimal()
data %>%
group_by(Estado_Civil) %>%
summarize(Empleados = n(),
Proporción = round(Empleados/nrow(data)*100,2)) %>% transmute(Estado_Civil, Empleados, Proporción)## # A tibble: 3 × 3
## Estado_Civil Empleados Proporción
## <chr> <int> <dbl>
## 1 Casado 673 45.8
## 2 Divorciado 327 22.2
## 3 Soltero 470 32.0Se observa que cerca del 50% de los empleados se encuentra casado, seguido por Solteros y por ultimo Divorciados
ggplot(data, aes(x = Horas_Extra))+
geom_bar(color = "black", fill = "aquamarine2")+
labs(x = "Horas Extra", y = "Empleados", title = "Horas extras realizadas por los trabajadores")+
theme_minimal()
data %>%
group_by(Horas_Extra) %>%
summarize(Empleados = n(),
Proporción = round(Empleados/nrow(data)*100,2)) %>% transmute(Horas_Extra, Empleados, Proporción)## # A tibble: 2 × 3
## Horas_Extra Empleados Proporción
## <chr> <int> <dbl>
## 1 No 1054 71.7
## 2 Si 416 28.3De esta manera, se observa que el 71.7% de los empleados no realiza horas extras en el trabajo,
ggplot(data, aes(x = Genero))+
geom_bar(color = "black", fill = "brown4")+
labs(x = "Genero", y = "Empleados", title = "Genero de los trabajadores")+
theme_minimal()
data %>%
group_by(Genero) %>%
summarize(Empleados = n(),
Proporción = round(Empleados/nrow(data)*100,2)) %>% transmute(Genero, Empleados, Proporción)## # A tibble: 2 × 3
## Genero Empleados Proporción
## <chr> <int> <dbl>
## 1 F 588 40
## 2 M 882 60El 60% del personal de la empresa son hombres mientras que las mujeres son el 40%.
3. Realiza un análisis de bivariado en donde la variable respuesta sea rotacion codificada de la siguiente manera (y=1 es si rotación, y=0 es no rotación). Con base en estos resultados identifique cuales son las variables determinantes de la rotación e interpretar el signo del coeficiente estimado. Compare estos resultados con la hipotesis planteada en el punto 2.
data$Rotación <- as.numeric(data$Rotación=="Si")
glm(Rotación ~ ., data = data, family = "binomial")##
## Call: glm(formula = Rotación ~ ., family = "binomial", data = data)
##
## Coefficients:
## (Intercept) Edad
## 2.613e-01 -3.655e-02
## `Viaje de Negocios`No_Viaja `Viaje de Negocios`Raramente
## -1.763e+00 -8.215e-01
## DepartamentoRH DepartamentoVentas
## -1.292e+01 1.231e-01
## Distancia_Casa Educación
## 4.250e-02 -1.149e-02
## Campo_EducaciónHumanidades Campo_EducaciónMercadeo
## 8.342e-01 3.823e-01
## Campo_EducaciónOtra Campo_EducaciónSalud
## 5.979e-02 -1.136e-01
## Campo_EducaciónTecnicos Satisfacción_Ambiental
## 9.281e-01 -4.424e-01
## GeneroM CargoDirector_Manofactura
## 3.248e-01 1.269e+00
## CargoEjecutivo_Ventas CargoGerente
## 1.989e+00 1.247e+00
## CargoInvestigador_Cientifico CargoRecursos_Humanos
## 1.643e+00 1.519e+01
## CargoRepresentante_Salud CargoRepresentante_Ventas
## 1.037e+00 2.962e+00
## CargoTecnico_Laboratorio Satisfación_Laboral
## 2.587e+00 -4.048e-01
## Estado_CivilDivorciado Estado_CivilSoltero
## -3.973e-01 1.033e+00
## Ingreso_Mensual Trabajos_Anteriores
## -9.588e-07 1.756e-01
## Horas_ExtraSi Porcentaje_aumento_salarial
## 1.872e+00 -2.302e-02
## Rendimiento_Laboral Años_Experiencia
## 1.702e-01 -5.408e-02
## Capacitaciones Equilibrio_Trabajo_Vida
## -1.828e-01 -3.654e-01
## Antigüedad Antigüedad_Cargo
## 9.630e-02 -1.414e-01
## Años_ultima_promoción Años_acargo_con_mismo_jefe
## 1.787e-01 -1.563e-01
##
## Degrees of Freedom: 1469 Total (i.e. Null); 1432 Residual
## Null Deviance: 1299
## Residual Deviance: 893.2 AIC: 969.2Dado lo anterior se puede afirmar lo siguiente:
Observando a manera general algunas variables como Años_Experiencia, Viaje de Negocios, Equilibrio_Trabajo_Vida, Porcentaje_aumento_Salarial, entre otras, se podría decir que con el incremento de dichas variables el trabajador no opta por cambiar de trabajo.
Por otro lado, existen variables que estimulan o aumentan la probabilidad de que el personal rote, siendo alguna de éstas, Años_ultima_promoción, Rendimiento_Laboral, Trabajos_Anteriores, DepartamentoVentas, entre otras.
En ultimas acorde a las hipotesis planteadas, se tiene que el genero masculino es mas propenso a rotar, cumpliendo su hipotesis, la Distancia a Casa también tiene incidencia y las Horas extras, mientras que el estado civil soltero, los ingresos y la edad incrementan la probabilidad de rotación.
4. Realice una partición en los datos de forma aleatoria donde 70% sea un set para entrenar el modelo y 30% para prueba. Estime un modelo logístico con la muestra del 70%. Muestre los resultados.
# Creación de la partición de la base
particion <- createDataPartition(data$Rotación, p = 0.7, list = FALSE)
# Crea los conjuntos de datos de entrenamiento y prueba
train <- data[particion, ]
test <- data[-particion, ]# Estimación del nuevo modelo
modelo <- glm(Rotación ~ Edad + Estado_Civil + Horas_Extra + Ingreso_Mensual + Genero + Distancia_Casa, family = "binomial", data = train)
summary(modelo)##
## Call:
## glm(formula = Rotación ~ Edad + Estado_Civil + Horas_Extra +
## Ingreso_Mensual + Genero + Distancia_Casa, family = "binomial",
## data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.520e+00 4.259e-01 -3.568 0.000360 ***
## Edad -2.335e-02 1.148e-02 -2.035 0.041846 *
## Estado_CivilDivorciado -3.976e-01 2.720e-01 -1.462 0.143863
## Estado_CivilSoltero 9.134e-01 1.968e-01 4.640 3.48e-06 ***
## Horas_ExtraSi 1.351e+00 1.829e-01 7.386 1.51e-13 ***
## Ingreso_Mensual -9.117e-05 2.733e-05 -3.336 0.000851 ***
## GeneroM 3.044e-01 1.867e-01 1.630 0.103114
## Distancia_Casa 3.238e-02 1.064e-02 3.045 0.002329 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 938.44 on 1028 degrees of freedom
## Residual deviance: 806.64 on 1021 degrees of freedom
## AIC: 822.64
##
## Number of Fisher Scoring iterations: 5En primera instancia se puede ver que las variables significativas que explican la rotación del personal entre las variables elegidas son Estado_Civil Soletero, Horas Extras, Ingreso Mensual, Edad, y Distancia Casa, dejando por fuera a Genero Masculina y Estado_Civil Divorciado.
5. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC en el set de datos de prueba.
prediccion = predict.glm(modelo, newdata = test, type = "response")
resultados = table(test$Rotación, ifelse(prediccion >0.2, 1, 0), dnn = c("observaciones", "predicciones"))
resultados## predicciones
## observaciones 0 1
## 0 283 96
## 1 18 44mosaic(resultados, shade = T, colorize = T,
gp = gpar(fill = matrix(c("aquamarine3", "darkblue", "darkblue", "aquamarine3"), 2, 2)))
Al realizar la matriz de confusión sobre el dataframe de evaluación, se
tiene que las predicciones positivas tiene un grado de prediccion
elevado, de igual forma las negativas, siendo en primera instancia un
buen modelo predictorio.
sum(diag(resultados)/sum(resultados))## [1] 0.7414966El modelo es capaz de clasificar correctamente 74% de las observaciones cuando se emplean los datos de evaluación.
prediccion_rotacion= ROCR::prediction(prediccion,test$Rotación)
Comportamiento= performance(prediction.obj = prediccion_rotacion, "tpr", "fpr")
plot(Comportamiento)
abline(a=0, b=1, col="blue")
grid()
AUC_test= performance(prediccion_rotacion, measure = "auc")@y.values[[1]]
cat("AUC: ", AUC_test, "n")## AUC: 0.786152 nEl área bajo la curva de 0.74 indica que el modelo es aceptable y puede servir para predecir.
6. En las conclusiones adicione una discución sobre cuál sería la estrategia para disminuir la rotación en la empresa (con base en las variables que resultaron significativas en el punto 3).
Siendo la variable Distancia_Casa significativa se puede proponer una ruta interna sobre aquellos empleados que vivan más de 6 km de distancia de la empresa o cuyo trayecto diario de su casa a la compañía esté sobre la hora.
Por otro lado, la antiguedad en la empresa debe ser premiada, con bonos o figuras administrativas que resulten estimulantes para las personas que lleven gran parte de su vida profesional en la empresa. Otra estrategia sería ofrecerle créditos o educación a sus hijos sujeto a un tiempo más prolongado en la compañia.
Dado que los campos técnicos son los de mayor rotación, se sugeríria una mejor atención a esta población empleada, en un sistema de recompensa a metas cumplidas, bonificaciones, entre otro estimulo.
Al personal soltero, se podría brindar capacitaciones, diplomados, o créditos que los sujeten a la empresa por un tiempo determinado.