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.

  1. Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación.

Nota: Debes justificar porque estas variables están relacionadas y que tipo de relación se espera entre ellas (Hipótesis).

Rta:

Variables Categoricas:

Variables Cuantativas:

  1. Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion.

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.

  1. Realiza un análisis de bivariado en donde la variable respuesta sea rotacion 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.
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.

  1. Realice una partición en los datos de forma aleatoria donde 70% sea un set para entrenar el modelo y 30% para prueba. Estime un modelo logístico con la muestra del 70%. Muestre los resultados.
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:

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:

valor_pronosticado <- predict(model1,test,type = "response")
niveles_pronosticados <- ifelse(valor_pronosticado >0.5, "Si","No") %>%
factor(.)
  1. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC en el set de datos de prueba.
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%.

  1. En las conclusiones adicione una discución sobre cuál sería la estrategia para disminuir la rotación en la empresa (con base en las variables que resultaron significativas en el punto 3).

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

  1. 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.

  2. 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.

  3. Plan carrera: establecer cuales son los trabajadores que tiene potencial y establer su perfil y preferencias para trazar plan carrera