INFORME MODELOS LINEALES GENERALES
CARLOS ANDRÉS TORRES RICAURTE Y FERNANDO CARDONA HANSEN
2023-03-29
SITUACIÓN 1. ROTACIÓN DE CARGO
Cargue de datos
rotacion <- read_delim("/Users/fernando/Desktop/Maestria Ciencia de Datos/Maestría Ciencia de Datos/Métodos y simulación Estadística/Taller 3 MLG_/rotacion.csv",
delim = ";", escape_double = FALSE, trim_ws = TRUE) ## Rows: 1470 Columns: 24
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## chr (8): Rotación, Viaje de Negocios, Departamento, Campo_Educación, Genero...
## dbl (16): Edad, Distancia_Casa, Educación, Satisfacción_Ambiental, Satisfaci...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.rotacion <- rotacion %>%
as.data.frame() %>%
mutate_if(is.character, as.factor)
str(rotacion)## 'data.frame': 1470 obs. of 24 variables:
## $ Rotación : Factor w/ 2 levels "No","Si": 2 1 2 1 1 1 1 1 1 1 ...
## $ Edad : num 41 49 37 33 27 32 59 30 38 36 ...
## $ Viaje de Negocios : Factor w/ 3 levels "Frecuentemente",..: 3 1 3 1 3 1 3 3 1 3 ...
## $ Departamento : Factor w/ 3 levels "IyD","RH","Ventas": 3 1 1 1 1 1 1 1 1 1 ...
## $ Distancia_Casa : num 1 8 2 3 2 2 3 24 23 27 ...
## $ Educación : num 2 1 2 4 1 2 3 1 3 3 ...
## $ Campo_Educación : Factor w/ 6 levels "Ciencias","Humanidades",..: 1 1 4 1 5 1 5 1 1 5 ...
## $ Satisfacción_Ambiental : num 2 3 4 4 1 4 3 4 4 3 ...
## $ Genero : Factor w/ 2 levels "F","M": 1 2 2 1 2 2 1 2 2 2 ...
## $ Cargo : Factor w/ 9 levels "Director_Investigación",..: 3 5 9 5 9 9 9 9 2 7 ...
## $ Satisfación_Laboral : num 4 2 3 3 2 4 1 3 3 3 ...
## $ Estado_Civil : Factor w/ 3 levels "Casado","Divorciado",..: 3 1 3 1 1 3 1 2 3 1 ...
## $ Ingreso_Mensual : num 5993 5130 2090 2909 3468 ...
## $ Trabajos_Anteriores : num 8 1 6 1 9 0 4 1 0 6 ...
## $ Horas_Extra : Factor w/ 2 levels "No","Si": 2 1 2 2 1 1 2 1 1 1 ...
## $ Porcentaje_aumento_salarial: num 11 23 15 11 12 13 20 22 21 13 ...
## $ Rendimiento_Laboral : num 3 4 3 3 3 3 4 4 4 3 ...
## $ Años_Experiencia : num 8 10 7 8 6 8 12 1 10 17 ...
## $ Capacitaciones : num 0 3 3 3 3 2 3 2 2 3 ...
## $ Equilibrio_Trabajo_Vida : num 1 3 3 3 3 2 2 3 3 2 ...
## $ Antigüedad : num 6 10 0 8 2 7 1 1 9 7 ...
## $ Antigüedad_Cargo : num 4 7 0 7 2 7 0 0 7 7 ...
## $ Años_ultima_promoción : num 0 1 0 3 2 3 0 0 1 7 ...
## $ Años_acargo_con_mismo_jefe : num 5 7 0 0 2 6 0 0 8 7 ...El conjunto de datos cuenta con información de 1.470 empleados, a los cuales se les ha medido 24 variables, de las cuales 16 son numericas y 8 son categóricas. Entre las variables categoricas se encuentra la rotación, que indica si el empleado Rota o No rota de puesto, representada de forma Binaria y será la variable interés, queriendo calcular un modelo explicativo que relacione a las variables independientes mediante el efecto causado a la ocurrencia de la rotación de un empleado.
Punto 1
Planteamiento hipótesis.
Selección de Variables Categóricas y Cuantitativas
En este primer ejercicio realizamos un análisis del número de variables cualitativas y cuantitativas con las que contaba el archivo inicial. Seguidamente seleccionamos las 6 variables relacionadas con la rotación 3 cualitativas y 3 cuantitativas como los quería el ejercicio.:
Variables Cualitativas
Variable 1: Satisfacción Ambiente: Se espera que la satisfacción en el ambiente laboral se relacione con la rotación, ya que los empleados con un nivel de satisfacción bajo en su lugar trabajo sean más propensos al cambio de trabajo. La hipótesis es que las personas que no se encuentran muy satisfechas en su ambiente laboral tienen mayor posibilidad de rotar con respecto a las que se sienten muy satisfechas.
Variable 2: Rendimiento Laboral: Con baja satisfacción en el ambiente laboral, se puede generar un mal rendimiento laboral, esta condición no permite pensar en tener oportunidades para seguir ascendiendo en la empresa. La hipótesis es que las personas con un bajo rendimiento laboral dado por las condiciones del ambiente, buscan mejorar esa condición laboral, es por esta razón que se puede presentar mayor posibilidad de rotar que las que tienen un buen rendimiento laboral y se sienten más satisfechos en su trabajo.
Variable 3: Equilibrio trabajo y vida: La satisfacción laboral influye de manera directa sobre la satisfacción en la vida cotidiana, esta variable evidencia el desarrollo de la persona tanto en su vida laboral como en su cotidianidad, la hipótesis que se puede generar es que las personas que se encuentran en un desequilibrio entre su trabajo y su vida cotidiana, están más propensas a querer cambiar de trabajo.
Variables Cuantitativas
Variable 1: Edad: En lo concerniente a la edad y su relación con las oportunidades de desarrollo en el trabajo, se espera que en ciertos grupos de edad sea mayor la probabilidad de rotación, ya que buscan mejorar condiciones de tipo profesional, es decir la satisfacción de necesidades y búsquedas de logros que probablemente la empresa no les da y por eso deciden buscarlos fuera de la organización en la que están actualmente. La hipótesis es que las personas en los grupos de edad más jóvenes sean más propensos a buscar otras oportunidades laborales y por lo tanto roten más.
Variable 2: Trabajos Anteriores: Presentar un historial laboral permanente de cambio, describe un patrón frecuente de cambio de su lugar de trabajo. La hipótesis es que el grupo de personas que han tenido varios trabajos antes de llegar a la empresa tienen mayor posibilidad de rotar que aquellas que no han presentado cambio de trabajos.
Variable 3: Antigüedad en el cargo: Es menos probable que los empleados más nuevos se queden en el mismo cargo. Los empleados con más años de experiencia en el cargo pueden tener un sentido de lealtad y estar más comprometidos con su trabajo. Además, pueden sentirse relativamente cómodos en las actividades relacionadas y por eso han durado más.
Punto 2
a. Caracterización de la fuente de rotación:
df_num <- rotacion %>% select_if(is.numeric)
df_chr <- rotacion %>% select_if(is.factor)
descriptivas_num <- data.frame(mini=apply(df_num, 2, min),
media=apply(df_num, 2, mean),
maxim=apply(df_num, 2, max),
sd=apply(df_num, 2, sd),
CV=apply(df_num, 2, function(x) sd(x)/mean(x)))
print(descriptivas_num)## mini media maxim sd CV
## Edad 18 36.923810 60 9.1353735 0.2474115
## Distancia_Casa 1 9.192517 29 8.1068644 0.8818982
## Educación 1 2.912925 5 1.0241649 0.3515933
## Satisfacción_Ambiental 1 2.721769 4 1.0930822 0.4016073
## Satisfación_Laboral 1 2.728571 4 1.1028461 0.4041844
## Ingreso_Mensual 1009 6502.931293 19999 4707.9567831 0.7239746
## Trabajos_Anteriores 0 2.693197 9 2.4980090 0.9275254
## Porcentaje_aumento_salarial 11 15.209524 25 3.6599377 0.2406346
## Rendimiento_Laboral 3 3.153741 4 0.3608235 0.1144113
## Años_Experiencia 0 11.279592 40 7.7807817 0.6898106
## Capacitaciones 0 2.799320 6 1.2892706 0.4605657
## Equilibrio_Trabajo_Vida 1 2.761224 4 0.7064758 0.2558560
## Antigüedad 0 7.008163 40 6.1265252 0.8741984
## Antigüedad_Cargo 0 4.229252 18 3.6231370 0.8566851
## Años_ultima_promoción 0 2.187755 15 3.2224303 1.4729392
## Años_acargo_con_mismo_jefe 0 4.123129 17 3.5681361 0.8653952Edad: La edad de los empleados oscila entre 18 y 60 años, con una media de 36.92 y una desviación estándar de 9.14. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 24.74%.
Distancia a casa: La distancia de la casa al trabajo oscila entre 1 y 29 km, con una media de 9.19 km y una desviación estándar de 8.11 km. El coeficiente de variación indica que la dispersión de los datos es alta, siendo del 88.19%.
Educación: El nivel de educación de los empleados oscila entre 1 y 5, con una media de 2.91 y una desviación estándar de 1.02. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 35.16%.
Satisfacción ambiental: La satisfacción ambiental oscila entre 1 y 4, con una media de 2.72 y una desviación estándar de 1.09. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 40.16%.
Satisfacción laboral: La satisfacción laboral oscila entre 1 y 4, con una media de 2.73 y una desviación estándar de 1.10. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 40.42%.
Ingreso mensual: Los ingresos mensuales oscilan entre 1009 y 19999 dólares, con una media de 6502.93 dólares y una desviación estándar de 4707.96 dólares. El coeficiente de variación indica que la dispersión de los datos es alta, siendo del 72.40%.
Trabajos anteriores: El número de trabajos anteriores oscila entre 0 y 9, con una media de 2.69 y una desviación estándar de 2.50. El coeficiente de variación indica que la dispersión de los datos es alta, siendo del 92.75%.
Porcentaje aumento salarial: El porcentaje de aumento salarial oscila entre 11% y 25%, con una media de 15.21% y una desviación estándar de 3.66%. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 24.06%.
Rendimiento laboral: El rendimiento laboral oscila entre 3 y 4, con una media de 3.15 y una desviación estándar de 0.36. El coeficiente de variación indica que la dispersión de los datos es baja, siendo del 11.44%.
Años de experiencia: Los años de experiencia oscilan entre 0 y 40 años, con una media de 11.28 años y una desviación estándar de 7.78 años. El coeficiente de variación indica que la dispersión de los datos es alta, siendo del 68.98%.
En resumen, algunas variables tienen una dispersión alta (como la distancia casa-trabajo, ingresos mensuales y número de trabajos anteriores), mientras que otras tienen una dispersión baja (como la satisfacción ambiental y laboral, y el rendimiento laboral). Y respecto al coeficiente de variación (CV), hay variables con una mayor variabilidad relativa (porcentaje aumento salarial y edad) y otras con una menor variabilidad relativa (educación y rendimiento laboral).
par(mfrow = c(2, 4))
for (col in colnames(df_chr)) {
# Obtener la frecuencia de cada categoría
freq <- table(df_chr[[col]])
# Calcular los porcentajes de cada categoría
percent <- round(100 * prop.table(freq), 1)
# Crear el gráfico de barras con los porcentajes en la etiqueta
barplot(freq, main = col, ylab = "Frecuencia", col = "skyblue",
ylim = c(0, max(freq) * 1.2), cex.names = 0.8,
names.arg = names(freq), las = 2)
text(x = 1:length(freq), y = freq * 1.05, labels = paste0(percent, "%"),
col = "black", cex = 0.8, pos = 3)
}
Rotación: La rotación varía entre un 83,9% de empleados que no ha rotado y un 16,1% que si lo ha hecho. Como variable de interés se puede decir que está desbalanceada a favor de quienes no han rotado.
Viaje de Negocios: Respecto a la frecuencia con la que los empleados realizan los empleados, se observa que el 71% raramente viaja, el 18,8% lo hace frecuentemente, y el 10,2% no viaja.
Departamento Respecto al tipo de departamento se observa que el 65,4% de los empleados pertenecen al departamento de Investigación y desarrollo (IyD), seguido del 30,0% que pertenece al departamento de Ventas y el 4,3% pertenece al grupo de Recursos humanos (RH).
Campo educación: Se observa que el 41,2% pertenece a campos de las ciencias naturales, el 31% pertenecen al campo de la salud, un 10,8% pertence al campo del mercadeo. El porcentaje restante se encuentra entre personas que estudiaron en el campos técnicos, otros campos y humanidades respectivamente.
Genero: Respecto al genero se observa que el personal femenino está conformado por un 40%, mientras que el másculino lo conforma el 60%
Cargo La tabla muestra porcentajes de la distribución de cargos dentro de una empresa. La posición más común es la de Ejecutivo de Ventas, que representa el 22,1% de los cargos, seguido por el Investigador Científico, que representa el 19,8%. El siguiente cargo más común es el Técnico de Laboratorio, que representa el 17,6% de los cargos, seguido por el Director de Manufactura, que representa el 9,8% de los cargos.
En cuanto a los cargos menos comunes, el que menos se repite es el de Recursos Humanos, que representa solo el 3,5% de los cargos. Seguido de cerca por el cargo de Representante de Ventas, que representa solo el 5,6% de los cargos. Otros cargos menos comunes incluyen el de Gerente, que representa solo el 6,9% de los cargos, y el de Representante de Salud, que representa el 8,9% de los cargos.
Estado civil: Respecto al estado civil se observa que el 45,8% de los empleados es casado, seguido del el 32% de empleados solteros el 22,2% es divorciado.
Horas extra: Respecto a las horas extras se observa que el 71,7% de los empleados no hace horas extras, mientras que el 28,3% si las hace.
b. Análisis bivariado de datos:
plots <- list()
numeric_vars <- sapply(rotacion, is.numeric)
for(var in names(rotacion[numeric_vars])){
p <- ggplot(rotacion, aes(x = Rotación, y = .data[[var]])) +
geom_boxplot() +
labs(title = paste(var),
x = "Rotación",
y = var)
plots[[var]] <- p
}
grid.arrange(grobs = plots[1:8], ncol = 3)
Gráficamente, habrá un posible efecto de la variable independiente si se observan cambios en la forma de las distribuciones (cajas) al observar la categoría de quienes rotan contra los que no los hacen.
En este primer bloque de gráficos se puede observar para los empleados que si rotan que:
- Sus edades tienen una distribución menor, con una mediana de 31 años.
- La distancia a sus casas se distribuye levemente hacia distancias mayores, es decir pueden ser empleados que viven más lejos.
- La satisfacción ambiental toma valores menores, con más ocurrencia.
- La satisfacción Laboral, igual que en la anterior variable, toma valores mayores con más ocurrencia.
- El ingreso suele estar por debajo de los que no rotan, siendo menor de $ 5.000. - La mediana de sus trabajos anteriores es de 1 trabajo, menor que la de aquellos que no rotan
- El promedio de aumento salarial parece mantenerce igual entre ambos.
grid.arrange(grobs = plots[9:16], ncol = 3)
Para este bloque de gráficos se observa que aquellos empleados que si rotan:
- Tienen una distribución más baja en años de experiencia, es decir que suelen ser empleados más novatos.
- Son menos antiguos tanto en la empresa como en los cargos, con presencia de punto atípicos.
- Tienen menos años con un mismo jefe, lo cual tendría sentido ya que han rotado.
Y en general las otras variables no parecen tener diferencias gráficas aparentes.
Punto 3
Estimación de coeficientes:
Se presentan los resultados de la estimación de coeficientes de regresión logística. Se presentará su p-valor y el exponencial del coeficiente beta, para poderlo estimar en términos de la razón de la probabilidad de que se presente una rotación. $ e ^{{}_j}$.
## PUNTO 3
# Realización de un modelo logistico bivariado.
# Arreglo previo de la estructura y definición de los objetos
colnames(rotacion) <- gsub(" ", "_", colnames(rotacion))
vari <- colnames(rotacion)
df_coeficientes <- data.frame(matrix(ncol=5, nrow=0)) # Inicializa un marco de datos vacío con dos columnas para los coeficientes y p-valores
for(xs in vari[-1]){
mod <- glm(as.formula(paste("Rotación ~", xs)), data = rotacion, family = binomial(link ="logit"))
resumen <- summary(mod)
tabla_resumen <- resumen$coefficients
#coeficiente <- exp(resumen$coefficients[2,1])
#pvalor <- resumen$coefficients[2,4]
df_coeficientes <- rbind(df_coeficientes, tabla_resumen) # Agrega una fila al marco de datos con los coeficientes y p-valores para cada variable independiente
}
# Asigna los nombres de las columnas del marco de datos
colnames(df_coeficientes) <- c("Coeficiente", "Sd error", "valor Z","P_valor")
round(df_coeficientes[,c(1,4)],3)## Coeficiente P_valor
## (Intercept) 0.206 0.500
## Edad -0.052 0.000
## (Intercept)1 -1.103 0.000
## Viaje_de_NegociosNo_Viaja -1.339 0.000
## Viaje_de_NegociosRaramente -0.635 0.000
## (Intercept)2 -1.829 0.000
## DepartamentoRH 0.382 0.253
## DepartamentoVentas 0.481 0.001
## (Intercept)3 -1.890 0.000
## Distancia_Casa 0.025 0.003
## (Intercept)4 -1.411 0.000
## Educación -0.083 0.229
## (Intercept)5 -1.759 0.000
## Campo_EducaciónHumanidades 0.710 0.118
## Campo_EducaciónMercadeo 0.494 0.027
## Campo_EducaciónOtra -0.105 0.759
## Campo_EducaciónSalud -0.091 0.607
## Campo_EducaciónTecnicos 0.620 0.008
## (Intercept)6 -0.986 0.000
## Satisfacción_Ambiental -0.253 0.000
## (Intercept)7 -1.751 0.000
## GeneroM 0.166 0.259
## (Intercept)8 -3.664 0.000
## CargoDirector_Manofactura 1.061 0.178
## CargoEjecutivo_Ventas 2.112 0.004
## CargoGerente 0.698 0.412
## CargoInvestigador_Cientifico 2.012 0.006
## CargoRecursos_Humanos 2.460 0.002
## CargoRepresentante_Salud 1.057 0.184
## CargoRepresentante_Ventas 3.248 0.000
## CargoTecnico_Laboratorio 2.507 0.001
## (Intercept)9 -0.990 0.000
## Satisfación_Laboral -0.251 0.000
## (Intercept)10 -1.948 0.000
## Estado_CivilDivorciado -0.239 0.271
## Estado_CivilSoltero 0.877 0.000
## (Intercept)11 -0.929 0.000
## Ingreso_Mensual 0.000 0.000
## (Intercept)12 -1.777 0.000
## Trabajos_Anteriores 0.046 0.096
## (Intercept)13 -2.150 0.000
## Horas_ExtraSi 1.327 0.000
## (Intercept)14 -1.496 0.000
## Porcentaje_aumento_salarial -0.010 0.605
## (Intercept)15 -1.718 0.006
## Rendimiento_Laboral 0.022 0.912
## (Intercept)16 -0.883 0.000
## Años_Experiencia -0.078 0.000
## (Intercept)17 -1.295 0.000
## Capacitaciones -0.130 0.023
## (Intercept)18 -0.997 0.000
## Equilibrio_Trabajo_Vida -0.240 0.014
## (Intercept)19 -1.156 0.000
## Antigüedad -0.081 0.000
## (Intercept)20 -1.118 0.000
## Antigüedad_Cargo -0.146 0.000
## (Intercept)21 -1.587 0.000
## Años_ultima_promoción -0.030 0.206
## (Intercept)22 -1.147 0.000
## Años_acargo_con_mismo_jefe -0.141 0.000Según los resultados del modelo se puede afirmar que, con una significancia del 5%:
La variable educación, el genero, trabajos anteriores, no es significativa, porcentaje de aumento salarial, rendimiento laboral, años de ultima promoción.
La edad es significativa y el signo negativo indica que a mendida que la edad aumenta, la probabilidad de que una persona rote de cargo disminuye.
La variable Viaje de negocios es significativa, y teniendo como referencia a quienes viajan frecuentemente por negocios, el hecho de que una persona no viaje disminuye la probabilidad de que una persona rote de puesto. Al igual que con las personas que viajan raramente.
El tipo de departamento es una variable significativa, y teniendo como referencia a quienes pertenecen al departamento IyD, el pertenecer departamento de ventas aumenta la probabilidad de rotar de puesto. Con respecto al departamento RH no se encontraron diferencias significativas.
La distancia a casa es una variable significativa, y el signo indica que al aumentar la distancia a la casa aumentará la probabilidad de que el empleado rote.
La distancia a la casa es significativa y a medida que aumente la distancia a la casa, aumenta la posibilidad de que el empleado rote de cargo.
El campo de educación es significativa para las categorías de mercadeo y carreras técnicas, cuyos signos indican que pertenecer a estas carreras, con respecto a empleados que estudiaron ciencias, la probabilidad de que roten será mayor.
La satisfacción ambiental es significativa y su signo indica que a medida que empleados que perciben menor satisfacción ambiental, son más propensos a rotar.
La variable cargo es significativas para categorías como ejecutivo de ventas, investigador cientifico, recurso humano, representante de ventas y técnico de laboratorio. Como todos sus signos son positivos, indican que empleados que pertenecen a estos cargos están más propensos a rotar con respecto al cargo de referencia Director de investigación.
La satisfacción laboral es significativa y su signo indica que a medida que empleados que perciben menor satisfacción laboral, son más propensos a rotar.
El estado civil es significativo para la categoría divorciados, y su signo indica que empleados divorsiados son más propensos a rotar, con respecto a empleados casados.
El ingreso mensual es significativo, sin embargo su coeficiente es muy cercano a cero. Se puede decir por su signo negativo, y teniendo en cuenta el gráfico de cajas correspondiente, que empleados con menores ingresos mensuales, son más propensos a rotar.
Las horas extras son significativas, y su signo indica que, con respecto a los empleado que no trabajan horas extras, aquellos que si lo hacen son más propensos a rotar.
Los años de experiencia es una variable significativa, y su signo negativo indica que a más años de experiencia tengan los empleados, estarán menos propensos a rotar.
Las capacitaciones es una variable significativa, y su signo negativo indica que a más capacitaciones tengan los empleados, estarán menos propensos a rotar.
Para resumir, otras variables numéricas como Equilibrio_Trabajo_Vida, Antigüedad, Antigüedad_Cargo y Años_acargo_con_mismo_jefe son significativas, y sus coeficientes son negativos, indicando que empleados con valores mayores en estas variables (por ejemplo mayor equilibrio en el trabajo y vida, o mayor antiguedad en años) serán menos propensos a rotar de cargo.
Comparación con las hipótesis
Las hipótesis planteadas con respecto al número de trabajos anteriores y el rendimiento laboral de los empleados no fueron soportadas por los resultados de los modelos ajustados. Mientras que las hipótesis sobre la Satisfacción Ambiente, el Equilibrio trabajo y vida, la edad y la antigüedad en el cargo fueron respaldadas por los resultados bajo una significancia del 5%, y fueron coherentes respecto al tipo de magnitud que tuvieron los coeficientes.
Punto 4
Es importante destacar que la transformación del coeficiente a su exponencial es lo que nos permite interpretarlo como una multiplicación en lugar de una adición o sustracción, y así entender su impacto relativo en la probabilidad de que la variable dependiente sea 1. Por lo tanto, a continuación se presenta un resumen de las interpretaciones de cada variable en términos del valor de exp(coeficiente):
## Punto 4
modelo_p4 <- glm(Rotación ~ Edad + Satisfacción_Ambiental + Trabajos_Anteriores + Rendimiento_Laboral + Equilibrio_Trabajo_Vida + Antigüedad_Cargo, data = rotacion, family = binomial(link ="logit"))
summary(modelo_p4)##
## Call:
## glm(formula = Rotación ~ Edad + Satisfacción_Ambiental + Trabajos_Anteriores +
## Rendimiento_Laboral + Equilibrio_Trabajo_Vida + Antigüedad_Cargo,
## family = binomial(link = "logit"), data = rotacion)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.2007 -0.6377 -0.4918 -0.3287 2.8838
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.490584 0.784089 1.901 0.057297 .
## Edad -0.052521 0.009416 -5.578 0.0000000244 ***
## Satisfacción_Ambiental -0.252816 0.066161 -3.821 0.000133 ***
## Trabajos_Anteriores 0.091959 0.029912 3.074 0.002110 **
## Rendimiento_Laboral 0.050445 0.202829 0.249 0.803588
## Equilibrio_Trabajo_Vida -0.228137 0.100450 -2.271 0.023138 *
## Antigüedad_Cargo -0.112415 0.025438 -4.419 0.0000099044 ***
## ---
## 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: 1201.5 on 1463 degrees of freedom
## AIC: 1215.5
##
## Number of Fisher Scoring iterations: 5Es importante destacar que la transformación del coeficiente a su exponencial es lo que nos permite interpretarlo como una multiplicación en lugar de una adición o sustracción, y así entender su impacto relativo en la probabilidad de que la variable dependiente sea 1. Por lo tanto, a continuación se presenta un resumen de las interpretaciones de cada variable en términos del valor de exp(coeficiente):
Edad: exp(-0.05252) = 0.948. Por cada año adicional de edad, la probabilidad de que un empleado rote disminuye en un 5.2%.
Satisfacción_Ambiental: exp(-0.25282) = 0.777. Por cada unidad adicional de satisfacción ambiental, la probabilidad de que un empleado rote disminuye en un 22.3%.
Trabajos_Anteriores: exp(0.09196) = 1.096. Por cada trabajo adicional anterior, la probabilidad de que un empleado rote aumenta en un 9.6%.
Rendimiento_Laboral: no es significativa.
Equilibrio_Trabajo_Vida: exp(-0.22814) = 0.796. Por cada unidad adicional en el equilibrio trabajo-vida, la probabilidad de que un empleado rote disminuye en un 20.4%.
Antigüedad_Cargo: exp(-0.11242) = 0.894. Por cada año adicional de antigüedad en el cargo, la probabilidad de que un empleado rote disminuye en un 10.6%.
Punto 5
#install.packages("pROC")
library(pROC)## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varmodelo_p4 <- glm(Rotación ~ Edad + Satisfacción_Ambiental + Trabajos_Anteriores + Rendimiento_Laboral + Equilibrio_Trabajo_Vida + Antigüedad_Cargo, data = rotacion, family = binomial(link ="logit"))
rotacion$Rotación <- ifelse(rotacion$Rotación== "Si",1,0)
# Generar curva ROC y calcular AUC
roc_p4 <- roc(rotacion$Rotación,modelo_p4$fitted.values)## Setting levels: control = 0, case = 1## Setting direction: controls < casesauc_p4 <- auc(roc_p4)
# Graficar curva ROC
plot(roc_p4, main = "Curva ROC del modelo")
coords(roc_p4, "best", ret="threshold")## threshold
## 1 0.2015382auc_p4## Area under the curve: 0.6957En este caso, el valor del umbral de corte óptimo es 0.202, lo que significa que si la probabilidad estimada de rotación de un empleado es mayor o igual a 0.202, se considera que el modelo predice que ese empleado rotará.
Por otro lado el área bajo la curva (AUC) de 0.696 indica el poder predictivo del modelo para distinguir entre empleados que rotan y aquellos que no rotan. También indica que el modelo tiene un poder predictivo moderado para distinguir entre las dos categorías de la variable dependiente, puesto que es mayor a 0.5, el cual es el escenario que indica que las predicciones son aleatorias.
Punto 6
nuevo_empleado <- data.frame(Edad = 27,
Satisfacción_Ambiental = 2,
Trabajos_Anteriores = 2,
Rendimiento_Laboral = 4,
Equilibrio_Trabajo_Vida = 4,
Antigüedad_Cargo = 1)prob_rotacion <- predict(modelo_p4, newdata = nuevo_empleado, type = "response")
prob_rotacion## 1
## 0.254948El nuevo empleado tiene una edad de 27 años, una satisfacción ambiental de 2, ha trabajado en 2 trabajos anteriores, tiene un rendimiento laboral de 4, un equilibrio trabajo-vida de 4 y una antigüedad en el cargo de 1. De acuerdo al modelo, la probabilidad de que este empleado rote es de 0.255.
Tomando como punto de corte el 0.20 encontrado en la curva ROC estimada y considerando la probabilidad estimada por el modelo, el empleado está propenso a rotar. Por lo tanto habría que incluirlo en una campaña en caso de que se quiera evitar que esto suceda.
Punto 7.
Por ejemplo, se podrían ofrecer programas de capacitación y desarrollo para los empleados que buscan mejorar sus habilidades y competencias, lo que a su vez, podría aumentar su satisfacción laboral y el compromiso con la empresa. También se podría implementar un sistema de retroalimentación constante para evaluar y mejorar el equilibrio trabajo-vida de los empleados.
En particular, los empleados con menor edad y a su vez con menos antiguedad en el cargo serían aquellos para los cuales habría que mantener una constante persuación para evitar la rotación inesperada. Finalmente, como en toda empresa se deberían generar espacios de dialogo y formación en comunicación asertiva empresarial y trabajo en equipo, con el fin de mantener arriba el ambiente y la satisfacción de los empleados.
SITUACIÓN 2. MODELO DE REGRESIÓN LOGÍSTICO MÚLTIPLE
Cargue de datos y exploración
Este conjunto de datos relaciona los préstamos de los clientes de un banco, y la variable de interés inidica si han incumplido en el pago de las obligaciones de crédito. Se muestran a continuación las variables del conjunto de datos:
creditos <- read_delim("/Users/fernando/Desktop/Maestria Ciencia de Datos/Maestría Ciencia de Datos/Métodos y simulación Estadística/Taller 3 MLG_/creditos.csv",
delim = ";", escape_double = FALSE, trim_ws = TRUE,
locale = locale(decimal_mark = ",")) ## Rows: 780 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## dbl (5): DEFAULT, ANTIUEDAD, EDAD, CUOTA_TOTAL, INGRESOS
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.creditos<-as.data.frame(creditos)
colnames(creditos)## [1] "DEFAULT" "ANTIUEDAD" "EDAD" "CUOTA_TOTAL" "INGRESOS"La base de datos cuenta con 780 registros y no tiene datos faltantes. Cuenta con las variables: “default”, que indica si el cliente ha incumplido en el pago de sus préstamos (1) o no (0); “antiguedad”, que representa la cantidad de años de antigüedad en la cuenta bancaria del cliente; “edad”, que indica la edad del cliente en años; “cuota_total”, que indica la cuota que el cliente debe pagar por sus préstamos; e “ingresos”, que representa los ingresos mensuales del cliente.
NAs<-colSums(is.na(creditos))
as.data.frame(NAs)## NAs
## DEFAULT 0
## ANTIUEDAD 0
## EDAD 0
## CUOTA_TOTAL 0
## INGRESOS 0
##
## 0 1
## 741 39En el gráfico de barras se puede observar que la variable “default” está desbalanceada, lo que significa que hay muy pocos registros donde los clientes han incumplido en el pago de sus préstamos (39 clientes) en comparación con los registros donde los clientes han cumplido con el pago de sus préstamos (741). Esto indica que el conjunto de datos está sesgado hacia los clientes que cumplen con sus pagos.
descriptivas_num2 <- data.frame(mini=apply(creditos[,-1], 2, min),
media=apply(creditos[,-1], 2, mean),
maxim=apply(creditos[,-1], 2, max),
sd=apply(creditos[,-1], 2, sd),
CV=apply(creditos[,-1], 2, function(x) sd(x)/mean(x)))
print(descriptivas_num2)## mini media maxim sd CV
## ANTIUEDAD 0.2547945 18.03525 37.31781 11.93930 0.6619982
## EDAD 26.6136986 56.98502 92.43288 12.50531 0.2194491
## CUOTA_TOTAL 387.0000000 885205.86154 6664588.00000 740212.32791 0.8362036
## INGRESOS 633825.0000000 5366430.23462 22197021.00000 2652186.01540 0.4942179ANTIUEDAD: La antigüedad de las cuentas bancarias de los clientes oscila entre 0 y 37 años, con una media de 18,3 y una desviación estándar de 11.93. El coeficiente de variación indica que la dispersión de los datos es alta, siendo del 66%.
EDAD: La edad de los clientes oscila entre 26 y 92 años, con una media de 56.9 y una desviación estándar de 12.5. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 22%.
CUOTA_TOTAL: La cuota total que los clientes deben pagar oscila entre 0 y 6,664,588, con una media de 8,852 y una desviación estándar de 740,212. El coeficiente de variación indica que la dispersión de los datos es alta, siendo del 8,360%.
INGRESOS: Los ingresos mensuales de los clientes oscilan entre 5,368 y 22,197,021, con una media de 5,366,430 y una desviación estándar de 2,652,186. El coeficiente de variación indica que la dispersión de los datos es moderada, siendo del 49%.
A continuación se presentas diagramas de caja de cada variable con respecto a si ha incumplido con el pago o no, para tener una idea de si alguna de estas tiene un efecto sobre la variable respuesta.
En el gráfico se percibe que los clientes que incumplen con el pago tienen menos años de antigüedad con el banco.
Para la edad se ve que los clientes que no pagan pueden ser un poco más jovenes, pero puede que esta diferencia no sea muy significativa, ya que ambas cajas son muy similares en cuanto a su mediana.
Con respecto a la mediana de la cuota total se ve que los clientes que incumplen el pago tienen un valor mayor, por lo tanto se pensaria que a medida que la cuota de pago es más alta hay más probabilidad de entrar en default.
En el gráfico se ve que los clientes que no incumplen con el pago pueden llegar a tener ingresos muy altos superando incluso los 20 millones, mientras que los que incumplen el pago tienen máximo 8 millones aproximadamente.
Ajuste Modelo de regresión logístico
Inicialmente se plantea un modelo con la variable respuesta “DEFAULT” en función de todas las demás variables para evaluar la significancia de cada una.
mod_c<- glm(DEFAULT ~ . , data = creditos[,], family = binomial)
round(summary(mod_c)$coefficients,3)## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.193 0.931 -3.431 0.001
## ANTIUEDAD -0.046 0.024 -1.961 0.050
## EDAD 0.022 0.019 1.154 0.249
## CUOTA_TOTAL 0.000 0.000 4.098 0.000
## INGRESOS 0.000 0.000 -2.474 0.013Coeficientes:
Antiguedad: exp(-0.0462) = 0.955. Por cada año adicional de antigüedad de la cuenta bancaria, la probabilidad de que la variable dependiente sea 1 disminuye en un 4.5%.
Edad: En este caso la variable edad no fue significativa.
Cuota_total: exp(0.0000010134) = 1.000001. Por cada unidad adicional en la cuota total, la probabilidad de que la variable dependiente sea 1 aumenta en un 0.0001%.
Ingresos: exp(-0.0000002615) = 0.9999997385. Por cada unidad adicional en los ingresos mensuales del cliente, la probabilidad de que la variable dependiente sea 1 disminuye en un 0.000026%.
Aunque la variable no sea significativa según el valor-p, se ha decidido incluirla en el modelo porque se considera que todavía puede aportar información valiosa. La eliminación de una variable no significativa puede disminuir el poder predictivo del modelo y por ende, disminuir la calidad de las predicciones.
Métricas modelo
En este caso, el punto óptimo es de 0.054, lo que significa que cualquier persona con una probabilidad de incumplimiento mayor a 0.054 será clasificada como “riesgosa”. En este caso, el modelo tiene una sensibilidad del 0.628 y una especificidad del 0.692, lo que significa que el modelo identifica mejor a las personas que no incumplen con el pago.
El AUC (área bajo la curva) en este caso es igual a 0.701, lo que indica que el modelo es aceptable.
objroc <- roc(creditos$DEFAULT, mod_c$fitted.values,auc=T,ci=T)
plot.roc(objroc,print.auc=T,print.thres = "best",
col="brown",xlab="1-ESpecificidad",ylab="Sensibilidad")
Conclusiones
El modelo desarrollado muestra una buena capacidad para predecir el incumplimiento de pago en clientes bancarios, lo que puede ayudar a reducir el número de usuarios que no cumplen con sus pagos. Sin embargo, es importante tener en cuenta que al clasificar los clientes, también se puede cometer errores. En particular, el modelo es más propenso a clasificar a un cliente que no va a incumplir como alguien que sí lo hará, ya que la mayoría de los clientes no incumplen con sus pagos.
Para comprender mejor el impacto de estos errores, se puede revisar la matriz de confusión a continuación:
prediccion <-as.factor(ifelse(mod_c$fitted.values>0.054,1,0))
#install.packages("caret")
library(caret)## Loading required package: latticeconfusionMatrix(as.factor(creditos$DEFAULT),prediccion)$table## Reference
## Prediction 0 1
## 0 471 270
## 1 14 25En este caso, la matriz muestra que de las 755 observaciones totales, 471 fueron clasificadas correctamente como no incumplimiento (VN) y 25 como incumplimiento (VP). Sin embargo, también se clasificaron incorrectamente 270 observaciones de no incumplimiento como incumplimiento (FP) y 14 observaciones de incumplimiento como no incumplimiento (FN).
Es importante destacar que la cantidad de falsos positivos es bastante alta en comparación con la cantidad de verdaderos positivos. Esto significa que el modelo clasifica incorrectamente a un gran número de personas como incumplidores, lo que podría resultar en una pérdida de clientes potenciales y oportunidades de negocio.
En este contexto, se debe analizar cuál es el error más costoso para la empresa: clasificar a alguien que no va a incumplir como incumplidor o clasificar a alguien que va a incumplir como no incumplidor. Una vez que se entienden los costos asociados a cada tipo de error, se pueden utilizar técnicas para mejorar el modelo y reducir los errores costosos.