INFORME REGRESIÓN LINEAL GENERALIZADA
Julieth Cerón
02/10/2022
PUNTO 1.ANÁLISIS DE ROTACIÓN LABORAL
En el presente ejercicio se desea hacer una análisis de la rotación de personal en una empresa. se cuenta con datos estructurados en Excel de una organización que contempla las siguientes variables:
## [1] "Rotación" "Edad"
## [3] "Viaje de Negocios" "Departamento"
## [5] "Distancia_Casa" "Educación"
## [7] "Campo_Educación" "Satisfacción_Ambiental"
## [9] "Genero" "Cargo"
## [11] "Satisfación_Laboral" "Estado_Civil"
## [13] "Ingreso_Mensual" "Trabajos_Anteriores"
## [15] "Horas_Extra" "Porcentaje_aumento_salarial"
## [17] "Rendimiento_Laboral" "Años_Experiencia"
## [19] "Capacitaciones" "Equilibrio_Trabajo_Vida"
## [21] "Antigüedad" "Antigüedad_Cargo"
## [23] "Años_ultima_promoción" "Años_acargo_con_mismo_jefe"Pregunta 1. Seleccionar 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que consideren estén relacionadas con la rotación. Nota: Justificar por que estas variables están relacionadas y que tipo de relación se espera (Hipótesis). Ejemplo: Se espera que las horas extra se relacionen con la rotación ya que las personas podrían desgastarse mas al trabajar horas extra y descuidan aspectos personales. La hipótesis es que las personas que trabajan horas extra tienen mayor posibilidad de rotar que las que no trabajan extra. (serian 6, una por variable).
Variables Cualitativas Seleccionadas.
1. Estado Civil: El estado civil puede estar relacionado con la rotación ya que a mayor grado de compromiso mayor necesidad de estabilidad. Por su parte, los empleados divorciados podrían encontrar en el trabajo una excusa para su soledad.
H1: Los empleados solteros son más propensos a rotar que los otros empleados.
2. Viaje de negocios: Los viajes de negocio pueden estar relacionados con la rotación, es posible que, a mayor frecuencia de viajes laborales un empleado puede sentir agotamiento en su labor, ya que el desplazamiento le agota físicamente. Además de esto, tiene que estar alejado mucho tiempo de su familia. Por lo anterior, el empleado busca una oportunidad laboral donde no tenga que hacer viajes de negocios para ejercer su labor.Además también se podría pensar que las personas que viajan frecuentemente probablemente no tienen la responsabilidad de quedarse en un lugar fijo y no podrían temer al cambio, por ello, podrian tambiénn rotar con mayor facilidad.
H2: Los empleados que viajan con mayor frecuencia son más propensos a rotar que los otros empleados.
3. Departamento: El departamento puede estar relacionado con la rotación ya que el mercado laboral puede presentar mayor oferta para ciertos departamentos y la competencia puede ser atractiva. En el caso del departamento de ventas, existe generalmente remuneración por cumplimiento, se ha visto que la empresas ofrecen a personal de estas áreas atractivos para ser contratados incluso seduciendo económicamente para que se trasladen con sus clientes.
H3: Los empleados del departamento de Ventas son más propensos a rotar que los otros empleados.
Variables Cuantitativas Seleccionadas.
4. Porcentaje de aumento salarial: La variable de porcentaje de aumento salarial puede tener relación con la rotación. Probablemente, un bajo porcentaje de incremento salarial, hace que los empleados opten por otras oportunidades laborales con salarios más competitivos.
H4: Los empleaos con menor porcentaje de aumento salarial son más propensos a rotar que los otros empleados.
5. Años a cargo con el mismo jefe: La variable de años a cargo con el mismo jefe puede tener relación con la rotación. Es posible que, la articulación y empatía con el jefe no se logre en los primeros años de relación, algunos empleados podrían “aguantar” los primeros años con su jefe y si no logran dicha articulación y empatía podrían rotar. Por su parte los empleados que llevan muchos años con el mismo jefe han logrado una sinergia para mantenerse en dicha posición.
H5: Los empleaos que tienen menor numero de años con el mismo jefe son más propensos a rotar que los otros empleados.
6. Años de experiencia: La variable de años de experiencia puede tener relación con la rotación. Es probable que, al tener menos años de experiencia la rotación sea mayor, ya que los empleados con menor experiencia buscan más oportunidades para crecer profesionalmente y llegar a lo que desean en su vocación como profesionales.
H6: Los empleados con pocos años de experiencia son más propensos a rotar que los otros empleados.
Pregunta 2. Realizar un análisis univariado (caracterización). Nota: Los indicadores o gráficos se usan dependiendo del tipo de variable (cuanti o cuali). Incluir interpretaciones de la rotación.
g0 = ggplot(Datos, aes(x = Rotación, color=Rotación)) + geom_bar(alpha=0.5) + theme_bw()+coord_flip()
ggarrange(g0, labels = c("1."), ncol = 1)
Del gráfico 1 podemos decir que de un total de 1.470
empleados en la compañía, 237 empleados presentan rotación (corresponde
al 16,1% de los empleados), mientras que 1.233 empleados no presentan
rotación corresponde al 83,9% de los empleados .Se considera que el
porcentaje de empleados que presenta rotación es considerable, por lo
tanto, es pertinente hacer los análisis de las variables anteriormente
seleccionadas para ver su relación con la rotación.
Análisis Univariado de las variables seleccionadas:
Variables Cualitativas
g1 = ggplot(Datos, aes(x = Estado_Civil)) + geom_bar(fill="#FF8C00") + theme_bw()+ theme(axis.text.x = element_text(angle = 90, hjust = 1))
g2 = ggplot(Datos, aes(x = `Viaje de Negocios`)) + geom_bar(fill="#FF8C00") + theme_bw() + theme(axis.text.x = element_text(angle = 90, hjust = 1))
g3 = ggplot(Datos, aes(x = Departamento)) + geom_bar(fill="#FF8C00") + theme_bw()+ theme(axis.text.x = element_text(angle = 90, hjust = 1))
ggarrange(g1, g2, g3, labels = c("A", "B", "C"), ncol = 3, nrow = 1)
En la gráfica A se evidencia que el mayor número de empleados está “Casado”, seguido de los “Soltero” y por ultimo los “Divorciado”.Es importante analizar la rotación vs el estado civil para validar la hipótesis H1. Se debe tener presente la población por cada Estado Civil y el porcentaje de ellos que presenta mayor rotación.
En la gráfica B se evidencia que el mayor número de empleados “Raramente” realiza Viajes de Negocio, seguido de “Frecuentemente” y “No_Viaja”.Es importante analizar la rotación vs los Viajes de Negocios para validar la hipótesis H2. Se debe tener presente la población por cada nivel de viajes y el porcentaje de ellos que presenta mayor rotación.
En la gráfica C se evidencia que el mayor número de empleados está en el departamento de “IyD”, seguido del departamento de “Ventas” y por último el de “RH”.Es importante analizar la rotación vs el Departamento para validar la hipótesis H3. Se debe tener presente la población por cada Deaprtamento y el porcentaje de ellos que presenta mayor rotación.
Variables Cuantitativas
g4 = ggplot(Datos, aes(x = Porcentaje_aumento_salarial)) + geom_histogram(bins = 20,fill="#1fd184") + theme_bw()
g5 = ggplot(Datos, aes(x = Años_acargo_con_mismo_jefe)) + geom_histogram(bins = 10,fill="#1fd184") + theme_bw()
g6 = ggplot(Datos, aes(x = Años_Experiencia)) + geom_histogram(bins = 18,fill="#1fd184") + theme_bw()
ggarrange(g4, g5, g6, labels = c("D", "E", "F"), ncol = 3, nrow = 1)
descr(Datos$Porcentaje_aumento_salarial,stats = "common")## Descriptive Statistics
## Datos$Porcentaje_aumento_salarial
## N: 1470
##
## Porcentaje_aumento_salarial
## --------------- -----------------------------
## Mean 15.21
## Std.Dev 3.66
## Min 11.00
## Median 14.00
## Max 25.00
## N.Valid 1470.00
## Pct.Valid 100.00En la gráfica D y con la estadística descriptiva para el “Porcentaje_aumento_salarial” se evidencia una media de 15.21 y una desviación estándar de 3.66; por su parte la mediana es de 14.00, La mayor concentración de empleados está entre 11.55 y 18.87. Es importante analizar la rotación vs el Porcentaje_aumento_salarial para validar la hipótesis H4.
descr(Datos$Años_acargo_con_mismo_jefe,stats = "common")## Descriptive Statistics
## Datos$Años_acargo_con_mismo_jefe
## N: 1470
##
## Años_acargo_con_mismo_jefe
## --------------- ----------------------------
## Mean 4.12
## Std.Dev 3.57
## Min 0.00
## Median 3.00
## Max 17.00
## N.Valid 1470.00
## Pct.Valid 100.00En la gráfica E y con la estadística descriptiva para la “Años_acargo_con_mismo_jefe” se evidencia una media de 4.12 y una desviación estándar de 3.57; por su parte la mediana es de 3.00, La mayor concentración de empleados está entre 0 y 7 años, Es importante analizar la rotación vs los Años_acargo_con_mismo_jefe para validar la hipótesis H5.
descr(Datos$Años_Experiencia,stats = "common")## Descriptive Statistics
## Datos$Años_Experiencia
## N: 1470
##
## Años_Experiencia
## --------------- ------------------
## Mean 11.28
## Std.Dev 7.78
## Min 0.00
## Median 10.00
## Max 40.00
## N.Valid 1470.00
## Pct.Valid 100.00En la gráfica F y con la estadística descriptiva para los “Años_Experiencia” se evidencia una media de 11.28 y una desviación estándar de 7.78; por su parte la mediana es de 10.00, Hay concentración de empleados en los 2-3 años y en los 3.5 y 19.06 años, Es importante analizar la rotación vs la Años_Experiencia para validar la hipótesis H6.
Pregunta 3: Realizar un análisis de bivariado en donde la variable respuesta sea la rotación 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 las hipótesis planteadas en el punto 2.
Estado Civil:
Gb3=PlotXTabs2(Datos,Estado_Civil, Rotación,plottype = "percent",palette = "Set2")+ theme(axis.text.x = element_text(angle = 0, hjust = 1))
Gb3
ctable(x = Datos$Estado_Civil,y = Datos$Rotación,chisq = FALSE,headings = TRUE)## Cross-Tabulation, Row Proportions
## Estado_Civil * Rotación
## Data Frame: Datos
##
## -------------- ---------- -------------- ------------- ---------------
## Rotación No Si Total
## Estado_Civil
## Casado 589 (87.5%) 84 (12.5%) 673 (100.0%)
## Divorciado 294 (89.9%) 33 (10.1%) 327 (100.0%)
## Soltero 350 (74.5%) 120 (25.5%) 470 (100.0%)
## Total 1233 (83.9%) 237 (16.1%) 1470 (100.0%)
## -------------- ---------- -------------- ------------- ---------------De acuerdo con el Estado_civil, el que mayor rotación presenta es el de los “Solteros” (el 25,5% rotaron), seguido de los “Casadso” (el 12,5% rotaron) y por último los “Divorciado” (el 10,1% rotaron).
Conclusión para H1: Los empleaos solteros son más propensos a rotar que los otros empleados: Válida
Viaje de negocios
Gb3=PlotXTabs2(Datos,`Viaje de Negocios`, Rotación,plottype = "percent",palette = "Set2")+ theme(axis.text.x = element_text(angle = 0, hjust = 1))
Gb3
ctable(x = Datos$`Viaje de Negocios`,y = Datos$Rotación,chisq = FALSE,headings = TRUE)## Cross-Tabulation, Row Proportions
## `Viaje de Negocios` * Rotación
## Data Frame: Datos
##
## ------------------- ---------- -------------- ------------- ---------------
## Rotación No Si Total
## Viaje de Negocios
## Frecuentemente 208 (75.1%) 69 (24.9%) 277 (100.0%)
## No_Viaja 138 (92.0%) 12 ( 8.0%) 150 (100.0%)
## Raramente 887 (85.0%) 156 (15.0%) 1043 (100.0%)
## Total 1233 (83.9%) 237 (16.1%) 1470 (100.0%)
## ------------------- ---------- -------------- ------------- ---------------De acuerdo con el Viaje_de_Negocios, el que mayor rotación presenta es el de los “Frecuentemente” (el 25% rotaron), seguido de los “Raramente” (el 15.0% rotaron) y por último los “No_Viaja” (el 8.0% rotaron).
Conclusión para H2: Los empleaos que viajan con mayor frecuencia son más propensos a rotar que los otros empleados: Válida
Departamento
Gb3=PlotXTabs2(Datos,Departamento, Rotación,plottype = "percent",palette = "Set2")+ theme(axis.text.x = element_text(angle = 0, hjust = 1))
Gb3
ctable(x = Datos$Departamento,y = Datos$Rotación,chisq = FALSE,headings = TRUE)## Cross-Tabulation, Row Proportions
## Departamento * Rotación
## Data Frame: Datos
##
## -------------- ---------- -------------- ------------- ---------------
## Rotación No Si Total
## Departamento
## IyD 828 (86.2%) 133 (13.8%) 961 (100.0%)
## RH 51 (81.0%) 12 (19.0%) 63 (100.0%)
## Ventas 354 (79.4%) 92 (20.6%) 446 (100.0%)
## Total 1233 (83.9%) 237 (16.1%) 1470 (100.0%)
## -------------- ---------- -------------- ------------- ---------------De acuerdo con el Departamento, el que mayor rotación presenta es el de “Ventas” (el 21% rotaron), seguido de los “RH” (el 19,0% rotaron) y por último el de “IyD” (el 13,8% rotaron). No obstante es importante considerar la rotación de “IyD” ya que su tamaño es el más grande n=961.
Conclusión para H3: Los empleados de departamentos de Ventas son más propensos a rotar que los empleados de otros departamentos. Válida
Cuantitativas:
Ingreso Mensual:
Gb4=ggplot(Datos,aes(x=Rotación,y= Porcentaje_aumento_salarial,fill=Rotación))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
Gb4_2=ggplot(Datos, aes(x = Porcentaje_aumento_salarial, color=Rotación, Fill="white")) + geom_histogram(alpha=0.5, bins = 20, position="identity")
subplot(Gb4, Gb4_2, titleY = TRUE, titleX = TRUE, margin = 0.05 )De acuerdo con el Porcentaje_aumento_salarial, se evidencia que la rotación NO esta exclusivamente relacionada con un porcentaje especifico, ya que los empleados con un porcentaje de aumento salarial menor, no rotan más que los que reciben un mayor porcentaje salarial. Por tal razón, no es un factor determinante la rotación para los empleados con menor porcentaje de incremento salarial, ya que se puede ver en la gráfica 1D empleados con porcentaje de incremento entre 22% y 24% con igual o mayor porcentaje de rotación que los que apenas le incrementan 11% en su salario.
Conclusión para H4: Los empleaos con menor porcentaje de aumento salarial son más propensos a rotar que los otros empleados.. No Válida
Años_acargo_con_mismo_jefe:
Gb4=ggplot(Datos,aes(x=Rotación,y= Años_acargo_con_mismo_jefe,fill=Rotación))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
Gb4_2=ggplot(Datos, aes(x = Años_acargo_con_mismo_jefe, color=Rotación, Fill="white")) + geom_histogram(alpha=0.5, bins = 20, position="identity")
subplot(Gb4, Gb4_2, titleY = TRUE, titleX = TRUE, margin = 0.05 )De acuerdo con el Años_acargo_con_mismo_jefe, se evidencia que la rotación en los primeros años con el mismo Jefe es mas frecuente que para otros años. sin embargo hay una alta rotación en los que llevan cerca de los 7 años con el mismo jefe. Por ende,se podría validar la hipótesis considerando atípico el comportamiento de los 7 años.
Conclusión para H5: Los empleados con menos años con el mismo jefe son más propensos a rotar que los otros empleados.. Válida
Años_Experiencia:
Gb4=ggplot(Datos,aes(x=Rotación,y= Años_Experiencia,fill=Rotación))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
Gb4_2=ggplot(Datos, aes(x = Años_Experiencia, color=Rotación, Fill="white")) + geom_histogram(alpha=0.5, bins = 20, position="identity")
subplot(Gb4, Gb4_2, titleY = TRUE, titleX = TRUE, margin = 0.05 )De acuerdo con el Años_Experiencia, se evidencia que la rotación en los empleados con poca experiencia es mas frecuente que los que tienen una mayor experiencia, principalmente en el primer año y posteriormente entre los 3 y los 10 años.
Conclusión para H6: Los empleados con menos años de experiencia son más propensos a rotar que los otros empleados.. Válida
Pregunta 4. Realizar 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. Interprete los coeficientes del modelo y la significancia de los parámetros.
Datos$Rotación=as.numeric(Datos$Rotación=="Si")
modelol=glm(Rotación~`Viaje de Negocios`+Departamento+Estado_Civil+Años_acargo_con_mismo_jefe+Años_Experiencia+Porcentaje_aumento_salarial,data = Datos,family = "binomial")
summary(modelol)##
## Call:
## glm(formula = Rotación ~ `Viaje de Negocios` + Departamento +
## Estado_Civil + Años_acargo_con_mismo_jefe + Años_Experiencia +
## Porcentaje_aumento_salarial, family = "binomial", data = Datos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.3522 -0.6202 -0.4663 -0.2974 2.8133
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.608406 0.385886 -1.577 0.114877
## `Viaje de Negocios`No_Viaja -1.377440 0.341205 -4.037 5.41e-05 ***
## `Viaje de Negocios`Raramente -0.657603 0.172920 -3.803 0.000143 ***
## DepartamentoRH 0.515112 0.348524 1.478 0.139413
## DepartamentoVentas 0.485131 0.158053 3.069 0.002145 **
## Estado_CivilDivorciado -0.203285 0.223122 -0.911 0.362246
## Estado_CivilSoltero 0.817903 0.164001 4.987 6.13e-07 ***
## Años_acargo_con_mismo_jefe -0.095802 0.027809 -3.445 0.000571 ***
## Años_Experiencia -0.049862 0.013135 -3.796 0.000147 ***
## Porcentaje_aumento_salarial -0.007158 0.020763 -0.345 0.730282
## ---
## 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: 1166.3 on 1460 degrees of freedom
## AIC: 1186.3
##
## Number of Fisher Scoring iterations: 5De acuerdo con los resultados del modelo, podemos evidenciar que las variables más significativas son: Estado_CivilSoltero, Viaje_de_NegociosNo_Viaja, Viaje_de_NegociosRaramente, Años_Experiencia, Años_acargo_con_mismo_jefe y DepartamentoVentas.
Destaca que la variable que más disminuye la probabilidad de rotación, es la de Viaje_de_NegociosNo_Viaja. Por el contrario, la variable Estado_CivilSoltero es la que más aumenta la probabilidad de rotación, seguida de DepartamentoRH (Aunque no es significativa) y Departamento Ventas.
COn ello, concluimos que:
-Un empleado soltero tiene mayor posibilidad de rotar que un casado y divorciado
Coeficientes del modelo
Según los coeficientes del modelo,se puede destacar que los empleados solteros tienen 2,26 veces (o 226%) más probabilidad de rotar que alquien que no está soltero. También, los empleados del departamento de ventas tienen 1,62 veces (o 162%) más probabilidad de rotar que algún otro empleado de otro departamento.
exp(modelol$coefficients)## (Intercept) `Viaje de Negocios`No_Viaja
## 0.5442178 0.2522235
## `Viaje de Negocios`Raramente DepartamentoRH
## 0.5180917 1.6738263
## DepartamentoVentas Estado_CivilDivorciado
## 1.6243886 0.8160457
## Estado_CivilSoltero Años_acargo_con_mismo_jefe
## 2.2657440 0.9086441
## Años_Experiencia Porcentaje_aumento_salarial
## 0.9513608 0.9928674Ahora, con el modelo calculado procedemos a comparar las varianzas entre las medias de los grupos de las variables del modelo. Para ello utilizaremos el análisis ANOVA
anova(modelol, test = "Chisq")| Df | Deviance | Resid. Df | Resid. Dev | Pr(>Chi) | |
|---|---|---|---|---|---|
| NULL | NA | NA | 1469 | 1298.583 | NA |
Viaje de Negocios |
2 | 23.7602374 | 1467 | 1274.822 | 0.0000069 |
| Departamento | 2 | 10.8297620 | 1465 | 1263.993 | 0.0044499 |
| Estado_Civil | 2 | 42.7674260 | 1463 | 1221.225 | 0.0000000 |
| Años_acargo_con_mismo_jefe | 1 | 38.2868754 | 1462 | 1182.938 | 0.0000000 |
| Años_Experiencia | 1 | 16.5264957 | 1461 | 1166.412 | 0.0000480 |
| Porcentaje_aumento_salarial | 1 | 0.1193512 | 1460 | 1166.293 | 0.7297392 |
A partir de los resultados de análisis ANOVA, podemos identificar que la mayoría de las variables son significativas, con excepción de Porcentaje_aumento_salarial Se debe evaluar si esta última se puede eliminar del modelo de regresión logístico.
Complementamos el análisis anterior con el análisis de factores de inflación de la varianza VIF; así:
vif(modelol)## GVIF Df GVIF^(1/(2*Df))
## `Viaje de Negocios` 1.008592 2 1.002141
## Departamento 1.015188 2 1.003776
## Estado_Civil 1.017690 2 1.004393
## Años_acargo_con_mismo_jefe 1.231233 1 1.109610
## Años_Experiencia 1.231569 1 1.109761
## Porcentaje_aumento_salarial 1.005315 1 1.002654Podemos confirmar que la variable Años_Experiencia y Años_acargo_con_mismo_jefe son las que reflejan mayor varianza de inflación, sin embargo, se encuentra dentro de los valores aceptados.
Pregunta 5. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
predict1= predict.glm(modelol, newdata = Datos, type = "response")
result1 = table(Datos$Rotación, ifelse(predict1 >0.2, 1, 0), dnn = c("observaciones", "predicciones"))
result1## predicciones
## observaciones 0 1
## 0 924 309
## 1 107 130mosaic(result1, shade = T, colorize = T,
gp = gpar(fill = matrix(c("Purple", "Orange", "Orange", "Purple"), 2, 2)))
sum(diag(result1)/sum(result1))## [1] 0.7170068Conforme a los resultados podemos identificar que de 1233 observaciones identificó 924 observaciones que efectivamente correspondían a la no rotación del personal, mientras que 309 de ellas fueron falsos negativos. Por otra parte, identificó que de las 237 observaciones 107 de ellas eran efectivamente positivas indicando la rotación del personal, pero con 130 falsos positivos.
En general podemos estimar una bondad del ajuste del modelo de regresión logístico de aproximadamente 71.7% entre el conjunto de datos observados.
Ahora, realizaremos un análisis ROC con la finalidad de identificar la proporción de verdaderos positivos frente a la proporción de falsos positivos según varía el umbral de discriminación. Así:
prediccion_rotacion= ROCR::prediction(predict1,Datos$Rotación)
perf= performance(prediction.obj = prediccion_rotacion, "tpr", "fpr")
plot(perf)
abline(a=0, b=1, col="red")
grid()
AUClog= performance(prediccion_rotacion, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog, "n")## AUC: 0.7170566 nComo podemos observar en la gráfica anterior, el punto óptimo más cercano a una sensibilidad igual al 100% y especificidad igual al 100% corresponde a un valor de 0.2. Este, fue el valor que se seleccionó como threshold para evaluar la matriz de confusión en el punto anterior. También es posible identificar que el área debajo de la curva refleja la bondad del test para discriminar el personal que rota o no dentro de la empresa, este valor corresponde a 71.7%, igual al valor calculado anteriormente de 71.7%.
Pregunta 6. Predecir 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).
A partir de todos los análisis anteriormente realizados frente a los resultados del modelo y análisis ROC, evaluaremos un caso en particular con algunas características de un trabajador hipotético. Para tal fin se plantea un trabajador que viaja frecuentemente, Casado, del departamento de ventas, con 3 años con el mismo jefe, un porcentaje de aumento de salario de 10 y con 4 años de experiencia.
Trotacion=(predict(modelol,list(`Viaje de Negocios` ="Frecuentemente",Departamento="Ventas",Estado_Civil="Casado",Años_acargo_con_mismo_jefe= 3, Porcentaje_aumento_salarial = 10, Años_Experiencia= 4),type = "response"))*100
cat("Tasa Rotación: ", Trotacion,"%")## Tasa Rotación: 33.588 %De acuerdo con estas características, es posible estimar que esta persona tenga una probabilidad de rotación de alrededor de 33.6%. En este caso y dado el tamaño de la compañía la intervención debería ser mínima, quizá reduciendo el nivel de viajes podría reducir su probabilidad de rotación.
Pregunta 7. En las conclusiones se discute sobre cual seria la estrategia para disminuir la rotación en la empresa (con base en las variables que resultaron significativas en el punto 3). Ejemplo: Mejorar el ambiente laboral, los incentivos económicos, distribuir la carga de horas extra (menos turnos y mas personal).
Recomendaciones
Dado que la rotación de empleados solteros y empleados jóvenes es significativa, es importante formular políticas y programas de desarrollo del talento humano que permitan que esta población pueda encontrar en la empresa oportunidades de permanencia y ascenso profesional.
El departamento de Ventas presenta rotación significativa y se ve reflejado no solo para los representantes de ventas, si no también para los ejecutivos de ventas. Es importante que la empresa proponga estrategias de incentivos monetarios y no monetarios para mantener el recurso humano de su fuerza de ventas.
Para los viajes por negocios, buscar conexiones remotas, ya que la tecnología permite reducir esas distancias. Para las condiciones de los viajes darles más comodidades al empleado, que se pueda sentir escuchados, en cuanto a los requerimientos de viaje, aerolínea, hoteles, viáticos y necesidades que le permita reducir el estrés del viaje. Establecer incentivos para los que viajan con mayor frecuencia.
La rotación de empleados con relación a los años bajo el mismo jefe, invita a contar con programas de liderazgo integral para los Jefes que permitan que se generen equipos de alto rendimiento, comprometidos y que se genere una mayor confianza con sus empleados.
La experiencia siempre será fundamental para las organizaciones y para los empleados, se plantea tener un plan carrera que permita a los empleados adquirir la experiencia necesaria para el desarrollo de sus funciones y que la rotación se de internamente en molimientos verticales u horizontales hacia arriba.
Como sólo se analizaron 6 variables es necesario adelantar el estudio con otras variables importantes como la satisfacción laboral, capacitaciones, edades, etc.
PUNTO 2. ANÁLISIS DE RIESGO CREDITICIO
Con base en los datos de créditos proponga un modelo de regresión logístico múltiple que permita predecir el riesgo de default en función de las covariables que considere importantes y seleccionándolas de acuerdo con un proceso adecuado. Tenga en cuenta realizar una evaluación de la significancia de los parámetros, interpretación y proponga un método de evaluación por medio de validación cruzada. Presente métricas apropiadas como el AUC y la curva ROC.
Para el desarrollo de la presente simulación utilizaremos los datos relacionados con el riesgo de dafault de una compañía con base las siguientes variables:
datos_creditos = read_excel("D:/Maestria Ciencia de Datos/SEMESTRE II/Modelos Estadisticos/Datos_Creditos.xlsx")
datos_creditos$DEFAULT <- ifelse(datos_creditos$DEFAULT == 1, "Si", "No")
head(datos_creditos)| DEFAULT | ANTIUEDAD | EDAD | CUOTA_TOTAL | INGRESOS |
|---|---|---|---|---|
| Si | 37.317808 | 76.98356 | 3020519 | 8155593 |
| Si | 37.317808 | 73.77534 | 1766552 | 6181263 |
| Si | 30.978082 | 78.93699 | 1673786 | 4328075 |
| Si | 9.728767 | 51.52877 | 668479 | 5290910 |
| Si | 8.443836 | 38.96986 | 1223559 | 5333818 |
| Si | 6.605480 | 44.87945 | 3517756 | 2710736 |
Análisis Univariado
Ahora, realizaremos un análisis univariado del dataset para identificar cuáles son las variables más relevantes a tener en cuenta para la construcción del modelo.
gr1 = ggplot(datos_creditos, aes(x = ANTIUEDAD)) + geom_histogram(bins = 20,alpha=0.5) + theme_bw()
gr2 = ggplot(datos_creditos, aes(x = EDAD)) + geom_histogram(bins = 10,alpha=0.5) + theme_bw()
gr3 = ggplot(datos_creditos, aes(x = CUOTA_TOTAL)) + geom_histogram(bins = 18,alpha=0.5) + theme_bw()
gr4 = ggplot(datos_creditos, aes(x = INGRESOS)) + geom_histogram(bins = 18,alpha=0.5) + theme_bw()
ggarrange(gr1, gr2, gr3, gr4, labels = c("A", "B", "C", "E"), ncol = 2, nrow = 2)
descr(datos_creditos, stats = "common")## Descriptive Statistics
## datos_creditos
## N: 780
##
## ANTIUEDAD CUOTA_TOTAL EDAD INGRESOS
## --------------- ----------- ------------- -------- -------------
## Mean 18.04 885205.86 56.99 5366430.23
## Std.Dev 11.94 740212.33 12.51 2652186.02
## Min 0.25 387.00 26.61 633825.00
## Median 15.12 694460.50 57.92 5038962.00
## Max 37.32 6664588.00 92.43 22197021.00
## N.Valid 780.00 780.00 780.00 780.00
## Pct.Valid 100.00 100.00 100.00 100.00La edad promedio de las personas analizadas, se encuentra alrededor de 56.99 años, con una desviación estándar de 12.51. Por su parte, la antiguedad en años promedio es de 18.04 años con una desviación estándar de 11.94. Lacuota inicial promedio está en 885,205.86 con una desviación estándar de 740,212.33. El ingreso promedio de la población es de 5,366,430.23 con una desviación estándar de 2,652,186.02.
También haremos un análisis bivariado con relación a la variable default:
Gbr1=ggplot(datos_creditos,aes(x=DEFAULT,y= ANTIUEDAD,fill=DEFAULT))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
Gbr2=ggplot(datos_creditos,aes(x=DEFAULT,y= EDAD,fill=DEFAULT))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
Gbr3=ggplot(datos_creditos,aes(x=DEFAULT,y=CUOTA_TOTAL,fill=DEFAULT))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
Gbr4=ggplot(datos_creditos,aes(x=DEFAULT,y= INGRESOS,fill=DEFAULT))+geom_boxplot()+theme_bw()+stat_summary(fun=mean, geom="point", shape=20, size=1, color="white", fill="Media")
subplot(Gbr1, Gbr2, titleY = TRUE, titleX = TRUE, margin = 0.05)subplot(Gbr3, Gbr4, titleY = TRUE, titleX = TRUE, margin = 0.05)ggpairs(select_if(datos_creditos, is.numeric), lower = list(continuous = "smooth"),
diag = list(continuous = "barDiag"), axisLabels = "none")
Las variables edad y antigüedad tienen un coeficiente de correlación alto (0.753) por lo que puede existir multicolinealidad entre estas y afectar al modelo.
Modelo de Regresión Logistico Multiple - Teniendo en cuenta Todas las variables
datos_creditos$DEFAULT = as.factor(datos_creditos$DEFAULT)
mod_creditos=glm(DEFAULT~EDAD+
INGRESOS+
ANTIUEDAD+
CUOTA_TOTAL,
data = datos_creditos,family = "binomial")
summary(mod_creditos)##
## Call:
## glm(formula = DEFAULT ~ EDAD + INGRESOS + ANTIUEDAD + CUOTA_TOTAL,
## family = "binomial", data = datos_creditos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.9181 -0.3672 -0.2873 -0.1917 3.1332
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.193e+00 9.306e-01 -3.431 0.000601 ***
## EDAD 2.229e-02 1.932e-02 1.154 0.248641
## INGRESOS -2.615e-07 1.057e-07 -2.474 0.013348 *
## ANTIUEDAD -4.616e-02 2.353e-02 -1.961 0.049849 *
## CUOTA_TOTAL 1.013e-06 2.473e-07 4.098 4.16e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 309.68 on 779 degrees of freedom
## Residual deviance: 287.49 on 775 degrees of freedom
## AIC: 297.49
##
## Number of Fisher Scoring iterations: 6En el modelo anterior se nota que la variable edad no es significativa, además, como se mostró anteriormente, puede existir problemas de multicolinealidad por la alta correlación entre las variables edad y antigüedad, por lo que Utilizaremos la función step(), para determinar el modelo dejando que la función elimine las variables que no aporten a la solución.
Modelo de Regresión Logístico Múltiple - Selección de variables relevantes
mod_credito_seleccion = step(mod_creditos)## Start: AIC=297.49
## DEFAULT ~ EDAD + INGRESOS + ANTIUEDAD + CUOTA_TOTAL
##
## Df Deviance AIC
## - EDAD 1 288.79 296.79
## <none> 287.49 297.49
## - ANTIUEDAD 1 291.28 299.28
## - INGRESOS 1 294.76 302.76
## - CUOTA_TOTAL 1 304.34 312.34
##
## Step: AIC=296.78
## DEFAULT ~ INGRESOS + ANTIUEDAD + CUOTA_TOTAL
##
## Df Deviance AIC
## <none> 288.79 296.79
## - ANTIUEDAD 1 291.37 297.37
## - INGRESOS 1 295.61 301.61
## - CUOTA_TOTAL 1 304.95 310.95summary(mod_credito_seleccion)##
## Call:
## glm(formula = DEFAULT ~ INGRESOS + ANTIUEDAD + CUOTA_TOTAL, family = "binomial",
## data = datos_creditos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8147 -0.3724 -0.2868 -0.1938 3.1088
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.244e+00 3.933e-01 -5.707 1.15e-08 ***
## INGRESOS -2.542e-07 1.059e-07 -2.400 0.0164 *
## ANTIUEDAD -2.817e-02 1.803e-02 -1.562 0.1183
## CUOTA_TOTAL 9.860e-07 2.456e-07 4.014 5.96e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 309.68 on 779 degrees of freedom
## Residual deviance: 288.78 on 776 degrees of freedom
## AIC: 296.78
##
## Number of Fisher Scoring iterations: 6En el modelo ajustado, se observa que se elimina la variable EDAD, ademas, se nota que ahora la variable antigüedad tiene baja significancia.
Se puede decir también que: si la edad es mayor, el riesgo de default seria mas alto. Entre mas alto sean los ingresos hay menos posibilidad de default, lo mismo con la antigüedad, entre mas antigüedad menor posibilidad de default. En cuanto a la cuota, entre esta sea mas alta, hay mayor probabilidad de default.
Validación Cruzada
## NO=0 y Si = 1
prediccion_credito= predict.glm(mod_credito_seleccion, newdata = datos_creditos, type = "response")
resultado_credito=table(datos_creditos$DEFAULT, ifelse(prediccion_credito>0.2,1,0),dnn = c("observaciones", "predicciones"))
resultado_credito## predicciones
## observaciones 0 1
## No 738 3
## Si 38 1mosaic(resultado_credito, shade = T, colorize = T,
gp = gpar(fill = matrix(c("Purple", "Orange", "Orange", "Purple"), 2, 2)))
sum(diag(resultado_credito)/sum(resultado_credito))## [1] 0.9474359El modelo es capaz de clasificar correctamente 0.947(94.7%) de las observaciones.
Cuando se emplean los datos de entrenamiento:
prediccion_default= ROCR::prediction(prediccion_credito,datos_creditos$DEFAULT)
perf_creditos= performance(prediction.obj = prediccion_default, "tpr", "fpr")
plot(perf_creditos)
abline(a = 0, b = 1,col="red")
grid()
AUC_credito= performance(prediccion_default,measure = "auc")@y.values[[1]]
cat("AUC: ",AUC_credito)## AUC: 0.6922385El área bajo la curva de 0.69 indica que el modelo es regular y no se recomendaría para realizar predicciones, el modelo no tiene buena capacidad de discriminación para distinguir entre clase positiva y clase negativa.
By Julieth Cerón
2022