Actividad03
william fernando ojea casallas
2025-09-25
Problema: Rotación de cargo
En una organización, se busca comprender y prever los factores que influyen en la rotación de empleados entre distintos cargos. La empresa ha recopilado datos históricos sobre el empleo de sus trabajadores, incluyendo variables como la antigüedad en el cargo actual, el nivel de satisfacción laboral, el salario actual, edad y otros factores relevantes. La gerencia planea desarrollar un modelo de regresión logística que permita estimar la probabilidad de que un empleado cambie de cargo en el próximo período y determinar cuales factores indicen en mayor proporción a estos cambios.
Con esta información, la empresa podrá tomar medidas proactivas para retener a su talento clave, identificar áreas de mejora en la gestión de recursos humanos y fomentar un ambiente laboral más estable y tranquilo. La predicción de la probabilidad de rotación de empleados ayudará a la empresa a tomar decisiones estratégicas informadas y a mantener un equipo de trabajo comprometido y satisfecho en sus roles actuales.
Antes de realizar los pasos para el analisis se carga la base de datos:
# Cargar paquete
library(readxl)Warning: package 'readxl' was built under R version 4.4.3# Leer el archivo Excel
datos <- read_excel("C:/Users/William/Documents/Actividad003/rotacion.xlsx")
# Ver las primeras filas
head(datos)# A tibble: 6 × 24
Rotacion Edad Viaje_de_Negocios Departamento Distancia_Casa Educación
<chr> <dbl> <chr> <chr> <dbl> <dbl>
1 Si 41 Raramente Ventas 1 2
2 No 49 Frecuentemente IyD 8 1
3 Si 37 Raramente IyD 2 2
4 No 33 Frecuentemente IyD 3 4
5 No 27 Raramente IyD 2 1
6 No 32 Frecuentemente IyD 2 2
# ℹ 18 more variables: Campo_Educación <chr>, Satisfacción_Ambiental <dbl>,
# Genero <chr>, Cargo <chr>, Satisfación_Laboral <dbl>, Estado_Civil <chr>,
# Ingreso_Mensual <dbl>, Trabajos_Anteriores <dbl>, Horas_Extra <chr>,
# Porcentaje_aumento_salarial <dbl>, Rendimiento_Laboral <dbl>,
# Años_Experiencia <dbl>, Capacitaciones <dbl>,
# Equilibrio_Trabajo_Vida <dbl>, Antigüedad <dbl>, Antigüedad_Cargo <dbl>,
# Años_ultima_promoción <dbl>, Años_acargo_con_mismo_jefe <dbl>dim(datos)[1] 1470 24en el resultaod se puede observar que hay 1.470 setenta filas y 24 columnas.
1. Selección de variables
Seleccione 3 variables categóricas (distintas de rotación) y 3 variables cuantitativas, que se consideren estén relacionadas con la rotación.
Segun el problema del enunciado se seleccionan las siguientes variables:
Atributos categoricos:
horas extra:se toma esta variable por que los empleadas que trabajan horas extras suelen presentar mas desgaste y mayor intencion derrotada.Se podria decir que quienes trabajan horas extra tienen mayor probabilidad de rotacion.
viaje de negocios: los viajes de negocio frecuentes pueden generrar desequilibrio en el trabajo en la vida personal afectando la permanencia.Podemos decir que quienes viajan frecuentemente tienen mayor probabilidad de rotacion.
estado civil esta varibale puede influir en la estabilidad laboral (solteros tieden a cambiar mas de empleado que casado. Empleados solteros tienen mayor probabilidad de rotacion)
Atributos numéricos:
ingreso mensual: la compnesacion es una factor critico; salrios bajos suelen asociarse a mayor a rotacion. a menor ingreso mayor probabilidad de rotacion
antiguedad los empleados con poca antiguedad son los que mas facilmente renuncian a la empresa. menor antiguedad mayor probabilidad de rotacion
edad los jovenes suelen a tender a rotar mas buscando crecimiento a nuevas oportunidades. A menor edad mayor probabilidad e rotacion
se va creer una base de datos seleccionadas del punto 1:
library(dplyr)
# Crear la nueva base solo con las variables seleccionadas
datos_1 <- datos %>%
select(Rotacion, Horas_Extra, Viaje_de_Negocios, Estado_Civil,
Ingreso_Mensual, Antigüedad, Edad)
# Verificar estructura
glimpse(datos_1)Rows: 1,470
Columns: 7
$ Rotacion <chr> "Si", "No", "Si", "No", "No", "No", "No", "No", "No"…
$ Horas_Extra <chr> "Si", "No", "Si", "Si", "No", "No", "Si", "No", "No"…
$ Viaje_de_Negocios <chr> "Raramente", "Frecuentemente", "Raramente", "Frecuen…
$ Estado_Civil <chr> "Soltero", "Casado", "Soltero", "Casado", "Casado", …
$ Ingreso_Mensual <dbl> 5993, 5130, 2090, 2909, 3468, 3068, 2670, 2693, 9526…
$ Antigüedad <dbl> 6, 10, 0, 8, 2, 7, 1, 1, 9, 7, 5, 9, 5, 2, 4, 10, 6,…
$ Edad <dbl> 41, 49, 37, 33, 27, 32, 59, 30, 38, 36, 35, 29, 31, …2. Análisis univariado
Realiza un análisis univariado (caracterización) de la información contenida en la base de datos rotacion.
str(datos_1)tibble [1,470 × 7] (S3: tbl_df/tbl/data.frame)
$ Rotacion : chr [1:1470] "Si" "No" "Si" "No" ...
$ Horas_Extra : chr [1:1470] "Si" "No" "Si" "Si" ...
$ Viaje_de_Negocios: chr [1:1470] "Raramente" "Frecuentemente" "Raramente" "Frecuentemente" ...
$ Estado_Civil : chr [1:1470] "Soltero" "Casado" "Soltero" "Casado" ...
$ Ingreso_Mensual : num [1:1470] 5993 5130 2090 2909 3468 ...
$ Antigüedad : num [1:1470] 6 10 0 8 2 7 1 1 9 7 ...
$ Edad : num [1:1470] 41 49 37 33 27 32 59 30 38 36 ...en el resultado s epuede evidenciar que efectivamente las varibales rotaicon horas extras viajes de negocios y estado civil son de tipo categorico y las varibales ingreso mensual, antiguedad y edad, son de tipo numerico.
colSums(is.na(datos_1)) Rotacion Horas_Extra Viaje_de_Negocios Estado_Civil
0 0 0 0
Ingreso_Mensual Antigüedad Edad
0 0 0 se identifica que la base de datos no tiene datos faltantes
# Solo categorías únicas de las variables categóricas
categoricas <- datos_1[, sapply(datos_1, function(x) is.factor(x) | is.character(x))]
lapply(categoricas, unique)$Rotacion
[1] "Si" "No"
$Horas_Extra
[1] "Si" "No"
$Viaje_de_Negocios
[1] "Raramente" "Frecuentemente" "No_Viaja"
$Estado_Civil
[1] "Soltero" "Casado" "Divorciado"se pueden indentificar que las categorias de los atributos categoricos estan bien escritos.
tabla de frencuencia relativa y porcentaje variables categoricas
library(dplyr)
library(ggplot2)Warning: package 'ggplot2' was built under R version 4.4.3# Seleccionar solo las variables categóricas
categoricas <- datos_1 %>%
select(where(~is.factor(.) | is.character(.)))
# ---- 1. Tablas de frecuencias (absolutas y relativas) ----
tablas_categoricas <- lapply(names(categoricas), function(var) {
abs_freq <- table(categoricas[[var]]) # absoluta
rel_freq <- prop.table(abs_freq) * 100 # relativa (%)
data.frame(
Variable = var,
Categoria = names(abs_freq),
Frecuencia = as.vector(abs_freq),
Porcentaje = round(as.vector(rel_freq), 2)
)
})
# Unir todas las tablas en un solo data.frame
tablas_categoricas <- do.call(rbind, tablas_categoricas)
print(tablas_categoricas) Variable Categoria Frecuencia Porcentaje
1 Rotacion No 1233 83.88
2 Rotacion Si 237 16.12
3 Horas_Extra No 1054 71.70
4 Horas_Extra Si 416 28.30
5 Viaje_de_Negocios Frecuentemente 277 18.84
6 Viaje_de_Negocios No_Viaja 150 10.20
7 Viaje_de_Negocios Raramente 1043 70.95
8 Estado_Civil Casado 673 45.78
9 Estado_Civil Divorciado 327 22.24
10 Estado_Civil Soltero 470 31.97para la variable rotacion 1233 empleados no rotan y 237 si rotan representados por 83.88% y 16.12 %. por otro lado el 71.70% no hacen horas extras y tan solo el 28.30 si hacen horas extras. para la variable viaje de negocios, 70.95% raramente viaja, el 18.84 porciento viaja frecuentemente tan solo el 10.20 no viaja. por ultimo el 45.78 porciento son casados, el 22.24 son divorciados el 31.97 porciento son solteros.
library(ggplot2)
# Hacer un gráfico por cada variable categórica
graficos_pastel <- lapply(split(tablas_categoricas, tablas_categoricas$Variable), function(df_var) {
ggplot(df_var, aes(x = "", y = Porcentaje, fill = Categoria)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
geom_text(aes(label = paste0(Porcentaje, "%")),
position = position_stack(vjust = 0.5), # coloca el texto al centro
color = "white", size = 4) +
labs(title = paste("Distribución de", unique(df_var$Variable))) +
theme_void() +
theme(legend.position = "right")
})
for (g in graficos_pastel) {
print(g)
}
los graficos me comprueban los resultados anteriores observando que la mayoria de los empleados no rotan, rara vez viajan, rara vez hacen horas extra.
medidas de tendencia central para la variables numerias
library(dplyr)
library(purrr)Warning: package 'purrr' was built under R version 4.4.3# Función para calcular la moda
get_mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
# Seleccionar solo variables numéricas
numericas <- datos_1 %>% select(where(is.numeric))
# Calcular medidas por cada variable y combinarlas en tabla
tendencia_central_tabla <- map_dfr(names(numericas), function(var) {
x <- numericas[[var]]
tibble(
Variable = var,
Media = mean(x, na.rm = TRUE),
Mediana = median(x, na.rm = TRUE),
Moda = get_mode(x)
)
})
# Mostrar tabla
tendencia_central_tabla# A tibble: 3 × 4
Variable Media Mediana Moda
<chr> <dbl> <dbl> <dbl>
1 Ingreso_Mensual 6503. 4919 2342
2 Antigüedad 7.01 5 5
3 Edad 36.9 36 35el salrio promedio es de 6,503 pero la mediana es mas baja 4,919 y la moda todavia es mas baja, que la mayoria de los empleados tiene de antiguedad entre 5 y 7 años , la edad de los empleados es aproximadamente 37 años.
la mayoria de los sueldos son bajos esto puede reforzar a idea que por eso menor antiguedad, empleados mas jovenes que suelen cambiar de trabajo con mas facilidad.
library(dplyr)
library(purrr)
# Seleccionar solo variables numéricas
numericas <- datos_1 %>% select(where(is.numeric))
# Calcular medidas de dispersión por cada variable
dispersion_tabla <- map_dfr(names(numericas), function(var) {
x <- numericas[[var]]
tibble(
Variable = var,
Minimo = min(x, na.rm = TRUE),
Maximo = max(x, na.rm = TRUE),
Rango = max(x, na.rm = TRUE) - min(x, na.rm = TRUE),
Varianza = var(x, na.rm = TRUE),
Desviacion_Estandar = sd(x, na.rm = TRUE),
Coef_Variacion = (sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)) * 100
)
})
# Mostrar tabla
dispersion_tabla# A tibble: 3 × 7
Variable Minimo Maximo Rango Varianza Desviacion_Estandar Coef_Variacion
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Ingreso_Mensu… 1009 19999 18990 2.22e7 4708. 72.4
2 Antigüedad 0 40 40 3.75e1 6.13 87.4
3 Edad 18 60 42 8.35e1 9.14 24.7el rango salarias es de 18990 que hay una expresion heterogenidad entre los ingresos por que represent auan desviacion estandar alta de 4,708 con un coeficiente de variacion del 72,4%para la variable antiguedad tambien representa una dispersion entre 0-40 años con el coeficiente de variacion del 87.4% lo que refleja mucho variabilidad en los años y permanencia. en la variabel edad hay unr ango mas moderado entre 18 y 60 años una desviacion estandar de 9.14 y conficiente de variacion de 24.7 porciento lo que indica que una variable es mas homogenia del conjunto.
library(dplyr)
library(ggplot2)
library(patchwork) # para combinar gráficosWarning: package 'patchwork' was built under R version 4.4.3# Seleccionar solo numéricas
numericas <- datos_1 %>%
select(where(is.numeric))
# Crear lista de boxplots
graficos_boxplot <- lapply(names(numericas), function(var) {
ggplot(numericas, aes(x = "", y = .data[[var]])) +
geom_boxplot(fill = "skyblue", color = "black") +
labs(title = paste("Boxplot de", var), x = NULL, y = var) +
theme_minimal()
})
# Mostrar todos en una cuadrícula
wrap_plots(graficos_boxplot)
En los boxtplot se puede visualizar que hay valores atipicos en ingreso mensual y antiguedad. la antguedad se concentra, la anitguedad se concentra en valores bajos en algunos empleados con muchos años en la empresa, en el ingreso mensual presenta una gra dispersion con pocos casos en salarios muy altos.
tratamiento de los valores atipos
# Seleccionar solo las variables numéricas
num_vars <- datos_1[, sapply(datos_1, is.numeric)]
# Función de escalamiento robusto
robust_scaling <- function(x) {
mediana <- median(x, na.rm = TRUE)
iqr_val <- IQR(x, na.rm = TRUE)
return((x - mediana) / iqr_val)
}
# Hacer una copia de la base original
datos_2 <- datos_1
# Aplicar solo a las variables con outliers
datos_2$Ingreso_Mensual <- robust_scaling(datos_1$Ingreso_Mensual)
datos_2$Antigüedad <- robust_scaling(datos_1$Antigüedad)
# Verificar primeras filas
head(datos_1)# A tibble: 6 × 7
Rotacion Horas_Extra Viaje_de_Negocios Estado_Civil Ingreso_Mensual Antigüedad
<chr> <chr> <chr> <chr> <dbl> <dbl>
1 Si Si Raramente Soltero 5993 6
2 No No Frecuentemente Casado 5130 10
3 Si Si Raramente Soltero 2090 0
4 No Si Frecuentemente Casado 2909 8
5 No No Raramente Casado 3468 2
6 No No Frecuentemente Soltero 3068 7
# ℹ 1 more variable: Edad <dbl>se comprueba que efectivamente se aplico el metodo de escalamiento robusto para los atributos que contenian valores atipicos.
# Convertir variables categóricas a factor
# Convertir Rotación en factor binario 0 = No, 1 = Si
datos_2$Rotacion <- factor(ifelse(datos_2$Rotacion == "Si", 1, 0), levels = c(0,1))
datos_2$Horas_Extra <- factor(datos_2$Horas_Extra)
datos_2$Viaje_de_Negocios <- factor(datos_2$Viaje_de_Negocios)
datos_2$Estado_Civil <- factor(datos_2$Estado_Civil)
# Revisar estructura
head(datos_2)# A tibble: 6 × 7
Rotacion Horas_Extra Viaje_de_Negocios Estado_Civil Ingreso_Mensual Antigüedad
<fct> <fct> <fct> <fct> <dbl> <dbl>
1 1 Si Raramente Soltero 0.196 0.167
2 0 No Frecuentemente Casado 0.0386 0.833
3 1 Si Raramente Soltero -0.517 -0.833
4 0 Si Frecuentemente Casado -0.368 0.5
5 0 No Raramente Casado -0.265 -0.5
6 0 No Frecuentemente Soltero -0.339 0.333
# ℹ 1 more variable: Edad <dbl>se puede visualizar que efectivamente se convitieron a variables a factor.
analisis bivariado
Realiza un análisis de bivariado en donde la variable respuesta sea rotacion codificada de la siguiente manera (y=1 es si rotación, y=0 es no rotación). Con base en estos resultados identifique cuales son las variables determinantes de la rotación e interpretar el signo del coeficiente estimado. Compare estos resultados con la hipótesis planteada en el punto 2.
table(datos_2$Rotacion)
0 1
1233 237 prop.table(table(datos_2$Rotacion))
0 1
0.8387755 0.1612245 el resultado indica aprimadamente que el 84% de los empleados de la organizacion no rotaron y el 16 porciento roto
analisis bivariado con las variables categoricas y rotacion
# Reemplaza con tus variables categóricas
categoricas <- c("Horas_Extra", "Viaje_de_Negocios", "Estado_Civil")
for (v in categoricas) {
cat("\n\n--- Variable:", v, " ---\n")
print(table(datos_2[[v]], datos_2$Rotacion, useNA = "ifany"))
print(prop.table(table(datos_2[[v]], datos_2$Rotacion), margin = 1))
tab <- table(datos_2[[v]], datos_2$Rotacion)
if (any(tab < 5)) {
print(fisher.test(tab))
} else {
print(chisq.test(tab))
}
f <- as.formula(paste0("Rotacion ~ ", v, ""))
mod <- glm(f, data = datos_2, family = binomial)
print(broom::tidy(mod, exponentiate = TRUE, conf.int = TRUE))
}
--- Variable: Horas_Extra ---
0 1
No 944 110
Si 289 127
0 1
No 0.8956357 0.1043643
Si 0.6947115 0.3052885
Pearson's Chi-squared test with Yates' continuity correction
data: tab
X-squared = 87.564, df = 1, p-value < 2.2e-16
# A tibble: 2 × 7
term estimate std.error statistic p.value conf.low conf.high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.117 0.101 -21.3 5.05e-101 0.0951 0.141
2 Horas_ExtraSi 3.77 0.147 9.06 1.35e- 19 2.83 5.03
--- Variable: Viaje_de_Negocios ---
0 1
Frecuentemente 208 69
No_Viaja 138 12
Raramente 887 156
0 1
Frecuentemente 0.7509025 0.2490975
No_Viaja 0.9200000 0.0800000
Raramente 0.8504314 0.1495686
Pearson's Chi-squared test
data: tab
X-squared = 24.182, df = 2, p-value = 5.609e-06
# A tibble: 3 × 7
term estimate std.error statistic p.value conf.low conf.high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.332 0.139 -7.94 1.98e-15 0.251 0.433
2 Viaje_de_NegociosNo_… 0.262 0.331 -4.04 5.36e- 5 0.131 0.485
3 Viaje_de_NegociosRar… 0.530 0.164 -3.87 1.07e- 4 0.386 0.734
--- Variable: Estado_Civil ---
0 1
Casado 589 84
Divorciado 294 33
Soltero 350 120
0 1
Casado 0.8751857 0.1248143
Divorciado 0.8990826 0.1009174
Soltero 0.7446809 0.2553191
Pearson's Chi-squared test
data: tab
X-squared = 46.164, df = 2, p-value = 9.456e-11
# A tibble: 3 × 7
term estimate std.error statistic p.value conf.low conf.high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.143 0.117 -16.7 1.33e-62 0.113 0.178
2 Estado_CivilDivorcia… 0.787 0.217 -1.10 2.71e- 1 0.508 1.19
3 Estado_CivilSoltero 2.40 0.157 5.57 2.54e- 8 1.77 3.28 se puede analizar que las variables categoricas seleccionadas estan relaiconadas significativamente con la rotaicon de personal. En el caso de horas extra el 30.5 pociento d elos que realizan horas extras rotan frente al 10.4 porciento de queines no lo hacen, por otro lao el modelo logistico indica que trabajr horas extras aumentan 3.77 veces la probabilidad de rotacion. para viaje de negocios del 24.9 porciento de quienes viajan frecuentemente y el 15 porciento de los que viajan raramente rotan,frente al 8 porciento e los que no viajan
Finalmente, para Estado_Civil, el 25,5% de los solteros rotan frente al 12,4% de los casados y el 10% de los divorciados, y el modelo indicó que los solteros tienen 2,40 veces más probabilidad de rotar que los casados (OR = 2.40; IC95%: 1.77–3.28; p < 0.001), mientras que los divorciados no presentaron diferencias significativas (p = 0.27). Estos resultados confirman que trabajar horas extra, viajar con frecuencia y ser soltero incrementan significativamente la probabilidad de rotación.
variables numericas
# Reemplaza con tus variables numéricas
numericas <- c("Ingreso_Mensual","Antigüedad", "Edad")
for (v in numericas) {
cat("\n\n--- Variable:", v, " ---\n")
# resumen por grupo
print(
datos_2 %>%
group_by(Rotacion) %>%
summarise(
n = n(),
mean = mean(.data[[v]], na.rm = TRUE),
sd = sd(.data[[v]], na.rm = TRUE)
)
)
}
--- Variable: Ingreso_Mensual ---
# A tibble: 2 × 4
Rotacion n mean sd
<fct> <int> <dbl> <dbl>
1 0 1233 0.350 0.881
2 1 237 -0.0241 0.666
--- Variable: Antigüedad ---
# A tibble: 2 × 4
Rotacion n mean sd
<fct> <int> <dbl> <dbl>
1 0 1233 0.395 1.02
2 1 237 0.0218 0.992
--- Variable: Edad ---
# A tibble: 2 × 4
Rotacion n mean sd
<fct> <int> <dbl> <dbl>
1 0 1233 37.6 8.89
2 1 237 33.6 9.69segun los resultados hay diferencias notorias entre los empleados que permanecen en la organizacion o en la empresa y los que rotan. los empleados que no rotaron presentan en promedio un mayor ingreso mensual, mayor antiguedad y mayor edad en comparacion con quienes si rotaron esto singifca que la rotacion tiende hacer mas en jovenes solteros con menor antiguedad y menores ingresos, esto me podria indicar que estos factores estan asociados conuna mayor probabilidad de abandono en la organizacion.
# test de normalidad sencillo por grupo (Shapiro)
by_group <- split(datos_2[[v]], datos_2$Rotacion)
if (all(sapply(by_group, function(x) sum(!is.na(x))) >= 3)) {
print(lapply(by_group, function(x) shapiro.test(x)))
}$`0`
Shapiro-Wilk normality test
data: x
W = 0.97821, p-value = 1.103e-12
$`1`
Shapiro-Wilk normality test
data: x
W = 0.94571, p-value = 1.005e-07podemos observar que no hay normalidad en el grupo de datos que rotan y no rotan, es decir no siguen una distribucion normal ya que p< que 0.000000000001 para el grupo sin rotacion y con p< 0.0000001 para el grupo con rotacion, por lo que se rechazan la hipotesis nula de ambos grupos
# test t o Wilcoxon
if (var.test(datos_2[[v]] ~ datos_2$Rotacion)$p.value > 0.05) {
print(t.test(datos_2[[v]] ~ datos_2$Rotacion, var.equal = TRUE))
} else {
print(t.test(datos_2[[v]] ~ datos_2$Rotacion))
}
Two Sample t-test
data: datos_2[[v]] by datos_2$Rotacion
t = 6.1796, df = 1468, p-value = 8.31e-10
alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
95 percent confidence interval:
2.699188 5.209709
sample estimates:
mean in group 0 mean in group 1
37.56204 33.60759 la prueba T indica que existe una diferencia significativa en la media de la variable analizada entre los empleados que no presentan rotacion media igual 37.56 y los que si presentan rotacion media igual a 33.61 lo que permite rechazar la hipotesis nula de igualdad de medias ademas el intervalo de confianza del 95 porciento para la difenrecia de medias 2.70 a 5.21 confirma que en promedio quienes no rotan tienen valores mayores en esta variable que quienes si rotan
# Seleccionar solo columnas numéricas
num_vars <- datos_2[sapply(datos_2, is.numeric)]
# Calcular matriz de correlación (Pearson por defecto)
cor_matrix <- cor(num_vars, use = "complete.obs", method = "pearson")
print(cor_matrix) Ingreso_Mensual Antigüedad Edad
Ingreso_Mensual 1.0000000 0.5142848 0.4977532
Antigüedad 0.5142848 1.0000000 0.3112408
Edad 0.4977532 0.3112408 1.0000000se puede observar en el resultado de la correlaciones que hay una relacion positiva moderada entre las variables numericas. en particular la mayor asociacion se observa entre ingreso mensual y antiguedad entre ingreso mensual y edad, lo cual me indica que a mayor antiguedad y edad los empleados tienden a tener ingresos mas altos. la correlacion entre edadya ntigua edad es positiva pero mas debil, indicando que aunque estan relacionadas no necesariamente crecende manera proporcionalpodemos observar que todas las correlaciones, son menores que 0,8 lo que reduce el riesgo de multicoloniedad.
regresion logistica bivariada variables numericas vs rotacion
library(dplyr)
library(broom)Warning: package 'broom' was built under R version 4.4.3# seleccionar solo variables numéricas (todas las covariables)
numericas <- datos_2 %>% select(where(is.numeric))
# asegurarse de que Rotación sea factor
datos_2$Rotacion <- factor(datos_2$Rotacion)
# lista para resultados
resultados <- list()
for (v in names(numericas)) {
# fórmula con Rotacion como respuesta
f <- as.formula(paste("Rotacion ~", v))
# modelo binomial
mod <- glm(f, data = datos_2, family = binomial)
# resultados tidy con OR y CI
resultados[[v]] <- broom::tidy(mod, exponentiate = TRUE, conf.int = TRUE)
}
# combinar resultados en un data frame
resultados_df <- bind_rows(resultados, .id = "Variable")
resultados_df# A tibble: 6 × 8
Variable term estimate std.error statistic p.value conf.low conf.high
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Ingreso_Mensu… (Int… 0.211 0.0719 -21.6 1.27e-103 0.183 0.243
2 Ingreso_Mensu… Ingr… 0.499 0.118 -5.88 4.12e- 9 0.392 0.623
3 Antigüedad (Int… 0.210 0.0718 -21.7 1.73e-104 0.182 0.242
4 Antigüedad Anti… 0.616 0.0956 -5.07 4.03e- 7 0.507 0.738
5 Edad (Int… 1.23 0.306 0.674 5.00e- 1 0.676 2.25
6 Edad Edad 0.949 0.00870 -6.01 1.90e- 9 0.933 0.965los siguientes modelos muestran que todas las variables son significativas ya que p < 0.001. los coheficientes indican que a mayor ingreso mensual OR igual a 0.50, mayo antiguedad OR aproximada 0.62 y mayor edad OR aproximadamente a 0.95 la probabilidad d erotacion disminuye, indicando un efecto protector de estas variables sobre rotacion distribucion de rotaicon de las variables categoricas
library(ggplot2)
# Horas_Extra vs Rotacion
ggplot(datos_2, aes(x = Horas_Extra, fill = Rotacion)) +
geom_bar(position = "fill") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Distribución de Rotacion según Horas_Extra",
y = "Porcentaje", x = "Horas_Extra") +
theme_minimal()
# Horas_Extra vs Rotacion
ggplot(datos_2, aes(x = Viaje_de_Negocios, fill = Rotacion)) +
geom_bar(position = "fill") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Distribución de Rotacion según Horas_Extra",
y = "Porcentaje", x = "viaje_de_negocios") +
theme_minimal()
# Horas_Extra vs Rotacion
ggplot(datos_2, aes(x = Estado_Civil, fill = Rotacion)) +
geom_bar(position = "fill") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Distribución de Rotacion según Estado_civil",
y = "Porcentaje", x = "Estado_civil") +
theme_minimal()
las graficas muestran que la rotacion laboral tiende hacer mas fecuente en los empleados que realizan horas extra viajn con mayor frecuencia por negocios o son solteros o divorciados mientras que aquellos no hacen horas extra, viajan poco o nada y estan casados presentan mayor estabilida dlaboral esto sugiere que tanto las condiciones de trabajo carga de hora sy viaje como factores personas estado cvil puedne influir significativamente en la decisioones pueden ingluir en permanecer o abandonar la relacion.
distribucion de variables numericas¨
num_vars <- names(datos_2)[sapply(datos_2, is.numeric)]
num_vars <- setdiff(num_vars, "Rotacion") # excluir Rotacion si está como numérica
for (v in num_vars) {
p <- ggplot(datos_2, aes(x = Rotacion, y = !!sym(v), fill = Rotacion)) +
geom_boxplot(alpha = 0.7) +
labs(title = paste("Distribución de", v, "según Rotacion"),
x = "Rotacion", y = v) +
theme_minimal() +
scale_fill_brewer(palette = "Set2")
print(p)
}
podemos observar que en los ingresos mensuales la mayoria de empleados
que rotan se concentran en valores bajos y muy pocos en valores altos.
En este mismo atributo los empleados que no rotan tienen un amplio rango
de valores mas altos en el ingreso mensual. en ambas clases de rotacion
se puede evidenciar que hay valores atipicos.
en el atrubyto rotaicon con respecto a la antiguedad s epeude evidenciar que hay valores aitpicos y tambien la mayoria de trabajadores presentan valores bajos en la antiguedad mostrando unos pocos valores aproxumadamente mayores a dos años.
podemos observar que los empleados que rotan, unos pocos empleados tienen mas de 55 años. por otro lado podemos observar que no hay valores atipicos en los empleaados que no rotan, concentradose entre 30 y 40 años
comparacion en los resultados del punto dos se puede visualizar que la mayoria de los empleados no rota y no realiza horas extras, viajan rara vez y estas casadas, ademas las edades se concentran entre los 30 y 40 años, antiguedades bajas ya salarios en rangos bajos. el punto tres se peude evidenciar dentrod elas distribuiciones que son los empleaos que salen de los patrones mayoritarios quienes hacen horas extra viajan con frecuencia y son solteros y divorsiados los que tienden a rotar mas. Por otro aldo, la edad no muestra grandes diferencias entre los grupos varibales como el ingrreso y la antiguedad si presentan mayor varabialidad y presencia de vlaores atipicos en quienes rotan. En conjunto, mientras el analissi descriptivo refleja estabilidad y concentracion en ciertos perfiles el analisis relacional muestra que las ocndiciones laborales exigentes y algunos factores personales amrcan diferencias signficativas en el propension abandonar la organnizacion.
estimacion del modelo
# Modelo de regresión logística
modelo_logit <- glm(Rotacion ~ Horas_Extra + Viaje_de_Negocios + Estado_Civil +
Ingreso_Mensual + Antigüedad + Edad,
data = datos_2, family = binomial)
# Resumen del modelo
summary(modelo_logit)
Call:
glm(formula = Rotacion ~ Horas_Extra + Viaje_de_Negocios + Estado_Civil +
Ingreso_Mensual + Antigüedad + Edad, family = binomial,
data = datos_2)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.80514 0.40181 -2.004 0.045096 *
Horas_ExtraSi 1.45145 0.15735 9.224 < 2e-16 ***
Viaje_de_NegociosNo_Viaja -1.30292 0.35077 -3.714 0.000204 ***
Viaje_de_NegociosRaramente -0.64548 0.18036 -3.579 0.000345 ***
Estado_CivilDivorciado -0.27018 0.22858 -1.182 0.237211
Estado_CivilSoltero 0.81950 0.17060 4.804 1.56e-06 ***
Ingreso_Mensual -0.39999 0.14481 -2.762 0.005741 **
Antigüedad -0.24511 0.11098 -2.209 0.027201 *
Edad -0.02834 0.01008 -2.811 0.004934 **
---
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: 1092.9 on 1461 degrees of freedom
AIC: 1110.9
Number of Fisher Scoring iterations: 5# Calcular pseudo-R² de McFadden
null_dev <- modelo_logit$null.deviance
resid_dev <- modelo_logit$deviance
pseudo_r2 <- 1 - (resid_dev / null_dev)
pseudo_r2[1] 0.1584244el modelos con variables explicame mejor las ariables repsuesta que el modelos nulo sin predictores 1298.6 vs 1092.9. un a y c de 10110.9 es una bondad de ajuste util para comprar modelos. el r cuadrado me indica que el modelos con la coovariables explica aproximadamente el 16 poricneto de la variabilidad en la probabilidad de rotacion en comparaicoin con el modelos nulo.
interpreatcion dela coheficientes
# Odds ratios (exp(coeficientes))
exp(coef(modelo_logit)) (Intercept) Horas_ExtraSi
0.4470267 4.2692798
Viaje_de_NegociosNo_Viaja Viaje_de_NegociosRaramente
0.2717371 0.5244106
Estado_CivilDivorciado Estado_CivilSoltero
0.7632431 2.2693538
Ingreso_Mensual Antigüedad
0.6703263 0.7826154
Edad
0.9720611 los resultado de los coheficientes delmodelo logisticos muestran el efecto de cada variable sobre la probabilidad de rotacion. los empleados que trabajn horas extra tienen mas de 4 ves mayor de probabilidad de rotar OR_4,27, mientras que ser soltero tambien incrmenta el riesgo el mas del doble OR_2.27. En comparacion, no viajar Or_0.27 o viajar raramento por negocios _0.52 asi como tener mayorres ingreso or. 0.57 o mas antiguedada OR 0.78 Y MAYOR EDAD OR 0.97 reducen al probabilidad de rotacion. por otro lado, estar divorciado no muestra un efecto tan marco OR 0.76 sugiriendo que esta condicion no constituye un facotr detemrinante en el modelo.
internvalos de confianza
# Intervalos de confianza de los OR
exp(confint(modelo_logit))Waiting for profiling to be done... 2.5 % 97.5 %
(Intercept) 0.2036573 0.9854424
Horas_ExtraSi 3.1411473 5.8239478
Viaje_de_NegociosNo_Viaja 0.1310969 0.5236812
Viaje_de_NegociosRaramente 0.3691072 0.7492207
Estado_CivilDivorciado 0.4823237 1.1844924
Estado_CivilSoltero 1.6270178 3.1779671
Ingreso_Mensual 0.5001349 0.8832532
Antigüedad 0.6266317 0.9688696
Edad 0.9527131 0.9911501los resultaod smuestran que las horas extras que realizan los empleados tienen entre 3.14 y 5.82 mas probabilidad de rotar de quienes rotan. ser soltero tambien incrementa el riesgo, entre 1.63 y 3.18 veces mas respecto a pasados. no viajr por negocios entre 0-13 y 0.52 viajar raramente 0.37 y 0.75, tener mayores ingresos 0.50 y 0.88 mas antiguedad entre.0.63 y0.97 y mayor edad entre 0.95 y 0.99 reducen la probabilidad de rotacion al indicar intervalos de confianza por debajo de 1. por ultimo el estaod civil divorciado entre 0.48 y 1.18 incluye el valor de uno en su intervalo por lo que no se puede observar que tenga un efecto significativo en al rotacion.
supuestos para modelo logistico
library(gridExtra) Warning: package 'gridExtra' was built under R version 4.4.3
Adjuntando el paquete: 'gridExtra'The following object is masked from 'package:dplyr':
combinelibrary(car) Warning: package 'car' was built under R version 4.4.3Cargando paquete requerido: carDataWarning: package 'carData' was built under R version 4.4.3
Adjuntando el paquete: 'car'The following object is masked from 'package:purrr':
someThe following object is masked from 'package:dplyr':
recodelibrary(ResourceSelection) Warning: package 'ResourceSelection' was built under R version 4.4.3ResourceSelection 0.3-6 2023-06-27vif_valores <- vif(modelo_logit)
print(vif_valores) GVIF Df GVIF^(1/(2*Df))
Horas_Extra 1.029203 1 1.014496
Viaje_de_Negocios 1.013192 2 1.003282
Estado_Civil 1.030179 2 1.007461
Ingreso_Mensual 1.405535 1 1.185553
Antigüedad 1.221176 1 1.105068
Edad 1.256140 1 1.120776este resutltaod em indica que todos los predictores del modelos tienen valores muy bajos, con GVIF^(1/(2*Df)) entre 1003 y y 1186 indicando que no hya coloniedad elvada entre las valoeriables ua que cada vairbale paorta informaicon demanera independiente sobra al rotaicon del personal
# Calcular logit predicho
datos_2$logit <- log(predict(modelo_logit, type = "response") /
(1 - predict(modelo_logit, type = "response")))
# Variables continuas
continuas <- c("Ingreso_Mensual", "Antigüedad", "Edad")
# Crear lista de gráficos con colores diferentes
plots <- lapply(continuas, function(var) {
ggplot(datos_2, aes_string(x = var, y = "logit")) +
geom_point(color = "#2ECC71") + # verde esmeralda
geom_smooth(method = "loess", color = "#8E44AD") + # morado intenso
ggtitle(paste("Logit vs", var)) +
theme_minimal()
})Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
ℹ Please use tidy evaluation idioms with `aes()`.
ℹ See also `vignette("ggplot2-in-packages")` for more information.
This warning is displayed once every 8 hours.
Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
generated.# Combinar todos los gráficos en un solo plano
do.call(grid.arrange, c(plots, ncol = length(continuas)))`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
las graficas muestran la relacion entre logit de la rotacion y las avriables continuas del modelo, en los tres atributos, la curva suavizada indica una tendencia aproximadamente decente, lo que sugiere que el supuesto de linealidad se cumple para als tres varibales.
# Crear el objeto influencia
influencia <- influence.measures(modelo_logit)
# Extraer la tabla de medidas de influencia
inf_df <- as.data.frame(influencia$infmat)
# Seleccionar solo las columnas de interés
tabla_influencia <- inf_df[, c("hat", "dffit", "cook.d")]
# Mostrar la tabla
head(tabla_influencia) hat dffit cook.d
1 0.006845874 0.13284055 1.222691e-03
2 0.004643789 -0.03277026 4.662070e-05
3 0.009574153 0.12576031 9.030361e-04
4 0.011631673 -0.13469838 1.015707e-03
5 0.003179506 -0.03314758 4.874585e-05
6 0.007828556 -0.08739995 3.819590e-04