Actividad 3 - GLM
Karen Carvajal
2023-10-02
##Actividad 3
#Modelos Estadísticos para la toma de decisiones
Problema: Rotación de cargo
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 cuales 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.
A continuación se describen los pasos que la gerencia ha propuesto para el análisis:
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: summarytools## Warning in fun(libname, pkgname): couldn't connect to display ":0"## system might not have X11 capabilities; in case of errors when using dfSummary(), set st_options(use.x11 = FALSE)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, …- Selección de variables Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación.
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.000head(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>Variables Categoricas:
Horas Extras: La hipotesis que se plantea es que una persona que realiza horas extras puede tener mayor probabilidad de rotación debido a que debe disponer de más tiempo lo que podria hacer que no exista un correcto equilibrio entre vida y trabajo
Satisfacción laboral: La hipotesis que se plantea es que hay departamentos que por su naturaleza pueden tener una mayor probabilidad de rotación como son los dptos comerciales por el cumplimiento de metas.
Equilibrio_trabajo_vida: La hipotesis es que las personas que con mayor calificación a este item tienen menor probabilidad de rotación ya que se sienten a gusto con su trabajo
Variables Cuantitativas:
Ingreso mensual: La hipotesis planteada es que a mayor calificación de satisfacción laboral menor será la probabilidad de rotación del empleado.
Antiguedad cargo: La hipotesis planteada es que a mayor antiguedad en el cargo menor probabilidad de rotación hay
Porcentaje_aumento_salarial: La hipotesis planteada es que a menor porcentaje de aumento salarial mayor probabilidad de rotación hay
- Análisis univariado Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion.
data("rotacion")
df <- rotacion %>%
select(Rotación, Satisfación_Laboral, Porcentaje_aumento_salarial, Antigüedad_Cargo, Equilibrio_Trabajo_Vida, Horas_Extra, Ingreso_Mensual)
kable(head(df))| Rotación | Satisfación_Laboral | Porcentaje_aumento_salarial | Antigüedad_Cargo | Equilibrio_Trabajo_Vida | Horas_Extra | Ingreso_Mensual |
|---|---|---|---|---|---|---|
| Si | 4 | 11 | 4 | 1 | Si | 5993 |
| No | 2 | 23 | 7 | 3 | No | 5130 |
| Si | 3 | 15 | 0 | 3 | Si | 2090 |
| No | 3 | 11 | 7 | 3 | Si | 2909 |
| No | 2 | 12 | 2 | 3 | No | 3468 |
| No | 4 | 13 | 7 | 2 | No | 3068 |
# Carga la librería ggplot2 si no está cargada
if (!require(ggplot2)) {
install.packages("ggplot2")
library(ggplot2)
}
ggplot(df, aes(x = Rotación)) +
geom_bar() + # Crea las barras
geom_text(stat = 'count', aes(label = after_stat(count)), vjust = -0.4) + # Agrega etiquetas de datos
labs(y = "Frecuencia", x = "Rotación") + # Etiqueta los ejes
ggtitle("Distribución de la Variable 'Rotación'") + # Título del gráfico
theme_minimal() # Estilo del gráfico
De acuerdo con el grafico obtenido se puede evidenciar que la rotación
de la empresa correponde al 16%
library(ggplot2)
ggplot(df, aes(x = df$Porcentaje_aumento_salarial)) +
geom_density(color = "blue",
fill = "blue",
alpha = 0.25) +
labs(title = "Distribución de % de aumento salarial",
x = "% de aumento",
y = "Densidad")## Warning: Use of `df$Porcentaje_aumento_salarial` is discouraged.
## ℹ Use `Porcentaje_aumento_salarial` instead.
library(ggplot2)
ggplot(df, aes(x = df$Ingreso_Mensual)) +
geom_density(color = "blue",
fill = "blue",
alpha = 0.25) +
labs(title = "Distribución de Ingresos",
x = "Ingresos",
y = "Densidad")## Warning: Use of `df$Ingreso_Mensual` is discouraged.
## ℹ Use `Ingreso_Mensual` instead.
library(ggplot2)
ggplot(df, aes(x = df$Antigüedad_Cargo)) +
geom_density(color = "blue",
fill = "blue",
alpha = 0.25) +
labs(title = "Antiguedad en el cargo",
x = "Antiguedad",
y = "Densidad")## Warning: Use of `df$Antigüedad_Cargo` is discouraged.
## ℹ Use `Antigüedad_Cargo` instead.
library(ggplot2)
library(ggpubr)
g1 = ggplot(rotacion, aes(x =Satisfación_Laboral)) + geom_histogram() + theme_gray()
g2 = ggplot(rotacion, aes(x = Horas_Extra)) + geom_bar() + theme_gray()
g3 = ggplot(rotacion, aes(x = Equilibrio_Trabajo_Vida)) + geom_bar() + theme_gray()
ggarrange(g1, g2, g3, labels = c("A", "B", "C"), ncol = 3, nrow = 2)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
De acuerdo a los graficos obtenidos podemos evidenciar que la mayor
concentración de ingresos se encuentra en empleados con ingresos <
5000, por otra parte tambien se evidencia que la mayor concentración de
porcentaje de aumento salarial esta en empleados que han recibido un %
de hasta el 15% de aumento de su salario y los porcentajes de aumento
salarial en la compañia van desde el 0% de hasta maximo el 25%, por otra
parte se evidencia que más del 5o% de los empleados se siente satisfecho
laboralmente y siente un equilibrio trabajo vida, por otra parte <
del 25% de los empleados realizan horas extras.
- Análisis bivariado 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.
# Convierte "Rotación" en variable numérica (0 para "no" y 1 para "si")
datos <- df
datos$Rotación <- as.numeric(factor(datos$Rotación, levels = c("No", "Si"), labels = c(0, 1)))
datos$Horas_Extra <- as.numeric(factor(datos$Horas_Extra, levels = c("No", "Si"), labels = c(0, 1)))
# Calcula la matriz de correlación
correlation_matrix <- cor(datos[, c("Horas_Extra", "Rotación", "Ingreso_Mensual","Equilibrio_Trabajo_Vida", "Antigüedad_Cargo","Porcentaje_aumento_salarial", "Satisfación_Laboral")])
print(correlation_matrix)## Horas_Extra Rotación Ingreso_Mensual
## Horas_Extra 1.000000000 0.24611799 0.006089285
## Rotación 0.246117994 1.00000000 -0.159839582
## Ingreso_Mensual 0.006089285 -0.15983958 1.000000000
## Equilibrio_Trabajo_Vida -0.027091878 -0.06393905 0.030683082
## Antigüedad_Cargo -0.029758009 -0.16054500 0.363817667
## Porcentaje_aumento_salarial -0.005432827 -0.01347820 -0.027268586
## Satisfación_Laboral 0.024539481 -0.10348113 -0.007156742
## Equilibrio_Trabajo_Vida Antigüedad_Cargo
## Horas_Extra -0.027091878 -0.029758009
## Rotación -0.063939047 -0.160545004
## Ingreso_Mensual 0.030683082 0.363817667
## Equilibrio_Trabajo_Vida 1.000000000 0.049856498
## Antigüedad_Cargo 0.049856498 1.000000000
## Porcentaje_aumento_salarial -0.003279636 -0.001520027
## Satisfación_Laboral -0.019458710 -0.002304785
## Porcentaje_aumento_salarial Satisfación_Laboral
## Horas_Extra -0.005432827 0.024539481
## Rotación -0.013478202 -0.103481126
## Ingreso_Mensual -0.027268586 -0.007156742
## Equilibrio_Trabajo_Vida -0.003279636 -0.019458710
## Antigüedad_Cargo -0.001520027 -0.002304785
## Porcentaje_aumento_salarial 1.000000000 0.020002039
## Satisfación_Laboral 0.020002039 1.000000000# Muestra la matriz de correlación
heatmap(correlation_matrix,
main= "Grafico de correlación")
De acuerdo al grafico obtenido de la matriz de correlación se puede
evidenciar que las variables que mejor podrian explicar la variabilidad
de la variable de rotación corresponde a las horas_extras y el ingreso
mensual
- Estimación del modelo Realiza la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotacion (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.
df$rotacion <- ifelse(df$Rotación == "Si", 1, 0)
modelo_logistico <- glm(rotacion ~ Satisfación_Laboral+ Porcentaje_aumento_salarial+ Antigüedad_Cargo+ Horas_Extra+ Equilibrio_Trabajo_Vida +Ingreso_Mensual,
data = df, family = binomial(link = "logit"))
summary(modelo_logistico)##
## Call:
## glm(formula = rotacion ~ Satisfación_Laboral + Porcentaje_aumento_salarial +
## Antigüedad_Cargo + Horas_Extra + Equilibrio_Trabajo_Vida +
## Ingreso_Mensual, family = binomial(link = "logit"), data = df)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 5.267e-01 5.015e-01 1.050 0.2936
## Satisfación_Laboral -3.049e-01 6.815e-02 -4.474 7.69e-06 ***
## Porcentaje_aumento_salarial -1.779e-02 2.122e-02 -0.838 0.4018
## Antigüedad_Cargo -1.087e-01 2.652e-02 -4.097 4.18e-05 ***
## Horas_ExtraSi 1.428e+00 1.541e-01 9.265 < 2e-16 ***
## Equilibrio_Trabajo_Vida -2.378e-01 1.051e-01 -2.262 0.0237 *
## Ingreso_Mensual -1.071e-04 2.269e-05 -4.720 2.36e-06 ***
## ---
## 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: 1124.6 on 1463 degrees of freedom
## AIC: 1138.6
##
## Number of Fisher Scoring iterations: 5Intercept (Intercepción):
El coeficiente para la variable de intercepción (Intercept) es 0.5267 lo que indica que cuando todas las demás variables independientes son iguales a cero (Satisfacción laboral, Antiguedad en el cargo, Ingreso mensual, porcentaje de aumento salarial, Equilibrio vida trabajo y horas extras) la probabilidad de rotación de un empleado es del 52.67%
Un cambio unitario en la satisfacción laboral está asociado con una disminución del 0.3049 puntos basico en la variable rotación
Un aumento unitario en el porcentaje de aumento salarial está asociado con una disminución de 0.01779 puntos basico en la variable rotación
Un aumento unitario en la antigüedad en el cargo está asociado con una disminución de 0.1087 puntos basicos en la variable rotación
Cuando un trabajador realiza horas extras está asociado con un aumento de 1.428 en la variable rotación
El coeficiente para la variable “Equilibrio Trabajo-Vida” es -0.2378. Este coeficiente representa cómo el equilibrio entre el trabajo y la vida personal afecta a la variable dependiente. Un valor negativo indica que un mejor equilibrio se asocia con un valor menor en la variable rotación.
Un aumento unitario en el ingreso mensual está asociado con un cambio de -0.0001071 en la variable dependiente rotación.
- Evaluación Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
if (!require(pROC)) {
install.packages("pROC")
library(pROC)
}## Loading required package: pROC## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varprediccion = predict(modelo_logistico,list( Satisfación_Laboral=df$Satisfación_Laboral, Porcentaje_aumento_salarial=df$Porcentaje_aumento_salarial,
Antigüedad_Cargo = df$Antigüedad_Cargo,
Horas_Extra = df$Horas_Extra,
Ingreso_Mensual = df$Ingreso_Mensual,
Antigüedad_Cargo = df$Antigüedad_Cargo,
Equilibrio_Trabajo_Vida =df$Equilibrio_Trabajo_Vida),type = "response")
ROC_P= roc(df$rotacion~prediccion, percent = T, ci=T)## Setting levels: control = 0, case = 1## Setting direction: controls < casesROC_P##
## Call:
## roc.formula(formula = df$rotacion ~ prediccion, percent = T, ci = T)
##
## Data: prediccion in 1233 controls (df$rotacion 0) < 237 cases (df$rotacion 1).
## Area under the curve: 75.83%
## 95% CI: 72.32%-79.34% (DeLong)plot(ROC_P,print.auc=T,print.thres = "best",col="violet"
,xlab = "Specificity", ylab = "Sensitivity")
De acuerdo con los resultados obtenidos se puede evidenciar que de
acuerdo con los AUC los intervalos de presición del modelo se encuentran
entre 72.3% y 79.3% para predecir los valores positivos y negativos,
tambien podemos observar que su accuracy es de 75.8% lo cual es un
rendimiento buen rendimiento de predicción para fase de despliegue.
- 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).
Empleado1 <- data.frame(Equilibrio_Trabajo_Vida = 2,
Antigüedad_Cargo = 3,
Ingreso_Mensual = 5000,
Horas_Extra = "No",
Porcentaje_aumento_salarial = 10,
Satisfación_Laboral = 4)
rotacionx <- predict(modelo_logistico, newdata = Empleado1, type = "response")
rotacionx## 1
## 0.09906312De acuerdo con la predicción realizada por el modelo podemos ver que la probabilidad de que un empleado tenga rotación con las siguientes caracteristicas: Equilibrio_Trabajo_Vida = 2, Antigüedad_Cargo = 3, Ingreso_Mensual = 5000, Horas_Extra = “No”, Porcentaje_aumento_salarial = 10, Satisfación_Laboral = 4) es del 10% aproximadamente.
- Conclusiones 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).
De acuerdo con los resultados obtenidos en el modelo se evidencia que aunque todas las variables son estaditicamente significativas para influir en la decición de rotación de un empleado las variables con maayor relevancia son: La satisfacción laboral, la antiguedad en el cargo y el ingreso mensual, por lo cual si la empresa desea disminuir su porcentaje de rotación debe crear politicas en caminadas a mejorar la satifacción laboral de sus empleados como por ejemplo con reconocimiento por sus laborales y de acuerdo a sus capacidades tambien tener un modelo de ascenso que permita que la variable antiguedad en el cargo disminuya por otra parte tener una politica de remuneración justa con beneficios para que las personas no sientan la necesidad inmediata de buscar otras empresas para trabajar.