#Carga de Datos
library(paqueteMODELOS)
## Loading required package: boot
## Warning: package 'boot' was built under R version 4.2.3
## Loading required package: broom
## Warning: package 'broom' was built under R version 4.2.3
## Loading required package: GGally
## Warning: package 'GGally' was built under R version 4.2.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.2.3
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
## Loading required package: gridExtra
## Warning: package 'gridExtra' was built under R version 4.2.3
## Loading required package: knitr
## Warning: package 'knitr' was built under R version 4.2.3
## Loading required package: summarytools
## Warning: package 'summarytools' was built under R version 4.2.3
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>
class(rotacion)
## [1] "tbl_df" "tbl" "data.frame"
data_1 = rotacion
#Actividad 3. Rotación de cargo
#Planteamiento
#En una organización, se busca comprender y prever los factores que influyen en la rotación de empleados entre distintos cargos. La empresa ha recopilado datos históricos sobre el empleo de sus trabajadores, incluyendo variables como la antigüedad en el cargo actual, el nivel de satisfacción laboral, el salario actual, edad y otros factores relevantes. La gerencia planea 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 cuáles factores indicen en mayor proporción a estos cambios.
#Con esta información, la empresa podrá tomar medidas proactivas para retener a su talento clave, identificar áreas de mejora en la gestión de recursos humanos y fomentar un ambiente laboral más estable y tranquilo.
#La predicción de la probabilidad de rotación de empleados ayudará a la empresa a tomar decisiones estratégicas informadas y a mantener un equipo de trabajo comprometido y satisfecho en sus roles actuales.
#1. Selección de variables
#Categóricas
#• Horas extra: se espera que las personas que trabajen horas extras puedan anhelar rotación de su puesto de trabajo, debido al tiempo adicional que se invierte en el trabajo, dejando a un lado actividades familiares, personales y de ocio.
#• Estado Civil: se plantea la hipótesis de que la soltería como estado civil favorece la probabilidad de rotación, debido a que cuentan con menos responsabilidad de tipo familiar y en sus decisiones no intervienen terceros.
#• Departamento: se plantea la hipótesis de que el talento humano que pertenece al departamento lyD, que es el 65.4% de la empresa, este buscando rotar al departamento de ventas o RH, pues en ventas es donde se puede mejorar los ingresos debido a las comisiones por venta y en RH, tener un trabajo menos operativo y mejor remunerado.
#Cuantitativas
#• Edad: se plantea la hipótesis que las personas más jóvenes están en búsqueda de ganar experiencia laboral, por lo tanto, pueden estar con disposición para rotar voluntariamente. En contraste con aquellos con edades cerca a la edad de pensión, tienden a rotar menos, debido a que se asume que, para dicha edad, están conformes con su proyecto de vida laboral.
#• Años de experiencia: se espera que las personas jóvenes favorezcan su permanencia en el cargo con el propósito de acumular años de experiencia, en contraste con personas con más edad que estén en busca de consolidar su estabilidad laboral, busquen la rotación.
#• Ingreso mensual: se plantea la hipótesis de que personas con bajos ingresos mensuales, estén en búsqueda de crecer en la empresa, por lo tanto, buscando la rotación, en comparación con aquellos con salarios más altos, los cuales buscaran su permanencia en el cargo.
#Tablas de distribución de frecuencias para Ananlisis Univariado
#Distribución entre variables seleccionadas
#Se procede a realizar tablas de contigencia para revisar como se distribuyen las variables categóricas seleccionada: Departamento, Estado Civil y Horas Extras en la Variable de interés del Modelo, Rotación
tabla1 <- table(data_1$Rotación, data_1$Horas_Extra, data_1$Departamento, data_1$Estado_Civil)
tabla1
## , , = IyD, = Casado
##
##
## No Si
## No 283 101
## Si 18 31
##
## , , = RH, = Casado
##
##
## No Si
## No 24 4
## Si 5 1
##
## , , = Ventas, = Casado
##
##
## No Si
## No 139 38
## Si 18 11
##
## , , = IyD, = Divorciado
##
##
## No Si
## No 156 50
## Si 8 10
##
## , , = RH, = Divorciado
##
##
## No Si
## No 6 5
## Si 1 4
##
## , , = Ventas, = Divorciado
##
##
## No Si
## No 52 25
## Si 5 5
##
## , , = IyD, = Soltero
##
##
## No Si
## No 192 46
## Si 33 33
##
## , , = RH, = Soltero
##
##
## No Si
## No 9 3
## Si 1 0
##
## , , = Ventas, = Soltero
##
##
## No Si
## No 83 17
## Si 21 32
tabla2 <-table(data_1$Rotación, data_1$Horas_Extra) # Horas Extras en Rotación
tabla2
##
## No Si
## No 944 289
## Si 110 127
tabla3<- table(data_1$Rotación, data_1$Departamento) #Departamento en Rotación
tabla3
##
## IyD RH Ventas
## No 828 51 354
## Si 133 12 92
tabla4 <- table(data_1$Rotación, data_1$Estado_Civil) #Estado civil en Rotación
tabla4
##
## Casado Divorciado Soltero
## No 589 294 350
## Si 84 33 120
barplot(table(data_1$Rotación, data_1$Departamento),
main = "Distribución Departamento vs Rotación",
col = c("lightblue", "pink", "lightgreen"),
ylab = "Frecuencia")
barplot(table(data_1$Rotación, data_1$Estado_Civil),
main = "Distribución Estado Civil vs Rotación",
col = c("lightblue", "pink", "lightgreen"),
ylab = "Frecuencia")
barplot(table(data_1$Rotación, data_1$Horas_Extra),
main = "Distribución Horas extras vs Rotación",
col = c("lightblue", "pink", "lightgreen"),
ylab = "Frecuencia")
#Como se planteó en las hipótesis iniciales de este informe, en efecto, se tiene que para la variable Estado Civil, soltero, es donde hay mayor distribución de la Rotación (50.6%), de igual forma, en la variable Departamento, en IyD con un (56.1%), realizaron Rotación; finalmente para la variable seleccionada Horas Extras, la rotación se ha presentado con mayor proporción en aquellas personas que Sí realizaron horas extras.
Cuanti <- data_1 %>%
dplyr::select(Edad, Años_Experiencia, Ingreso_Mensual) %>%
summary(Cuanti)
Cuanti
## Edad Años_Experiencia Ingreso_Mensual
## Min. :18.00 Min. : 0.00 Min. : 1009
## 1st Qu.:30.00 1st Qu.: 6.00 1st Qu.: 2911
## Median :36.00 Median :10.00 Median : 4919
## Mean :36.92 Mean :11.28 Mean : 6503
## 3rd Qu.:43.00 3rd Qu.:15.00 3rd Qu.: 8379
## Max. :60.00 Max. :40.00 Max. :19999
#Se observa que la edad promedio de los empleados es de 36.92 años, la mediana es de 36 años, muy cerca a la media, lo cual nos permite comprender que el 50% de los empleados tiene hasta 36 años y la segunda mitad, hasta 60 años, que es la edad máxima.
#Adicionalmente, en cuanto la variable Años de Experiencia, la media fue de 11.28 años y la mediana de 10, un dato interesante es el rango entre el valor mínimo y máximo, que es de 40 años de experiencia. Otro dato interesante es que el 25% de los trabajadores tienen como mínimo 6 años de experiencia.
#Sobre el ingreso mensual, el valor máximo de salario es de 19999 y el mínimo de 1009, la media de ingreso es de 6503, pero la mediana nos indica el 50% de los empleados gana como máximo 4919.
#Histogramas variables cuantitativas
#Edad
hist(data_1[["Edad"]], freq = FALSE)
lines(density(data_1[["Edad"]]), lwd = 3, col = "orange")
#Años de Experiencia
hist(data_1[["Años_Experiencia"]], freq = FALSE)
lines(density(data_1[["Años_Experiencia"]]), lwd = 3, col = "orange")
#Ingreso_Mensual
hist(data_1[["Ingreso_Mensual"]], freq = FALSE)
lines(density(data_1[["Ingreso_Mensual"]]), lwd = 3, col = "orange")
#De similar forma como se realizó con las variables categóricas, se procede con las variables cuantitativas, el gráfico elegido es el de histograma con la curva de densidad, el cual nos muestra la forma general de la distribución de los datos, nos permite visualizar si se distribuyen normalmente.
#La distribución de las variables Edad, Años de Experiencia e Ingreso Mensual, no siguen una distribución normal, la curva de densidad de Edad es quizás la que mejor se aproxima a una distribución normal con una pequeña asimetría de sesgo a la derecha, este es posible porque la Media y la Mediana son casi iguales (36.92 y 36) respectivamente y es Unimodal.
#Sobre Años de Experiencia, no se tiene una distribución normal, unimodal, su asimetría esta sesgada a la derecha, que nos indica que para esta variable la Media (11.28) es mayor que la Mediana (10).
#Finalmente, para la variable Ingreso Mensual se distribuye similarmente a la variable Años de Experiencia, es unimodal, con una asimetría sesgada a la derecha, lo cual nos indica que la Media es Mayor que la Mediana (6503 y 4919) respectivamente.
data_3=rotacion
data_3$Rotación=as.numeric(data_3$Rotación=="Si")
#Análisis Bivariado Variables Categoricas
data_2=rotacion
data_2$Rotación=as.numeric(data_2$Rotación=="Si")
#Departamento y Rotación
PlotXTabs2(data = data_2, x = Departamento, y = Rotación, bf.details = TRUE,
xlab = "Departamento", ylab = NULL,
data.label = "both",
label.fill.alpha = .3,
labels.legend = c("0 = No", "1 = Sí"),
legend.title = "Rotación",
legend.position = "left",
title = "Rotación y Departamento",
palette = "Pastel1")
#Estado Civil y Rotación
PlotXTabs2(data = data_2, x = Estado_Civil, y = Rotación, bf.details = TRUE,
xlab = "Estado Civil", ylab = NULL,
data.label = "both",
label.fill.alpha = .3,
labels.legend = c("0 = No", "1 = Sí"),
legend.title = "Rotación",
legend.position = "left",
title = "Rotación y Estado Civil",
palette = "Pastel1")
#Horas Extra y Rotación
PlotXTabs2(data = data_2, x = Horas_Extra, y = Rotación, bf.details = TRUE,
xlab = "Horas Extra", ylab = NULL,
data.label = "both",
label.fill.alpha = .3,
labels.legend = c("0 = No", "1 = Sí"),
legend.title = "Rotación",
legend.position = "left",
title = "Rotación y Horas Extra",
palette = "Pastel1")
#Al revisar la variable Rotación en relación con las Horas Extras y la hipótesis planteada al inicio del informe, las personas que realizan horas extras tienen mayor proporción de rotación 31%, en comparación con aquellos que No realizan Horas Extras, con este resultado se puede inferir un patrón en esta Variable que puede aportar al modelo de logit.
#En cuanto a la variable Departamento, en Rotación, se planteó la hipótesis en que por tener mayor proporción IyD, sería el Departamento con mayor Rotación, pero el gráfico nos demuestra que ha sido Ventas con 21%, seguido por RH con 19% e IyD con 14% de Rotación.
#Finalmente, en el análisis de Variables Categóricas, para el caso de Estado Civil, se planteó la hipótesis que en efecto, las personas solteras tendrían mayor rotación, el grafico nos demuestra que 26% de personas Solteras, han rotado, seguido de las personas Casadas con 112% y 10% las divorciadas
#Variables Cuantitativas
#Edad y Rotación
data_3$Edad =cut(data_3$Edad, breaks = c (0, 20, 30, 40, 50, 60))
PlotXTabs2(data = data_3, x = Edad, y = Rotación, bf.details = TRUE,
xlab = "Edad", ylab = NULL,
data.label = "both",
label.fill.alpha = .3,
labels.legend = c("0 = No", "1 = Sí"),
legend.title = "Rotación",
legend.position = "left",
title = "Rotación y Edad",
palette = "Pastel2")
#Años de Experiencia y Rotación
data_3$Años_Experiencia =cut(data_3$Años_Experiencia, breaks = c (0, 10, 20, 30, 40))
PlotXTabs2(data = data_3, x = Años_Experiencia, y = Rotación, bf.details = TRUE,
xlab = "Años Experiencia", ylab = NULL,
data.label = "both",
label.fill.alpha = .3,
labels.legend = c("0 = No", "1 = Sí"),
legend.title = "Rotación",
legend.position = "left",
title = "Rotación y Años Experiencia",
palette = "Pastel2")
#Ingreso Mensual y Rotación
data_3$Ingreso_Mensual =cut(data_3$Ingreso_Mensual, breaks = c (0, 3000, 10000, 15000, 20000))
PlotXTabs2(data = data_3, x = Ingreso_Mensual, y = Rotación, bf.details = TRUE,
xlab = "Ingreso Mensual", ylab = NULL,
data.label = "both",
label.fill.alpha = .3,
labels.legend = c("0 = No", "1 = Sí"),
legend.title = "Rotación",
legend.position = "left",
title = "Rotación e Ingreso Mensual",
palette = "Pastel2")
#Al revisar Edad y Rotación, para facilitar el análisis bivariado de la variable, se crearon rangos de edad, se observa en el gráfico que, tal como se planteó en la hipótesis inicial, las personas más jóvenes están en búsqueda de ganar experiencia laboral por lo tanto, el 57% de los mejores de 20 años, han rotado, a medida que avanza la edad, se disminuye la rotación, teniendo un leve incremento entre los 50 y 60 años, quizás asociado a buscar una mejoría laboral a través de la rotación cuando se acerca la edad de retiro
#En relación con Años de Experiencia y Rotación, se comporta de manera similar a la Edad, pues se tiene mayor rotación cuando se tiene menos años de experiencia, disminuye la rotación mientras se incrementa la experiencia, pero en el rango de 30 a 40 años de experiencia, se incrementa levemente, quizás, tal como la edad, asociado a buscar una mejoría laboral a través de la rotación cuando se acumulan varios años de experiencia.
#La ultima variable seleccionada fue Ingreso Mensual, se planteó como hipótesis, que personas con bajos ingresos, estaría en búsqueda de crecer en la empresa, por lo tanto, favoreciendo la rotación, el grafico de análisis bivariado nos demuestra que cerca del 29% de personas con ingresos hasta 3000, han rotado, a medida que se incrementa el Ingreso Mensual, se disminuye la Rotación.
#Estima el Modelo
#Realiza la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotación (y=1 es si rotación, y=0 es no rotación) y las covariables las 6 seleccionadas en el punto 1. Interprete los coeficientes del modelo y la significancia de los parámetros.
Mod1 <- glm(Rotación~ Horas_Extra + Departamento + Estado_Civil + Edad + Años_Experiencia + Ingreso_Mensual, data = data_2, family = "binomial" )
summary(Mod1)
##
## Call:
## glm(formula = Rotación ~ Horas_Extra + Departamento + Estado_Civil +
## Edad + Años_Experiencia + Ingreso_Mensual, family = "binomial",
## data = data_2)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.6088 -0.5925 -0.4110 -0.2466 2.9705
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.234e+00 3.693e-01 -3.343 0.000829 ***
## Horas_ExtraSi 1.485e+00 1.568e-01 9.471 < 2e-16 ***
## DepartamentoRH 6.625e-01 3.556e-01 1.863 0.062479 .
## DepartamentoVentas 5.859e-01 1.673e-01 3.501 0.000463 ***
## Estado_CivilDivorciado -3.041e-01 2.291e-01 -1.327 0.184426
## Estado_CivilSoltero 8.354e-01 1.695e-01 4.929 8.28e-07 ***
## Edad -2.065e-02 1.155e-02 -1.788 0.073724 .
## Años_Experiencia -2.196e-02 2.039e-02 -1.077 0.281526
## Ingreso_Mensual -9.281e-05 3.303e-05 -2.810 0.004954 **
## ---
## 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: 1100.7 on 1461 degrees of freedom
## AIC: 1118.7
##
## Number of Fisher Scoring iterations: 5
#Interpretación Modelo
#Variables Categóricas y Cuantitativas
#Nivel de Alfa α = 0.05, significancia al 5%, confiabilidad al 95%
#Intercepto: el valor del intercepto corresponde a -1.234e+00, este resultado nos puede indicar que el modelo no es adecuado y requiere ajustes.
#Interpretación Coeficientes betas
#• Estado Civil – Divorciado: con un coeficiente negativo de -3.041e-01, indica como afecta el estado civil a la razón de probabilidad del evento de interés, para este caso, Rotación, en comparación con los restantes estados civiles de la variable, dada su naturaleza negativa y su P-value es > al alfa, se interpreta que no contribuye significativamente al modelo, es decir, que no existen diferencias entre las personas de la empresa que están divorciadas y las que no lo están.
#• Estado Civil – Soltero: con un coeficiente de 8.354e-01, con un P-Value < al alfa, siendo estadísticamente significativo, indica que estar soltero en la empresa genera un incremento en la razón de probabilidad de la rotación en 8.354e-01, en comparación con los otros estados civiles de la variable.
#• Horas Extra -Si: con un coeficiente de 1.485e+00 y un P-Value < al alfa, indica que realizar horas extras en la empresa genera un incremento en la razón de probabilidad de rotación en 1.485e+00, en comparación con aquellos que no realizan horas extras.
#• Departamento – RH: con un coeficiente de 6.625e-01 y un P-Value > al alfa, indica que no es estadísticamente significativa, por lo tanto, su contribución al modelo no es significativo.
#• Departamento – Ventas: con un coeficiente de 5.859e-01 y un P-Value < al alfa, indica que pertenecer al Departamento de Ventas en la empresa genera un incremento en la razón de probabilidad de rotación en 5.859e-01, en comparación con las otras dependencias.
#• Edad: con un coeficiente de -2.065e-02, con un P-Value > al alfa, lo cual no es estadísticamente significativo, indica que un incremento en una unidad en la Edad disminuye en 2.065e-02 la razón de probabilidad de rotar.
#• Años de Experiencia: con un coeficiente de -2.196e-02, con un P-Value > al alfa, lo cual no es estadísticamente significativo, indica que un incremento en una unidad en los años de experiencia disminuye en 2.196e-02 la razón de probabilidad de rotar.
#• Ingreso Mensual: con un coeficiente de -9.281e-05, con un P-Value < al alfa, lo cual es estadísticamente significativo, indica que un incremento en una unidad en los ingresos mensuales disminuye en -9.281e-05 la razón de probabilidad de rotar.
#Se procede a validar el modelo con una prueba de hipotesis
#Ho: el modelo no es significativo, no hay diferencias
#H1: el modelo es significativo
with(Mod1, pchisq(null.deviance - deviance, df.null - df.residual, lower.tail = FALSE))
## [1] 1.782875e-38
#Se obtiene un valor menor al alfa de 0.05, por lo tanto se rechaza la hipotesis nula y se concluye que el modelo es significativo.
#Validación Cruzada del Modelo curva ROC y AUC
#5. Evaluación ROC y AUC
#El poder predictivo de un modelo, evaluado a través de la curva ROC (Receiver Operating Characteristic) y el Área bajo la Curva (AUC), se refiere a la capacidad del modelo para distinguir entre las clases o categorías de una variable de respuesta binaria.
#Se procede a dividir el Dataset en dos partes: train con el 60% de los registros y test(prueba) con el 40% de los registros.
train <- nrow(data_2)*0.6
test <- nrow(data_2) *0.4
set.seed(123)
train_1 <- sample(1:nrow(data_2),size = train)
train.sample <- data_2[train_1,] # muestra de entrenamiento
test_1 <- data_2[-train_1,] # muestra de prueba
#Se procede a realizar la separación de datos, ROC Y AUC
prediccion1 <- predict(Mod1, test_1, type = "response")
niveles_predic <- factor(ifelse(prediccion1 > 0.5, "Si", "No"))
curva_ROC <- roc(test_1$Rotación, prediccion1)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
auc <- round(auc(curva_ROC, levels = c(0, 1), direction = "<"), 4)
ggroc(curva_ROC, colour = "#7FFFD4", size =1) + ggtitle(paste0("Curva ROC", "(AUC = ", auc, ")")) + xlab("Especificidad") + ylab("Sensibilidad")
#Interpretación y análisis: la curva ROC permite evaluar la capacidad predictiva del modelo de área bajo la curva AUC, las variables seleccionadas en el Modelo tienen muy buena capacidad de predicción (0.75) con una sensibilidad de capturar verdaderos positivos y muy buena capacidad de evitar falsos positivos (Especificidad)
#Predicciones
#Realiza una predicción la probabilidad de que un individuo (hipotético) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
#Predicción para empleado con estas condiciones:
#• Horas extras: Sí
#• Departamento: IyD
#• Estado Civil: Soltero
#• Edad: 24 años
#• Años de Experiencia: 9
#• Ingreso Mensual: 4999
predict(Mod1, list(Horas_Extra = "Si", Departamento = "IyD", Estado_Civil = "Soltero", Edad = 24, Años_Experiencia = 9, Ingreso_Mensual = 3999), type = "response")
## 1
## 0.5055
#Análisis, con las condiciones previamente definidas, se tiene que un empleado presenta un 50% de probabilidad de rotar en la empresa si cumple con las características descritas anteriormente.
#Por lo tanto, a la Empresa se le sugiere:
#Crear incentivos de bienestar para favorecer la permanencia en el trabajo, algún tipo de "escalafón" para beneficiar la antigüedad en el mismo puesto de trabajo, que incluya que, con el paso del tiempo, la persona pueda no solo pueda acumular años de experiencia en su puesto de trabajo, sino que mejore sus ingresos salariales.
#Conclusiones
#Hay varias estrategias que puede crear la empresa si desea favorecer la permanencia, especialmente en jóvenes, en las variables estudiadas en el modelo, se logró identificar como factor predictor la asignación salarial, como se propuso en el punto anterior, los estímulos tipo “escalafón” que involucren un paquete de bienestar y acompañamiento orientado a la promoción del crecimiento de la empresa con su mejor recurso, el humano, puede incrementar que jóvenes con menos asignación salarial puedan incluir en sus proyectos de vida la vinculación permanente en la empresa
```