Informe 3 Rotación y Creditos
Emerson Trujillo Sierra
30/septiembre/2022
library(readxl)
Datos = read_excel("C:/DatosR/Metodos2/Datos_Rotacion.xlsx")Primer Punto
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).
Hipótesis de rotación laboral
1.Rotación por estado civil
La variable de estado civil puede tener relación con la rotación. Posiblemente, presentan alta rotación los solteros, al presentárse nuevas oportunidades laborales, fácilmente la pueden aceptar, ya que no están sujetos a las obligaciones derivadas del matrimonio, esto teniendo en cuenta, que tampoco tienen personas que dependan económicamente de ellos, por ejemplo, hijos, padres en su vejes entre otras.
2. Rotación por viaje de negocios
La variable de viaje de negocios puede tener relación 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.
3. Rotación por departamento
La variable de departamento puede tener relación con la rotación. Ya que pueden existir departamentos en la empresa, que presenten alta rotación por el tipo de trabajo que desempeñan. En caso de las ventas, el pago puede ser por comisión, y al no vender no genera ningún ingreso. Por tal razón, el empleado busca otra oportunidad laboral donde el departamento de ventas, por lo menos le pague un salario de base.
4. Rotación por 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.
5. Rotación por 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 capacidad de gestión de algunos jefes se quede corta, para logar bienestar de sus empleados. Además de esto, algunos jefes en su forma de liderar son muy autoritarios, lo que hace que los empleados busquen otros empleos. Por lo anterior los empleados con menos años con el mismo jefe tienden a tener mayor rotación.
6. Rotación por 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 vacación como profesionales.
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.
require(ggplot2)
require(ggpubr)
library(forcats)
gR=ggplot(Datos,aes(x=Rotación))+geom_bar(fill="#c92853")+theme_bw()+theme(axis.text.x = element_text(angle = 90))
Rota=ggarrange(gR, size=2)
Rota
round(prop.table(table(Datos$Rotación))*100,digits = 0)##
## No Si
## 84 16En general, los datos muestran que, la rotación voluntaria de empleados se representa en un 16 por ciento del total.
require(ggplot2)
require(ggpubr)
library(forcats)
g1=ggplot(Datos,aes(x=Viaje_de_Negocios))+geom_bar(fill="#b5b5b3")+theme_bw()+theme(axis.text.x = element_text(angle = 90))
g2=ggplot(Datos,aes(x=Departamento))+geom_bar(fill="#1fd184")+theme_bw()
g3=ggplot(Datos,aes(y=Años_acargo_con_mismo_jefe))+geom_bar(stat="count",fill="#f68060",alpha=.6,width=.4) +coord_flip()+theme_bw()
g4=ggplot(Datos,aes(x=Años_Experiencia))+geom_bar(fill="#1fbfd1")+theme_bw()+theme(axis.text.x = element_text(angle = 90))
g5=ggplot(Datos,aes(x=Estado_Civil))+geom_bar(fill="#cd42f0")+theme_bw()
g6=ggplot(Datos,aes(x=Porcentaje_aumento_salarial))+geom_bar(fill="#f0ba32")+theme_bw()
graf=ggarrange(g1, g2, g3, g4, g5, g6,labels = c("A", "B","C","D","E","F"), ncol = 3, nrow = 2)
graf
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 la hipotesis planteada en el punto 2.
require(CGPfunctions)
gb1=PlotXTabs2(Datos,Estado_Civil,Rotación, plottype = "percent" )
Grafica_Estado_Civil=ggarrange(gb1,labels = c("1A"))
Grafica_Estado_Civil
En la gráfica 1A, la hipótesis 1 se comprueba, ya que los empleados solteros rotan más que los casados o divorciados, en un 26 por ciento.
gb2=PlotXTabs2(Datos,Viaje_de_Negocios,Rotación, plottype = "percent" )
Gráfica_Viaje_de_Negocios=ggarrange(gb2,labels = c("1B"))
Gráfica_Viaje_de_Negocios
En la gráfica 1B, la hipótesis 2 se comprueba, ya que los empleados que viajan frecuentemente son las que más rotan, en un 25 por ciento
gb3=PlotXTabs2(Datos,Departamento, Rotación, plottype = "percent" )
Gráfica_Departamento=ggarrange(gb3,labels = c("1C"))
Gráfica_Departamento
En la gráfica 1C, la hipótesis 3 se comprueba, ya que los empleados en el departamento de ventas son las que más rotan, en un 21 por ciento. Ahora aquí se debe verificar el motivo de la rotación, puede ser, porque viajan demasiado o comisionan muy poco.
gb4=PlotXTabs2(Datos,Porcentaje_aumento_salarial,Rotación, plottype = "percent" )
Gráfica_Porcentaje_aumento_salarial=ggarrange(gb4,labels = c("1D"))
Gráfica_Porcentaje_aumento_salarial
En la gráfica 1D, la hipótesis 4 no es comprobada, 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.
gb5=PlotXTabs2(Datos,Años_acargo_con_mismo_jefe,Rotación, plottype = "percent" )+theme(axis.text.x = element_text(angle = 90))
Gráfica_Años_acargo_con_mismo_jefe=ggarrange(gb5,labels = c("1E"))
Gráfica_Años_acargo_con_mismo_jefe
En la gráfica 1E, la hipótesis 5 no es comprobada, ya que los empleados con menos años con el mismo jefe, no rotan más que los empleados con más años con el mismo jefe. Por tal razón, no es un factor determinante la rotación para los empleados con menos años con el mismo jefe, ya que se puede ver en la gráfica 1E empleados con 14 años con el mismo jefe con la rotación más alta en 40%.
gb6=ggplot(Datos,aes(x=Rotación, y=Años_Experiencia, fill=Rotación))+geom_boxplot()+theme_bw()
Gráfica_Años_Experiencia=ggarrange(gb6,labels = c("1F"))
Gráfica_Años_Experiencia
En la gráfica 1F, la hipótesis 6 se comprueba, ya que los empleados con menos años de experiencia rotan más que los empleados con más años de experiencia. Según la grafica 1F se muestra que el rango de 3 a 10 años de experiencia son los que presentan mayor rotación.
Pregunta 4
Realizar la estimación de un modelo de regresión logistico 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 parametros.
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_NegociosNo_Viaja -1.377440 0.341205 -4.037 5.41e-05 ***
## Viaje_de_NegociosRaramente -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: 5Todas las variables son significantivas a excepción de la variable Porcentaje de aumento salarial, Departamento de RH y el estado civil de divorciado
Pregunta 5
Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
library(vcd)
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("green3", "red2", "red2", "green3"), 2, 2)))
sum(diag(result1)/sum(result1))## [1] 0.7170068El modelo es capaz de clasificar correctamente 0.717(71.7%) de las observaciones cuando se emplean los datos de entrenamiento.
library(ROCR)
prediccion_rotacion= ROCR::prediction(predict1,Datos$Rotación)
perf= performance(prediction.obj = prediccion_rotacion, "tpr", "fpr")
plot(perf)
abline(a=0, b=1, col="blue")
grid()
AUClog= performance(prediccion_rotacion, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog, "n")## AUC: 0.7170566 nEl área bajo la curva de 0.71 indica que el modelo es aceptable y puede servir para predecir.
Pregunta 6
Predeccir la probabilida de que un individuo (hipotetico) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
Trotacion=(predict(modelol,list(Viaje_de_Negocios ="Frecuentemente",Departamento="Ventas",Estado_Civil="Casado",Años_acargo_con_mismo_jefe= 7, Porcentaje_aumento_salarial = 20, Años_Experiencia= 8),type = "response"))*100
cat("Tasa Rotación: ", Trotacion,"%")## Tasa Rotación: 20.81777 %Una empleado con las caracteristica anteriores tiene la probabilidad de rotar un 20.8%.Se rerquiere hacer un plan de retención para este personal
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 de estrategias:
A los empleados solteros como a los que tienen pocos años de experiencia, en muchas ocasiones no se sienten realizados. Por tal razón, pueden buscar otras opciones laborales. Por eso es fundamental como estrategia de la empresa, ser capaz de ofrecer a sus empleados tareas y planes de formación que les motiven y les hagan avanzar. La motivación es una acción empresarial en sí misma muy importante, que les puede motivar a su permanencia.
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 escuchado, 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.
Para el departamento de ventas establecer estrategias donde el empleado se sienta motivado:
• La empresa debería complementar el plan de incentivos con uno diferente y motivador • Marcar metas cortas y alcanzables • Retar con misiones • Premiar el esfuerzo, no sólo a los mejores • Alinear de forma más rápida acciones tácticas o de marketing a la ejecución de la venta • Premiar más frecuentemente • Hacer que el trabajo sea más divertido • Generar reconocimiento mostrando los progresos de todos • Pagar un salario base para que el empleado se motive a seguir en departamento de venta
Segundo Punto
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.
datos_creditos = read_excel("C:/DatosR/Metodos2/Datos_Creditos.xlsx")
datos_creditos$DEFAULT <- ifelse(datos_creditos$DEFAULT == 1, "Si", "No")
datos_creditos## # A tibble: 780 × 5
## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 Si 37.3 77.0 3020519 8155593
## 2 Si 37.3 73.8 1766552 6181263
## 3 Si 31.0 78.9 1673786 4328075
## 4 Si 9.73 51.5 668479 5290910
## 5 Si 8.44 39.0 1223559 5333818
## 6 Si 6.61 44.9 3517756 2710736
## 7 Si 10.7 58.0 1304790 3169775
## 8 Si 12.8 56.7 2095525 4799180
## 9 Si 7.16 53.7 204865 2243815
## 10 Si 19.9 51.0 1667409 5633822
## # … with 770 more rows
## # ℹ Use `print(n = ...)` to see more rowstable(datos_creditos$DEFAULT)##
## No Si
## 741 39prop.table(table(datos_creditos$DEFAULT)) %>% round(digits = 2)##
## No Si
## 0.95 0.05Anlisis de variables
library(GGally)
library(dplyr)
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 mulicolinealidad entre las variables y verse afectado el 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 utilizando la función step(), el modelo eligirá eliminará las variables que no aporten a la solución.
Modelo de Regresión Logístico Multiple - 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 modejo ajustado, se observa que se elimina la variable EDAD, ademas, se nota que ahora la variable antiguedad tiene poca significancia en el modelo.
Se puede decir tambien 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 antiguedad, entre mas antiguedad 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("green3", "red2", "red2", "green3"), 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="blue")
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 negativo