Actividad 3 - Regresion_Logistica
Giovanny Ortega Solarte
2024-09-21
1 Punto 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(paqueteMODELOS)
library(dplyr)
library(plotly)
library(ggplot2)
library(vcd)
data("rotacion")
rotaciondf = rotacion %>% select(Departamento, Satisfación_Laboral, Estado_Civil, Edad, Ingreso_Mensual, Antigüedad_Cargo, Rotación)rotaciondf$Rotación <- factor(ifelse(rotacion$Rotación == "Si", 1, 0))
head(rotaciondf$Rotación)## [1] 1 0 1 0 0 0
## Levels: 0 1Rotación - Ingreso Mensual
# Crear el box plot
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)"))
pmodelo_rotacion_Ingreso <- glm(Rotación ~ Ingreso_Mensual , data = rotaciondf, family = binomial)
# Resumen del modelo
summary(modelo_rotacion_Ingreso)##
## Call:
## glm(formula = Rotación ~ Ingreso_Mensual, family = binomial,
## data = rotaciondf)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.291e-01 1.292e-01 -7.191 6.43e-13 ***
## Ingreso_Mensual -1.271e-04 2.162e-05 -5.879 4.12e-09 ***
## ---
## 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: 5Podemos 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.
Rotación - Edad
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"))
pmodelo_rotacion_Edad <- glm(Rotación ~ Edad , data = rotaciondf, family = binomial)
# Resumen del modelo
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 1.9e-09 ***
## ---
## 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: 4El 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”
Rotación - Antigüedad_Cargo
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"))
pmodelo_rotacion_Antiguedad <- glm(Rotación ~ Antigüedad_Cargo , data = rotaciondf, family = binomial)
# Resumen del modelo
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 < 2e-16 ***
## Antigüedad_Cargo -0.14628 0.02424 -6.033 1.61e-09 ***
## ---
## 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: 5El 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”
Rotación - Departamento
tabla_Departamento_Rotacion = table(rotaciondf$Departamento,rotaciondf$Rotación)
tabla_Departamento_Rotacion##
## 0 1
## IyD 828 133
## RH 51 12
## Ventas 354 92tasa_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 < 2e-16 ***
## 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: 4Se 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”
Rotación - Satisfación Laboral
tabla_Satisfaccion_Rotacion = table(rotaciondf$Satisfación_Laboral,rotaciondf$Rotación)
tabla_Satisfaccion_Rotacion##
## 0 1
## 1 223 66
## 2 234 46
## 3 369 73
## 4 407 52tasa_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 1.75e-08 ***
## Satisfación_Laboral -0.2510 0.0637 -3.940 8.16e-05 ***
## ---
## 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: 4Los 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.”
Rotación - Estado Civil
tabla_Estcivil_Rotacion = table(rotaciondf$Estado_Civil,rotaciondf$Rotación)
tabla_Estcivil_Rotacion##
## 0 1
## Casado 589 84
## Divorciado 294 33
## Soltero 350 120tasa_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 < 2e-16 ***
## Estado_CivilDivorciado -0.2395 0.2175 -1.101 0.271
## Estado_CivilSoltero 0.8772 0.1575 5.571 2.54e-08 ***
## ---
## 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: 4Los 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”