In diesem Kapitel wird die Fluktuation von Mitarbeitern im Unternehmen untersucht. Es werden die Fluktuationsrate berechnet und - mittels einer multiplen logistischen Regression - die Treiber für die Mitarbeiterfluktuation identifiziert. Anschließend werden die Ergebnisse visualisiert.
packages <- c("rmarkdown", "rio", "tidyverse", "tidyr", "here", "pscl")
lapply(packages, function(package){
if (!require(package, character.only = TRUE)) {
install.packages(package, dependencies = TRUE)
}
library(package, character.only = TRUE)
})
here::here()
# Rohdaten importieren
data <- rio::import(file = "HRDataset.csv")
summary(data[,c(6, 8:9, 11:13, 30, 32:33, 37)])
## GenderID DeptID PerfScoreID Salary
## Min. :0.0000 Min. :1.000 Min. :1.000 Min. : 45046
## 1st Qu.:0.0000 1st Qu.:5.000 1st Qu.:3.000 1st Qu.: 55502
## Median :0.0000 Median :5.000 Median :3.000 Median : 62810
## Mean :0.4341 Mean :4.611 Mean :2.977 Mean : 69021
## 3rd Qu.:1.0000 3rd Qu.:5.000 3rd Qu.:3.000 3rd Qu.: 72036
## Max. :1.0000 Max. :6.000 Max. :4.000 Max. :250000
## Termd PositionID RecruitmentSource EngagementSurvey
## Min. :0.0000 Min. : 1.00 Length:311 Length:311
## 1st Qu.:0.0000 1st Qu.:18.00 Class :character Class :character
## Median :0.0000 Median :19.00 Mode :character Mode :character
## Mean :0.3344 Mean :16.85
## 3rd Qu.:1.0000 3rd Qu.:20.00
## Max. :1.0000 Max. :30.00
## EmpSatisfaction Absences
## Min. :1.000 Min. : 1.00
## 1st Qu.:3.000 1st Qu.: 5.00
## Median :4.000 Median :10.00
## Mean :3.891 Mean :10.24
## 3rd Qu.:5.000 3rd Qu.:15.00
## Max. :5.000 Max. :20.00
Die Fluktuationsrate misst den Anteil der Mitarbeiter, die das Unternehmen innerhalb eines bestimmten Zeitraums verlassen haben. Sie wird wie folgt berechnet:
Fluktuationsrate = (Anzahl der Mitarbeiter, die das Unternehmen verlassen haben / Gesamtanzahl der Mitarbeiter) * 100
# Fluktuationsrate berechnen
fluktuationsrate <- data %>%
dplyr::summarize(turnover_rate = mean(Termd == 1) * 100)
print(fluktuationsrate)
## turnover_rate
## 1 33.44051
In diesem Fall beträgt die Fluktuationsrate 33.44%, was bedeutet, dass 33.44% der Mitarbeiter das Unternehmen im betrachteten Zeitraum verlassen haben.
Um die wichtigsten Einflüsse auf die vorhergesagte Fluktuation zu erhalten, wird eine z-Standardisierung aller Prädiktoren benötigt. Aus diesem Grund müssen die unabhängigen Modellvariablen von einem character-Format in ein numerisches Format umgewandelt werden.
# Konvertierung des character-Formats in ein numerisches-Format
data$EngagementSurvey <- gsub(",", ".", data$EngagementSurvey)
data <- data %>%
dplyr::mutate(
EngagementSurveyID = as.numeric(EngagementSurvey),
RecruitmentSourceID = as.numeric(factor(RecruitmentSource, nmax = 9)))
# Modellierung mit der glm-Funktion
turnover_model <- glm(Termd ~
scale(GenderID) + scale(DeptID) + scale(PositionID) +
scale(Salary) + scale(Absences) + scale(PerfScoreID) +
scale(EmpSatisfaction) + scale(EngagementSurveyID) +
scale(RecruitmentSourceID), data = data,
family = binomial(link = "logit"))
summary(turnover_model)
##
## Call:
## glm(formula = Termd ~ scale(GenderID) + scale(DeptID) + scale(PositionID) +
## scale(Salary) + scale(Absences) + scale(PerfScoreID) + scale(EmpSatisfaction) +
## scale(EngagementSurveyID) + scale(RecruitmentSourceID), family = binomial(link = "logit"),
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4735 -0.9112 -0.7053 1.2152 2.1760
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.771813 0.130133 -5.931 3.01e-09 ***
## scale(GenderID) -0.002673 0.127552 -0.021 0.983279
## scale(DeptID) 0.108646 0.163531 0.664 0.506448
## scale(PositionID) 0.332840 0.145968 2.280 0.022594 *
## scale(Salary) -0.166975 0.175278 -0.953 0.340777
## scale(Absences) 0.245996 0.128043 1.921 0.054706 .
## scale(PerfScoreID) -0.272536 0.157967 -1.725 0.084478 .
## scale(EmpSatisfaction) 0.045976 0.133777 0.344 0.731092
## scale(EngagementSurveyID) 0.101486 0.151547 0.670 0.503068
## scale(RecruitmentSourceID) -0.459964 0.134129 -3.429 0.000605 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 396.37 on 310 degrees of freedom
## Residual deviance: 367.58 on 301 degrees of freedom
## AIC: 387.58
##
## Number of Fisher Scoring iterations: 4
# Finales Modell mit (marginal-)signifikanten Prädiktoren
turnover_model_final <- glm(Termd ~ scale(PositionID) + scale(Absences) +
scale(PerfScoreID) + scale(RecruitmentSourceID),
family = binomial(link = "logit"),
data = data)
summary(turnover_model_final)
##
## Call:
## glm(formula = Termd ~ scale(PositionID) + scale(Absences) + scale(PerfScoreID) +
## scale(RecruitmentSourceID), family = binomial(link = "logit"),
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5424 -0.9008 -0.7022 1.2061 2.0235
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.7584 0.1284 -5.905 3.52e-09 ***
## scale(PositionID) 0.3539 0.1415 2.501 0.012368 *
## scale(Absences) 0.2379 0.1270 1.873 0.061109 .
## scale(PerfScoreID) -0.2236 0.1251 -1.788 0.073834 .
## scale(RecruitmentSourceID) -0.4407 0.1328 -3.318 0.000907 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 396.37 on 310 degrees of freedom
## Residual deviance: 370.99 on 306 degrees of freedom
## AIC: 380.99
##
## Number of Fisher Scoring iterations: 4
# McFadden's R² index [Pseudo-R2]
pscl::pR2(object = turnover_model_final)
## fitting null model for pseudo-r2
## llh llhNull G2 McFadden r2ML
## -185.49252087 -198.18615197 25.38726220 0.06404903 0.07838809
## r2CU
## 0.10880710
# Visualisierung des Kriteriumsplots
ggplot(data, aes(x = fitted(turnover_model_final), y = Termd)) +
geom_point() +
geom_smooth(method = "glm",
method.args = list(family = binomial(link = "logit")),
se = FALSE) +
theme_bw()
## `geom_smooth()` using formula = 'y ~ x'