En una organización se nos pide realizar un analisis de rotación de empleados para conservar los talentos claves para la organización, e identificar oportunidades de mejora que impacten en el ambiente laboral
Se nos pide desarrollar un modelo logistico que permita estimar la probabilidad de que un empleado tenga un cambio en su cargo. esto con el fin de tomar decisioens estrategicas y manter a los empleados comprometidos y satisfechos.
Se proponen los siguientes pasos en el analisis: 2. Selección de variables (3 categoricas y 3 cuantitativas) 3. Análisis univariado 4. Análisis bivariado 5. Estimación del modelo 6. Evaluación 7. Predicciones 8. Conclusiones
A continuación los primeros registros de los datos suministrados
| Rotación | Edad | Viaje.de.Negocios | Departamento | Distancia_Casa | Educación | Campo_Educación | Satisfacción_Ambiental | Genero | Cargo | Satisfación_Laboral | Estado_Civil | Ingreso_Mensual | Trabajos_Anteriores | Horas_Extra | Porcentaje_aumento_salarial | Rendimiento_Laboral | Años_Experiencia | Capacitaciones | Equilibrio_Trabajo_Vida | Antigüedad | Antigüedad_Cargo | Años_ultima_promoción | Años_acargo_con_mismo_jefe |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Si | 41 | Raramente | Ventas | 1 | 2 | Ciencias | 2 | F | Ejecutivo_Ventas | 4 | Soltero | 5993 | 8 | Si | 11 | 3 | 8 | 0 | 1 | 6 | 4 | 0 | 5 |
| No | 49 | Frecuentemente | IyD | 8 | 1 | Ciencias | 3 | M | Investigador_Cientifico | 2 | Casado | 5130 | 1 | No | 23 | 4 | 10 | 3 | 3 | 10 | 7 | 1 | 7 |
| Si | 37 | Raramente | IyD | 2 | 2 | Otra | 4 | M | Tecnico_Laboratorio | 3 | Soltero | 2090 | 6 | Si | 15 | 3 | 7 | 3 | 3 | 0 | 0 | 0 | 0 |
| No | 33 | Frecuentemente | IyD | 3 | 4 | Ciencias | 4 | F | Investigador_Cientifico | 3 | Casado | 2909 | 1 | Si | 11 | 3 | 8 | 3 | 3 | 8 | 7 | 3 | 0 |
| No | 27 | Raramente | IyD | 2 | 1 | Salud | 1 | M | Tecnico_Laboratorio | 2 | Casado | 3468 | 9 | No | 12 | 3 | 6 | 3 | 3 | 2 | 2 | 2 | 2 |
| No | 32 | Frecuentemente | IyD | 2 | 2 | Ciencias | 4 | M | Tecnico_Laboratorio | 4 | Soltero | 3068 | 0 | No | 13 | 3 | 8 | 2 | 2 | 7 | 7 | 3 | 6 |
Se observa multiples campos de categorias tanto de categorias como ordinales, tambien se aprecian algunos campos númericos discretos.
resumen_data <- list(
num_filas = nrow(rotacion),
num_col= ncol(rotacion),
vacios_totales = sum(is.na(rotacion)),
porc_vacios = sprintf('%.2f%%',sum(is.na(rotacion))/(nrow(rotacion)*ncol(rotacion))*100),
filas_con_mas_un_vacio = sum(apply(is.na(rotacion), 1, any)),
filas_all_vacios = sum(apply(is.na(rotacion), 1, all)),
col_all_vacios = sum(colSums(is.na(rotacion)) == nrow(rotacion)),
filas_duplicadas= nrow(rotacion[duplicated(rotacion), ])
)
kable(do.call(data.frame, resumen_data),
format = "markdown",
caption = "**Tabla Resumen de dataset antes de tratamientos**",
align = "c", escape = FALSE,
row.names = FALSE,
booktabs = TRUE)
| num_filas | num_col | vacios_totales | porc_vacios | filas_con_mas_un_vacio | filas_all_vacios | col_all_vacios | filas_duplicadas |
|---|---|---|---|---|---|---|---|
| 1470 | 24 | 0 | 0.00% | 0 | 0 | 0 | 0 |
Se que todos los registros estan completos y sin duplicados, dando una base con 24 columnas y 1470 registros.
A continuación mostraremos los
#col_originales = names(rotacion)
#str(rotacion)
resumen_df <- as.data.frame.matrix(summary(rotacion))
resumen_df <- t(resumen_df)
types <- sapply(rotacion, class)
resumen_cuantitativa <- resumen_df[types %in% c("numeric", "integer"), ]
resumen_cuantitativa <- rownames(resumen_cuantitativa)
resumen_cuantitativa <- gsub(" ", "", resumen_cuantitativa) # para quitar los espacios en blanco
resumen_cualitativa <- resumen_df[!(types %in% c("numeric", "integer")), ]
resumen_cualitativa <- rownames(resumen_cualitativa)
resumen_cualitativa <- gsub(" ", "", resumen_cualitativa) # para quitar los espacios en blanco
# cuantitativos
for (elemento in resumen_cuantitativa) {
cat("- ", elemento, "\n")
}
## - Edad
## - Distancia_Casa
## - Educación
## - Satisfacción_Ambiental
## - Satisfación_Laboral
## - Ingreso_Mensual
## - Trabajos_Anteriores
## - Porcentaje_aumento_salarial
## - Rendimiento_Laboral
## - Años_Experiencia
## - Capacitaciones
## - Equilibrio_Trabajo_Vida
## - Antigüedad
## - Antigüedad_Cargo
## - Años_ultima_promoción
## - Años_acargo_con_mismo_jefe
# cualitativos
for (elemento in resumen_cualitativa) {
cat("- ", elemento, "\n")
}
## - Rotación
## - ViajedeNegocios
## - Departamento
## - Campo_Educación
## - Genero
## - Cargo
## - Estado_Civil
## - Horas_Extra
Revisando los campos que tenemos en el dataset suministrados y asumiendo un rol de negocio se seleccionaron los siguientes campos:
Satisfación_Laboral: Si nuestro objeto es precisamente medir las condiciones laborales, que mejor campo para incluir en nuestra selección de campos. \(Hipotesis:\) las personas con un valor de saisfación alto cuenten con una menor probabilidad de rotación, que el personal que tenga un valor de satisfacción menor.
Satisfacción_Ambiental: no es clara la diferencia entre satisfacción laboral con ambiental, pero considero que debo tenerla dado que puede deberse a condiciones netamente de ambiente social,\(Hipotesis:\) las personas con un valor de saisfación ambiental alto cuenten con una menor probabilidad de rotación, que el personal que tenga un valor de satisfacción menor.
Edad : La mentalidad de exito laboral esta cambiando mucho entre generación; antes las personas entre mas duraban en las empresas lo consideraban como un exito. por lo que tener encuenta la edad de las personas, puede ser un factor muy influyente en el modelo. \(Hipotesis:\) las personas con una edad avanzada cuentan con una menor probabilidad de rotación, que el personal que tenga una edad menor.
Ingreso_Mensual: Es un favor muy influente en algunos cargos, y de hecho se ve mucho que las personas jovenes, si no cuentan con un buen salario, la probailidad de rotación dado que se asocia con ‘exito laboral’ \(Hipotesis:\) las personas con un salario alto cuenten con una menor probabilidad de rotación, que el personal que tenga un salario menor.
Campo_Educación: Se puede relacionar el campo de educación frente a la experticia que peude tener las personas, en donde a menor expertis, se puede tener una rotación mayor. \(Hipotesis:\) las personas con ciertos campos de educación pueden ser mas propensas a rotar.
Estado_Civil: El estado civil puede decirnos a grueso modo como es la persepción de estabilidad familiar que puede querer las personas, por lo que a mayor estabilidad, menor probabilidad de rotación (Nota: Aunque esta premisa cambio mucho por tema de edades)\(Hipotesis:\) las personas con ciertos estado civil, como solteros pueden ser mas propensas a rotar.
Cargo: El cargo puede decirnos la persepción de ambición que puede tener las personas, visto como posibles aspiraciones, por lo que \(Hipotesis:\) cargos operativos en edades tempranas, se puede decir que son personas que pueden tener una altar probabilidad de rotación
col <- 'Satisfación_Laboral'
frecuencias <- table(rotacion[[col]])
porcentajes <- round(frecuencias / sum(frecuencias) * 100, 2)
valores_ordenados <- factor(names(sort(frecuencias, decreasing = TRUE)), levels = names(frecuencias))
ggplot(data = data.frame(valores = valores_ordenados, frecuencias), aes(x = valores_ordenados, y = frecuencias)) +
geom_bar(stat = "identity", fill = "#0576FF") +
geom_text(aes(label = paste(porcentajes, "%")), vjust = -0.5) +
labs(title = paste("Grafico de Barras",col), x = paste("Valores de ",col), y = "Frecuencia") +
theme_minimal()+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
## Don't know how to automatically pick scale for object of type <table>.
## Defaulting to continuous.
describe(rotacion[[col]])
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 1470 2.73 1.1 3 2.79 1.48 1 4 3 -0.33 -1.22 0.03
Tenemos una escala de satisfacción laboral que llega hasta 4, curioso, dado que se hace hasta 5, y si le sumamos que el 60% son satisfacción de 1 y 2, vemos que la población de empleados no tiene buena satisfacción laboral.
col <- 'Satisfacción_Ambiental'
frecuencias <- table(rotacion[[col]])
porcentajes <- round(frecuencias / sum(frecuencias) * 100, 2)
valores_ordenados <- factor(names(sort(frecuencias, decreasing = TRUE)), levels = names(frecuencias))
ggplot(data = data.frame(valores = valores_ordenados, frecuencias), aes(x = valores_ordenados, y = frecuencias)) +
geom_bar(stat = "identity", fill = "#0576FF") +
geom_text(aes(label = paste(porcentajes, "%")), vjust = -0.5) +
labs(title = paste("Grafico de Barras",col), x = paste("Valores de ",col), y = "Frecuencia") +
theme_minimal()+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
## Don't know how to automatically pick scale for object of type <table>.
## Defaulting to continuous.
describe(rotacion[[col]])
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 1470 2.72 1.09 3 2.78 1.48 1 4 3 -0.32 -1.2 0.03
Satisfacción ambiente, se asemeja mucho a la satisfacción laboral, escala que sube hasta 4, y donde el 60% tiene una clasificación de 1 y 2
col <- 'Edad'
ggplot(data = rotacion, aes(x = !!as.name(col))) +
geom_histogram(bins = 30, color = "#515354", fill = "#0576FF") +
geom_vline(aes(xintercept = mean(!!as.name(col))), color = "#FF0576", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median(!!as.name(col))), color = "#50AC05", linetype = "dashed", size = 1) +
theme_bw() +
labs(title = paste('Histograma de', col), x = col, y = "Frecuencia")+
theme_minimal()+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
describe(rotacion[[col]])
## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 1470 36.92 9.14 36 36.47 8.9 18 60 42 0.41 -0.41 0.24
Segun el histograma tenemos dos picos , valores cercanos a 40 años y otro grupo de 30 a 35 años. y en general la población esta concentrada en este rando de 30 años a 45 años aproximadamente.
col<-'Ingreso_Mensual'
ggplot(data = rotacion, aes(x = !!as.name(col))) +
geom_histogram(bins = 30, color = "#515354", fill = "#0576FF") +
geom_vline(aes(xintercept = mean(!!as.name(col))), color = "#FF0576", linetype = "dashed", size = 1) +
geom_vline(aes(xintercept = median(!!as.name(col))), color = "#50AC05", linetype = "dashed", size = 1) +
theme_bw() +
labs(title = paste('Histograma de', col), x = col, y = "Frecuencia")+
theme_minimal()+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
describe(rotacion[[col]])
## vars n mean sd median trimmed mad min max range skew
## X1 1 1470 6502.93 4707.96 4919 5667.24 3260.24 1009 19999 18990 1.37
## kurtosis se
## X1 0.99 122.79
Frene ingresos, vemos que muchos salarios estan muy concentrados 5000 y mediana en 6000, ingresos muestran que mucha población gana poco, pero vemos que tenemos varios cargos que ganana hasta 3 veces mas que la media de empleados. nota la realidad de una empresa.
lista_graficos_cuali <- list()
for (col in c('Campo_Educación','Estado_Civil','Cargo')) {
frecuencia_palabras_temp = aggregate(rotacion[[col]], list(rotacion[[col]]), FUN=length)
colnames(frecuencia_palabras_temp)=c("Palabra","Frecuencia")
lista_graficos_cuali[[col]] <- as.data.frame(frecuencia_palabras_temp)
}
frecuencia_palabras_temp = lista_graficos_cuali[['Campo_Educación']]
wordcloud(words = frecuencia_palabras_temp$Palabra,
freq = frecuencia_palabras_temp$Frecuencia,
min.freq = 2,
max.words = 60,
colors = c("#515354","#50AC05","#0576FF", "#FF0576"),
random.order = F,
random.color = F,
scale = c(4 ,0.5),
rot.per = 0.25)
Vemos una categorias muy estandarizadas, donde vemos Ciencia y Salud muy marcadas, por lo que podemos concluir que estamos en una organización de salud e investigación.
frecuencia_palabras_temp = lista_graficos_cuali[['Estado_Civil']]
wordcloud(words = frecuencia_palabras_temp$Palabra,
freq = frecuencia_palabras_temp$Frecuencia,
min.freq = 2,
max.words = 60,
colors = c("#515354","#50AC05","#0576FF", "#FF0576"),
random.order = F,
random.color = F,
scale = c(4 ,0.5),
rot.per = 0.25)
Una participación de Casados muy alta, y donde solteros le sigue en aprticipación.
col <- 'Cargo'
frecuencias <- table(rotacion[[col]])
porcentajes <- round(frecuencias / sum(frecuencias) * 100, 2)
valores_ordenados <- factor(names(sort(frecuencias, decreasing = TRUE)), levels = names(frecuencias))
ggplot(data = data.frame(valores = valores_ordenados, frecuencias), aes(x = valores_ordenados, y = frecuencias)) +
geom_bar(stat = "identity", fill = "#0576FF") +
geom_text(aes(label = paste(porcentajes, "%")), vjust = -0.5) +
labs(title = paste("Grafico de Barras",col), x = paste("Valores de ",col), y = "Frecuencia") +
theme_minimal()+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1))
## Don't know how to automatically pick scale for object of type <table>.
## Defaulting to continuous.
Frente a los cargos, vemos que tecnico_laboratorio , representante _salud y recursos_humanos, son los cargos mas recurrentes. por lo que confirmamos que estamos en una organización de investigación
col <- 'Rotación'
frecuencias <- table(rotacion[[col]])
porcentajes <- round(frecuencias / sum(frecuencias) * 100, 2)
valores_ordenados <- factor(names(sort(frecuencias, decreasing = TRUE)), levels = names(frecuencias))
ggplot(data = data.frame(valores = valores_ordenados, frecuencias), aes(x = valores_ordenados, y = frecuencias)) +
geom_bar(stat = "identity", fill = "#0576FF") +
geom_text(aes(label = paste(porcentajes, "%")), vjust = -0.5) +
labs(title = paste("Grafico de Barras",col), x = paste("Valores de ",col), y = "Frecuencia") +
theme_minimal()+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
## Don't know how to automatically pick scale for object of type <table>.
## Defaulting to continuous.
Frente a nuestro campo etiqueta, vemos que tenemos un desbalanceo de aproximado 5 a 1, afortunadamente son pocos las personas que tiene el indice de rotación, por lo que determinar buenos planes preventivos, sera vital para mejorar la satisfacción laboral y ambiental.
Procedemos a realizar la comparación entre variables, creemos que un vehiculo en general de todo trabajo pueden ser los ingresos de salario. (nota al menos por un tiempo, las personas sacrifican varias cosas por un salario), por lo que compararemos todo contra ingresos para tener una persepeción general y facil de relacionar.
ggplot(data = rotacion, aes(x = Edad, y = Ingreso_Mensual, color = Rotación)) +
geom_point() +
facet_wrap(~ Rotación, ncol = 2)
Se aprecia que los ingresos frente a la edad, tiene una relación no tan directa. se observa que a medida que avanzamos ene dad y en ingresos mensuales, la rotación del personal disminuye entre mas grandes sone stas dos caracteristicas.
ggplot(data = rotacion, aes(x = Rotación, y = Ingreso_Mensual, color = Rotación)) +
geom_boxplot() + # Añadir caja de bigotes
facet_wrap(~ Satisfación_Laboral) # Separar por niveles de satisfacción laboral
Observamos que la relación entre satisfacción laboral e ingreso, no tiene una relación directa, es decir, entre más alto sea la calificación de satisfacción laboral no influye a los ingresos persibidos, de hecho, el box plot tanto de rotación si o no, en cada clasificacipón laboral, se mantiene muy similares.
ggplot(data = rotacion, aes(x = Rotación, y = Ingreso_Mensual, color = Rotación)) +
geom_boxplot() + # Añadir caja de bigotes
facet_wrap(~ Satisfacción_Ambiental) # Separar por niveles de satisfacción laboral
Observamos que la relación entre satisfacción ambiental e ingreso, no tiene una relación directa, de hecho se parece mucho el comprotamiento de ingresos con la relación ambiental.
ggplot(data = rotacion, aes(x = Rotación, y = Ingreso_Mensual, color = Rotación)) +
geom_boxplot() + # Añadir caja de bigotes
facet_wrap(~ Campo_Educación) # Separar por niveles de satisfacción laboral
Vemos que los ingresos varian mucho frente al campo de educación, llama mucho la atención el comportamiento del blox plot de humanidades que rota, muy bajito con relación a los que no rotan, ¿podrian ser un área muy estable y por eso no rotan?
porcentaje_rotacion <- aggregate(Rotación ~ Campo_Educación, data = rotacion, function(x) {
table(x)
})
# Calcular el total para cada categoría de Cargo
porcentaje_rotacion$Total <- rowSums(porcentaje_rotacion$Rotación)
# Calcular los porcentajes relativos
porcentaje_rotacion$Porcentaje_Si <- porcentaje_rotacion$Rotación[, "Si"] / porcentaje_rotacion$Total
porcentaje_rotacion$Porcentaje_No <- porcentaje_rotacion$Rotación[, "No"] / porcentaje_rotacion$Total
# Reorganizar los datos para usar con ggplot2
porcentaje_rotacion_long <- reshape2::melt(porcentaje_rotacion, id.vars = "Campo_Educación",
measure.vars = c("Porcentaje_Si", "Porcentaje_No"),
variable.name = "Rotación", value.name = "Porcentaje")
# Crear la gráfica de barras apiladas
ggplot(data = porcentaje_rotacion_long, aes(x = Campo_Educación, y = Porcentaje, fill = Rotación)) +
geom_bar(stat = "identity", position = "stack") +
scale_y_continuous(labels = scales::percent_format()) +
labs(x = "Cargo", y = "Porcentaje de empleados") +
ggtitle("Porcentaje de rotación por cargo") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Frente a propiamente a la rotación por las áreas , vemos que es justo el área de humanidades que mas rota, si recordamos el anterior grafico, vemos que fueron los de salario bajo de dicha área que rotaban, pero los de salarios grandes, no se tenian valores atipicos o una cola del driama boxplot pesada.
ggplot(data = rotacion, aes(x = Rotación, y = Ingreso_Mensual, color = Rotación)) +
geom_boxplot() + # Añadir caja de bigotes
facet_wrap(~ Estado_Civil) # Separar por niveles de satisfacción laboral
En el estado civil frente al ingreso, vemos que no tenemos un comportamiento que resaltar, de hecho la relación de rotación en divorciados es apenas notable el cambio frente a casados o solteros.
porcentaje_rotacion <- aggregate(Rotación ~ Estado_Civil, data = rotacion, function(x) {
table(x)
})
# Calcular el total para cada categoría de Cargo
porcentaje_rotacion$Total <- rowSums(porcentaje_rotacion$Rotación)
# Calcular los porcentajes relativos
porcentaje_rotacion$Porcentaje_Si <- porcentaje_rotacion$Rotación[, "Si"] / porcentaje_rotacion$Total
porcentaje_rotacion$Porcentaje_No <- porcentaje_rotacion$Rotación[, "No"] / porcentaje_rotacion$Total
# Reorganizar los datos para usar con ggplot2
porcentaje_rotacion_long <- reshape2::melt(porcentaje_rotacion, id.vars = "Estado_Civil",
measure.vars = c("Porcentaje_Si", "Porcentaje_No"),
variable.name = "Rotación", value.name = "Porcentaje")
# Crear la gráfica de barras apiladas
ggplot(data = porcentaje_rotacion_long, aes(x = Estado_Civil, y = Porcentaje, fill = Rotación)) +
geom_bar(stat = "identity", position = "stack") +
scale_y_continuous(labels = scales::percent_format()) +
labs(x = "Cargo", y = "Porcentaje de empleados") +
ggtitle("Porcentaje de rotación por estado civil") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Pero si nos fijamos netalmente en el estado civil de las personas, se observa una participación de solteros en la rotación , mas que en en casosdos o divorciados.
ggplot(data = rotacion, aes(x = Rotación, y = Ingreso_Mensual, color = Rotación)) +
geom_boxplot() + # Añadir caja de bigotes
facet_wrap(~ Cargo) # Separar por niveles de satisfacción laboral
En los campos e ingresos, vemos que existe una relación directa en dinero, y tiene mucho sentido, los jefes o especialidades en un cargo deben reconocerse con dinero, pero frente a su rotación, vemos que son casi identifics a los que si rotan, , con excepción ed eodcot investigación, quien tiene un box plot mas alto que los que no rotaron.
porcentaje_rotacion <- aggregate(Rotación ~ Cargo, data = rotacion, function(x) {
table(x)
})
# Calcular el total para cada categoría de Cargo
porcentaje_rotacion$Total <- rowSums(porcentaje_rotacion$Rotación)
# Calcular los porcentajes relativos
porcentaje_rotacion$Porcentaje_Si <- porcentaje_rotacion$Rotación[, "Si"] / porcentaje_rotacion$Total
porcentaje_rotacion$Porcentaje_No <- porcentaje_rotacion$Rotación[, "No"] / porcentaje_rotacion$Total
# Reorganizar los datos para usar con ggplot2
porcentaje_rotacion_long <- reshape2::melt(porcentaje_rotacion, id.vars = "Cargo",
measure.vars = c("Porcentaje_Si", "Porcentaje_No"),
variable.name = "Rotación", value.name = "Porcentaje")
# Crear la gráfica de barras apiladas
ggplot(data = porcentaje_rotacion_long, aes(x = Cargo, y = Porcentaje, fill = Rotación)) +
geom_bar(stat = "identity", position = "stack") +
scale_y_continuous(labels = scales::percent_format()) +
labs(x = "Cargo", y = "Porcentaje de empleados") +
ggtitle("Porcentaje de rotación por cargo") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Si vemos en la participación de cargos, vemos que es el cargo de representante de ventas son los que mas rotan , seguido de cargo de recursos humanos.
Iniciamos preparando la etiqueta label como valroes binarios.
data <- rotacion
data$Rotación <- ifelse(data$Rotación == "Si", 1, 0)#as.numeric(rotacion$Rotación=="Si")
Generamos el modelo con las variables seleccionadas
modelo <- glm(Rotación ~ Satisfación_Laboral + Satisfacción_Ambiental + Edad + Ingreso_Mensual + Campo_Educación + Estado_Civil + Cargo, data = data,family = "binomial")
summary(modelo)
##
## Call:
## glm(formula = Rotación ~ Satisfación_Laboral + Satisfacción_Ambiental +
## Edad + Ingreso_Mensual + Campo_Educación + Estado_Civil +
## Cargo, family = "binomial", data = data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.498e+00 1.048e+00 -1.429 0.15296
## Satisfación_Laboral -2.837e-01 6.827e-02 -4.155 3.25e-05 ***
## Satisfacción_Ambiental -2.962e-01 6.975e-02 -4.247 2.17e-05 ***
## Edad -2.596e-02 1.003e-02 -2.588 0.00964 **
## Ingreso_Mensual 1.079e-05 4.451e-05 0.242 0.80848
## Campo_EducaciónHumanidades 9.268e-01 6.467e-01 1.433 0.15186
## Campo_EducaciónMercadeo 3.792e-01 2.733e-01 1.387 0.16533
## Campo_EducaciónOtra -1.107e-01 3.636e-01 -0.305 0.76067
## Campo_EducaciónSalud -1.411e-01 1.897e-01 -0.744 0.45706
## Campo_EducaciónTecnicos 5.597e-01 2.573e-01 2.175 0.02960 *
## Estado_CivilDivorciado -2.215e-01 2.266e-01 -0.977 0.32838
## Estado_CivilSoltero 8.505e-01 1.686e-01 5.044 4.56e-07 ***
## CargoDirector_Manofactura 1.064e+00 8.726e-01 1.219 0.22267
## CargoEjecutivo_Ventas 1.879e+00 8.356e-01 2.249 0.02453 *
## CargoGerente 7.249e-01 8.636e-01 0.839 0.40129
## CargoInvestigador_Cientifico 1.849e+00 9.133e-01 2.024 0.04296 *
## CargoRecursos_Humanos 2.036e+00 9.938e-01 2.049 0.04049 *
## CargoRepresentante_Salud 1.048e+00 8.784e-01 1.193 0.23294
## CargoRepresentante_Ventas 2.866e+00 9.458e-01 3.030 0.00244 **
## CargoTecnico_Laboratorio 2.421e+00 9.091e-01 2.664 0.00773 **
## ---
## 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: 1121.8 on 1450 degrees of freedom
## AIC: 1161.8
##
## Number of Fisher Scoring iterations: 6
Se aprecia que la satisfacción laboral (relación inversa con probabilidad de rotación), satisfacción ambiental (relación inversa con probabilidad de rotación), edad (relación inversa con probabilidad de rotación) y el estado divicil soltero (relación directa con probabilidad de rotación), son muy representativos, seguido de cargos como el de representante de ventas y cargo tecnico_laboratorio. es decir, que los planes de recursos humanos deben ir enfocados a estos cargo con su alta influencia en el rotación de cargo (relación directa con probabilidad de rotación en ambos cargos).
Debemos entonces revisar el umbral de decisión que debemos tener encuenta en nuestra predicciones, para ello veamos la matriz de confusión:
pred_probabilidades <- predict(modelo, type = "response", newdata = data)
rotacion_modelo = pred_probabilidades> 0.5
mconf = table(rotacion_modelo,rotacion$Rotación)
mconf
##
## rotacion_modelo No Si
## FALSE 1220 211
## TRUE 13 26
vemos que con el umbral de 0.5 estamos dejando muchos falsos positivos referenciados en nuestro modelo, y muy pocos falsos no rotados de los que si rotaron,
verdaderos_positivos <- mconf[1, 1]
falsos_negativos <- mconf[2, 1]
falsos_positivos <- mconf[1, 2]
verdaderos_negativos <- mconf[2, 2]
# Calcular la precisión
precision <- (verdaderos_positivos + verdaderos_negativos) / sum(mconf)
cat('Precision del modelo con umbral 0.5: ', precision)
## Precision del modelo con umbral 0.5: 0.847619
Pero, sera el mejor umbral que disponemos del modelo, para ello vamos a realizar una exploración a partir de la precisión (en nuestro caso buscamos que nuestras prediciones tanto buenas como malas sea muy acertadas, eixsten otras metricas que buscan darle prioridad a las falsas elecciones o omisiones, pero no seran tenias encuenta para este ejercicio)
calc_precision =function(umbral){
rotacion_modelo = pred_probabilidades> umbral
mconf = table(rotacion_modelo,rotacion$Rotación)
verdaderos_positivos <- mconf[1, 1]
falsos_negativos <- mconf[2, 1]
falsos_positivos <- mconf[1, 2]
verdaderos_negativos <- mconf[2, 2]
precision <- (verdaderos_positivos + verdaderos_negativos) / sum(mconf)
return(precision)
}
umbrales <- seq(from=0.15,to=0.4,by=0.01)
preciones_modelo <- sapply(umbrales,"calc_precision")
plot(x=umbrales,y=preciones_modelo, type = "b")
Observamos que la precisión del modelo se alcanza muy rapidamente con un umbral del 0.30 y alcanza un maximo en aprox 0.35
# Calcula la curva ROC
curva_roc <- roc(data$Rotación, pred_probabilidades)
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
auc<- round(auc(curva_roc, levels =c(0,1), direction = "<"),4) # 0.9177
ggroc(curva_roc, colour = "#FF7F00", size=1)+
ggtitle(paste0("Curva ROC ", "(AUC = ", auc, ")"))+
xlab("Especificidad")+
ylab("Sensibilidad")
La curva ROC nos muestra que la selección de variables,tiene un buen comportamiento, se separa rapidamente de la diagonal, aunque puede mejorarse bastante. tiene un AUC de 0.7448.
set.seed(1000)
indice_aleatorio <- sample(nrow(data), 1)
dato_hipotetico <- data[indice_aleatorio, ][, c("Satisfación_Laboral","Satisfacción_Ambiental","Edad","Ingreso_Mensual","Campo_Educación","Estado_Civil","Cargo")]
kable(do.call(data.frame, dato_hipotetico),
format = "markdown",
caption = "**Tabla de caso Hipotetico**",
align = "c", escape = FALSE,
row.names = FALSE,
booktabs = TRUE)
| Satisfación_Laboral | Satisfacción_Ambiental | Edad | Ingreso_Mensual | Campo_Educación | Estado_Civil | Cargo |
|---|---|---|---|---|---|---|
| 4 | 3 | 29 | 7553 | Otra | Soltero | Representante_Salud |
#COn lineal, nos referimos a que la formula de coeficientes nos da un incercepto y un coeficiente (formula lineal)
#lineal = interp - (coef*valor)
# esta formual la influimos en nuestra formula logistica para obtener la probabilidad.
lineal =predict(object = modelo, newdata = dato_hipotetico, type = 'response')
#para consultar la probabilidad, la formula lineal la incluimos en la formula logistica
cat("Probabilidad de rotación segun caso elegido aleatoriamente : ", 1/(1+exp(-lineal)), " lineal de: ", lineal)
## Probabilidad de rotación segun caso elegido aleatoriamente : 0.5206916 lineal de: 0.0828136
Se observa que una personas con una buena satisfación ambiental y laboral, pero soltero y con una edad alrededor de los 30 años, tiene una probailidad del 52.06% de rotar. lo cual tiene mucho sentido a los comportamientos que veniamos expresando y a como se comporta el modelo.
A la pregunta: debemos invervenir este empleado: la respuesta seria, no, el umbra de decisión ideal del 0.35 , que es el valor que tiene mayor precisión, y nuestro registro tiene un valor de 0.08281, valor inferior al umbral definido como referencia maxima de nuestro modelo.
¿Que podemos mejorar para este empleado no tenga una subida en su probailidad de rotación? podemos realizar actividades que refuerecen su alta satisfacción laboral y ambiental que esta mostrando en estos momentos.
Mejorar el ambiente laboral y ambiental , debe ser una prioridad de estrategias para mejorar la rotación, vemos con preocupación que las calificaciones muestran un 60% de la poblacón intatisfechas.
Enfocarse en programas retadores y de oportunidades en personal joven y con cargos como el de representante de ventas y cargo tecnico laboral (para evitr sobre costos en entrenamientos. nota: aveces se piensa que al ser personal que no cuesta tanto a las empresas, es personal que no tiene tanta improtancia, no obstante, desde el punto de vista de costo de entrenar yla curvas de aprendizaje , estos cargos deben ser tenidos encuentan, porque generan muchos sobre costos a la empresa)
Extender el ambiente laboral de recursos humanos en la compañia, vemos que es un área en donde casi no rotan las personas. y en esté puede estar la clave que requiere la empresa para disminuir a futuró la rotación laboral.