Modelo de Regresión Logiística binomial
Actividad 3 Problema: Rotación de cargo
En una organización, se busca comprender y prever los factores que influyen en la rotación de empleados entre distintos cargos. La empresa ha recopilado datos históricos sobre el empleo de sus trabajadores, incluyendo variables como la antigüedad en el cargo actual, el nivel de satisfacción laboral, el salario actual, edad y otros factores relevantes. La gerencia planea desarrollar un modelo de regresión logística que permita estimar la probabilidad de que un empleado cambie de cargo en el próximo período y determinar cuales factores indicen en mayor proporción a estos cambios.
Con esta información, la empresa podrá tomar medidas proactivas para retener a su talento clave, identificar áreas de mejora en la gestión de recursos humanos y fomentar un ambiente laboral más estable y tranquilo. La predicción de la probabilidad de rotación de empleados ayudará a la empresa a tomar decisiones estratégicas informadas y a mantener un equipo de trabajo comprometido y satisfecho en sus roles actuales.
En primer lugar hacemos el cargue de los datos y el analisix exploratorio de los mismos
#install.packages("devtools")
#devtools::install_github("centromagis/paqueteMODELOS", force =TRUE)
library(paqueteMODELOS)
## Cargando paquete requerido: boot
## Cargando paquete requerido: broom
## Cargando paquete requerido: GGally
## Cargando paquete requerido: ggplot2
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
## Cargando paquete requerido: gridExtra
## Cargando paquete requerido: knitr
## Cargando paquete requerido: summarytools
data("rotacion")
str(rotacion)
## 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 ...
summary(rotacion)
## 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.000
Evidenciamos que trabajamos con un DF de 24 variables con 1469 datos, de los cuales tenemos 7 variables categorias y el resto cuantitativas, donde la poblacion se encuentra con edades entre los 18 y 60 años, con un rendimiento laboral estable y constante.
Nota: Debes justificar porque estas variables están relacionadas y que tipo de relación se espera entre ellas (Hipótesis).
Rta:
Variables Categoricas:
Departamento: en la mayoria de las industrias un area o departamento de la empresa supera a los demas en rotacion. Se parte del supuesto que los trabajadores del area comercial tengan mayor rotacion
Estado Civil: el estado civil de las personas condiciona temas como viajes y desciciones que fecten una rutina del trabajado, por esto se parte del supuesto que los trabajadores solteros tengan mayor rotacion
Genero: el genero puede determinar alguna variacion en la rotacion de los trabajadores, se espera que los hombres tengan mayor rotacion que las mujeres
Variables Cuantativas:
Edad: aunque la edad perse puede ser no determiante de la rotacion laboral, en combinacion con otras variables si puede ser determinante para aumentar la rotacion laboral. Se parte del suspuesto que menor edad mayor rotacion
Ingreso mensual: el salario es la principal razon por la que se trabaja y uno de los mayores incentivo, por lo tanto se parte del supuesto que a mayor salario menor rotacion
Años Experiencia: los trabajadores con mas años de experiencia tienden a conocer muy bien su funcion y ser valoradorados por ello, asi mismo sostienen relaciones mas solidas y fraternas con sus compañeros y buscan estabilidad laboral por esto se espera que los trabajadores con mas años de experiencia tengan mayor tiempo en sus trabajos
Rta:
En primer lugar cargamos libreria
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::combine() masks gridExtra::combine()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ tibble::view() masks summarytools::view()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
Procedemos con la grafica univariada
Departamento:
ggplot(rotacion, aes(x = rotacion$Departamento)) +
geom_bar() +
labs(x = "Area", y = "Número de observaciones")
## Warning: Use of `rotacion$Departamento` is discouraged.
## ℹ Use `Departamento` instead.
Estado Civil
ggplot(rotacion, aes(x = rotacion$Estado_Civil)) +
geom_bar() +
labs(x = "Estado Civil", y = "Número de observaciones")
## Warning: Use of `rotacion$Estado_Civil` is discouraged.
## ℹ Use `Estado_Civil` instead.
Genero:
ggplot(rotacion, aes(x = rotacion$Genero)) +
geom_bar() +
labs(x = "Genero", y = "Número de observaciones")
## Warning: Use of `rotacion$Genero` is discouraged.
## ℹ Use `Genero` instead.
Edad:
ggplot(rotacion, aes(x = rotacion$Edad)) +
geom_bar() +
labs(x = "Edad", y = "Número de observaciones")
## Warning: Use of `rotacion$Edad` is discouraged.
## ℹ Use `Edad` instead.
Años de Experiencia
ggplot(rotacion, aes(x = rotacion$Años_Experiencia)) +
geom_bar() +
labs(x = "Años de Experiencia", y = "Número de observaciones")
## Warning: Use of `rotacion$Años_Experiencia` is discouraged.
## ℹ Use `Años_Experiencia` instead.
Ingresos:
ggplot(rotacion, aes(x = rotacion$Ingreso_Mensual)) +
geom_bar() +
labs(x = "Ingreso", y = "Número de observaciones")
## Warning: Use of `rotacion$Ingreso_Mensual` is discouraged.
## ℹ Use `Ingreso_Mensual` instead.
x1 <- table(rotacion$Rotación,rotacion$Genero)
barplot( x1, col = rainbow(4), legend.text = rownames(rotacion$Rotación),
main = "Rotacion por Genero")
El grafico anterior nos permite evidenciar que porcentualmente tanto hombres como mujeres rotan del trabajo muy similar.
Ahora revisamos la segunda variable seleccionada:
x2 <- table(rotacion$Rotación,rotacion$Departamento)
barplot( x2, col = rainbow(4), legend.text = rownames(rotacion$Rotación),
main = "Rotacion por Area")
El grafico anterior nos permite evidenciar que el area donde mas
rotacion se presenta es en el area de IyD y en Ventas, confirmando la
hipotesis de la alta rotacion en areas comerciales.
Tercera variable seleccionada:
x4 <- table(rotacion$Rotación,rotacion$Estado_Civil)
barplot( x4, col = rainbow(4), legend.text = rownames(rotacion$Rotación),
ylab = "Cantidad de personas",
main = "Rotacion por Estado Civil")
El analisis de la variable 3 nos permite evidenciar que el estado civil
que mayor rotacion presenta es en los trabajadores solteros.
Analisis Variables cuantitativas:
#install.packages("CGPfunctions")
#library(CGPfunctions)
library(plotly)
##
## Adjuntando el paquete: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(purrr)
library(tidyselect)
x4 <- table(rotacion$Rotación,rotacion$Edad)
prop.table(x4)
##
## 18 19 20 21 22 23
## No 0.002721088 0.002040816 0.003401361 0.004761905 0.007482993 0.006802721
## Si 0.002721088 0.004081633 0.004081633 0.004081633 0.003401361 0.002721088
##
## 24 25 26 27 28 29
## No 0.012925170 0.013605442 0.018367347 0.030612245 0.023129252 0.034013605
## Si 0.004761905 0.004081633 0.008163265 0.002040816 0.009523810 0.012244898
##
## 30 31 32 33 34 35
## No 0.034693878 0.034693878 0.034013605 0.031292517 0.046258503 0.046258503
## Si 0.006122449 0.012244898 0.007482993 0.008163265 0.006122449 0.006802721
##
## 36 37 38 39 40 41
## No 0.042857143 0.029931973 0.038095238 0.024489796 0.035374150 0.023129252
## Si 0.004081633 0.004081633 0.001360544 0.004081633 0.003401361 0.004081633
##
## 42 43 44 45 46 47
## No 0.029931973 0.020408163 0.017687075 0.027210884 0.019727891 0.014285714
## Si 0.001360544 0.001360544 0.004081633 0.001360544 0.002721088 0.002040816
##
## 48 49 50 51 52 53
## No 0.011564626 0.014965986 0.017006803 0.011564626 0.010204082 0.011564626
## Si 0.001360544 0.001360544 0.003401361 0.001360544 0.002040816 0.001360544
##
## 54 55 56 57 58 59
## No 0.012244898 0.012925170 0.007482993 0.002721088 0.006122449 0.006802721
## Si 0.000000000 0.002040816 0.002040816 0.000000000 0.003401361 0.000000000
##
## 60
## No 0.003401361
## Si 0.000000000
prop.table(x4, 2)
##
## 18 19 20 21 22 23
## No 0.50000000 0.33333333 0.45454545 0.53846154 0.68750000 0.71428571
## Si 0.50000000 0.66666667 0.54545455 0.46153846 0.31250000 0.28571429
##
## 24 25 26 27 28 29
## No 0.73076923 0.76923077 0.69230769 0.93750000 0.70833333 0.73529412
## Si 0.26923077 0.23076923 0.30769231 0.06250000 0.29166667 0.26470588
##
## 30 31 32 33 34 35
## No 0.85000000 0.73913043 0.81967213 0.79310345 0.88311688 0.87179487
## Si 0.15000000 0.26086957 0.18032787 0.20689655 0.11688312 0.12820513
##
## 36 37 38 39 40 41
## No 0.91304348 0.88000000 0.96551724 0.85714286 0.91228070 0.85000000
## Si 0.08695652 0.12000000 0.03448276 0.14285714 0.08771930 0.15000000
##
## 42 43 44 45 46 47
## No 0.95652174 0.93750000 0.81250000 0.95238095 0.87878788 0.87500000
## Si 0.04347826 0.06250000 0.18750000 0.04761905 0.12121212 0.12500000
##
## 48 49 50 51 52 53
## No 0.89473684 0.91666667 0.83333333 0.89473684 0.83333333 0.89473684
## Si 0.10526316 0.08333333 0.16666667 0.10526316 0.16666667 0.10526316
##
## 54 55 56 57 58 59
## No 1.00000000 0.86363636 0.78571429 1.00000000 0.64285714 1.00000000
## Si 0.00000000 0.13636364 0.21428571 0.00000000 0.35714286 0.00000000
##
## 60
## No 1.00000000
## Si 0.00000000
x4_porc <- prop.table(x4, 2)
barplot(x4_porc*100, main = "Rotacion por edad",
xlab = "Edades",
ylab = "Frecuencias",
legend = T)
Con lo que evidenciamos que la rotacion mas alta se presenta en las
edades mas bajas
Ahora revisamos ingresos mensuales:
x5 <- rotacion
x5$Rotacion=as.numeric(x5$Rotación=="Si")
x5$Ing_agru=cut(x5$Ingreso_Mensual,breaks = c(1000,4000,8000,12000,16000,20000))
x5 <- table(x5$Rotación,x5$Ing_agru)
prop.table(x5)
##
## (1e+03,4e+03] (4e+03,8e+03] (8e+03,1.2e+04] (1.2e+04,1.6e+04]
## No 0.276190476 0.330612245 0.106802721 0.042857143
## Si 0.093197279 0.040816327 0.019727891 0.004081633
##
## (1.6e+04,2e+04]
## No 0.082312925
## Si 0.003401361
prop.table(x5, 2)
##
## (1e+03,4e+03] (4e+03,8e+03] (8e+03,1.2e+04] (1.2e+04,1.6e+04]
## No 0.74769797 0.89010989 0.84408602 0.91304348
## Si 0.25230203 0.10989011 0.15591398 0.08695652
##
## (1.6e+04,2e+04]
## No 0.96031746
## Si 0.03968254
x5_porc <- prop.table(x5, 2)
barplot(x5_porc*100, main = "Rotacion por Ingresos",
xlab = "Ingresos",
ylab = "Frecuencias",
legend = T)
Aca podemos comprobar que los ingresos mas bajos son los que tiene mayor rotacion
y finalmente revisamos la rotacion de en funcion de los años de experiencia:
x6 <- table(rotacion$Rotación,rotacion$Años_Experiencia)
prop.table(x6)
##
## 0 1 2 3 4
## No 0.0040816327 0.0278911565 0.0149659864 0.0224489796 0.0346938776
## Si 0.0034013605 0.0272108844 0.0061224490 0.0061224490 0.0081632653
##
## 5 6 7 8 9
## No 0.0489795918 0.0700680272 0.0428571429 0.0591836735 0.0585034014
## Si 0.0108843537 0.0149659864 0.0122448980 0.0108843537 0.0068027211
##
## 10 11 12 13 14
## No 0.1204081633 0.0197278912 0.0292517007 0.0224489796 0.0183673469
## Si 0.0170068027 0.0047619048 0.0034013605 0.0020408163 0.0027210884
##
## 15 16 17 18 19
## No 0.0238095238 0.0231292517 0.0204081633 0.0156462585 0.0129251701
## Si 0.0034013605 0.0020408163 0.0020408163 0.0027210884 0.0020408163
##
## 20 21 22 23 24
## No 0.0190476190 0.0224489796 0.0129251701 0.0136054422 0.0102040816
## Si 0.0013605442 0.0006802721 0.0013605442 0.0013605442 0.0020408163
##
## 25 26 27 28 29
## No 0.0088435374 0.0088435374 0.0047619048 0.0088435374 0.0068027211
## Si 0.0006802721 0.0006802721 0.0000000000 0.0006802721 0.0000000000
##
## 30 31 32 33 34
## No 0.0047619048 0.0054421769 0.0061224490 0.0040816327 0.0027210884
## Si 0.0000000000 0.0006802721 0.0000000000 0.0006802721 0.0006802721
##
## 35 36 37 38 40
## No 0.0020408163 0.0040816327 0.0027210884 0.0006802721 0.0000000000
## Si 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0013605442
prop.table(x6, 2)
##
## 0 1 2 3 4 5
## No 0.54545455 0.50617284 0.70967742 0.78571429 0.80952381 0.81818182
## Si 0.45454545 0.49382716 0.29032258 0.21428571 0.19047619 0.18181818
##
## 6 7 8 9 10 11
## No 0.82400000 0.77777778 0.84466019 0.89583333 0.87623762 0.80555556
## Si 0.17600000 0.22222222 0.15533981 0.10416667 0.12376238 0.19444444
##
## 12 13 14 15 16 17
## No 0.89583333 0.91666667 0.87096774 0.87500000 0.91891892 0.90909091
## Si 0.10416667 0.08333333 0.12903226 0.12500000 0.08108108 0.09090909
##
## 18 19 20 21 22 23
## No 0.85185185 0.86363636 0.93333333 0.97058824 0.90476190 0.90909091
## Si 0.14814815 0.13636364 0.06666667 0.02941176 0.09523810 0.09090909
##
## 24 25 26 27 28 29
## No 0.83333333 0.92857143 0.92857143 1.00000000 0.92857143 1.00000000
## Si 0.16666667 0.07142857 0.07142857 0.00000000 0.07142857 0.00000000
##
## 30 31 32 33 34 35
## No 1.00000000 0.88888889 1.00000000 0.85714286 0.80000000 1.00000000
## Si 0.00000000 0.11111111 0.00000000 0.14285714 0.20000000 0.00000000
##
## 36 37 38 40
## No 1.00000000 1.00000000 1.00000000 0.00000000
## Si 0.00000000 0.00000000 0.00000000 1.00000000
x6_porc <- prop.table(x6, 2)
barplot(x6_porc*100, main = "Rotacion Segun Años de Experencia",
xlab = "Años Exp",
ylab = "Frecuencias",
legend = T)
De igual manera se comprueba que a menos años de experiencia hay mayor rotacion.
colnames(rotacion)[3] <- "Viaje_de_Negocios"
Data_train <- nrow(rotacion)*0.7
Data_test <- nrow(rotacion)*0.3
set.seed(123)
index_train<-sample(1:nrow(rotacion),size = Data_train)
train<-rotacion[index_train,] # muestra de entrenamiento
test<-rotacion[-index_train,] # muestra de prueba
Estimacion del modelo
rotacion$Rotación=as.numeric(rotacion$Rotación=="Si")
str(rotacion)
## tibble [1,470 × 24] (S3: tbl_df/tbl/data.frame)
## $ Rotación : num [1:1470] 1 0 1 0 0 0 0 0 0 0 ...
## $ 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 ...
model1 = glm(Rotación~Estado_Civil+Departamento+Genero+Edad+Años_Experiencia+Ingreso_Mensual,data = rotacion,family = "binomial")
summary(model1)
##
## Call:
## glm(formula = Rotación ~ Estado_Civil + Departamento + Genero +
## Edad + Años_Experiencia + Ingreso_Mensual, family = "binomial",
## data = rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.111e-01 3.685e-01 -2.473 0.013408 *
## Estado_CivilDivorciado -2.284e-01 2.210e-01 -1.033 0.301529
## Estado_CivilSoltero 7.912e-01 1.624e-01 4.871 1.11e-06 ***
## DepartamentoRH 5.413e-01 3.473e-01 1.559 0.119071
## DepartamentoVentas 5.588e-01 1.598e-01 3.497 0.000471 ***
## GeneroM 1.806e-01 1.529e-01 1.181 0.237624
## Edad -1.789e-02 1.112e-02 -1.609 0.107625
## Años_Experiencia -2.193e-02 1.972e-02 -1.112 0.265994
## Ingreso_Mensual -8.479e-05 3.144e-05 -2.697 0.006994 **
## ---
## 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: 1190.4 on 1461 degrees of freedom
## AIC: 1208.4
##
## Number of Fisher Scoring iterations: 5
Analisis del modelo:
Analizando las variables del modelo eoncontramos:
Estado Civil: los estimadores indican que la condicion Divorciado no es una condicion determinante en la rotacion en el trabajo sin embargo los estimadores positivos para estado civil Soltero al igual que una p-value de 4.87 nos indican la probabilidad mas alta que se presente rotacion dada una hipótesis nula cierta, lo que confirma nuestro supuesto inicial.
Departamento o Area donde trabaja: tanto las personas que trabajan en el area de RH y Ventas los estimadores son positivos, sin embargo la probabilidad que se presente rotacion es mayor en las personas del area de ventas 3.49 casi tres veces superior a las personas del area de RH 1.55, lo que confirma nuestro supuesto inicial.
Genero: tanto hombres como mujeres tiene probabilidades similares sin embargo la rotacion es mayor por en valores absolutos por el mayor numero de trabajadores hombres, lo que no confirma del todo nuestro supuesto inicial.
Edad: los estimadores de la variable edad son negativos y es estadisticamente significativo p-value < 0.05 que nos indican a mayor edad del trabajador menor es la probabilidad de rotacion,lo cual nos indica que nuestra hiposis planteada incialmente es cierta.
Años de experiencia: los estimadores de en la variable experiencia son negativos al igual que el p-value < 0.05 nos indican que a mayor experiencia se reduce la probabilidad de rotacion,lo cual nos indica que nuestra hiposis planteada incialmente es cierta.
Ingreso Mensual: el estimador es negativo pero la p-value < 0.05 demuestra que lso trabajadores mejor remunerados tienen menor probabilidad de rotacion en sus trabajos,lo cual nos indica que nuestra hiposis planteada incialmente es cierta.
Para ver la probabilidad de de cada variable convertimos en exponenciales los coeficientes de nuestro modelo, de esta manera podemos analizar en funcion de la probabilidad.
Probabilidad_Rot = exp(model1$coefficients)/(exp(model1$coefficients) +1)
Probabilidad_Rot
## (Intercept) Estado_CivilDivorciado Estado_CivilSoltero
## 0.2867696 0.4431520 0.6880849
## DepartamentoRH DepartamentoVentas GeneroM
## 0.6321116 0.6361857 0.5450195
## Edad Años_Experiencia Ingreso_Mensual
## 0.4955279 0.4945178 0.4999788
Interpretacion de probabilidades:
Estado Civil: las personas soltera tienen una probabilidad de 0.68 de probabilidad de rotar en sus trabajos cuando las demas variables variables son constantes
Departamento o area: las personas del area de ventas tiene una probabilidad de 0.63 de rotar en sus trabajos, sin embargo no esta muy alejado de las personas que trabajan en el area de RH, en contraparte las peronas del area de IyD son las que menor probabilidad de rotacion tienen.
Genero: las personas Hombres tienen una probabilidad de 0.54 de rotar en sus trabajos cuando todas las demás variables se mantienen constantes.
Edad: las personas de menor edad tiene una probabilidad de 0.49 de rotar cuando todas las demás variables se mantienen constantes.
Años de Experiencia: tienen una probabilidad de 0.49 de éxito cuando todas las demás variables se mantienen constantes.
Ingreso Mensual: tienen una probabilidad de 0.49 de éxito cuando todas las demás variables se mantienen constantes.
valor_pronosticado <- predict(model1,test,type = "response")
niveles_pronosticados <- ifelse(valor_pronosticado >0.5, "Si","No") %>%
factor(.)
prediccion1= predict(model1,list( Departamento=rotacion$Departamento, Estado_Civil=rotacion$Estado_Civil, Genero = rotacion$Genero, Edad = rotacion$Edad, Ingreso_Mensual = rotacion$Ingreso_Mensual, Años_Experiencia = rotacion$Años_Experiencia ),type = "response")
#install.packages("pROC")
#library(pROC)
#curva_ROC <- roc(test$Rotación, valor_pronosticado)
#auc<- round(auc(curva_ROC, levels =c(0,1), direction = "<"),4) # 0.9177
#plot(curva_ROC,print.auc=T,print.thres = "best",col="red"
# ,xlab = "Specificity", ylab = "Sensitivity")
El modelo nos arrojo un AUC del 66.1%, lo que indica que el modelo tiene un rendimiento moderado para determinar los empleados que tienen una probabilidad alta de rotación, en otras palabras el un valor predictivo moderado para distinguir entre las dos categorías de la variable dependiente, puesto que es mayor a 0.5, el cual es el escenario que indica que las predicciones son aleatorias. El modelo tiene un intervalo de confianza del 95% indica que existe una alta probabilidad de que el verdadero AUC esté entre el 61% y el 68%.
En primer lugar para establecer la estrategia se determinara cuales son las caracteristicas del trabajador con mayor probabilidad de rotar basados en el punto 3 que trabajamos en nuestro modelo, de esta manera encontramos que una persona hombre, soltero, del area de ventas, con edad menor a 33 años con ingresos bajos o medios y experiencia menor a 8 años tiene la probabilidad mayor de rotar.
Una vez identificadas las caracteristicas de los trabajadores con mayor rotacion descartamos las caracteristicas sobre las cuales no es posible hacer algun plan como lo son el genero, el estado civil y la edad y planteamos las siguientes estrategias:
I. Un plan de insentivo por desempeño para retener a trabajadores con bajos o medios salarios pero con buen desempeño
Plan de rotacion entre areas: promover que los trabajadores tengan encargos o rotacion por diferentes areas con el fin que puedan conocer mas a fondo la organizacion en especial para el equipo de comercial.
Reconocimiento por aniversario, que implique que a mas años en la organizacion y con buen desepeño pueda recibir alguna bonificacion economica o en tiempo para su disfrute.
Plan carrera: establecer cuales son los trabajadores que tiene potencial y establer su perfil y preferencias para trazar plan carrera