EJEMPLO REGRESIÓN LOGÍSTICA
Julieth Cerón
02/05/2023
La idea con este ejemplo es que puedan intentar entenderlo y resolver los apartados donde dice “TAREA”. En la sustentación deberán explicar lo que entendieron de este ejemplo para regresión logística.
library(readxl)
library(stats)
library(summarytools)
library(forcats)
require(ggplot2)
require(ggpubr)
require(CGPfunctions)
require(plotly)
library(caTools)
library(car)
library(vcd)
library(ROCR)
library(GGally)
library(dplyr)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:
Datos = read_excel("D:/Datos_Rotación.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"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.
TAREA: Justificar las siguientes variables y plantear hipótesis respectivas
2. Viaje de negocios:
H2:
3. Departamento:
H3:
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.
TAREA:Terminar de justificar y plantear hipótesis
5. Años a cargo con el mismo jefe:
H5:
6. Años de experiencia:
H6: .
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.
TAREA En la gráfica B se evidencia que…..
TAREA En la gráfica C se evidencia que …..
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.00TAREA En la gráfica E y con la estadística descriptiva para la “Años_acargo_con_mismo_jefe” se evidencia que……
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.00TAREA En la gráfica F y con la estadística descriptiva para los “Años_Experiencia” se evidencia que…
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 26% rotaron), seguido de los “Casados” (el 12% rotaron) y por último los “Divorciado” (el 10% 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%)
## ------------------- ---------- -------------- ------------- ---------------TAREA De acuerdo con el Viaje_de_Negocios, se puede decir que….
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%)
## -------------- ---------- -------------- ------------- ---------------TAREA De acuerdo con el Departamento, se puede decir que….
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 )TAREA De acuerdo con el Años_acargo_con_mismo_jefe, se evidencia que ……
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 )TAREA De acuerdo con el Años_Experiencia, se evidencia que….
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
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.9928674Segú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.
Ahora, 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 |
TAREA: A partir de los resultados de análisis ANOVA, podemos identificar que….(DEBEN BUSCAR COMO INTERPRETAR ESTE TEST ANOVA PARA EVALUAR SIGNIFICANCIA DE VARIABLES).
Pregunta 5. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
TAREA: BUSCAR COMO INTERPRETAR ROC Y AUC Y PARA QUE SIRVEN
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.
TAREA: RESOLVER EL PUNTO 7: 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).
By Julieth Cerón
2022