TALLER DE SIMULACION ESTADISTICA EN R
Alumno: Oscar Andres Ramirez Avendaño
codigo: 1118863919
Maestria en Ciencia de datos
Pontificia Universidad Javeriana
Primer Punto
###tinytex::install_tinytex()
library(readxl)
library(ggplot2)
require(ggpubr)
library(dplyr)
library(knitr)
library(CGPfunctions)
library(plotly)
library(pROC)
## Warning: package 'pROC' was built under R version 4.1.3
library(data.table)
library(tidyr)
datos = read_excel("Datos_Rotacion.xlsx")
names(datos)
## [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"
Se escogieron las Siguientes Variables:
Categoricas:
1)Satisfaccion Laboral
Hipotesis 1 : Se espera que las personas con el indice de satisfaccion laboral mas bajo sean las que mas tienden a rotar, debido a que no se encuentran satisfechas con las labores en las cuales se desempeñan, por lo cual deciden partir a otra empresa o a otros cargos en donde se sientan satisfechos con lo que realizan y de esta manera mejorar su nivel de satisfaccion.
2)Satisfaccion Ambiental
Hipotesis 2 : Se espera que las personas con el indice de satisfaccion ambiental mas bajo, sean las que presenten el mayor porcentaje de rotacion, debido a que los empleados valoran mucho el ambiente en el que se desenvuelven, debido a que la mayor parte del tiempo la pasan en el trabajo y no es agradable laborar en un lugar donde se maneje un mal ambiente.
3)Equilibrio Trabajo vs Vida
Hipotesis 3: Se espera que las personas con el indice de Equilibrio Trabajo-Vida mas bajo sean las que tienden a rotar, debido a que la tendencia de la sociedad es emigrar a empleos donde obtengan un buen equilibrio con su vida personal, es decir; que apesar de que tienen un empleo, pueden realizar las demas actividades o hobbies que disfrutan, como por ejemplo: Practicar un deporte, Tocar un instrumento, Viajar con la familia, etc.
Estas variables pese a que se evaluan en una escala de 1 a 4, se consideran categoricas ya que permiten categorizar la variable a evaluar, donde 1 es lo mas desfavorable y 4 lo mas favorable.
Cuantitativas:
4)Porcentaje aumento salarial
Hipotesis 4: Se espera que las personas con el porcentaje de aumento salarial mas bajo sean las que mas tienden a rotar, debido a que, al no tener un buen aumento salarial, se encuentran desmotivadas y tienden a buscar otras opciones.
5)Horas Extras
Hipotesis 4: Se espera que las personas que trabajan horas sean tengan un alto nivel de rotacion ya que las dedicarle mas tiempo al trabajo, los obliga a disminuir el tiempo para su vida personal y de esta manera disminuye el equilibrio laboral-personal.
6)Antiguedad en el cargo
Hipotesis 6: Se espera que las personas con el mayor numero de años en el cargo sean las que mas tienden a rotar, debido a que, al tener tantos años realizando en el mismo cargo y realizando las mismas funciones, se sienten en la monotonia de hacer siempre lo mismo y deciden buscar opciones diferentes para variar.
require(ggplot2)
require(ggpubr)
require(CGPfunctions)
require(plotly)
library(readxl)
datos = read_excel("Datos_Rotacion.xlsx")
g1=PlotXTabs2(datos,Satisfación_Laboral,Rotación,plottype = "percent")
g1
tabla1= table(datos$Satisfación_Laboral,datos$Rotación)
prop.table(tabla1,margin = 1)*100
##
## No Si
## 1 77.16263 22.83737
## 2 83.57143 16.42857
## 3 83.48416 16.51584
## 4 88.67102 11.32898
g2=PlotXTabs2(datos,Satisfacción_Ambiental,Rotación,plottype = "percent")
g2
tabla2= table(datos$Satisfacción_Ambiental,datos$Rotación)
prop.table(tabla2,margin = 1)*100
##
## No Si
## 1 74.64789 25.35211
## 2 85.01742 14.98258
## 3 86.31347 13.68653
## 4 86.54709 13.45291
g3=PlotXTabs2(datos,Equilibrio_Trabajo_Vida,Rotación,plottype = "percent")
g3
tabla3= table(datos$Equilibrio_Trabajo_Vida,datos$Rotación)
prop.table(tabla3,margin = 1)*100
##
## No Si
## 1 68.75000 31.25000
## 2 83.13953 16.86047
## 3 85.77828 14.22172
## 4 82.35294 17.64706
g4=ggplot(datos,aes(x=Rotación,y=Porcentaje_aumento_salarial,fill=Rotación))+geom_boxplot()+theme_bw()
ggplotly(g4)
tabla5= table(datos$Horas_Extra,datos$Rotación)
tabla5
##
## No Si
## No 944 110
## Si 289 127
prop.table(tabla5,margin = 1)*100
##
## No Si
## No 89.56357 10.43643
## Si 69.47115 30.52885
g6=ggplot(datos,aes(x=Rotación,y=Antigüedad_Cargo,fill=Rotación))+geom_boxplot()+theme_bw()
ggplotly(g6)
paso.3 Realizar un análisis bivariado (siempre contra la rotación). Nota: Los indicadores y gráficos se usan dependiendo del tipo de variable (cuanti VS cuali, cuali VS cuali). Comparar los resultados con la hipótesis planteada inicialmente y determinar si los datos apoyan o no la hipótesis
1)Satisfaccion Laboral
Hipotesis 1 : Mediante el analisis se observa que existe una relacion directa en el indice de satisfaccion laboral y la rotacion, las personas que menor satisfaccion laboral indicaron, fueron las que obtuvieron el porcentaje de rotacion mas alto, ubicandose con un 23 % y a medida que mejoraba el indice de satisfaccion laboral, se disminuia gradualmente el porcentaje de rotacion.
2)Satisfaccion ambiental:
Hipotesis 2 : Mediante el analisis se observa que existe una relacion directa en el indice de ambiente laboral y la rotacion, las personas que menor satisfaccion Ambiental indicaron, fueron las que obtuvieron el porcentaje de rotacion mas alto, ubicandose con un 25 % y a medida que mejoraba el indice de satisfaccion Ambiental, se disminuia gradualmente el porcentaje de rotacion.
3)Equilibrio Trabajo vs Vida
Hipotesis 3: Mediante el analisis se observa que existe una relacionentre en el indice deequilibrio trabajo_Vs_Vida y la rotacion, las personas que menor indice de equilibrio trabajo_Vs_Vida indicaron, fueron las que obtuvieron el porcentaje de rotacion mas alto, ubicandose con un 31 % y a medida que mejoraba el, se disminuia gradualmente el porcentaje de rotacion, a diferencia de las personas que evaluaron con el mejor indice (4) el equilibrio trabajo_Vs_Vida que presentaron un leve incremento en el indice de rotacion vs los que indicaron nivel 2 y 3 .
Cuantitativas:
4)Porcentaje aumento salarial
Hipotesis 4: No se encontro una relacion clara entre el porcentaje de aumento salarial y el indice de rotacion.
5)Horas Extras
Hipotesis 4: mediante el analisis se observa que las personas que trabajan horas tienen un alto nivel de rotacion (30%) vs un indice del (10%) de las personas que rotaron y no realizaban horas extras, ya que las dedicarle mas tiempo al trabajo, los obliga a disminuir el tiempo para su vida personal y de esta manera disminuye el equilibrio laboral-personal.
6)Antiguedad en el cargo
Hipotesis 6: Mediante el analisis se observa que la hipotesis no es valida y que por el contrario las personas con menor tiempo de antiguedad en el cargo son las que mas tienden a rotar.
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_modelo = data.frame(datos[,1], datos[,8], datos[,11], datos[,15], datos[,13], datos[,16], datos[,23])
colnames(datos_modelo) = c("Rotacion", "Satisfacción_Ambiental", "Satisfacción_Laboral", "Horas_Extra", "Porcentaje_aumento_salarial", "Equilibrio_Trabajo_Vida", "Antigüedad_Cargo")
names(datos_modelo)
## [1] "Rotacion" "Satisfacción_Ambiental"
## [3] "Satisfacción_Laboral" "Horas_Extra"
## [5] "Porcentaje_aumento_salarial" "Equilibrio_Trabajo_Vida"
## [7] "Antigüedad_Cargo"
datos_modelo$Rotacion = 0
datos_modelo$Rotacion[datos[,1]=="Si"] = 1
datos_modelo$Rotacion <- as.factor(datos_modelo$Rotacion)
datos_modelo$Satisfacción_Ambiental <- as.factor(datos_modelo$Satisfacción_Ambiental)
datos_modelo$Satisfacción_Laboral <- as.factor(datos_modelo$Satisfacción_Laboral)
datos_modelo$Equilibrio_Trabajo_Vida <- as.factor(datos_modelo$Equilibrio_Trabajo_Vida)
modelo_rotacion=glm(Rotacion~Satisfacción_Ambiental+Satisfacción_Laboral+Horas_Extra + Porcentaje_aumento_salarial + Equilibrio_Trabajo_Vida + Antigüedad_Cargo,data = datos_modelo,family = "binomial"(link="logit"))
summary(modelo_rotacion)
##
## Call:
## glm(formula = Rotacion ~ Satisfacción_Ambiental + Satisfacción_Laboral +
## Horas_Extra + Porcentaje_aumento_salarial + Equilibrio_Trabajo_Vida +
## Antigüedad_Cargo, family = binomial(link = "logit"), data = datos_modelo)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8484 -0.5773 -0.4150 -0.2479 2.8058
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.949e-01 3.105e-01 0.628 0.530325
## Satisfacción_Ambiental2 -9.078e-01 2.353e-01 -3.859 0.000114 ***
## Satisfacción_Ambiental3 -1.042e+00 2.136e-01 -4.878 1.07e-06 ***
## Satisfacción_Ambiental4 -1.168e+00 2.180e-01 -5.357 8.45e-08 ***
## Satisfacción_Laboral2 -4.313e-01 2.351e-01 -1.834 0.066602 .
## Satisfacción_Laboral3 -4.747e-01 2.094e-01 -2.266 0.023423 *
## Satisfacción_Laboral4 -1.017e+00 2.227e-01 -4.565 4.99e-06 ***
## Horas_ExtraSi 1.561e+00 1.605e-01 9.730 < 2e-16 ***
## Porcentaje_aumento_salarial -1.588e-04 2.475e-05 -6.413 1.42e-10 ***
## Equilibrio_Trabajo_Vida12 -2.837e-01 2.804e-01 -1.012 0.311664
## Equilibrio_Trabajo_Vida13 -4.118e-01 2.796e-01 -1.473 0.140700
## Equilibrio_Trabajo_Vida14 -6.632e-01 3.044e-01 -2.179 0.029349 *
## Equilibrio_Trabajo_Vida15 3.972e-03 3.412e-01 0.012 0.990712
## Equilibrio_Trabajo_Vida16 -2.345e-01 3.757e-01 -0.624 0.532603
## Equilibrio_Trabajo_Vida17 -5.504e-02 3.691e-01 -0.149 0.881451
## Equilibrio_Trabajo_Vida18 -3.475e-01 3.703e-01 -0.938 0.348049
## Equilibrio_Trabajo_Vida19 -6.653e-01 4.191e-01 -1.587 0.112421
## Equilibrio_Trabajo_Vida20 -8.709e-01 4.725e-01 -1.843 0.065294 .
## Equilibrio_Trabajo_Vida21 -8.206e-01 5.361e-01 -1.531 0.125835
## Equilibrio_Trabajo_Vida22 2.764e-02 4.108e-01 0.067 0.946356
## Equilibrio_Trabajo_Vida23 -8.137e-02 5.607e-01 -0.145 0.884618
## Equilibrio_Trabajo_Vida24 3.351e-01 5.989e-01 0.560 0.575810
## Equilibrio_Trabajo_Vida25 -1.834e+00 1.106e+00 -1.659 0.097194 .
## Antigüedad_Cargo 4.385e-02 2.819e-02 1.556 0.119797
## ---
## 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: 1096.2 on 1446 degrees of freedom
## AIC: 1144.2
##
## Number of Fisher Scoring iterations: 5
Teniendo en cuenta que para los coeficientes podemos validar su signo encontramos que:
Variables que aumentan la probabilidad de rotacion:
Variables que Dismuyen la probabilidad de rotacion:
sig.var<- summary(modelo_rotacion)$coeff[-1,4] < 0.01
names(sig.var)[sig.var == TRUE]
## [1] "Satisfacción_Ambiental2" "Satisfacción_Ambiental3"
## [3] "Satisfacción_Ambiental4" "Satisfacción_Laboral4"
## [5] "Horas_ExtraSi" "Porcentaje_aumento_salarial"
5)Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
modelo_rotacion <- glm(Rotacion ~ Satisfacción_Ambiental+Satisfacción_Laboral+ Horas_Extra + Porcentaje_aumento_salarial, data=datos_modelo, family=binomial(link="logit"))
# Se obtienen las probabilidades predichas para cada clase
datos_significativos <- list(Satisfacción_Ambiental=datos_modelo$Satisfacción_Ambiental
, Satisfacción_Laboral=datos_modelo$Satisfacción_Laboral
, Porcentaje_aumento_salarial=datos$Porcentaje_aumento_salarial
, Horas_Extra=datos_modelo$Horas_Extra
)
predicciones <- predict(object=modelo_rotacion, newdata=datos_significativos, type="response")
# Cálculo de la curva ROC
curva_roc = roc(datos_modelo$Rotacion ~ predicciones, percent=T, ci=T)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
# Gráfico de la curva ROC
plot(curva_roc, print.auc=T, print.thres="best", col="red", xlab="Specificity", ylab="Sensitivity")
auc(curva_roc)
## Area under the curve: 72.19%
reales = ifelse(modelo_rotacion$fitted.values>0.2, yes=1, no=0)
matriz_confusion = table(modelo_rotacion$model$Rotacion, reales,
dnn = c('predicciones', 'reales'))
matriz_confusion
## reales
## predicciones 0 1
## 0 969 264
## 1 95 142
ANALISIS
De acuerdo a los resultados representados en la matriz de confusión, de 1064 observaciones que corresponden a trabajadores que no rotaron en la realidad, el modelo identificó 969 correctamente, mientras que 95 fueron falsos negativos. Por otra parte, de 406 observaciones que efectivamente corresponden a rotaciones de trabajadores, identificó 264 de forma correcta, mientras que 142 fueron falsos positivos.
individuo = datos_modelo[2,]
individuo$Rotacion = 1
individuo$Satisfacción_Ambiental = "3"
individuo$Satisfaccion_Laboral = "3"
individuo$Horas_Extra = "Si"
individuo$Porcentaje_aumento_salarial = 2086
individuo$Equilibrio_Trabajo_Vida = 24
individuo$Antigüedad_Cargo = 8
predict(modelo_rotacion, newdata = individuo, type = "response")
## 2
## 0.4243484
Para un empleado hipotetico que obtuvo un aumento salarial del 20.86 %, que si realice horas extras, con una satisfaccion laboral de grado 3 y Satisfaccion Ambiental de grado 3 tiene una probabilidad de rotación del 42.43 % por lo que no encontramos necesaria una estrategia para intervenir en él
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).
RECOMENDACIONES
Realizar un estudio profundo de las perpceciones de los trabajarores acerca de la satisfaccion laboral y ambiental, mediante una empresa externa experta en el area, como “Great Place To work” para evaluar cuales son los aspectos que mas impactan sobre los empleados y trabajar sobre ellos.
Brindar espacios de integraciones laborales, donde los trabajadores se puedan relacionar entre si para crear un mejor ambiente.
De ser posible dentro de las instalaciones brindar opciones de descanso y diversion, donde los empleados puedan llegar y tomar pausas activas.
Mejorar los beneficios que se les otorgan al empleado: Becas para educacion, auxilios para hijos, bonos de productividad, planes de apoyo al ahorro.
Evaluar el porcentaje de empleados que realizan horas extras y reducir este indicador, si no se da abosto con el personal que se tiene, se debe evaluar la posibilidad de contratar personal adicional para realizar el trabajo sin necesidad de generar trabajos extras sobre los empleados.
se le debe hacer un mayor seguimiento y acompañamiento a los empleados en sus primeros años laborales, para brindarles todo el apoyo que requieran en su proceso de adaptacion.
SEGUNDO PUNTOCon 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:/Users/user/Desktop/Estadistica 2/Datos_Creditos.xlsx")
modelo_creditos <- glm(DEFAULT ~ ., data = Datos_Creditos, family = "binomial")
summary(modelo_creditos)
##
## Call:
## glm(formula = DEFAULT ~ ., 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 ***
## ANTIUEDAD -4.616e-02 2.353e-02 -1.961 0.049849 *
## EDAD 2.229e-02 1.932e-02 1.154 0.248641
## CUOTA_TOTAL 1.013e-06 2.473e-07 4.098 4.16e-05 ***
## INGRESOS -2.615e-07 1.057e-07 -2.474 0.013348 *
## ---
## 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: 6
ANALISIS DE VARIABLES Y COEFICIENTES
Se observa que para el modelo es altamente significativa la variable “Cuota TotAL” y en menor proporcion los “INgresos” y la “antiguedad” por contraparte la Edad no tiene significancia en el modelo.
Variables Aumentan la Probabilidad de Default:
Cuota_Total, es decir que entre mas alta sea la cuota mayor es la probabilidad de entrar en Default.
Variables Disminuyen la Probabilidad de Default:
library(pROC)
library(ROCR)
## Warning: package 'ROCR' was built under R version 4.1.3
creditos_predict = predict.glm(modelo_creditos, newdata = Datos_Creditos, type ="response")
pred = ROCR::prediction(creditos_predict, Datos_Creditos$DEFAULT)
perf = performance(pred, "tpr", "fpr")
ACLog1 = performance(pred, measure = "auc")@y.values[[1]]
ROC <- plot.roc(Datos_Creditos$DEFAULT, creditos_predict,col="red", smooth = FALSE, percent = FALSE, print.auc=TRUE,of="thresholds", thresholds="best", print.thres="best")
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
El modelo presenta un buen manejo predictivo, el area bajo la curva es del 70% lo que da buenos indicios para determinar los clientes rentables o no para la entidad bancaria.