Julian Andres Ospina Cuesta

Maestría en Ciencia de Datos - Universidad Javeriana Cali
Cali, Colombia
Código: 8984933 +57 3043912471
Autorizo que el documento sea publicado con el resto de mis compañeros de la Universidad Javeriana

1.Introducción

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

1.1 Entedimiento de los datos

A continuación los primeros registros de los datos suministrados

Tabla de los primeros registros base rotación
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)
Tabla Resumen de dataset antes de tratamientos
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.

1.2 Tipo de datos de los campos

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

# 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

# cualitativos
for (elemento in resumen_cualitativa) {
  cat("- ", elemento, "\n")
}
## -  Rotación 
## -  ViajedeNegocios 
## -  Departamento 
## -  Campo_Educación 
## -  Genero 
## -  Cargo 
## -  Estado_Civil 
## -  Horas_Extra

2. Selección de variables (3 categoricas y 3 cuantitativas)

Revisando los campos que tenemos en el dataset suministrados y asumiendo un rol de negocio se seleccionaron los siguientes campos:

campos cuantitativos

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

campos cualitativos

  • 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

3. Análisis univariado

Variables cuantitativas

Satisfación_Laboral
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.

Satisfacción_Ambiental
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

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

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

Variables cualitativas

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)
}

Campo_Educación
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.

Campo_Educació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.

Cargo
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

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

4. Análisis bivariado

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.

Edad vs Ingresos

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.

Satisfación_Laboral vs Ingresos

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.

Satisfacción_Ambiental vs Ingresos

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.

Campo_Educación vs Ingresos

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.

Estado_Civil vs Ingresos

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.

Cargos vs Ingresos

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.

5. Estimación del modelo

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

6. Evaluación

6.1 Matriz de confusión

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

6.2 Umbral de decisión

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

6.3 Curva ROC

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

7. Predicciones

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)
Tabla de caso Hipotetico
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.

8. Conclusiones

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