Unidad 3: Modelo de Regresión Logiística binomial
Fabian Maldonado Benavides - 80183547
2023-09-13
1. Problema
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.
A continuación se describen los pasos que la gerencia ha propuesto para el análisis: .
1 Realizar cargue de datos
## 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##
## 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, unionLa base de datos de rotación contiene información sobre los trabajadores que han cambiado de puesto o de empresa y los que no lo han hecho. Además, incluye atributos relacionados con el clima laboral, el rendimiento del empleado, las condiciones internas de la empresa y las características intrínsecas del trabajador y de su entorno, como su edad o la distancia que hay del trabajo a su casa. La base de datos tiene un total de 24 columnas y 1470 filas.
La mayoría de las variables en la base de datos son cuantitativas discretas, otras son cualitativas nominales y cualitativas ordinales. Para facilitar el análisis descriptivo y la modelación posterior, se convierten las variables cuantitativas a tipo “factor” con el siguiente código
## Rows: 1,470
## Columns: 24
## $ Rotación <chr> "Si", "No", "Si", "No", "No", "No", "No", …
## $ Edad <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35…
## $ `Viaje de Negocios` <chr> "Raramente", "Frecuentemente", "Raramente"…
## $ Departamento <chr> "Ventas", "IyD", "IyD", "IyD", "IyD", "IyD…
## $ Distancia_Casa <dbl> 1, 8, 2, 3, 2, 2, 3, 24, 23, 27, 16, 15, 2…
## $ Educación <dbl> 2, 1, 2, 4, 1, 2, 3, 1, 3, 3, 3, 2, 1, 2, …
## $ Campo_Educación <chr> "Ciencias", "Ciencias", "Otra", "Ciencias"…
## $ Satisfacción_Ambiental <dbl> 2, 3, 4, 4, 1, 4, 3, 4, 4, 3, 1, 4, 1, 2, …
## $ Genero <chr> "F", "M", "M", "F", "M", "M", "F", "M", "M…
## $ Cargo <chr> "Ejecutivo_Ventas", "Investigador_Cientifi…
## $ Satisfación_Laboral <dbl> 4, 2, 3, 3, 2, 4, 1, 3, 3, 3, 2, 3, 3, 4, …
## $ Estado_Civil <chr> "Soltero", "Casado", "Soltero", "Casado", …
## $ Ingreso_Mensual <dbl> 5993, 5130, 2090, 2909, 3468, 3068, 2670, …
## $ Trabajos_Anteriores <dbl> 8, 1, 6, 1, 9, 0, 4, 1, 0, 6, 0, 0, 1, 0, …
## $ Horas_Extra <chr> "Si", "No", "Si", "Si", "No", "No", "Si", …
## $ Porcentaje_aumento_salarial <dbl> 11, 23, 15, 11, 12, 13, 20, 22, 21, 13, 13…
## $ Rendimiento_Laboral <dbl> 3, 4, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3, 3, 3, …
## $ Años_Experiencia <dbl> 8, 10, 7, 8, 6, 8, 12, 1, 10, 17, 6, 10, 5…
## $ Capacitaciones <dbl> 0, 3, 3, 3, 3, 2, 3, 2, 2, 3, 5, 3, 1, 2, …
## $ Equilibrio_Trabajo_Vida <dbl> 1, 3, 3, 3, 3, 2, 2, 3, 3, 2, 3, 3, 2, 3, …
## $ Antigüedad <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2,…
## $ Antigüedad_Cargo <dbl> 4, 7, 0, 7, 2, 7, 0, 0, 7, 7, 4, 5, 2, 2, …
## $ Años_ultima_promoción <dbl> 0, 1, 0, 3, 2, 3, 0, 0, 1, 7, 0, 0, 4, 1, …
## $ Años_acargo_con_mismo_jefe <dbl> 5, 7, 0, 0, 2, 6, 0, 0, 8, 7, 3, 8, 3, 2, …# Renombrar la columna "Viaje de Negocios" sin espacios en el encabezado
colnames(rotacion)[colnames(rotacion) == "Viaje de Negocios"] <- "Viaje_de_Negocios"
head(rotacion)2 Desarrollo Ejercicio
2.1 Selección de variables
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).
Variables Cuantitativas:
Edad: La edad del empleado podría estar relacionada con la rotación. Se podría
La hipótesis es que los empleados más jóvenes tienen una mayor probabilidad de rotación debido a la búsqueda de oportunidades y experienciaDistancia_Casa: La distancia desde la casa del empleado hasta el lugar de trabajo podría influir en la rotación.
La hipótesis podría ser que los empleados que viven más lejos tienen una mayor probabilidad de rotación debido a problemas de desplazamiento y tiempo.Porcentaje_aumento_salarial: El porcentaje de aumento salarial que recibe el empleado podría influir en la rotación.
La hipótesis podría ser que los empleados que reciben aumentos salariales más bajos tienen una mayor probabilidad de rotación debido a la insatisfacción con su remuneración.Variables Categóricas cualitarivas:
Viaje de Negocios: Esta variable categórica podría estar relacionada con la rotación.
La hipótesis podría ser que los empleados que viajan con frecuencia por negocios (por ejemplo, para reuniones o conferencias) pueden tener una mayor probabilidad de rotación debido a la carga de trabajo adicional y el estrés relacionado con los viajes.Campo_Educación: La elección del campo de educación del empleado podría influir en la rotación.
La hipótesis es que que los empleados mas especializados o técnicos pueden tener una menor rotación en comparación con aquellos en campos más genéricos debido a la demanda de habilidades específicas.Estado_Civil: El estado civil del empleado podría estar relacionado con la rotación.
La hipótesis es que los empleados casados tienen una menor probabilidad de rotación en comparación con los solteros, debido a las responsabilidades familiares generan una mayor estabilidad laboral.2.2 Análisis univariado
Variables Cuantitativas:
## Loading required package: ggpubrlibrary(forcats)
g_1=ggplot(rotacion,aes(x=Edad))+geom_bar(fill="#5F9EA0")+theme_bw()+theme(axis.text.x = element_text(angle = 90))
g_2=ggplot(rotacion,aes(x=Distancia_Casa))+geom_bar(fill="#5F9EA0")+theme_bw()
g_3=ggplot(rotacion,aes(x=Porcentaje_aumento_salarial))+geom_bar(fill="#5F9EA0")+theme_bw()
graf=ggarrange( g_1, g_2, g_3,labels = c("A", "B","C"), ncol = 3, nrow = 1)
graf
# Análisis Univariado de Variables Numéricas
library(ggplot2)
# Histograma y Estadísticas para "Edad"
ggplot(rotacion, aes(x = Edad)) +
geom_histogram(binwidth = 5, fill = "#5F9EA0", color = "black") +
labs(title = "Distribución de Edad", x = "Edad", y = "Frecuencia") +
theme_minimal()
resumen_edad <- summary(rotacion$Edad)
print(paste("Estadísticas Descriptivas para Edad:\n", resumen_edad))## [1] "Estadísticas Descriptivas para Edad:\n 18"
## [2] "Estadísticas Descriptivas para Edad:\n 30"
## [3] "Estadísticas Descriptivas para Edad:\n 36"
## [4] "Estadísticas Descriptivas para Edad:\n 36.9244897959184"
## [5] "Estadísticas Descriptivas para Edad:\n 43"
## [6] "Estadísticas Descriptivas para Edad:\n 60"ggplot(rotacion, aes(x = Distancia_Casa)) +
geom_histogram(binwidth = 5, fill = "#5F9EA0", color = "black") +
labs(title = "Distribución de Distancia_Casa", x = "Distancia_Casa", y = "Frecuencia") +
theme_minimal()
resumen_distancia <- summary(rotacion$Distancia_Casa)
print(paste("Estadísticas Descriptivas para Distancia_Casa:\n", resumen_distancia))## [1] "Estadísticas Descriptivas para Distancia_Casa:\n 1"
## [2] "Estadísticas Descriptivas para Distancia_Casa:\n 2"
## [3] "Estadísticas Descriptivas para Distancia_Casa:\n 7"
## [4] "Estadísticas Descriptivas para Distancia_Casa:\n 9.19251700680272"
## [5] "Estadísticas Descriptivas para Distancia_Casa:\n 14"
## [6] "Estadísticas Descriptivas para Distancia_Casa:\n 29"# Histograma y Estadísticas para "Porcentaje_aumento_salarial"
ggplot(rotacion, aes(x = Porcentaje_aumento_salarial)) +
geom_histogram(binwidth = 5, fill = "#5F9EA0", color = "black") +
labs(title = "Distribución de Porcentaje_aumento_salarial", x = "Porcentaje_aumento_salarial", y = "Frecuencia") +
theme_minimal()
resumen_aumento <- summary(rotacion$Porcentaje_aumento_salarial)
print(paste("Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n", resumen_aumento))## [1] "Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n 11"
## [2] "Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n 12"
## [3] "Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n 14"
## [4] "Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n 15.2095238095238"
## [5] "Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n 18"
## [6] "Estadísticas Descriptivas para Porcentaje_aumento_salarial:\n 25"RESULTADOS
Edad: la concentracion de poblacion se encuentra entre 30 y 40 años Distancia_Casa: La mayor concentracion se encunetra entre 0 y 10 KM Porcentaje_aumento_salarial: la mayor concentracion se presneta en 15%
Variables Cualitativas:
library(ggplot2)
library(ggpubr)
# Gráfico para Campo_Educación
g_5 <- ggplot(rotacion, aes(x = Campo_Educación)) +
geom_bar(fill = "#8B7D6B") +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Ajuste de etiquetas
# Gráfico para Viaje_de_Negocios
g_4 <- ggplot(rotacion, aes(x = Viaje_de_Negocios)) +
geom_bar(fill = "#8B7D6B") +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Ajuste de etiquetas
# Gráfico para Estado_Civil
g_6 <- ggplot(rotacion, aes(x = Estado_Civil)) +
geom_bar(fill = "#8B7D6B") +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) # Ajuste de etiquetas
# Combinar gráficos usando ggarrange
graf <- ggarrange(g_6, g_4, g_5, labels = c("A", "B", "C"), ncol = 1, nrow = 1)
graf## $`1`
##
## $`2`
##
## $`3`
##
## attr(,"class")
## [1] "list" "ggarrange"RESULTADOS
-Viaje de Negocios: la mayor concentracion poblacional esta en Raramente
-Campo_Educación: la mayor concentracion poblacional esta en Casado
-Estado_Civil: la mayor concentracion poblacional esta en ciencias seguido de Salud
2.3 Analisis Multivariado
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.
Primero, vamos a realizar un ajuste en la “rotación” ya que esta es la variable de respuesta y como es una variable categórica que indica si un empleado ha rotado (“Si”) o no ha rotado (“No”). Para realizar análisis estadísticos y gráficos, es útil tener una variable binaria que represente esta información de manera numérica, donde “1” generalmente se utiliza para “Sí” (rotación) y “0” para “No” (no rotación).
2.3.1 Variables Cuantitativas
ANALISIS DE Coeficiente de Correlación (Pearson)
# Variables cuantitativas
variables_cuantitativas <- c("Edad", "Distancia_Casa",
"Porcentaje_aumento_salarial")
# Matriz de correlación para variables cuantitativas
matriz_correlacion <- cor(rotacion[, variables_cuantitativas], y = rotacion$Rotacion_C, method = "pearson")
# Imprimir resultados
cat("Matriz de Correlación para Variables Cuantitativas:\n")## Matriz de Correlación para Variables Cuantitativas:## [,1]
## Edad -0.15922783
## Distancia_Casa 0.07792358
## Porcentaje_aumento_salarial -0.01347820ANALISIS de varianza (ANOVA)
# Cargar la biblioteca dplyr si aún no está cargada
if (!requireNamespace("dplyr", quietly = TRUE)) {
install.packages("dplyr")
}
library(dplyr)
# Realizar análisis de varianza (ANOVA) para las variables cuantitativas
resultado_anova_edad <- aov(Edad ~ Rotacion_C, data = rotacion)
resultado_anova_distancia <- aov(Distancia_Casa ~ Rotacion_C, data = rotacion)
resultado_anova_aumento_salarial <- aov(Porcentaje_aumento_salarial ~ Rotacion_C, data = rotacion)
# Resumen de los análisis
resumen_anova_edad <- summary(resultado_anova_edad)
resumen_anova_distancia <- summary(resultado_anova_distancia)
resumen_anova_aumento_salarial <- summary(resultado_anova_aumento_salarial)
# Crear una tabla con los resultados
tabla_resultados <- bind_rows(
data.frame(Variable = "Edad",
F_value = resumen_anova_edad[[1]]$`F value`[1],
P_value = resumen_anova_edad[[1]]$`Pr(>F)`[1]),
data.frame(Variable = "Distancia_Casa",
F_value = resumen_anova_distancia[[1]]$`F value`[1],
P_value = resumen_anova_distancia[[1]]$`Pr(>F)`[1]),
data.frame(Variable = "Porcentaje_aumento_salarial",
F_value = resumen_anova_aumento_salarial[[1]]$`F value`[1],
P_value = resumen_anova_aumento_salarial[[1]]$`Pr(>F)`[1])
)
# Mostrar la tabla de resultados
tabla_resultados# Cargar la biblioteca para regresión logística
##install.packages("glm2")
library(glm2)
# Ajustar el modelo de regresión logística
modelo_logistico <- glm(Rotacion_C ~ Edad + Distancia_Casa + Porcentaje_aumento_salarial,
data = rotacion, family = "binomial")
summary(modelo_logistico) ##
## Call:
## glm(formula = Rotacion_C ~ Edad + Distancia_Casa + Porcentaje_aumento_salarial,
## family = "binomial", data = rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.172794 0.436223 0.396 0.69202
## Edad -0.052766 0.008740 -6.037 1.57e-09 ***
## Distancia_Casa 0.026160 0.008527 3.068 0.00215 **
## Porcentaje_aumento_salarial -0.013441 0.019918 -0.675 0.49980
## ---
## 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: 1249.6 on 1466 degrees of freedom
## AIC: 1257.6
##
## Number of Fisher Scoring iterations: 4Resultados Cuantitativas
Edad
# Gráfico de caja y bigotes para la variable "Edad" en relación con la Rotación
ggplot(rotacion, aes(x = as.factor(Rotación ), y = Edad, fill = as.factor(Rotación ))) +
geom_boxplot() +
labs(title = "Relación entre Edad y Rotación (0 = No, 1 = Sí)")
# Gráfico de densidad para la variable "Edad" en relación con la Rotación (Rotación = SI)
ggplot(rotacion, aes(x = Edad, fill = as.factor(Rotación ))) +
geom_density(alpha = 0.6) +
labs(title = "Distribución de Edad en relación con la Rotación") +
theme_bw()
Coeficiente de Correlación (Pearson): -0.1592 Interpretación: Existe una correlación negativa débil entre la edad y la rotación. Esto sugiere que, en general, a medida que la edad aumenta, es menos probable que las personas se vayan. La hipótesis inicial podría haber sido que las personas más jóvenes tienen una mayor probabilidad de rotación, y esta hipótesis se confirma en parte. Distancia_Casa:
Resultados del ANOVA:F_value: 38.1871160 , P_value: 8.309571e-10 El valor p es extremadamente bajo (cercano a cero), lo que indica una fuerte evidencia en contra de la hipótesis nula. Esto significa que la edad está significativamente relacionada con la rotación, y los empleados más jóvenes tienen una mayor probabilidad de rotación, respaldando la hipótesis.
Edad: El coeficiente estimado para la variable “Edad” es -0.052766, y el valor p es muy bajo (1.57e-09), lo que indica que la edad está significativamente relacionada con la probabilidad de rotación. Además, el coeficiente es negativo, lo que significa que a medida que la edad aumenta, la probabilidad de rotación disminuye. Esto sugiere que los empleados más jóvenes tienen una mayor probabilidad de rotación en comparación con los empleados más viejos.
Distancia desde casa :
ggplot(rotacion, aes(x = as.factor(Rotación ), y = Distancia_Casa, fill = as.factor(Rotación ))) +
geom_boxplot() +
labs(title = "Relación entre Distancia_Casa y Rotación (0 = No, 1 = Sí)")
ggplot(rotacion, aes(x = Distancia_Casa, fill = as.factor(Rotación ))) +
geom_density(alpha = 0.6) +
labs(title = "Distancia_Casa Vs Rotación (0 = No, 1 = Sí)") +
theme_bw()
Coeficiente de Correlación (Pearson): 0.0779 Interpretación: Hay una correlación positiva muy débil entre la distancia desde casa y la rotación. Esto indica que las personas que viven más lejos de la empresa tienden ligeramente a tener una mayor probabilidad de rotación. Sin embargo, esta correlación es muy baja y no es estadísticamente significativa. La hipótesis inicial no se cumple. Porcentaje_aumento_salarial:
Resultados del ANOVA:F_value: 8.9682766P_value: 2.793060e-03. El valor p es bajo (0.002793060), lo que sugiere que la distancia desde casa hasta el trabajo está significativamente relacionada con la rotación. Esto respalda la hipótesis de que los empleados que viven más lejos tienen una mayor probabilidad de rotación.
Distancia_Casa: El coeficiente estimado para la variable “Distancia_Casa” es 0.026160, y el valor p es bajo (0.00215), lo que indica una relación significativa con la probabilidad de rotación. El coeficiente es positivo, lo que significa que a medida que la distancia entre la casa y el trabajo aumenta, la probabilidad de rotación también aumenta. Esto sugiere que los empleados que tienen que viajar distancias más largas son más propensos a la rotación. lsa grafica expresa que entre mas cercano o menos distancia se presneta una menor rotacion
Aumento salarial :
# Carga la librería ggpubr
library(ggpubr)
ggplot(rotacion, aes(x = as.factor(Rotacion_C), y = Porcentaje_aumento_salarial, fill = as.factor(Rotación ))) +
geom_boxplot() +
labs(title = "Relación entre Porcentaje_aumento_salarial y Rotación (0 = No, 1 = Sí)")
ggplot(rotacion, aes(x = Porcentaje_aumento_salarial, fill = as.factor(Rotación ))) +
geom_density(alpha = 0.6) +
labs(title = "Porcentaje_aumento_salarial vs Rotación(0 = No, 1 = Sí)") +
theme_bw()
Coeficiente de Correlación (Pearson): -0.0135 Interpretación: Existe una correlación negativa extremadamente débil entre el porcentaje de aumento salarial y la rotación. Esto sugiere que un aumento salarial más alto no necesariamente reduce la probabilidad de rotación. La hipótesis inicial de que un mayor aumento salarial reduce la rotación no se cumple. En resumen, en el análisis de las variables cuantitativas, ninguna de las correlaciones es lo suficientemente fuerte como para respaldar completamente las hipótesis iniciales planteadas en el Punto 2. La relación entre estas variables cuantitativas y la rotación es débil o insignificante.
Resultados del ANOVA:F_value: 0.2667282, P_value: 6.056128e-01Interpretación: El valor p es alto (0.6056128), lo que indica que no hay evidencia suficiente para rechazar la hipótesis nula. Esto significa que el porcentaje de aumento salarial no está significativamente relacionado con la rotación, lo que contradice la hipótesis. En resumen, los resultados del análisis de varianza (ANOVA) respaldan las hipótesis planteadas para las variables de “Edad” y “Distancia_Casa”. Sin embargo, no se encuentra evidencia suficiente para respaldar la hipótesis relacionada con el “Porcentaje_aumento_salarial”.
2.3.2 Variables Cualitativas
# Crear una tabla de contingencia para la variable "Viaje_de_Negocios" y "Rotación"
tabla_Viaje_de_Negocios <- table(rotacion$Viaje_de_Negocios, rotacion$Rotación)
# Realizar una prueba de chi-cuadrado
resultado_chi_cuadrado_Viaje_de_Negocios <- chisq.test(tabla_Viaje_de_Negocios)
tabla_Campo_Educacion <- table(rotacion$Campo_Educación, rotacion$Rotación)
# Realizar una prueba de chi-cuadrado
resultado_chi_cuadrado_Campo_Educacion<- chisq.test(tabla_Campo_Educacion)## Warning in chisq.test(tabla_Campo_Educacion): Chi-squared approximation may be
## incorrect# Crear una tabla de contingencia para la variable "Estado_Civil" y "Rotación"
tabla_contingencia_Estado_Civil <- table(rotacion$Estado_Civil, rotacion$Rotación)
resultado_chi_cuadrado_tabla_contingencia_Estado_Civil <- chisq.test(tabla_contingencia_Estado_Civil)
resultados <- matrix(NA, nrow = 3, ncol = 2)
resultados[1, 1] <- resultado_chi_cuadrado_Viaje_de_Negocios$statistic
resultados[1, 2] <- resultado_chi_cuadrado_Viaje_de_Negocios$p.value
resultados[2, 1] <- resultado_chi_cuadrado_Campo_Educacion$statistic
resultados[2, 2] <- resultado_chi_cuadrado_Campo_Educacion$p.value
resultados[3, 1] <- resultado_chi_cuadrado_tabla_contingencia_Estado_Civil$statistic
resultados[3, 2] <- resultado_chi_cuadrado_tabla_contingencia_Estado_Civil$p.value
resultados_df <- data.frame(
Variable = c("Viaje_de_Negocios", "Campo_Educación", "Estado_Civil"),
X_squared = resultados[, 1],
p_value = resultados[, 2]
)
# Imprimir la tabla de resultados
print(resultados_df)## Variable X_squared p_value
## 1 Viaje_de_Negocios 24.18241 5.608614e-06
## 2 Campo_Educación 16.02467 6.773980e-03
## 3 Estado_Civil 46.16368 9.455511e-11Resultados Cualitativas
Variable “Viaje_de_Negocios”
library(ggplot2)
# Gráfico de barras para variable categórica "Viaje de Negocios" con cantidad y porcentajes en las etiquetas
ggplot(rotacion, aes(x = Viaje_de_Negocios, fill = as.factor(Rotación ))) +
geom_bar(position = "fill") +
labs(title = "Relación entre Viaje de Negocios y Rotación (0 = No, 1 = Sí)") +
geom_text(stat = 'count', aes(label = ..count..), position = position_fill(vjust = 0.5), vjust = -0.5) +
geom_text(stat = 'count', aes(label = scales::percent(..count../sum(..count..))),
position = position_fill(vjust = 0.5), vjust = 1.5)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Hipótesis: Los empleados que viajan con frecuencia por negocios pueden tener una mayor probabilidad de rotación debido a la carga de trabajo adicional y el estrés relacionado con los viajes. Resultado: La prueba de chi-cuadrado mostró un valor de p extremadamente pequeño (p-value = 5.608614e-06), lo que indica que la variable “Viaje_de_Negocios” está relacionada de manera significativa con la rotación. Esto respalda la hipótesis de que los viajes de negocios están asociados con una mayor probabilidad de rotación cuadno raramente o frecuentemente tienen que viajar.
Variable “Campo_Educación”
# Gráfico de barras para variable categórica "Campo de Educación" con cantidad y porcentajes en las etiquetas
ggplot(rotacion, aes(x = Campo_Educación, fill = as.factor(Rotación ))) +
geom_bar(position = "fill") +
labs(title = "Relación entre Campo de Educación y Rotación (0 = No, 1 = Sí)") +
geom_text(stat = 'count', aes(label = ..count..), position = position_fill(vjust = 0.5), vjust = -0.5) +
geom_text(stat = 'count', aes(label = scales::percent(..count../sum(..count..))),
position = position_fill(vjust = 0.5), vjust = 1.5)
Hipótesis: Los empleados más especializados o técnicos pueden tener una menor rotación en comparación con aquellos en campos más genéricos debido a la demanda de habilidades específicas. Resultado: La prueba de chi-cuadrado mostró un valor de p pequeño (p-value = 6.773980e-03), lo que indica que la variable “Campo_Educación” está relacionada de manera significativa con la rotación. Esto respalda la hipótesis de que el campo de educación influye en la rotación.
Variable “Estado_Civil”
# Gráfico de barras para variable categórica "Estado Civil" con cantidad y porcentajes en las etiquetas
ggplot(rotacion, aes(x = Estado_Civil, fill = as.factor(Rotación ))) +
geom_bar(position = "fill") +
labs(title = "Relación entre Estado Civil y Rotación (0 = No, 1 = Sí)") +
geom_text(stat = 'count', aes(label = ..count..), position = position_fill(vjust = 0.5), vjust = -0.5) +
geom_text(stat = 'count', aes(label = scales::percent(..count../sum(..count..))),
position = position_fill(vjust = 0.5), vjust = 1.5)
Hipótesis: Los empleados casados tienen una menor probabilidad de rotación en comparación con los solteros, debido a las responsabilidades familiares generan una mayor estabilidad laboral. Resultado: La prueba de chi-cuadrado mostró un valor de p extremadamente pequeño (p-value = 9.455511e-11), lo que indica que la variable “Estado_Civil” está relacionada de manera significativa con la rotación. Esto respalda la hipótesis de que el estado civil está asociado con la rotación. Se identifica que evidentemente los casados y los divorciados tienen una mas baja probavilidad de rotacion .
2.4 Estimación del modelo
Realiza la estimación de un modelo de regresión logístico en el cual la variable respuesta es rotacion (y=1 es si rotación, y=0 es no rotación) y las covariables las 6 seleccionadas en el punto 1. Interprete los coeficientes del modelo y la significancia de los parámetros.
- para este ejercicio relice el analisis con 2 modelos
2.4.1 modelo_logistico_1
library(stats)
data <- data.frame(
Rotacion_C = c(1, 0, 1, 0, 0, 1, 0, 1, 0, 0), # Variable de respuesta (0 o 1)
Edad = c(41, 49, 37, 33, 27, 32, 59, 30, 38, 36), # Variable cuantitativa
Distancia_Casa = c(1, 8, 2, 3, 2, 2, 3, 24, 23, 27), # Variable cuantitativa
Porcentaje_aumento_salarial = c(11, 23, 15, 11, 12, 13, 20, 22, 21, 13), # Variable cuantitativa
Viaje_de_Negocios = c("Raramente", "Frecuentemente", "Raramente", "Frecuentemente", "Raramente", "Frecuentemente", "Raramente", "Raramente", "Frecuentemente", "Frecuentemente"), #
Campo_Educación = c("Ciencias", "Ciencias", "Otra", "Ciencias", "Salud", "Ciencias", "Salud", "Ciencias", "Ciencias", "Salud"), # Variable cualitativa
Estado_Civil = c("Soltero", "Casado", "Soltero", "Casado", "Casado", "Soltero", "Casado", "Divorciado", "Soltero", "Casado") # Variable cualitativa
)
modelo_logistico <- glm(Rotacion_C ~ Edad + Distancia_Casa + Porcentaje_aumento_salarial +
Viaje_de_Negocios + Campo_Educación + Estado_Civil,
data = data, family = binomial(link = "logit"))## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred##
## Call:
## glm(formula = Rotacion_C ~ Edad + Distancia_Casa + Porcentaje_aumento_salarial +
## Viaje_de_Negocios + Campo_Educación + Estado_Civil, family = binomial(link = "logit"),
## data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -11.694 306589.653 0 1
## Edad 1.128 13950.243 0 1
## Distancia_Casa -1.074 13553.857 0 1
## Porcentaje_aumento_salarial -4.252 36974.163 0 1
## Viaje_de_NegociosRaramente -19.998 283993.697 0 1
## Campo_EducaciónOtra 23.258 297165.067 0 1
## Campo_EducaciónSalud 28.626 329624.915 0 1
## Estado_CivilDivorciado 142.738 642818.102 0 1
## Estado_CivilSoltero 58.192 233234.368 0 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1.3460e+01 on 9 degrees of freedom
## Residual deviance: 2.2558e-10 on 1 degrees of freedom
## AIC: 18
##
## Number of Fisher Scoring iterations: 24RESULTADOS
Intercept (Intercepción): El valor del coeficiente de intercepción es -11.694. Esto representa el valor logarítmico de la razón de probabilidad (odds ratio) cuando todas las demás variables son iguales a cero.
Edad: El coeficiente para la variable “Edad” es 1.128. Esto significa que, manteniendo todas las demás variables constantes, por cada unidad adicional de edad, la probabilidad de rotación (y=1) aumenta en un factor de exp(1.128) ≈ 3.09. Esto sugiere que a medida que los empleados son más jóvenes, tienen una mayor probabilidad de rotación.
Distancia_Casa: El coeficiente para la variable “Distancia_Casa” es -1.074. la probabilidad de rotación disminuye en un factor de exp(-1.074) . Esto implica que cuanto más lejos viva un empleado de su lugar de trabajo, menor es la probabilidad de rotación.
Porcentaje_aumento_salarial: El coeficiente para la variable “Porcentaje_aumento_salarial” es -4.252. Esto sugiere que, manteniendo todas las demás variables constantes, por cada unidad adicional de aumento salarial, la probabilidad de rotación disminuye los empleados que reciben aumentos salariales más bajos tienen una mayor probabilidad de rotación.
Viaje_de_Negocios: Hay dos categorías para esta variable: “Raramente” y “Frecuentemente”. Ambos coeficientes para estas categorías son altamente negativos (-19.998 para “Raramente”). Esto indica que, en comparación con aquellos que raramente viajan por negocios, los empleados que viajan frecuentemente tienen una menor probabilidad de rotación. Sin embargo, No es clara esta definicion lo que podría indicar un problema de multicolinealidad o un ajuste inadecuado del modelo.
Campo_Educación: Las categorías “Otra” y “Salud” tienen coeficientes positivos (23.258 y 28.626, respectivamente). Esto sugiere que los empleados en estos campos tienen una mayor probabilidad de rotación en comparación con aquellos en el campo de “Ciencias”
Estado_Civil: Las categorías “Divorciado” y “Soltero” tienen coeficientes positivos (142.738 y 58.192, respectivamente). Esto sugiere que los empleados en estas categorías tienen una mayor probabilidad de rotación en comparación con los empleados casados, que es la categoría de referencia. estos coeficientes son muy altos indica que se debe identificar apacidad inadecuada de entender el modelo
2.4.1 modelo_logistico_1
Debido a los reusltado anteriores se deliza ajustede del modelo
modelo_2=glm(Rotacion_C~Edad+Distancia_Casa+Porcentaje_aumento_salarial+Viaje_de_Negocios+Campo_Educación+Estado_Civil,data = rotacion,family = "binomial")
summary(modelo_2)##
## Call:
## glm(formula = Rotacion_C ~ Edad + Distancia_Casa + Porcentaje_aumento_salarial +
## Viaje_de_Negocios + Campo_Educación + Estado_Civil, family = "binomial",
## data = rotacion)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.012625 0.492835 0.026 0.979563
## Edad -0.047762 0.008923 -5.353 8.66e-08 ***
## Distancia_Casa 0.030681 0.008806 3.484 0.000494 ***
## Porcentaje_aumento_salarial -0.008124 0.020558 -0.395 0.692698
## Viaje_de_NegociosNo_Viaja -1.413038 0.342691 -4.123 3.73e-05 ***
## Viaje_de_NegociosRaramente -0.638947 0.172569 -3.703 0.000213 ***
## Campo_EducaciónHumanidades 1.026372 0.478895 2.143 0.032096 *
## Campo_EducaciónMercadeo 0.569127 0.235370 2.418 0.015606 *
## Campo_EducaciónOtra -0.161515 0.356642 -0.453 0.650636
## Campo_EducaciónSalud -0.103048 0.184662 -0.558 0.576820
## Campo_EducaciónTecnicos 0.622849 0.248201 2.509 0.012092 *
## Estado_CivilDivorciado -0.219964 0.222923 -0.987 0.323779
## Estado_CivilSoltero 0.854289 0.165533 5.161 2.46e-07 ***
## ---
## 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: 1172.2 on 1457 degrees of freedom
## AIC: 1198.2
##
## Number of Fisher Scoring iterations: 5RESULTADOS
Edad: A medida que la edad aumenta, la probabilidad de rotación disminuye.
Distancia_Casa: A medida que la distancia entre la casa y el trabajo aumenta, la probabilidad de rotación aumenta.
Porcentaje_aumento_salarial: El aumento salarial no tiene un impacto significativo en la probabilidad de rotación.
Viaje_de_Negocios: Los empleados que viajan frecuentemente o raramente por negocios tienen una menor probabilidad de rotación en comparación con los que no viajan.
Campo_Educación: El campo de educación influye en la probabilidad de rotación, pero su interpretación depende de la categoría específica.
Estado_Civil: Los empleados divorciados y solteros tienen una mayor probabilidad de rotación en comparación con los empleados casados.
En resumen, la edad, la distancia a casa y el tipo de viaje de negocios son factores importantes para predecir la rotación. El aumento salarial no parece influir significativamente en la rotación. La educación y el estado civil también desempeñan un papel, pero su impacto puede variar según las categorías específicas.
2.5. Evaluación
Evaluar el poder predictivo del modelo con base en la curva ROC y el AUC.
## Loading required package: gridpredict1= predict.glm(modelo_2, newdata = rotacion, type = "response")
resultado1 = table(rotacion$Rotación, ifelse(predict1 >0.2, 1, 0), dnn = c("observaciones", "predicciones"))
resultado1## predicciones
## observaciones 0 1
## No 948 285
## Si 115 122mosaic(resultado1, shade = T, colorize = T,
gp = gpar(fill = matrix(c("#9BCD9B", "#EE6A50", "#EE9572", "#698B69"), 2, 2)))
## [1] 0.7278912El modelo es capaz de clasificar correctamente 0.727(72.7%) .
#install.packages("ROCR")
library(ROCR)
Prediccion_rotacion= ROCR::prediction(predict1,rotacion$Rotación)
perf= performance(prediction.obj = Prediccion_rotacion, "tpr", "fpr")
plot(perf,xlab = "Especificidad", ylab = "Sensitivity", col="red")
abline(a=0, b=1, col="#104E8B")
grid()
## AUC: 0.7051085 nEl área bajo la curva de 0.77 indica que el modelo es aceptable y puede servir para predecir la probabilidad de rotación del empleado. sugiere un rendimiento bueno del modelo
2.6 Predicciones
Realiza una predicción la probabilidad de que un individuo (hipotético) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
empleado_hipotetico <- data.frame(
Edad = 30, # Edad del empleado hipotético
Distancia_Casa = 5, # Distancia a casa
Porcentaje_aumento_salarial = 10, # Porcentaje de aumento salarial
Viaje_de_Negocios = "No_Viaja", # Frecuencia de viaje
Campo_Educación = "Ciencias", # Campo de educación
Estado_Civil = "Casado" # Estado civil
)
probabilidad_rotacion <- predict(modelo_2, newdata = empleado_hipotetico, type = "response")
umbral <- 0.5
if (probabilidad_rotacion > umbral) {
mensaje <- "Se debe Seleccionar con el empleado hipotético."
} else {
mensaje <- "No se debe selecccionar con el empleado hipotético."
}
# Imprimir el resultado
cat("Probabilidad de rotación:", probabilidad_rotacion, "\n")## Probabilidad de rotación: 0.05946233## No se debe selecccionar con el empleado hipotético.2.7 Conclusiones
Realiza una predicción la probabilidad de que un individuo (hipotético) rote y defina un corte para decidir si se debe intervenir a este empleado o no (posible estrategia para motivar al empleado).
RESPUESTA
En conclusión, el modelo de regresión logística desarrollado para predecir la rotación de empleados en la empresa con una precision ha identificado variables clave que influyen en la probabilidad de que un empleado decida dejar la organización. Entre estas variables, la edad, la distancia a casa y el porcentaje de aumento salarial se destacan como factores significativos.A medida que los empleados envejecen y experimentan un aumento salarial más significativo,
Las estrategias son :
Programas de Desarrollo Profesional: Implementar programas de desarrollo profesional que fomenten el crecimiento y la promoción dentro de la empresa. Esto puede aumentar la satisfacción de los empleados, especialmente entre los más jóvenes, y reducir la probabilidad de rotación.
Flexibilidad en el Trabajo: Ofrecer opciones de trabajo flexible, como teletrabajo o horarios flexibles, para aquellos empleados que enfrentan largas distancias para llegar al trabajo. Esto puede mejorar su calidad de vida y reducir la probabilidad de rotación. Compensación Competitiva:
Mantener una política de compensación competitiva. Asegurarse de los aumentos salariales sean acordes con el mercado y al sector .
Ajuste de horarios para no tener dificultades de transporte