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)

Selección de Variables Categóricas.

Selección de Variables Cuantitativas.

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

rotaciondf = rotacion %>%
  select(Departamento, Satisfación_Laboral, Estado_Civil, Edad, Ingreso_Mensual,
         Antigüedad_Cargo, Rotación)
kable(sample_n(rotaciondf,10), "html") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Departamento Satisfación_Laboral Estado_Civil Edad Ingreso_Mensual Antigüedad_Cargo Rotación
Ventas 4 Soltero 36 4502 7 No
Ventas 4 Casado 35 5204 8 No
Ventas 3 Casado 31 8346 2 No
IyD 3 Soltero 32 4998 7 No
IyD 2 Divorciado 55 13577 9 No
IyD 2 Divorciado 50 19144 4 No
IyD 3 Divorciado 27 2566 1 No
IyD 3 Divorciado 43 5257 7 No
Ventas 3 Soltero 35 4859 4 No
Ventas 3 Divorciado 29 8620 7 No 
kable(sapply(rotaciondf[, c("Edad", "Ingreso_Mensual", "Antigüedad_Cargo")], 
             summary) , "html", caption = "Resumen de variables numéricas") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Resumen de variables numéricas
Edad Ingreso_Mensual Antigüedad_Cargo
Min. 18.00000 1009.000 0.000000
1st Qu. 30.00000 2911.000 2.000000
Median 36.00000 4919.000 3.000000
Mean 36.92449 6502.931 4.229252
3rd Qu. 43.00000 8379.000 7.000000
Max. 60.00000 19999.000 18.000000 
frecuencia_dep <- rotaciondf %>%
  group_by(Departamento) %>%
  summarise(Frecuencia = n())

frecuencia_SL <- rotaciondf %>%
     group_by(Satisfación_Laboral) %>%
     summarise(Frecuencia = n())

frecuencia_EC <- rotaciondf %>%
     group_by(Estado_Civil) %>%
     summarise(Frecuencia = n())

kable(frecuencia_dep , "html", caption = "Resumen por Departamento") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Resumen por Departamento
Departamento Frecuencia
IyD 961
RH 63
Ventas 446 
kable(frecuencia_SL , "html", caption = "Resumen por Satisfacción Laboral") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Resumen por Satisfacción Laboral
Satisfación_Laboral Frecuencia
1 289
2 280
3 442
4 459 
kable(frecuencia_EC , "html", caption = "Resumen por Estado civil") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Resumen por Estado civil
Estado_Civil Frecuencia
Casado 673
Divorciado 327
Soltero 470 
g1=ggplot(rotaciondf,aes(x=Departamento))+geom_bar(fill = "cyan3")+theme_bw()
g2=ggplot(rotaciondf,aes(x=Satisfación_Laboral))+geom_bar(fill = "cyan3")+theme_bw()
g3=ggplot(rotaciondf,aes(x=Estado_Civil))+geom_bar(fill = "cyan3")+theme_bw()
g4=ggplot(rotaciondf,aes(x=Edad))+geom_histogram(fill = "cyan3")+theme_bw()
g5=ggplot(rotaciondf,aes(x=Ingreso_Mensual))+geom_histogram(fill = "cyan3")+theme_bw()
g6=ggplot(rotaciondf,aes(x=Antigüedad_Cargo))+geom_histogram(fill = "cyan3")+theme_bw()
ggarrange(g1, g2, g3, g4, g5, g6,labels = c("A", "B","C","D","E","F"),ncol = 2, nrow = 1)

Departamento: El departamento con el mayor número de empleados es IyD, que cuenta con un total de 961 colaboradores. En contraste, el departamento con el menor número de empleados es HR, con solo 63. Por otro lado, el departamento de ventas tiene 446 empleados.

Satisfacción Laboral: La mayoría de los empleados clasifican su satisfacción laboral en los niveles 3 y 4, obteniendo 442 calificaciones de “satisfecho” y 459 de “muy satisfecho”, respectivamente. En cambio, un menor número de empleados se posiciona en los niveles 1 y 2, con 289 clasificaciones de “muy insatisfecho” y 280 de “insatisfecho”.

Estado Civil: En cuanto al estado civil, la empresa presenta un mayor número de empleados casados (673), seguidos por los solteros (470) y, en menor cantidad, los divorciados (327).

Edad: La mayoría de los empleados se encuentra en el rango de edad de 25 a 45 años. El empleado más joven tiene 18 años y el de mayor edad con 60 años.

Salario: El salario promedio es de aproximadamente 5 millones. La mayoría de los salarios se sitúan entre 1 millón y 7 millones, con un salario mínimo de 1 millón y un máximo de 20 millones.

Antigüedad en el cargo: La mayoría de los empleados tiene una antigüedad en su cargo que oscila entre 0 y 7 años, con una media de 4.2 años y un valor máximo de 18 años.

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

library(vcd)
rotaciondf$Rotación <- factor(ifelse(rotacion$Rotación == "Si", 1, 0))
tabla_Departamento_Rotacion = table(rotaciondf$Departamento,rotaciondf$Rotación)

tasa_rotacion <- rotaciondf %>%
  group_by(Departamento, Rotación) %>%
  summarise(Count = n()) %>%
  ungroup()
# Calcular porcentajes
tasa_rotacion <- tasa_rotacion %>%
  group_by(Departamento) %>%
  mutate(Proporción = Count / sum(Count)) # Calcula la proporción

ggplot(tasa_rotacion, aes(x = Departamento, y = Proporción, fill = factor(Rotación))) +
  geom_bar(stat = "identity", position = "fill") +
  geom_text(aes(label = scales::percent(Proporción)), position = position_fill(vjust = 0.5) ) + # Añadir etiquetas
  labs(title = "Distribución de Rotación por Departamento",
       x = "Departamento",
       y = "Proporción",
       fill = "Rotación") +
  scale_y_continuous(labels = scales::percent) +
  theme_minimal()

colores <- c("lightblue", "lightgreen", "lightcoral", "lightsalmon")
# gráfico de mosaico
mosaic(~ Departamento + factor(Rotación), data = rotaciondf, 
       main = "Gráfico de Mosaico: Rotación por Departamento",
       gp = gpar(fill = colores),
       labeling = labeling_values)

modelo_departamento_nuevo <- glm(Rotación ~ Departamento, family = binomial, data = rotaciondf)
summary(modelo_departamento_nuevo)

Call:
glm(formula = Rotación ~ Departamento, family = binomial, data = rotaciondf)

Coefficients:
                   Estimate Std. Error z value             Pr(>|z|)    
(Intercept)        -1.82866    0.09342 -19.576 < 0.0000000000000002 ***
DepartamentoRH      0.38175    0.33417   1.142              0.25330    
DepartamentoVentas  0.48116    0.14974   3.213              0.00131 ** 
---
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: 1288.1  on 1467  degrees of freedom
AIC: 1294.1

Number of Fisher Scoring iterations: 4

Observamos que el departamento de ventas presenta la mayor proporción de rotación, seguido por el de Recursos Humanos. Por otro lado, el departamento con la menor rotación es Investigación y Desarrollo. Se observa que existe una relación significativa entre el área en la que trabajan los empleados y la rotación. Los resultados del modelo indican que en Ventas se tiene un coeficiente positivo (0.48116), lo que sugiere que los empleados en este departamento tienen una mayor probabilidad de rotación en comparación con aquellos en IyD, que es el grupo de referencia, y el p-value asociado (0.00131) confirma que esta diferencia es estadísticamente relevante. En contraste, RH presenta un coeficiente positivo (0.38175), pero su p-value (0.25330) indica que la relación con la rotación no es significativa. Entonces, es a destacar que el Departamento de Ventas influye notablemente en la rotación, mientras que no se observa un efecto significativo en Recursos Humanos. Los resultados obtenidos confirman la hipótesis de “Se anticipa que algunos departamentos presenten una mayor rotación de empleados en comparación con otros”.

tabla_Satisfaccion_Rotacion = table(rotaciondf$Satisfación_Laboral,rotaciondf$Rotación)
tasa_rotacion <- rotaciondf %>%
  group_by(Satisfación_Laboral, Rotación) %>%
  summarise(Count = n()) %>%
  ungroup()

# Calcular porcentajes
tasa_rotacion <- tasa_rotacion %>%
  group_by(Satisfación_Laboral) %>%
  mutate(Proporción = Count / sum(Count)) # Calcula la proporción

ggplot(tasa_rotacion, aes(x = Satisfación_Laboral, y = Proporción, fill = factor(Rotación))) +
  geom_bar(stat = "identity", position = "fill") +
  geom_text(aes(label = scales::percent(Proporción)), position = position_fill(vjust = 0.5) ) + # Añadir etiquetas
  labs(title = "Distribución de Rotación por Satisfación Laboral",
       x = "Satisfación Laboral",
       y = "Proporción",
       fill = "Rotación") +
  scale_y_continuous(labels = scales::percent) +
  theme_minimal()

colores <- c("lightblue", "lightgreen", "lightcoral", "lightsalmon")
#gráfico de mosaico
mosaic(~ Satisfación_Laboral + factor(Rotación), data = rotaciondf, 
       main = "Gráfico de Mosaico: Rotación por Satisfacción Laboral",
       gp = gpar(fill = colores),
       labeling = labeling_values)

modelo_Satisfación_Laboral <- glm(Rotación ~ Satisfación_Laboral, family = binomial, data = rotaciondf)
summary(modelo_Satisfación_Laboral)

Call:
glm(formula = Rotación ~ Satisfación_Laboral, family = binomial, 
    data = rotaciondf)

Coefficients:
                    Estimate Std. Error z value     Pr(>|z|)    
(Intercept)          -0.9903     0.1757  -5.635 0.0000000175 ***
Satisfación_Laboral  -0.2510     0.0637  -3.940 0.0000815786 ***
---
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: 1283.1  on 1468  degrees of freedom
AIC: 1287.1

Number of Fisher Scoring iterations: 4

Se observa que a menor satisfacción laboral, mayor es la tasa de rotación. Los resultados del modelo muestran un coeficiente negativo para la Satisfacción Laboral (-0.2510), lo que indica que a medida que aumenta la satisfacción, la probabilidad de rotación disminuye. Este efecto es respaldado por un p-value muy bajo, lo que sugiere que la Satisfacción Laboral es un determinante estadísticamente significativo de la rotación. Estos resultados confirman la hipótesis planteada de “Se espera que a medida que disminuye la satisfacción laboral, la tasa de rotación aumente”.

tabla_Estcivil_Rotacion = table(rotaciondf$Estado_Civil,rotaciondf$Rotación)

tasa_rotacion <- rotaciondf %>%
  group_by(Estado_Civil, Rotación) %>%
  summarise(Count = n()) %>%
  ungroup()

# Calcular porcentajes
tasa_rotacion <- tasa_rotacion %>%
  group_by(Estado_Civil) %>%
  mutate(Proporción = Count / sum(Count)) # Calcula la proporción

ggplot(tasa_rotacion, aes(x = Estado_Civil, y = Proporción, fill = factor(Rotación))) +
  geom_bar(stat = "identity", position = "fill") +
  geom_text(aes(label = scales::percent(Proporción)), position = position_fill(vjust = 0.5) ) + # Añadir etiquetas
  labs(title = "Distribución de Rotación por Estado Civil",
       x = "Estado Civil",
       y = "Proporción",
       fill = "Rotación") +
  scale_y_continuous(labels = scales::percent) +
  theme_minimal()

colores <- c("lightblue", "lightgreen", "lightcoral", "lightsalmon")

# gráfico de mosaico
mosaic(~ Estado_Civil + factor(Rotación), data = rotaciondf, 
       main = "Gráfico de Mosaico: Rotación por Estado Civil",
       gp = gpar(fill = colores),
       labeling = labeling_values)

modelo_Estado_Civil <- glm(Rotación ~ Estado_Civil, family = binomial, data = rotaciondf)
summary(modelo_Estado_Civil)

Call:
glm(formula = Rotación ~ Estado_Civil, family = binomial, data = rotaciondf)

Coefficients:
                       Estimate Std. Error z value             Pr(>|z|)    
(Intercept)             -1.9476     0.1166 -16.699 < 0.0000000000000002 ***
Estado_CivilDivorciado  -0.2395     0.2175  -1.101                0.271    
Estado_CivilSoltero      0.8772     0.1575   5.571         0.0000000254 ***
---
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: 1254.6  on 1467  degrees of freedom
AIC: 1260.6

Number of Fisher Scoring iterations: 4

Los solteros presentan una tasa de rotación más alta en comparación con los casados y divorciados. Los resultados del modelo muestran que, en comparación con el grupo de referencia (Casado), el Estado Civil Soltero presenta un coeficiente positivo (0.8772), lo que sugiere que los empleados solteros tienen una mayor probabilidad de rotación, con un p-value muy bajo, indicando que esta relación es estadísticamente significativa. En contraste, el coeficiente para el Estado Civil Divorciado (-0.2395) no es significativo (p-value = 0.271), lo que sugiere que no hay una relación clara entre este estado civil y la rotación. Lo anterior confirma la hipotesis de “Las personas solteras tienden a cambiar de trabajo con mayor facilidad”.

p <- plot_ly(rotaciondf, y = ~Ingreso_Mensual, color = ~factor(Rotación), 
             type = "box", 
             boxpoints = "all", 
             pointpos = 0, 
             colors = c("blue", "orange")) %>%
  layout(title = "Box Plot de Ingreso Mensual según Rotación",
         yaxis = list(title = "Ingreso Mensual"),
         xaxis = list(title = "Rotación (1 = Sí, 0 = No)"))
p
modelo_rotacion_Ingreso <- glm(Rotación ~ Ingreso_Mensual , data = rotaciondf, family = binomial)
summary(modelo_rotacion_Ingreso)

Call:
glm(formula = Rotación ~ Ingreso_Mensual, family = binomial, 
    data = rotaciondf)

Coefficients:
                   Estimate  Std. Error z value          Pr(>|z|)    
(Intercept)     -0.92910875  0.12920214  -7.191 0.000000000000643 ***
Ingreso_Mensual -0.00012710  0.00002162  -5.879 0.000000004119147 ***
---
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: 1253.1  on 1468  degrees of freedom
AIC: 1257.1

Number of Fisher Scoring iterations: 5

A menor salario mensual mayor la tasa de rotación. Podemos observar en el gráfico que a menor salario mensual, mayor es la tasa de rotación. Además, los resultados del modelo muestran que el Ingreso Mensual es una variable determinante significativa en la rotación, ya que el p-value es menor que 0.001. El coeficiente negativo indica que, a medida que el ingreso mensual aumenta, la probabilidad de rotación disminuye. La hipotesis de “Existe una relación inversa entre los ingresos mensuales y la tasa de rotación: a mayores ingresos, menor es la tasa de rotación” con los resultados obtenidos, se confirma.

graficoAntigüedad =ggplot(rotaciondf,aes(x=Rotación,y= Antigüedad_Cargo,fill=Rotación))+geom_boxplot()+theme_bw()
graficoAntigüedad

p <- plot_ly(rotaciondf, x = ~Antigüedad_Cargo, color = ~factor(Rotación), 
             type = "histogram", opacity = 0.6) %>%
  layout(barmode = "overlay", 
         title = "Histograma de Antigüedad Cargo según Rotación",
         xaxis = list(title = "Antigüedad Cargo"),
         yaxis = list(title = "Frecuencia"))
p
modelo_rotacion_Antiguedad <- glm(Rotación ~ Antigüedad_Cargo , data = rotaciondf, family = binomial)
summary(modelo_rotacion_Antiguedad)

Call:
glm(formula = Rotación ~ Antigüedad_Cargo, family = binomial, 
    data = rotaciondf)

Coefficients:
                 Estimate Std. Error z value             Pr(>|z|)    
(Intercept)      -1.11841    0.10380 -10.775 < 0.0000000000000002 ***
Antigüedad_Cargo -0.14628    0.02424  -6.033        0.00000000161 ***
---
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: 1255.9  on 1468  degrees of freedom
AIC: 1259.9

Number of Fisher Scoring iterations: 5

A menor antigüedad en el empleo, mayor es la tasa de rotación. El gráfico sugiere que a mayor antigüedad en el cargo, menor es la tasa de rotación. Los resultados del modelo muestran que la Antigüedad en el Cargo es una variable determinante significativa en la rotación, con un p-value menor que 0.001. El coeficiente negativo (-0.14628) indica que, a medida que aumenta la antigüedad de los empleados en su puesto, la probabilidad de rotación disminuye. Lo anterior confirma que “Los empleados con mayor antigüedad suelen tener un mayor sentido de pertenencia, lo que se traduce en tasas de rotación más bajas”

graficoedad =ggplot(rotaciondf,aes(x=Rotación,y=Edad,fill=Rotación))+
  geom_boxplot()+theme_bw()
graficoedad

p <- plot_ly(rotaciondf, x = ~Edad, color = ~factor(Rotación), 
             type = "histogram", opacity = 0.6) %>%
  layout(barmode = "overlay", 
         title = "Histograma de Edad según Rotación",
         xaxis = list(title = "Edad"),
         yaxis = list(title = "Frecuencia"))
p
modelo_rotacion_Edad <- glm(Rotación ~ Edad , data = rotaciondf, family = binomial)
summary(modelo_rotacion_Edad)

Call:
glm(formula = Rotación ~ Edad, family = binomial, data = rotaciondf)

Coefficients:
            Estimate Std. Error z value     Pr(>|z|)    
(Intercept)  0.20637    0.30597   0.674          0.5    
Edad        -0.05225    0.00870  -6.006 0.0000000019 ***
---
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: 1259.1  on 1468  degrees of freedom
AIC: 1263.1

Number of Fisher Scoring iterations: 4

Se evidencia que a menor edad, mayor es la tasa de rotación. El gráfico muestra que a medida que aumenta la edad, la tasa de rotación disminuye. Los resultados del modelo indican que la Edad es una variable determinante significativa en la rotación, con un p-value menor que 0.001. El coeficiente negativo (-0.05225) sugiere que, a medida que la edad de los empleados aumenta, la probabilidad de rotación disminuye. Se confirma que “A medida que aumenta la edad, es razonable esperar una mayor estabilidad laboral, por lo que anticipamos una menor tasa de rotación en grupos de mayor edad”.

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

Luego de realizar la división aleatoria de los datos en conjunto de entrenamiento y conjunto de prueba, se genera el modelo de regresión logística con nuevas variables dicotómicas creadas a partir de las variables categóricas.

# Selección de columnas
rotacion_6 <- select(rotacion, Rotación, Departamento, Satisfación_Laboral, 
                     Estado_Civil,Ingreso_Mensual, Antigüedad_Cargo, Edad)
rotacion_6$Rotación=as.numeric(rotacion_6$Rotación=="Si")
# División de datos de entrenamiento y prueba
set.seed(123)
split <- sample.split(rotacion_6$Rotación, SplitRatio=0.7)
train_data <- subset(rotacion_6, split==TRUE)
test_data <- subset(rotacion_6, split==FALSE)
# Modelo
modelo_glm <- glm(Rotación ~ as.factor(Departamento) + as.factor(Satisfación_Laboral) + as.factor(Estado_Civil)
                  + Ingreso_Mensual + Antigüedad_Cargo + Edad, data = train_data, family = binomial(link = "logit"))
summary(modelo_glm) 

Call:
glm(formula = Rotación ~ as.factor(Departamento) + as.factor(Satisfación_Laboral) + 
    as.factor(Estado_Civil) + Ingreso_Mensual + Antigüedad_Cargo + 
    Edad, family = binomial(link = "logit"), data = train_data)

Coefficients:
                                     Estimate  Std. Error z value  Pr(>|z|)    
(Intercept)                       -0.53153405  0.42974329  -1.237   0.21614    
as.factor(Departamento)RH          0.11391948  0.47151388   0.242   0.80909    
as.factor(Departamento)Ventas      0.80368019  0.19199547   4.186 0.0000284 ***
as.factor(Satisfación_Laboral)2   -0.38717382  0.27316406  -1.417   0.15638    
as.factor(Satisfación_Laboral)3   -0.36360741  0.24027264  -1.513   0.13020    
as.factor(Satisfación_Laboral)4   -1.08175962  0.26633006  -4.062 0.0000487 ***
as.factor(Estado_Civil)Divorciado -0.31053018  0.26888231  -1.155   0.24813    
as.factor(Estado_Civil)Soltero     0.81703784  0.19859788   4.114 0.0000389 ***
Ingreso_Mensual                   -0.00009667  0.00003114  -3.104   0.00191 ** 
Antigüedad_Cargo                  -0.10137729  0.03188877  -3.179   0.00148 ** 
Edad                              -0.00750788  0.01112659  -0.675   0.49982    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 909.34  on 1028  degrees of freedom
Residual deviance: 802.28  on 1018  degrees of freedom
AIC: 824.28

Number of Fisher Scoring iterations: 5

Interpretación de los coeficientes.

odds_ratios <- exp(coef(modelo_glm))
tabla_odds_ratios <- data.frame(
  Variable = names(odds_ratios),
  Odds_Ratio = odds_ratios        
)
kable(select(tabla_odds_ratios,Odds_Ratio), "html", caption = "Razón de probabilidad") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Razón de probabilidad
Odds_Ratio
(Intercept) 0.5877027
as.factor(Departamento)RH 1.1206619
as.factor(Departamento)Ventas 2.2337464
as.factor(Satisfación_Laboral)2 0.6789731
as.factor(Satisfación_Laboral)3 0.6951641
as.factor(Satisfación_Laboral)4 0.3389985
as.factor(Estado_Civil)Divorciado 0.7330582
as.factor(Estado_Civil)Soltero 2.2637842
Ingreso_Mensual 0.9999033
Antigüedad_Cargo 0.9035920
Edad 0.9925202

5. Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC en el set de datos de prueba

Procedemos a realizar la evaluación del modelo haciendo predicciones con el conjunto de datos de prueba.

predicciones_prob <- predict(modelo_glm, test_data, type = "response")
predicciones_bool <- ifelse(predicciones_prob > 0.5, 1, 0)
roc_curve <- roc(test_data$Rotación, predicciones_prob)
plot(roc_curve, col = "blue", lwd = 2, main = "Curva ROC")
abline(a = 0, b = 1, col = "red", lty = 2)
text(0.6, 0.4, paste("AUC =", round(auc(roc_curve), 2)), col = "black")
grid()

La curva ROC muestra la relación entre la tasa de verdaderos positivos (Sensibilidad) y la tasa de falsos positivos (Especificidad). En este caso la curva no está muy cerca al punto (0, 1), por lo que la clasificación no es excelente y el modelo tendrá limitaciones para clasificar los datos. El área bajo la curva AUC tiene un valor de 0.7, lo cual puede ser aceptable en la clasificación aunque presentará problemas distinguiendo clases. El valor de 0.7 significa que el modelo tiene un 70% de probabilidad de clasificar correctamente un caso positivo que un caso negativo.

rendimiento <- data.frame(observados=test_data$Rotación,predicciones=predicciones_bool)
total <- nrow(rendimiento)
VP<-sum(rendimiento$observados==1 & rendimiento$predicciones==1)
VN<-sum(rendimiento$observados==0 & rendimiento$predicciones==0)
FP<-sum(rendimiento$observados==0 & rendimiento$predicciones==1)
FN<-sum(rendimiento$observados==1 & rendimiento$predicciones==0)
exactitud = (VP+VN)/total
error_rate = (FP+FN)/total
sensibilidad = VP/(VP+FN)
especificidad = VN/(VN+FP)
presicion = VP/(VP+FP)
vpn = VN/(VN+FN)
indicadores <- data.frame(
    Indicador = c("Exactitud", "Tasa de Error", "Sensibilidad", "Especificidad", "Precisión", "Valor predicción negativo"),
    Valor = c(exactitud, error_rate, sensibilidad, especificidad, presicion, vpn)
)
kable(indicadores, "html", caption = "Indicadores") %>%
  kable_styling("striped", full_width = FALSE) %>%
  row_spec(0, bold = TRUE)
Indicadores
Indicador Valor
Exactitud 0.8435374
Tasa de Error 0.1564626
Sensibilidad 0.0563380
Especificidad 0.9945946
Precisión 0.6666667
Valor predicción negativo 0.8459770

El modelo presenta un alto valor de especificidad, que significa que el modelo tiene una alta capacidad para identificar correctamente los casos negativos. En el contexto de caso de estudio, este no es un valor que realmente convenga debido a que se intenta determinar los casos positivos para rotación. Es posible que esto esté sucediendo a causa del desbalance en la clase a predecir.

6. 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)