Actividad_3_Modelos.Esta.Toma.Decisiones

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.

1. Selección de variables

Variables Cuantitativas

Se espera que la edad de los trabajadores se relacione con la rotación, ya que se cree que las personas más jóvenes estarán constantemente desarrollando su vida profesional. La hipótesis es que las personas menores a 30 años tienen mayor posibilidad de rotar que las personas mayores a 30 años.

Se cree que el aumento salarial de los trabajadores se relacione directamente con la rotación. La hipótesis es que las personas con menor incremento salarial tenderán a dejar la compañía por un sitio donde puedan percibir un mejor salario.

Se espera que la antigüedad sea una variable importante al momento que un empleado decida continuar en su trabajo. La hipótesis es que las personas con menor antigüedad en la compañía tienen mayor probabilidad de buscar nuevas oportunidades en otras compañías.

Variables cualitativas

Se cree que la satisfacción laboral está directamente relacionada con la rotación, ya que indica que tan a gusto están los empleados en su actual rol. La hipótesis es que las personas con menor satisfacción laboral tenderán a dejar la compañía.

Se espera que el estado civil de las personas este relacionado con la rotación, la hipótesis es que las personas solteras tienen mayor probabilidad de rotar laboralmente.

Por ultimo se cree que el equilibrio de vida esta altamente relacionada con la rotación. La hipótesis es que las personas que expresan tener un equilibrio de vida con su trabajo están menos dispuestas a dejar su actual posición en la compañía.

2. Análisis univariado

library(paqueteMODELOS)

## Loading required package: boot

## Loading required package: broom

## Loading required package: GGally

## Loading required package: ggplot2

## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2

## Loading required package: gridExtra

## Loading required package: knitr

## Loading required package: summarytools

## Warning in fun(libname, pkgname): couldn't connect to display ":0"

## system might not have X11 capabilities; in case of errors when using dfSummary(), set st_options(use.x11 = FALSE)

library(plotly)

## 
## Attaching package: '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

data("rotacion")
data_rotacion<-data.frame(rotacion)

rotacion=select(data_rotacion, Edad,Satisfación_Laboral,Estado_Civil,
                  Porcentaje_aumento_salarial,Equilibrio_Trabajo_Vida,
                  Antigüedad,Rotación)

##Revisión Faltantes

faltantes <- colSums(is.na(rotacion)) %>% # dataframe de faltantes por variable
  as.data.frame()
faltantes

##                             .
## Edad                        0
## Satisfación_Laboral         0
## Estado_Civil                0
## Porcentaje_aumento_salarial 0
## Equilibrio_Trabajo_Vida     0
## Antigüedad                  0
## Rotación                    0

Validar balanceo de la clase

#Validar el balanceo de la clase
prop.table(table(rotacion$Rotación))

## 
##        No        Si 
## 0.8387755 0.1612245

Variable Edad

plot_ly(rotacion, 
        x = ~Edad, 
        type = "histogram",
        marker = list(color = "rgba(55, 128, 191, 0.7)",
                      line = list(color = "rgba(55, 128, 191, 1)", width = 1.5))) %>%
  layout(title = "Distribución de Edad",
         xaxis = list(title = "Edad empleados", 
                      gridcolor = "rgba(200, 200, 200, 0.5)"), 
         yaxis = list(title = "Frecuencia"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")  

De acuerdo al histograma se puede observar una distribución casi normal de la variable Edad.

rotacion %>% 
  plot_ly(y = ~Edad, x = ~"Distribución", type = "box", 
          marker = list(color = "rgba(55, 128, 191, 0.7)"),  
          boxpoints = "all",   
          jitter = 0.3,        
          pointpos = -1.8,    
          line = list(color = "rgba(0, 0, 139, 1)", width = 2)) %>%  
  layout(title = "Edad de empleados",
         xaxis = list(title = "", showgrid = FALSE), 
         yaxis = list(title = "Edad de empleados"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

Por otro lado no se observa datos atipicos en la variable Edad.

Porcentaje aumento salarial

plot_ly(rotacion, 
        x = ~Porcentaje_aumento_salarial, 
        type = "histogram",
        marker = list(color = "rgba(55, 128, 191, 0.7)",
                      line = list(color = "rgba(55, 128, 191, 1)", width = 1.5))) %>%
  layout(title = "Distribución % aumento laboral",
         xaxis = list(title = "% aumento laboral", 
                      gridcolor = "rgba(200, 200, 200, 0.5)"), 
         yaxis = list(title = "Frecuencia"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)") 

El porcentaje del aumento salarial se concentra en valores inferiores al 15%

rotacion %>% 
  plot_ly(y = ~Porcentaje_aumento_salarial, x = ~"Distribución", type = "box", 
          marker = list(color = "rgba(55, 128, 191, 0.7)"),  
          boxpoints = "all",   
          jitter = 0.3,        
          pointpos = -1.8,    
          line = list(color = "rgba(0, 0, 139, 1)", width = 2)) %>%  
  layout(title = "% aumento salarial",
         xaxis = list(title = "", showgrid = FALSE), 
         yaxis = list(title = "% aumento salaria"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

No se evidencia presencia de grandes datos atipicos, apesar de la concentración de % de aumento de los salarios inferiores al 15% Antiguedad

plot_ly(rotacion, 
        x = ~Antigüedad, 
        type = "histogram",
        marker = list(color = "rgba(55, 128, 191, 0.7)",
                      line = list(color = "rgba(55, 128, 191, 1)", width = 1.5))) %>%
  layout(title = "Distribución Antiguedad de empleados",
         xaxis = list(title = "Antiguedad de empleados", 
                      gridcolor = "rgba(200, 200, 200, 0.5)"), 
         yaxis = list(title = "Frecuencia"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

Se observa de acuerdo al histograma que la mayoria de empleados de la compañia tienen una antiguedad entre 0 a 10 años.

rotacion %>% 
  plot_ly(y = ~Antigüedad, x = ~"Distribución", type = "box", 
          marker = list(color = "rgba(55, 128, 191, 0.7)"),  
          boxpoints = "all",   
          jitter = 0.3,        
          pointpos = -1.8,    
          line = list(color = "rgba(0, 0, 139, 1)", width = 2)) %>%  
  layout(title = "Antiguedad",
         xaxis = list(title = "", showgrid = FALSE), 
         yaxis = list(title = "Antiguedad"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

De acuerdo a la distribución de datos, se evidencia algunos datos atipicos los cuales corresponden a empleados con antiguedad mayor a los 20 años.

Estado Civil

plot_ly(rotacion, 
        x = ~Estado_Civil, 
        type = "histogram",
        marker = list(color = "rgba(55, 128, 191, 0.7)",
                      line = list(color = "rgba(55, 128, 191, 1)", width = 1.5))) %>%
  layout(title = "Distribución Estado civil",
         xaxis = list(title = "Estado civil", 
                      gridcolor = "rgba(200, 200, 200, 0.5)"), 
         yaxis = list(title = "Frecuencia"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

fig <- plot_ly(
  data = rotacion,
  labels = ~Estado_Civil,
  type = "pie",
  textinfo = "label+percent",
  marker = list(colors = c("#636EFA", "#EF553B", "#00CC96", "#AB63FA", "#FFA15A")) 
)

# Personalizar el diseño
fig <- fig %>%
  layout(
    title = "Distribución de estado civil empleados",
    showlegend = TRUE
  )

# Mostrar el gráfico
fig

La empresa cuenta dentro de sus empleados con una mayoria con estado civil casado, correspodiente al 46%, mientras que los divorciados son los de menor proporción con un 22%.

Equilibrio de vida

plot_ly(rotacion, 
        x = ~Equilibrio_Trabajo_Vida, 
        type = "histogram",
        marker = list(color = "rgba(55, 128, 191, 0.7)",
                      line = list(color = "rgba(55, 128, 191, 1)", width = 1.5))) %>%
  layout(title = "Distribución Equilibrio de vida empleados",
         xaxis = list(title = "Equilibrio de vida", 
                      gridcolor = "rgba(200, 200, 200, 0.5)"), 
         yaxis = list(title = "Frecuencia"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

fig <- plot_ly(
  data = rotacion,
  labels = ~Equilibrio_Trabajo_Vida,
  type = "pie",
  textinfo = "label+percent",
  marker = list(colors = c("#636EFA", "#EF553B", "#00CC96", "#AB63FA", "#FFA15A")) 
)

# Personalizar el diseño
fig <- fig %>%
  layout(
    title = "Distribución de Equilibrio trabajo y vida",
    showlegend = TRUE
  )

# Mostrar el gráfico
fig

De acuerdo a la variable de equilibrio de vida, se evidencia que la mayoria de los empleados se sienten con una satisfacción media entre su vida laboral y personal con un 66% mientras que el 5.44% indican que su equilibrio entre trabajo y su vida personal es muy baja. es importante investigar porque el 23% de los empleados consideran que esta variable esta percibida como baja y si ella esta condiciona principalmente por elementos atribuidos al ambiente laboral o són externos al mismo, podria hacerse contraste con la variable de satisfación laboral.

Satisfacción Laboral

plot_ly(rotacion, 
        x = ~Satisfación_Laboral, 
        type = "histogram",
        marker = list(color = "rgba(55, 128, 191, 0.7)",
                      line = list(color = "rgba(55, 128, 191, 1)", width = 1.5))) %>%
  layout(title = "Distribución Satisfacción Laboral",
         xaxis = list(title = "Satisfacción Laboral", 
                      gridcolor = "rgba(200, 200, 200, 0.5)"), 
         yaxis = list(title = "Frecuencia"),
         plot_bgcolor = "rgba(240, 240, 240, 0.8)")

fig <- plot_ly(
  data = rotacion,
  labels = ~Satisfación_Laboral,
  type = "pie",
  textinfo = "label+percent",
  marker = list(colors = c("#636EFA", "#EF553B", "#00CC96", "#AB63FA", "#FFA15A")) 
)

# Personalizar el diseño
fig <- fig %>%
  layout(
    title = "Distribución de Satisfacción laboral",
    showlegend = TRUE
  )

# Mostrar el gráfico
fig

En la variable satisfacción Laboral, el 61% de los empleados indican estar satisfechos o muy satisfechos con su trabajo, mientras que el 39% restante indican no estarlo.

de acuerdo a este resultado, junto con el de variable de equilibrio viday trabajo, pueden realizarse proyectos desde el area de bienestar para subir dichas percepciones y validar como esto mejora el comportamiento de la rotación.

3. Análisis bivariado

Edad vs Rotación

plot_ly(rotacion, x = ~Rotación, y = ~Edad, type = "bar", summary = "sum")

## Warning: 'bar' objects don't have these attributes: 'summary'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'base', 'basesrc', 'cliponaxis', 'constraintext', 'customdata', 'customdatasrc', 'dx', 'dy', 'error_x', 'error_y', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetgroup', 'offsetsrc', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'x', 'x0', 'xaxis', 'xcalendar', 'xhoverformat', 'xperiod', 'xperiod0', 'xperiodalignment', 'xsrc', 'y', 'y0', 'yaxis', 'ycalendar', 'yhoverformat', 'yperiod', 'yperiod0', 'yperiodalignment', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

plot_ly(rotacion, x = ~Rotación, y = ~Edad, type = "box")

t_test_result <- t.test(Edad ~ Rotación, data = rotacion, var.equal = TRUE)
print(t_test_result)

## 
##  Two Sample t-test
## 
## data:  Edad by Rotación
## t = 6.1796, df = 1468, p-value = 8.31e-10
## alternative hypothesis: true difference in means between group No and group Si is not equal to 0
## 95 percent confidence interval:
##  2.699188 5.209709
## sample estimates:
## mean in group No mean in group Si 
##         37.56204         33.60759

Hay evidencia estadísticamente significativa de acuerdo al analisis de medias que la edad tiene relación y es explicativa sobre si hay rotación o no en la compañia.

Porcentaje aumento salarial

plot_ly(rotacion, x = ~Rotación, y = ~Porcentaje_aumento_salarial, type = "bar", summary = "sum")

## Warning: 'bar' objects don't have these attributes: 'summary'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'base', 'basesrc', 'cliponaxis', 'constraintext', 'customdata', 'customdatasrc', 'dx', 'dy', 'error_x', 'error_y', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetgroup', 'offsetsrc', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'x', 'x0', 'xaxis', 'xcalendar', 'xhoverformat', 'xperiod', 'xperiod0', 'xperiodalignment', 'xsrc', 'y', 'y0', 'yaxis', 'ycalendar', 'yhoverformat', 'yperiod', 'yperiod0', 'yperiodalignment', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

plot_ly(rotacion, x = ~Rotación, y = ~Porcentaje_aumento_salarial, type = "box")

t_test_result <- t.test(Porcentaje_aumento_salarial ~ Rotación, data = rotacion, var.equal = TRUE)
print(t_test_result)

## 
##  Two Sample t-test
## 
## data:  Porcentaje_aumento_salarial by Rotación
## t = 0.51646, df = 1468, p-value = 0.6056
## alternative hypothesis: true difference in means between group No and group Si is not equal to 0
## 95 percent confidence interval:
##  -0.3752236  0.6434179
## sample estimates:
## mean in group No mean in group Si 
##         15.23114         15.09705

No hay evidencia suficiente para afirmar que existe una diferencia significativa en el aumento salarial entre los empleados que rotaron y los que no rotaron.

Antiguedad

plot_ly(rotacion, x = ~Rotación, y = ~Antigüedad, type = "bar", summary = "sum")

## Warning: 'bar' objects don't have these attributes: 'summary'
## Valid attributes include:
## '_deprecated', 'alignmentgroup', 'base', 'basesrc', 'cliponaxis', 'constraintext', 'customdata', 'customdatasrc', 'dx', 'dy', 'error_x', 'error_y', 'hoverinfo', 'hoverinfosrc', 'hoverlabel', 'hovertemplate', 'hovertemplatesrc', 'hovertext', 'hovertextsrc', 'ids', 'idssrc', 'insidetextanchor', 'insidetextfont', 'legendgroup', 'legendgrouptitle', 'legendrank', 'marker', 'meta', 'metasrc', 'name', 'offset', 'offsetgroup', 'offsetsrc', 'opacity', 'orientation', 'outsidetextfont', 'selected', 'selectedpoints', 'showlegend', 'stream', 'text', 'textangle', 'textfont', 'textposition', 'textpositionsrc', 'textsrc', 'texttemplate', 'texttemplatesrc', 'transforms', 'type', 'uid', 'uirevision', 'unselected', 'visible', 'width', 'widthsrc', 'x', 'x0', 'xaxis', 'xcalendar', 'xhoverformat', 'xperiod', 'xperiod0', 'xperiodalignment', 'xsrc', 'y', 'y0', 'yaxis', 'ycalendar', 'yhoverformat', 'yperiod', 'yperiod0', 'yperiodalignment', 'ysrc', 'key', 'set', 'frame', 'transforms', '_isNestedKey', '_isSimpleKey', '_isGraticule', '_bbox'

plot_ly(rotacion, x = ~Rotación, y = ~Antigüedad, type = "box")

t_test_result <- t.test(Antigüedad ~ Rotación, data = rotacion, var.equal = TRUE)
print(t_test_result)

## 
##  Two Sample t-test
## 
## data:  Antigüedad by Rotación
## t = 5.1963, df = 1468, p-value = 2.319e-07
## alternative hypothesis: true difference in means between group No and group Si is not equal to 0
## 95 percent confidence interval:
##  1.393301 3.083133
## sample estimates:
## mean in group No mean in group Si 
##         7.369019         5.130802

Existe una diferencia estadísticamente significativa entre las medias de los empleados que rotan y los que no, en función de la variable antiguedad. lo cual indica que la antiguedad esta relacionada con la rotación.

Estado Civil

install.packages("ggmosaic")

## Installing package into '/cloud/lib/x86_64-pc-linux-gnu-library/4.4'
## (as 'lib' is unspecified)

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:gridExtra':
## 
##     combine

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggmosaic)

## 
## Attaching package: 'ggmosaic'

## The following object is masked from 'package:GGally':
## 
##     happy

ggplot(data = rotacion) +
  geom_mosaic(aes(x = product(Rotación), fill = Estado_Civil))

## Warning: The `scale_name` argument of `continuous_scale()` is deprecated as of ggplot2
## 3.5.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## Warning: The `trans` argument of `continuous_scale()` is deprecated as of ggplot2 3.5.0.
## ℹ Please use the `transform` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## Warning: `unite_()` was deprecated in tidyr 1.2.0.
## ℹ Please use `unite()` instead.
## ℹ The deprecated feature was likely used in the ggmosaic package.
##   Please report the issue at <https://github.com/haleyjeppson/ggmosaic>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# Agrupar y calcular el porcentaje dentro de cada categoría
df_porcentaje <- rotacion %>%
  group_by(Rotación, Estado_Civil) %>%
  summarise(Conteo = n()) %>%
  mutate(Percent = round((Conteo / sum(Conteo)) * 100, 1)) 

## `summarise()` has grouped output by 'Rotación'. You can override using the
## `.groups` argument.

# Crear gráfico con etiquetas de porcentaje
plot_ly(df_porcentaje, 
        x = ~Rotación, 
        y = ~Conteo, 
        type = "bar", 
        color = ~Estado_Civil, 
        text = ~paste(Percent, "%"), 
        textposition = 'inside')  

library(FactoMineR)
estado_civil <- table(rotacion$Rotación, rotacion$Estado_Civil)
colnames(estado_civil) <- c("Casado", "Divorciado", "Soltero")
estado_civil

##     
##      Casado Divorciado Soltero
##   No    589        294     350
##   Si     84         33     120

chisq.test(estado_civil)

## 
##  Pearson's Chi-squared test
## 
## data:  estado_civil
## X-squared = 46.164, df = 2, p-value = 9.456e-11

Hya evidencia significativa que los 3 grupos de estado civil, se diferencian entre si y tienen relación con la rotación de empleados.

Equilibrio de vida

rotacion_resumen <- rotacion %>%
  group_by(Rotación, Equilibrio_Trabajo_Vida) %>%
  summarise(Conteo = n(), .groups = 'drop')

# Crear la gráfica de barras
plot_ly(rotacion_resumen, 
        x = ~Rotación, 
        y = ~Conteo, 
        type = "bar", 
        color = ~Equilibrio_Trabajo_Vida) 

## Warning: textfont.color doesn't (yet) support data arrays
## Warning: textfont.color doesn't (yet) support data arrays

plot_ly(rotacion, x = ~Rotación, y = ~Equilibrio_Trabajo_Vida, type = "box")

equilibrio_vida <- table(rotacion$Rotación, rotacion$Equilibrio_Trabajo_Vida)
colnames(equilibrio_vida) <- c("1", "2", "3","4")
equilibrio_vida

##     
##        1   2   3   4
##   No  55 286 766 126
##   Si  25  58 127  27

chisq.test(equilibrio_vida)

## 
##  Pearson's Chi-squared test
## 
## data:  equilibrio_vida
## X-squared = 16.325, df = 3, p-value = 0.0009726

De acuerdo al analisis de medias, se puede inferir que la variable equilibrio de vida es explicativa a la rotación de personal

Satisfacción Laboral

rotacion_resumen <- rotacion %>%
  group_by(Rotación, Satisfación_Laboral) %>%
  summarise(Conteo = n(), .groups = 'drop')

# Crear la gráfica de barras
plot_ly(rotacion_resumen, 
        x = ~Rotación, 
        y = ~Conteo, 
        type = "bar", 
        color = ~Satisfación_Laboral) 

## Warning: textfont.color doesn't (yet) support data arrays
## Warning: textfont.color doesn't (yet) support data arrays

plot_ly(rotacion, x = ~Rotación, y = ~Satisfación_Laboral, type = "box")

satisfaccion_laboral <- table(rotacion$Rotación, rotacion$Satisfación_Laboral)
colnames(satisfaccion_laboral) <- c("1", "2", "3","4")
satisfaccion_laboral

##     
##        1   2   3   4
##   No 223 234 369 407
##   Si  66  46  73  52

chisq.test(satisfaccion_laboral)

## 
##  Pearson's Chi-squared test
## 
## data:  satisfaccion_laboral
## X-squared = 17.505, df = 3, p-value = 0.0005563

De acuerdo a la prueba estadistica de diferencia de medias, se puede afirmar que la variable de satisfación laboral esta relacionada con la rotación de personal.

4. Estimación del modelo

# convertir la clase Rotación en númerica
rotacion2 <- rotacion %>%
  mutate(Rotación = ifelse( Rotación== "Si", 1, 0))

# convertir la variable Estado civil en númerica
rotacion2$Estado_Civil <- as.numeric(as.factor(rotacion2$Estado_Civil))

modelo1 <- glm(Rotación ~ Edad + Satisfación_Laboral + Estado_Civil + Porcentaje_aumento_salarial + Equilibrio_Trabajo_Vida+Antigüedad , data = rotacion2, family = binomial(link = "logit"))

summary(modelo1) 

## 
## Call:
## glm(formula = Rotación ~ Edad + Satisfación_Laboral + Estado_Civil + 
##     Porcentaje_aumento_salarial + Equilibrio_Trabajo_Vida + Antigüedad, 
##     family = binomial(link = "logit"), data = rotacion2)
## 
## Coefficients:
##                              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                  0.881248   0.587752   1.499 0.133782    
## Edad                        -0.037431   0.008959  -4.178 2.94e-05 ***
## Satisfación_Laboral         -0.275670   0.065778  -4.191 2.78e-05 ***
## Estado_Civil                 0.409758   0.084675   4.839 1.30e-06 ***
## Porcentaje_aumento_salarial -0.010835   0.020582  -0.526 0.598588    
## Equilibrio_Trabajo_Vida     -0.277331   0.101929  -2.721 0.006512 ** 
## Antigüedad                  -0.060046   0.016711  -3.593 0.000327 ***
## ---
## 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: 1196.1  on 1463  degrees of freedom
## AIC: 1210.1
## 
## Number of Fisher Scoring iterations: 5

Análisis de coeficientes y significancia de los parametros

Edad: En la variable edad (-0.0374, p = 2.94e-05), el coeficiente es negativo, lo que indica que a medida que la edad aumenta, la probabilidad de rotación disminuye. asi mismo se infiere que es estadisticamente muy significativo dado (p < 0.001).tal como lo indico el análisis bivariado.

lo anterior se concluye que un aumento en la edad está asociado con una menor probabilidad de rotación.

Satisfacción Laboral: En la variable Satisfacción Laboral (-0.2757 , p =2.78e-05), el coeficiente es negativo, lo que presume que a medida que la satisfacción aumenta, la probabilidad de rotación baja. por otro lado de acuerdo al valor de p, se infiere que la variable es muy significativa estadisticamente. esto tambien se evidencio en el analisis bivariado.

Estado Civil: Esta variable con valores (0.4098,p = 1.30e-06), el coeficientes es positivo, por lo que se infiere que dado que 3 es el valor mas alto de esta variable y corresponde al valor soltero, las personas solteras tienden a rotar más que las personas casadas o divorciadas. así mismo esta variable es altamente significativa(p < 0.001) confirmando el resultado del análisis bivariado.

Porcentaje Aumento Salarial: El % de aumento salarial(-0.0108, p = 0.599) .Estadisticamente no es significativo tal como se evidencio en el analisis bivariado.

Equilibrio Trabajo-Vida: Esta variable(-0.2773 , p = 0.0065), cuyo coeficiente es negativo, indica que ha mayor percepción de equilibrio entre el trabajo y la vida,reduce la probabilidad de rotación. Estadisticamente es significativo(p < 0.05).

Antiguedad: La antiguedad(-0.0600 , p = 0.0003), indica que a mayor antiguedad de los empleados menor es la probabilidad de rotación. Esta variable es muy significativa(p < 0.001).

5. Evaluación

probabilidades <- predict(modelo1, newdata = rotacion2, type = "response")

# Cargar librerías necesarias
library(caret)  # Para métricas de clasificación

## Loading required package: lattice

## 
## Attaching package: 'lattice'

## The following object is masked from 'package:boot':
## 
##     melanoma

library(pROC)   # Para curva ROC y AUC

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

# Convertir a clase binaria usando umbral de 0.5
predicciones <- ifelse(probabilidades > 0.5, 1, 0)

# Crear la matriz de confusión
matriz_confusion <- table(Predicho = predicciones, Real = rotacion2$Rotación)
print(matriz_confusion)

##         Real
## Predicho    0    1
##        0 1229  233
##        1    4    4

# Calcular métricas
accuracy <- sum(diag(matriz_confusion)) / sum(matriz_confusion)  # Precisión general
sensibilidad <- matriz_confusion[2,2] / sum(matriz_confusion[,2])  # Verdaderos positivos (TPR)
especificidad <- matriz_confusion[1,1] / sum(matriz_confusion[,1])  # Verdaderos negativos (TNR)
ppv <- matriz_confusion[2,2] / sum(matriz_confusion[2,])  # Precisión (PPV)
npv <- matriz_confusion[1,1] / sum(matriz_confusion[1,])  # Valor predictivo negativo (NPV)

# Imprimir métricas
cat("Accuracy:", accuracy, "\n")

## Accuracy: 0.8387755

cat("Sensibilidad (TPR):", sensibilidad, "\n")

## Sensibilidad (TPR): 0.01687764

cat("Especificidad (TNR):", especificidad, "\n")

## Especificidad (TNR): 0.9967559

cat("Precisión (PPV):", ppv, "\n")

## Precisión (PPV): 0.5

cat("Valor Predictivo Negativo (NPV):", npv, "\n")

## Valor Predictivo Negativo (NPV): 0.8406293

# Calcular y graficar la curva ROC
roc_obj <- roc(rotacion2$Rotación, probabilidades)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

auc_value <- auc(roc_obj)
cat("AUC-ROC:", auc_value, "\n")

## AUC-ROC: 0.7024615

# Gráfico de la curva ROC
plot(roc_obj, col = "blue", main = "Curva ROC")
abline(a = 0, b = 1, lty = 2, col = "red")  # Línea de referencia

De acuerdo al resultado de la curva ROC(0.7024),se puede inferir que el poder predictivo del modelo es moderadamente bueno para determinar la rotación de los empleados.

Respecto a las metricas derivadas de la matriz de confusión podemos indicar que:

Accuracy (Precisión general) = indica que le modelo puede predecir el 83.95% de los casos totales.

Sensibilidad (TPR, Recall) = con un 2.1% indica que el modelo no esta identificando correctamente la mayoria de los empleados que realmente rotan, esto se podria explicar dado que en el dataset de la clase rotación se encuentra considerablemente desbalanceada.

Especificidad (TNR) = con un 99.68% el modelo identifica casi totalmente los empleados que no rotan correctamente.

Precisión (PPV) = el modelo puede predecir con un 55.56% cuando una persona va a rotar

Valor Predictivo Negativo (NPV) = el modelo puede predecir con un 84.12% cuando una persona no va a rotar

6. Predicciones.

En esta actividad se toma como muestra un empleado del dataset original para validar si el modelo lo clasifica correctamente.

set.seed(123)
registro <- sample(1:1470, 1) 
empleado<-(rotacion2[registro,1:6])
print(empleado)

##     Edad Satisfación_Laboral Estado_Civil Porcentaje_aumento_salarial
## 415   24                   2            3                          16
##     Equilibrio_Trabajo_Vida Antigüedad
## 415                       3          5

# Predecir la probabilidad de rotación
prediccion <- predict(modelo1, newdata = empleado, type = "response")
print(prediccion)

##       415 
## 0.3441769

clasificacion <- ifelse(prediccion >= 0.5, 1, 0)
print(clasificacion)

## 415 
##   0

De acuerdo al resultado de predicción del modelo, el empleado de la muestra indica que no va a rotar,pero en la realidad el empleado si rota de acuerdo al dataset original.

10. Conclusiones

• De acuerdo al analisis descriptivo del dataset se evidenció un gran desbalance de la clase(84% vs 16%), lo cual suguiere que se debe balancear con alguno de los metodos existentes como las de undersampling(eliminar instancias de la clase mayoritaria), oversampling(aumentar las instancias de la clase minoritaria) y tecnicas hibridas de resampling. con dicho balanceo el modelo podra mejorar su desempeño especificamente en la metrica de sensibilidad, la cual con el dataset actual su desempeño es deficiente.

• Así mismo, dentro del analisis bivariado, se evidencio que la variable % de aumento del salario de los empleados, no resulto significativo, lo que se siguiere en este punto es buscar otra variable cuyo relación con la clase sea significativa y mejore el desempeño predictivo general del modelo, ya que de acuerdo a la metrica “AUC-ROC”¨ con un 0.70 su desempeño moderado, se esperaria que contra variable explicativa este valor mejore.

• Otro analisis valido para el modelo, es validar si hay relación entre las variables independientes tales como, satisfacción laboral y equilibrio vida trabajo, en orden de buscar variables que tengan relación con la rotación pero que no se correlacionen entre si.

• Dentro del analisis puramente dicho de politicas para minimizar la rotación de la compañia, se sugiere crear programas de bienestar que apunten a mejorar la satisfacción laboral que esta casi al 40% de insatisfacción, dentro de esas politicas se podria validar horarios hibridos(casa-oficina), plan carrera, revisar dias libres como cumpleaños u otras que pueden conocerce por medio de encuestas.

• Otra acción importante es revisar como incentivar a los empleados más jovenes para que puedan desarrollarse dentro de la compañia y vean en ella una forma de tener un plan de vida.