Ein Finazdienstleister steht vor der Herausforderung, die Mitarbeiterfluktuation besser zu verstehen und potenzielle Abgänge gezielt zu verhindern. Es wird deshalb eine externe Beratung beauftragt, die zugrunde liegenden Faktoren der Fluktuation zu identifizieren.
Die Unternehmensberatung nutzt Maschinelles Lernen, um die Fluktuation der Mitarbeiter basierend auf erhobenen Daten zu modellieren und vorherzusagen. Dazu werden verschiedene Algorithmen trainiert, miteinander verglichen und die Bedeutung einzelner Prädiktoren analysiert.
packages <- c("caret", "ranger", "lsr", "ggplot2", "rsample", "data.table",
"e1071", "grid", "tidyverse", "MLeval", "here", "rio")
lapply(packages, function(package){
if (!require(package, character.only = TRUE)) {
install.packages(package, dependencies = TRUE)
}
library(package, character.only = TRUE)
})
set.seed(241)
here::here()
# Rohdaten importieren
mitarbeiter_data <- rio::import(file = "HRDataset_v14_4.csv")
str(mitarbeiter_data)
## 'data.frame': 311 obs. of 9 variables:
## $ Salary : int 62506 104437 64955 64991 50825 57568 95660 59365 47837 50178 ...
## $ DateofHire : chr "7/5/2011" "3/30/2015" "7/5/2011" "1/7/2008" ...
## $ PerformanceScore : chr "Exceeds" "Fully Meets" "Fully Meets" "Fully Meets" ...
## $ EngagementSurvey : chr "4,6" "4,96" "3,02" "4,84" ...
## $ EmpSatisfaction : int 5 3 3 5 4 5 3 4 3 5 ...
## $ SpecialProjectsCount: int 0 6 0 0 0 0 4 0 0 6 ...
## $ DaysLateLast30 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Absences : int 1 17 3 15 2 15 19 19 4 16 ...
## $ Turnover : chr "Retained" "Departed" "Departed" "Retained" ...
Die Daten wurden vom Finanzdienstleister vorab gefiltert, sodass
ausschließlich die relevanten Fluktuationswerte in die Analyse
einfließen.
Da das caret-Paket lediglich
numerischen Input akzeptiert, ist zunächst eine Konvertierung der
Variablen von einem Zeichen- in ein numerisches Format erforderlich.
Das Anstellungsdatum wird in ein Datumsformat konvertiert und die Dauer der Anstellung in Tagen berechnen. Das ursprüngliche Datum wird danach entfernt, da es nicht mehr benötigt wird.
mitarbeiter_data$DateofHire <- as.Date(mitarbeiter_data$DateofHire, format = "%m/%d/%Y")
mitarbeiter_data$DaysSinceHire <- as.numeric(Sys.Date() - mitarbeiter_data$DateofHire)
mitarbeiter_data$DateofHire <- NULL
Die Zielvariable “Turnover” wird in einen Faktor umgewandelt, damit sie in den Modellen korrekt verarbeitet werden kann.
mitarbeiter_data$Turnover <- factor(x = mitarbeiter_data$Turnover,
levels = c("Retained", "Departed"))
Die Variable “EngagementSurvey” wird von einem Zeichen- in ein numerisches Format konvertiert, um sie für die Modellierung vorzubereiten.
mitarbeiter_data$EngagementSurvey <- sub(",", ".", mitarbeiter_data$EngagementSurvey)
mitarbeiter_data$EngagementSurvey <- as.numeric(mitarbeiter_data$EngagementSurvey)
Für die kategoriale Variable “PerformanceScore” werden Dummy-Variablen erstellt.
dummyVars <- caret::dummyVars(~ PerformanceScore, data = mitarbeiter_data)
performance_dummy <- predict(dummyVars, newdata = mitarbeiter_data)
mitarbeiter_data$perfromance_dummy <- performance_dummy
mitarbeiter_data$PerformanceScore <- NULL
str(mitarbeiter_data)
## 'data.frame': 311 obs. of 9 variables:
## $ Salary : int 62506 104437 64955 64991 50825 57568 95660 59365 47837 50178 ...
## $ EngagementSurvey : num 4.6 4.96 3.02 4.84 5 5 3.04 5 4.46 5 ...
## $ EmpSatisfaction : int 5 3 3 5 4 5 3 4 3 5 ...
## $ SpecialProjectsCount: int 0 6 0 0 0 0 4 0 0 6 ...
## $ DaysLateLast30 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Absences : int 1 17 3 15 2 15 19 19 4 16 ...
## $ Turnover : Factor w/ 2 levels "Retained","Departed": 1 2 2 1 2 1 1 1 1 1 ...
## $ DaysSinceHire : num 4893 3529 4893 6168 4887 ...
## $ perfromance_dummy : num [1:311, 1:4] 1 0 0 0 0 1 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:311] "1" "2" "3" "4" ...
## .. ..$ : chr [1:4] "PerformanceScoreExceeds" "PerformanceScoreFully Meets" "PerformanceScoreNeeds Improvement" "PerformanceScorePIP"
Die Daten werden in Trainings- (80%) und Testdaten (20%) aufgeteilt, um die Modelle zu trainieren und später deren Leistung zu bewerten.
trainIndex <- caret::createDataPartition(mitarbeiter_data$Turnover, p = .8, list = FALSE)
mitarbeiterTrain <- mitarbeiter_data[ trainIndex,]
mitarbeiterTest <- mitarbeiter_data[-trainIndex,]
Wir verwenden eine wiederholte 10-fache Kreuzvalidierung, um die Modelle zu trainieren. Diese Methode hilft, die Modelle robust gegenüber Überanpassungen zu machen.
train_control <- trainControl(method = "repeatedcv", number = 10, repeats = 3,
savePredictions = "all")
Hier wird ein Gradient Boosting Modell (gbm) trainiert, wobei Genauigkeit (Accuracy) als Leistungskennzahl verwendet wird. Die Ergebnisse und die Lernkurve werden anschließend visualisiert.
set.seed(42)
model_gbm <- train(
Turnover ~.,
data = mitarbeiterTrain,
trControl = train_control,
method = "gbm",
metric = "Accuracy",
verbose = FALSE)
print(model_gbm)
## Stochastic Gradient Boosting
##
## 250 samples
## 8 predictor
## 2 classes: 'Retained', 'Departed'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 226, 226, 225, 225, 224, 226, ...
## Resampling results across tuning parameters:
##
## interaction.depth n.trees Accuracy Kappa
## 1 50 0.7427094 0.4031564
## 1 100 0.7279701 0.3641271
## 1 150 0.7228974 0.3565213
## 2 50 0.7306410 0.3674851
## 2 100 0.7306368 0.3754948
## 2 150 0.7297222 0.3747818
## 3 50 0.7161624 0.3450445
## 3 100 0.7252949 0.3725178
## 3 150 0.7037778 0.3232909
##
## Tuning parameter 'shrinkage' was held constant at a value of 0.1
##
## Tuning parameter 'n.minobsinnode' was held constant at a value of 10
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were n.trees = 50, interaction.depth =
## 1, shrinkage = 0.1 and n.minobsinnode = 10.
plot(model_gbm)
Ein Support-Vector-Machine Modell mit linearem Kernel wird trainiert. Auch hier werden die Ergebnisse und die Lernkurve visualisiert.
set.seed(42)
model_svm <- train(
Turnover ~.,
data = mitarbeiterTrain,
trControl = train_control,
method = "svmLinear2",
metric = "Accuracy",
verbose = FALSE)
print(model_svm)
## Support Vector Machines with Linear Kernel
##
## 250 samples
## 8 predictor
## 2 classes: 'Retained', 'Departed'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 226, 226, 225, 225, 224, 226, ...
## Resampling results across tuning parameters:
##
## cost Accuracy Kappa
## 0.25 0.6712393 0.1575262
## 0.50 0.6910897 0.2373848
## 1.00 0.6950470 0.2606354
##
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was cost = 1.
plot(model_svm)
Ein Random Forest Modell (ranger) wird trainiert. Es wird die impurity-Metrik zur Bewertung der Variablenwichtigkeit verwendet.
set.seed(42)
model_rf <- train(
Turnover ~.,
data = mitarbeiterTrain,
trControl = train_control,
method = "ranger",
importance = "impurity",
metric = "Accuracy",
verbose = FALSE)
print(model_rf)
## Random Forest
##
## 250 samples
## 8 predictor
## 2 classes: 'Retained', 'Departed'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 226, 226, 225, 225, 224, 226, ...
## Resampling results across tuning parameters:
##
## mtry splitrule Accuracy Kappa
## 2 gini 0.7176111 0.32511115
## 2 extratrees 0.6680726 0.06790103
## 6 gini 0.7031966 0.32113821
## 6 extratrees 0.6989829 0.30072652
## 11 gini 0.6937949 0.30289769
## 11 extratrees 0.6845128 0.27750334
##
## Tuning parameter 'min.node.size' was held constant at a value of 1
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were mtry = 2, splitrule = gini
## and min.node.size = 1.
plot(model_rf)
results <- resamples(list(GBM = model_gbm, RF = model_rf, SVM = model_svm))
summary(results)
##
## Call:
## summary.resamples(object = results)
##
## Models: GBM, RF, SVM
## Number of resamples: 30
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## GBM 0.5600000 0.6923077 0.7253846 0.7427094 0.8057692 0.8750000 0
## RF 0.5833333 0.6666667 0.7003205 0.7176111 0.7837500 0.8800000 0
## SVM 0.5600000 0.6538462 0.7003205 0.6950470 0.7307692 0.7916667 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## GBM -0.04562738 0.2775862 0.3946309 0.4031564 0.5790323 0.6896552 0
## RF 0.05109489 0.2000000 0.2827586 0.3251112 0.4356955 0.7148289 0
## SVM -0.21145374 0.1848132 0.2573529 0.2606354 0.3565096 0.5714286 0
bwplot(results)
Die Bewertung erfolgt anhand zweier Metriken: Accuracy (Genauigkeit) und Kappa (Maß für die Übereinstimmung).
Die Genauigkeit gibt den Anteil der korrekten Vorhersagen am gesamten Datensatz an. Das GBM-Modell hat im Durchschnitt die höchste Genauigkeit, gefolgt von RF und SVM.
Der Kappa-Wert bewertet die Genauigkeit, indem er die Übereinstimmung zwischen den vorhergesagten und tatsächlichen Klassen berücksichtigt, und dabei die Möglichkeit zufälliger Übereinstimmungen herausrechnet. Auch hier zeigt das GBM-Modell die besten Ergebnisse mit einer moderaten Übereinstimmung.
# Gradient Boosting Machine
predicted_test_GBM <- predict(model_gbm, newdata = mitarbeiterTest)
confusionMatrix(predicted_test_GBM, mitarbeiterTest$Turnover, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction Retained Departed
## Retained 34 7
## Departed 7 13
##
## Accuracy : 0.7705
## 95% CI : (0.645, 0.8685)
## No Information Rate : 0.6721
## P-Value [Acc > NIR] : 0.06369
##
## Kappa : 0.4793
##
## Mcnemar's Test P-Value : 1.00000
##
## Sensitivity : 0.8293
## Specificity : 0.6500
## Pos Pred Value : 0.8293
## Neg Pred Value : 0.6500
## Precision : 0.8293
## Recall : 0.8293
## F1 : 0.8293
## Prevalence : 0.6721
## Detection Rate : 0.5574
## Detection Prevalence : 0.6721
## Balanced Accuracy : 0.7396
##
## 'Positive' Class : Retained
##
# Random Forest
predicted_test_RF <- predict(model_rf, newdata = mitarbeiterTest)
confusionMatrix(predicted_test_RF, mitarbeiterTest$Turnover, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction Retained Departed
## Retained 37 7
## Departed 4 13
##
## Accuracy : 0.8197
## 95% CI : (0.7002, 0.9064)
## No Information Rate : 0.6721
## P-Value [Acc > NIR] : 0.007899
##
## Kappa : 0.5745
##
## Mcnemar's Test P-Value : 0.546494
##
## Sensitivity : 0.9024
## Specificity : 0.6500
## Pos Pred Value : 0.8409
## Neg Pred Value : 0.7647
## Precision : 0.8409
## Recall : 0.9024
## F1 : 0.8706
## Prevalence : 0.6721
## Detection Rate : 0.6066
## Detection Prevalence : 0.7213
## Balanced Accuracy : 0.7762
##
## 'Positive' Class : Retained
##
# Support Vector Machine
predicted_test_svm <- predict(model_svm, newdata = mitarbeiterTest)
confusionMatrix(predicted_test_svm, mitarbeiterTest$Turnover, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction Retained Departed
## Retained 36 8
## Departed 5 12
##
## Accuracy : 0.7869
## 95% CI : (0.6632, 0.8814)
## No Information Rate : 0.6721
## P-Value [Acc > NIR] : 0.03468
##
## Kappa : 0.4971
##
## Mcnemar's Test P-Value : 0.57910
##
## Sensitivity : 0.8780
## Specificity : 0.6000
## Pos Pred Value : 0.8182
## Neg Pred Value : 0.7059
## Precision : 0.8182
## Recall : 0.8780
## F1 : 0.8471
## Prevalence : 0.6721
## Detection Rate : 0.5902
## Detection Prevalence : 0.7213
## Balanced Accuracy : 0.7390
##
## 'Positive' Class : Retained
##
Das Random Forest (RF)-Modell zeigt die beste Leistung mit der höchsten Genauigkeit und dem höchsten Kappa-Wert.
# Gradient Boosting Machine
predicted_full_GBM <- predict(model_gbm, newdata = mitarbeiter_data)
confusionMatrix(predicted_full_GBM, mitarbeiter_data$Turnover, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction Retained Departed
## Retained 182 38
## Departed 25 66
##
## Accuracy : 0.7974
## 95% CI : (0.7484, 0.8407)
## No Information Rate : 0.6656
## P-Value [Acc > NIR] : 1.982e-07
##
## Kappa : 0.5303
##
## Mcnemar's Test P-Value : 0.1306
##
## Sensitivity : 0.8792
## Specificity : 0.6346
## Pos Pred Value : 0.8273
## Neg Pred Value : 0.7253
## Precision : 0.8273
## Recall : 0.8792
## F1 : 0.8525
## Prevalence : 0.6656
## Detection Rate : 0.5852
## Detection Prevalence : 0.7074
## Balanced Accuracy : 0.7569
##
## 'Positive' Class : Retained
##
# Random Forest
predicted_full_RF <- predict(model_rf, newdata = mitarbeiter_data)
confusionMatrix(predicted_full_RF, mitarbeiter_data$Turnover, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction Retained Departed
## Retained 201 15
## Departed 6 89
##
## Accuracy : 0.9325
## 95% CI : (0.8986, 0.9577)
## No Information Rate : 0.6656
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.845
##
## Mcnemar's Test P-Value : 0.08086
##
## Sensitivity : 0.9710
## Specificity : 0.8558
## Pos Pred Value : 0.9306
## Neg Pred Value : 0.9368
## Precision : 0.9306
## Recall : 0.9710
## F1 : 0.9504
## Prevalence : 0.6656
## Detection Rate : 0.6463
## Detection Prevalence : 0.6945
## Balanced Accuracy : 0.9134
##
## 'Positive' Class : Retained
##
# Support Vector Machine
predicted_full_SVM <- predict(model_svm, newdata = mitarbeiter_data)
confusionMatrix(predicted_full_SVM, mitarbeiter_data$Turnover, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction Retained Departed
## Retained 183 59
## Departed 24 45
##
## Accuracy : 0.7331
## 95% CI : (0.6803, 0.7815)
## No Information Rate : 0.6656
## P-Value [Acc > NIR] : 0.006157
##
## Kappa : 0.3457
##
## Mcnemar's Test P-Value : 0.000190
##
## Sensitivity : 0.8841
## Specificity : 0.4327
## Pos Pred Value : 0.7562
## Neg Pred Value : 0.6522
## Precision : 0.7562
## Recall : 0.8841
## F1 : 0.8151
## Prevalence : 0.6656
## Detection Rate : 0.5884
## Detection Prevalence : 0.7781
## Balanced Accuracy : 0.6584
##
## 'Positive' Class : Retained
##
Obwohl GBM im Resampling die höchste durchschnittliche Genauigkeit und den besten Kappa-Wert erzielt, ist RF im Test- und im Gesamtdatensatz überlegen, was darauf hindeutet, dass RF möglicherweise besser generalisiert. Für die Vorhersage der Mitarbeiter-Fluktuation ist Random Forest damit das insgesamt zuverlässigste Modell, gefolgt von GBM. SVM zeigt in beiden Fällen die schwächste Leistung.
Imp_RF <- varImp(model_rf, scale = FALSE)
Imp_RF
## ranger variable importance
##
## Overall
## DaysSinceHire 29.177
## Salary 14.333
## EngagementSurvey 10.893
## Absences 9.267
## SpecialProjectsCount 4.305
## EmpSatisfaction 4.244
## DaysLateLast30 2.477
## perfromance_dummyPerformanceScoreExceeds 1.588
## perfromance_dummyPerformanceScoreFully Meets 1.409
## perfromance_dummyPerformanceScoreNeeds Improvement 1.136
## perfromance_dummyPerformanceScorePIP 0.554
Die Analyse zeigt, dass die Anstellungsdauer, das Gehalt und die Ergebnisse der Engagement-Umfrage die wichtigsten Faktoren für die Vorhersage der Fluktuation sind. Basierend auf diesen Erkenntnissen empfiehlt die Unternehmensberatung dem Finanzdienstleister folgende strategische Maßnahmen:
Mitarbeiterbindung stärken: Die Anstellungsdauer als zentraler Faktor weist darauf hin, dass langfristige Mitarbeiterbeziehungen besonders wertvoll sind. Programme zur Förderung der Mitarbeiterbindung, wie individuelle Entwicklungsmöglichkeiten sollten intensiviert werden.
Wettbewerbsfähige Gehaltsstrukturen: Das Gehalt hat einen erheblichen Einfluss auf die Fluktuation. Es wird empfohlen, regelmäßig Gehaltsbenchmarks durchzuführen und sicherzustellen, dass die Vergütung den Branchenstandards entspricht.
Mitarbeiterengagement verbessern: Die Ergebnisse zeigen, dass das Engagement der Mitarbeiter eng mit ihrer Loyalität verbunden sind. Die Entwicklung persönlicher Ressourcen wie Resilienz, Selbstwirksamkeit und Optimismus ist essenziell, da diese Faktoren Mitarbeitende befähigen, Herausforderungen effektiver zu bewältigen. Gleichzeitig sollten Autonomie, konstruktives Feedback und soziale Unterstützung gestärkt werden.