Unidad 3 - Modelos Lineales Generalizados
María Isabel Fernández Acosta
16 de Septiembre de 2024
Carga de datos
## 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: summarytoolsAnalisis de exploratorio de datos
## 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 ...## 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.000Punto 1
Variables categoricas
Departamento: Cada departamento puede tener una cultura y ambiente laboral únicos, lo que impacta la satisfacción y comodidad de los empleados.
Género: Las mujeres suelen ganar menos que los hombres en trabajos similares, y los sesgos de género pueden influir en las oportunidades y el trato en el trabajo.
Estado Civil: Los empleados casados, con más responsabilidades financieras, tienden a ser más sensibles a la compensación y beneficios que los solteros o divorciados.
Variables cuantitativas
Edad: Los empleados jóvenes tienden a cambiar de trabajo con mayor frecuencia, mientras que los mayores muestran menos rotación.
Ingreso Mensual: Si un empleado siente que su salario es bajo en relación con su esfuerzo o el mercado, buscará mejores oportunidades.
Antigüedad en el Cargo: Los empleados con más tiempo en su puesto pueden buscar cambios por falta de crecimiento, mientras que los nuevos suelen adaptarse mejor.
Hipotesis
Departamento: Debido a las exigencias y la presión en el área de Ventas, estimamos que la rotación de personal es más alta que en I+D o Recursos Humanos.
Género: Por temas relacionados con el machismo y la desigualdad salarial, consideramos que los hombres tienen más probabilidades de cambiar de trabajo que las mujeres.
Estado Civil: Las personas solteras, al no tener tantos compromisos familiares, podrían ser más propensas a cambiar de empleo en comparación con los casados o divorciados.
Edad: Se espera que los empleados más jóvenes tengan una mayor tendencia a la rotación laboral, mientras que los de mayor edad tienden a permanecer más tiempo en sus empleos.
Ingreso Mensual: Los empleados con sueldos más bajos suelen buscar otras oportunidades con mayor frecuencia que aquellos con salarios más altos.
Antigüedad en el Cargo: Se considera que los empleados con menos tiempo en su puesto presentan una mayor tasa de rotación que aquellos con más años en la empresa.
Punto 2
Crear un histograma usando ggplot2
### Cargar la librería ggplot2
library(ggplot2)
### Graficas variables categoricas
### Gráfico de barras para la variable Estado Civil
ggplot(rotacion, aes(x = Estado_Civil)) +
geom_bar(fill = "lightblue", color = "black") +
labs(title = "Frecuencia de Estado Civil", x = "Estado_civil", y = "Frecuencia") +
theme_minimal()
# Gráfico de barras para la variable Departamento
ggplot(rotacion, aes(x = Departamento)) +
geom_bar(fill = "lightblue", color = "black") +
labs(title = "Frecuencia de los Departamentos", x = "Departamento", y = "Frecuencia") +
theme_minimal()
# Gráfico de barras para la variable Genero
ggplot(rotacion, aes(x = Genero)) +
geom_bar(fill = "lightblue", color = "black") +
labs(title = "Frecuencia de Genero", x = "Genero", y = "Frecuencia") +
theme_minimal()
Hipotesis
Departamento: El área de ventas muestra un bajo porcentaje de rotación en comparación con Innovación y Desarrollo, lo que podría indicar que los empleados de ventas tienen mayor estabilidad laboral o menores tasas de cambio debido a la estructura de incentivos en esta área.
Género: La proporción de mujeres en la empresa es considerablemente menor que la de hombres, lo que podría sugerir que las mujeres tienen menor representación en la organización o que enfrentan barreras para acceder a ciertos cargos que implican rotación.
Estado Civil: Los empleados solteros muestran una menor rotación que los casados, lo que podría deberse a que las personas solteras tienen mayor flexibilidad para adaptarse a cambios o a que están más enfocadas en desarrollar sus carreras sin compromisos familiares que dificulten su movilidad.
Graficas variables cuantitativas
Gráfico de barras para la variable Edad
ggplot(rotacion, aes(x = Edad)) +
geom_histogram(binwidth = 1, fill = "red", color = "black", alpha = 0.7) +
labs(title = "Histograma de la Edad",
x = "Edad",
y = "Frecuencia") +
theme_minimal()
### Gráfico de barras para la variable Ingreso Mensual
# Graficar el histograma de la variable Ingreso_Mensual
ggplot(rotacion, aes(x = Ingreso_Mensual)) +
geom_histogram(binwidth = 100, fill = "blue", color = "black", alpha = 0.7) +
labs(title = "Histograma de Ingreso Mensual",
x = "Ingreso Mensual",
y = "Frecuencia") +
theme_minimal()
Gráfico de barras para la variable Antiguedad Cargo
ggplot(rotacion, aes(x = Antigüedad_Cargo )) +
geom_histogram(binwidth = 1, fill = "green", color = "black", alpha = 0.7) +
labs(title = "Histograma de Antigüedad en Cargo",
x = "Antigüedad Cargo",
y = "Frecuencia") +
theme_minimal()
Hipotesis
Edad: Las personas más jóvenes suelen adaptarse mejor al cambio, lo que sugiere que la edad puede ser un factor importante para predecir la rotación de cargos. Además, el género también puede influir en la adaptación y la rotación, aunque no se ofrece más detalle sobre esta relación en el análisis.
Ingreso Mensual: Esto puede señalar una disparidad económica dentro de la empresa, lo que podría estar vinculado a factores como la estructura jerárquica o la falta de oportunidades para progresar dentro de la compañía. Esta brecha salarial puede influir en la motivación y la retención de los empleados.
Antiguedad en el cargo: Este dato puede relacionarse con la alta rotación, ya que los empleados con menos tiempo en la empresa podrían estar más abiertos a cambiar de cargo o a adaptarse a nuevos procesos. Esto podría ser beneficioso para la empresa en términos de flexibilidad y crecimiento interno.
Punto 3
rotacion_map = c("Si" = 1, "No" = 0)
rotacion$rotacion_numerica = rotacion_map[as.character(rotacion$Rotación)]
rotacion$Rotación = rotacion_map[as.character(rotacion$Rotación)]
rotacion$Rotación = as.character(rotacion$Rotación)
rotacion$rotacion_numerica = as.numeric(rotacion$rotacion_numerica)
mean_rotacion = mean(rotacion$Ingreso_Mensual[rotacion$rotacion_numerica == 1])
mean_no_rotacion = mean(rotacion$Ingreso_Mensual[rotacion$rotacion_numerica == 0])CuantitativasPunto3 <- function(columna){
t_valoresNumericos <- t.test(rotacion$rotacion_numerica, rotacion[[columna]])
print("Prueba t")
print(t_valoresNumericos)
hist(rotacion[[columna]],
xlab = columna,
ylab = "Frecuencia",
col = "blue",
main = paste("Rotacion en relacion con ", columna))
abline(v = mean(rotacion[[columna]]), col = "red", lwd = 2)
}
CuantitativasPunto3("Ingreso_Mensual")## [1] "Prueba t"
##
## Welch Two Sample t-test
##
## data: rotacion$rotacion_numerica and rotacion[[columna]]
## t = -52.957, df = 1469, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -6743.638 -6261.902
## sample estimates:
## mean of x mean of y
## 0.1612245 6502.9312925
## [1] "Prueba t"
##
## Welch Two Sample t-test
##
## data: rotacion$rotacion_numerica and rotacion[[columna]]
## t = -154.16, df = 1473.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -37.23106 -36.29548
## sample estimates:
## mean of x mean of y
## 0.1612245 36.9244898
## [1] "Prueba t"
##
## Welch Two Sample t-test
##
## data: rotacion$rotacion_numerica and rotacion[[columna]]
## t = -42.828, df = 1499.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.254344 -3.881710
## sample estimates:
## mean of x mean of y
## 0.1612245 4.2292517
### Variables categoricas
CategoricasPunto3 <- function(columna){
tabla_contingencia <- table(rotacion[[columna]], rotacion$Rotación)
chi_square_test_result <- chisq.test(tabla_contingencia)
print(chi_square_test_result)
df <- as.data.frame.matrix(tabla_contingencia)
df$category <- rownames(df)
df <- tidyr::gather(df, "Rotación", "Frecuencia", -category)
ggplot(df, aes(x = category, y = Frecuencia, fill = Rotación)) +
geom_bar(stat = "identity") +
labs(title = paste("Tabla de Contingencia para:", columna),
x = "Categoría",
y = "Frecuencia",
fill = "Rotación") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
}
CategoricasPunto3("Departamento")##
## Pearson's Chi-squared test
##
## data: tabla_contingencia
## X-squared = 10.796, df = 2, p-value = 0.004526
##
## Pearson's Chi-squared test with Yates' continuity correction
##
## data: tabla_contingencia
## X-squared = 1.117, df = 1, p-value = 0.2906
##
## Pearson's Chi-squared test
##
## data: tabla_contingencia
## X-squared = 46.164, df = 2, p-value = 9.456e-11
Hipotesis
La rotación laboral está influenciada por la edad, los ingresos y la antigüedad en la compañía. Los empleados menores de 30 años presentan mayor rotación, lo que confirma que los jóvenes tienden a buscar nuevas oportunidades con más frecuencia. Además, aquellos que ganan menos de 4 millones de pesos muestran una mayor tendencia a cambiar de trabajo en busca de mejores remuneraciones. Sin embargo, contrario a lo esperado, los empleados con menos de 4 años en la empresa son quienes más rotan, mientras que los de mayor antigüedad tienden a mantenerse, lo que sugiere que la estabilidad laboral aumenta con el tiempo.
Los resultados indican que los empleados solteros, de género masculino, y aquellos que trabajan en el departamento de Investigación y Desarrollo presentan mayores tasas de rotación dentro de la empresa. Esto sugiere que, debido a la naturaleza dinámica de sus roles, la alta demanda laboral en el sector de I+D, y posiblemente una menor estabilidad personal y profesional, estos grupos están más propensos a buscar nuevas oportunidades laborales. Por lo tanto, se puede plantear la hipótesis de que ser soltero, ser hombre y trabajar en Investigación y Desarrollo son factores que aumentan la probabilidad de rotación laboral en comparación con otros grupos dentro de la organización.
Punto 4
# Cargar la biblioteca
library(caTools)
# Establecer una semilla para reproducibilidad
set.seed(123)
# Convertir la variable de respuesta a factor
rotacion$Rotación <- as.factor(rotacion$Rotación)
# Dividir los datos en conjunto de entrenamiento y de prueba
split <- sample.split(rotacion$Rotación, SplitRatio = 0.7)
# Subconjunto de entrenamiento
train_set <- subset(rotacion, split == TRUE)
# Subconjunto de prueba
test_set <- subset(rotacion, split == FALSE)
# Ajustar el modelo de regresión logística
modelo_logistico <- glm(Rotación ~ Antigüedad_Cargo + Ingreso_Mensual + Edad +
factor(Departamento) + factor(Estado_Civil) +
factor(Genero),
data = train_set, family = binomial(link = "logit"))
# Mostrar el resumen del modelo
summary(modelo_logistico)##
## Call:
## glm(formula = Rotación ~ Antigüedad_Cargo + Ingreso_Mensual +
## Edad + factor(Departamento) + factor(Estado_Civil) + factor(Genero),
## family = binomial(link = "logit"), data = train_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.101e+00 4.143e-01 -2.658 0.00786 **
## Antigüedad_Cargo -1.026e-01 3.166e-02 -3.241 0.00119 **
## Ingreso_Mensual -9.564e-05 3.086e-05 -3.100 0.00194 **
## Edad -8.474e-03 1.101e-02 -0.770 0.44146
## factor(Departamento)RH 1.194e-01 4.662e-01 0.256 0.79780
## factor(Departamento)Ventas 8.234e-01 1.901e-01 4.331 1.48e-05 ***
## factor(Estado_Civil)Divorciado -2.853e-01 2.660e-01 -1.073 0.28345
## factor(Estado_Civil)Soltero 7.807e-01 1.962e-01 3.980 6.90e-05 ***
## factor(Genero)M 2.037e-01 1.846e-01 1.103 0.26987
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 909.34 on 1028 degrees of freedom
## Residual deviance: 819.47 on 1020 degrees of freedom
## AIC: 837.47
##
## Number of Fisher Scoring iterations: 5Conclusiones
Antigüedad_Cargo (-0.103): Por cada año adicional en la antigüedad del cargo, la rotación disminuye en aproximadamente 0.103. Esto sugiere que a medida que los empleados tienen más antigüedad, es menos probable que se vayan.
Ingreso_Mensual (-0.0000956): Por cada incremento de un peso en el ingreso mensual, la rotación disminuyen en aproximadamente 0.0000956. Esto indica que un mayor ingreso mensual se asocia con una menor probabilidad de rotación, aunque el efecto es muy pequeño.
Edad (-0.00847): Cada año adicional de edad se asocia con una disminución de aproximadamente 0.00847 en la rotación, pero este efecto no es estadísticamente significativo (p=0.44146).
factor(Departamento)RH (0.119): Comparado con el grupo de referencia, estar en el departamento de Recursos Humanos se asocia con un ligero aumento en la rotación, pero no es estadísticamente significativo (p=0.79780).
factor(Departamento)Ventas (0.823): Trabajar en el departamento de Ventas se asocia con un aumento significativo en los log-odds de rotación (p<0.001), sugiriendo que es más probable que los empleados de ventas se vayan en comparación con el grupo de referencia.
factor(Estado_Civil)Divorciado (-0.285): Estar divorciado se asocia con una disminución en la rotación, pero no es significativo (p=0.28345).
factor(Estado_Civil)Soltero (0.780): Ser soltero se asocia con un aumento significativo en la rotación (p<0.001), lo que sugiere que los solteros son más propensos a rotar.
factor(Genero)M (0.203) Ser hombre se asocia con un aumento en la de rotación, pero este efecto no es estadísticamente significativo (p=0.26987).
Conclusión Los coeficientes estimados proporcionan información sobre cómo cada variable se relaciona con la probabilidad de rotación. Las variables Antigüedad_Cargo, Ingreso_Mensual, y las categorías de estado civil y departamento tienen efectos significativos en la rotación, lo que puede ayudar en la toma de decisiones relacionadas con la retención de empleados.
Punto 5
## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, var# Usar el modelo para hacer predicciones en el conjunto de prueba
predicciones_prob <- predict(modelo_logistico, newdata = test_set, type = "response")
# Crear la curva ROC
roc_obj <- roc(test_set$Rotación, predicciones_prob)## Setting levels: control = 0, case = 1## Setting direction: controls < cases# Calcular el área bajo la curva ROC
auc_obj <- auc(roc_obj)
# Crear el gráfico de la curva ROC
plot(roc_obj, main=sprintf("Curva ROC (AUC = %0.2f)", auc_obj))
# Agregar color al gráfico
plot(roc_obj, col="#1c61b6", main=sprintf("Curva ROC (AUC = %0.2f)", auc_obj))
abline(a=0, b=1, col="red")
## Area under the curve: 0.703Conclusion
El resultado se presenta como una Curva ROC, y se observa que el AUC (Área Bajo la Curva) es de 0.70. Esto sugiere que el modelo de regresión logística tiene una habilidad moderada para diferenciar entre empleados que dejarán la empresa y aquellos que no lo harán. En términos estadísticos, un AUC de 0.70 implica que hay un 70% de probabilidad de que el modelo identifique correctamente un caso positivo aleatorio en comparación con un caso negativo aleatorio.
Punto 6
Establecer un plan de incrementos salariales progresivos basado en la antigüedad y el desarrollo de habilidades. Esto asegurará que los empleados vean un crecimiento en sus ingresos a medida que avanzan en su carrera dentro de la empresa.
Crear un ambiente de trabajo dinámico y colaborativo, con eventos sociales y de integración dentro de la empresa, puede aumentar el sentido de pertenencia entre los empleados solteros, ayudándolos a construir conexiones y lazos dentro de la organización.
La falta de oportunidades de crecimiento impulsa la rotación. Para reducirla, se pueden implementar programas de formación, certificaciones y trayectorias claras de ascenso. Además, apoyar a todos los empleados, sin importar el genero en su adaptación al trabajo mediante campañas de mejora del ambiente laboral y evaluaciones psicológicas, ayudará a optimizar su integración y compromiso.