In diesem Kapitel wird die Fluktuation mithilfe von Maschinellem Lernen vorhergesagt. Unter Zuhilfenahme des Caret-Pakets werden drei Algorithmen trainiert und evaluiert. Von den drei trainierten Modellen wird dann das beste ausgewählt und die Wichtigkeit einzelner Prädiktoren untersucht.
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)
})
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 ...
## $ Fluktuation : chr "verblieben" "gegangen" "gegangen" "verblieben" ...
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 “Fluktuation” wird in einen Faktor umgewandelt, damit sie in den Modellen korrekt verarbeitet werden kann.
mitarbeiter_data$Fluktuation <- factor(x = mitarbeiter_data$Fluktuation,
levels = c("verblieben", "gegangen"))
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)
Da das caret-Paket nur ein numerisches Format bei den Prädiktoren zulässt, werden für die kategoriale Variable “PerformanceScore” 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 ...
## $ Fluktuation : Factor w/ 2 levels "verblieben","gegangen": 1 2 2 1 2 1 1 1 1 1 ...
## $ DaysSinceHire : num 4858 3494 4858 6133 4852 ...
## $ 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$Fluktuation, 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(
Fluktuation ~.,
data = mitarbeiterTrain,
trControl = train_control,
method = "gbm",
metric = "Accuracy",
verbose = FALSE)
print(model_gbm)
## Stochastic Gradient Boosting
##
## 250 samples
## 8 predictor
## 2 classes: 'verblieben', 'gegangen'
##
## 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.7455470 0.4195539
## 1 100 0.7535427 0.4327954
## 1 150 0.7482607 0.4178813
## 2 50 0.7467009 0.4142901
## 2 100 0.7376838 0.4003171
## 2 150 0.7351709 0.3935886
## 3 50 0.7325556 0.3837739
## 3 100 0.7230556 0.3648297
## 3 150 0.7300470 0.3827655
##
## 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 = 100, 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(
Fluktuation ~.,
data = mitarbeiterTrain,
trControl = train_control,
method = "svmLinear2")
print(model_svm)
## Support Vector Machines with Linear Kernel
##
## 250 samples
## 8 predictor
## 2 classes: 'verblieben', 'gegangen'
##
## 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.6976453 0.2807762
## 0.50 0.6935299 0.2847356
## 1.00 0.6987094 0.3101811
##
## 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.
model_rf <- train(
Fluktuation ~.,
data = mitarbeiterTrain,
trControl = train_control,
method = "ranger",
importance = "impurity",
metric = "Accuracy")
print(model_rf)
## Random Forest
##
## 250 samples
## 8 predictor
## 2 classes: 'verblieben', 'gegangen'
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times)
## Summary of sample sizes: 226, 225, 226, 224, 225, 226, ...
## Resampling results across tuning parameters:
##
## mtry splitrule Accuracy Kappa
## 2 gini 0.7484829 0.4044017
## 2 extratrees 0.6817607 0.1067582
## 6 gini 0.7460769 0.4215495
## 6 extratrees 0.7444231 0.4133110
## 11 gini 0.7367863 0.4045579
## 11 extratrees 0.7498590 0.4282054
##
## 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 = 11, splitrule = extratrees
## 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.5769231 0.6770833 0.7600000 0.7535427 0.8057692 0.9200000 0
## RF 0.5769231 0.7112500 0.7600000 0.7498590 0.8000000 0.9166667 0
## SVM 0.5384615 0.6434615 0.7083333 0.6987094 0.7575000 0.8076923 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## GBM -0.01418440 0.2564655 0.4706178 0.4327954 0.5849754 0.8263889 0
## RF 0.00000000 0.3564370 0.4638480 0.4282054 0.5709934 0.8000000 0
## SVM -0.01960784 0.2131401 0.3026696 0.3101811 0.4318039 0.5454545 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 (0.7427), gefolgt von RF (0.7176) und SVM (0.6950). Dies deutet darauf hin, dass das GBM-Modell tendenziell die besten Vorhersagen trifft.
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 einem durchschnittlichen Kappa-Wert von 0.4032, was auf eine moderate Übereinstimmung hinweist. Die Kappa-Werte von RF (0.3251) und SVM (0.2606) sind geringer, was auf eine schlechtere Übereinstimmung der Vorhersagen mit den tatsächlichen Ergebnissen hinweist.
predicted_test_GBM <- predict(model_gbm, newdata = mitarbeiterTest)
confusionMatrix(predicted_test_GBM, mitarbeiterTest$Fluktuation, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction verblieben gegangen
## verblieben 35 11
## gegangen 6 9
##
## Accuracy : 0.7213
## 95% CI : (0.5917, 0.8285)
## No Information Rate : 0.6721
## P-Value [Acc > NIR] : 0.2505
##
## Kappa : 0.3244
##
## Mcnemar's Test P-Value : 0.3320
##
## Sensitivity : 0.8537
## Specificity : 0.4500
## Pos Pred Value : 0.7609
## Neg Pred Value : 0.6000
## Precision : 0.7609
## Recall : 0.8537
## F1 : 0.8046
## Prevalence : 0.6721
## Detection Rate : 0.5738
## Detection Prevalence : 0.7541
## Balanced Accuracy : 0.6518
##
## 'Positive' Class : verblieben
##
predicted_test_RF <- predict(model_rf, newdata = mitarbeiterTest)
confusionMatrix(predicted_test_RF, mitarbeiterTest$Fluktuation, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction verblieben gegangen
## verblieben 31 9
## gegangen 10 11
##
## Accuracy : 0.6885
## 95% CI : (0.5571, 0.801)
## No Information Rate : 0.6721
## P-Value [Acc > NIR] : 0.452
##
## Kappa : 0.3022
##
## Mcnemar's Test P-Value : 1.000
##
## Sensitivity : 0.7561
## Specificity : 0.5500
## Pos Pred Value : 0.7750
## Neg Pred Value : 0.5238
## Precision : 0.7750
## Recall : 0.7561
## F1 : 0.7654
## Prevalence : 0.6721
## Detection Rate : 0.5082
## Detection Prevalence : 0.6557
## Balanced Accuracy : 0.6530
##
## 'Positive' Class : verblieben
##
predicted_test_svm <- predict(model_svm, newdata = mitarbeiterTest)
confusionMatrix(predicted_test_svm, mitarbeiterTest$Fluktuation, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction verblieben gegangen
## verblieben 35 13
## gegangen 6 7
##
## Accuracy : 0.6885
## 95% CI : (0.5571, 0.801)
## No Information Rate : 0.6721
## P-Value [Acc > NIR] : 0.4520
##
## Kappa : 0.2237
##
## Mcnemar's Test P-Value : 0.1687
##
## Sensitivity : 0.8537
## Specificity : 0.3500
## Pos Pred Value : 0.7292
## Neg Pred Value : 0.5385
## Precision : 0.7292
## Recall : 0.8537
## F1 : 0.7865
## Prevalence : 0.6721
## Detection Rate : 0.5738
## Detection Prevalence : 0.7869
## Balanced Accuracy : 0.6018
##
## 'Positive' Class : verblieben
##
Das Random Forest (RF)-Modell zeigt die beste Leistung mit der höchsten Genauigkeit (0.8197) und dem höchsten Kappa-Wert (0.5745).
predicted_full_GBM <- predict(model_gbm, newdata = mitarbeiter_data)
confusionMatrix(predicted_full_GBM, mitarbeiter_data$Fluktuation, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction verblieben gegangen
## verblieben 179 33
## gegangen 28 71
##
## Accuracy : 0.8039
## 95% CI : (0.7553, 0.8465)
## No Information Rate : 0.6656
## P-Value [Acc > NIR] : 4.748e-08
##
## Kappa : 0.5541
##
## Mcnemar's Test P-Value : 0.6085
##
## Sensitivity : 0.8647
## Specificity : 0.6827
## Pos Pred Value : 0.8443
## Neg Pred Value : 0.7172
## Precision : 0.8443
## Recall : 0.8647
## F1 : 0.8544
## Prevalence : 0.6656
## Detection Rate : 0.5756
## Detection Prevalence : 0.6817
## Balanced Accuracy : 0.7737
##
## 'Positive' Class : verblieben
##
predicted_full_RF <- predict(model_rf, newdata = mitarbeiter_data)
confusionMatrix(predicted_full_RF, mitarbeiter_data$Fluktuation, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction verblieben gegangen
## verblieben 198 9
## gegangen 9 95
##
## Accuracy : 0.9421
## 95% CI : (0.9101, 0.9653)
## No Information Rate : 0.6656
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.87
##
## Mcnemar's Test P-Value : 1
##
## Sensitivity : 0.9565
## Specificity : 0.9135
## Pos Pred Value : 0.9565
## Neg Pred Value : 0.9135
## Precision : 0.9565
## Recall : 0.9565
## F1 : 0.9565
## Prevalence : 0.6656
## Detection Rate : 0.6367
## Detection Prevalence : 0.6656
## Balanced Accuracy : 0.9350
##
## 'Positive' Class : verblieben
##
predicted_full_SVM <- predict(model_svm, newdata = mitarbeiter_data)
confusionMatrix(predicted_full_SVM, mitarbeiter_data$Fluktuation, mode = "everything")
## Confusion Matrix and Statistics
##
## Reference
## Prediction verblieben gegangen
## verblieben 178 49
## gegangen 29 55
##
## Accuracy : 0.7492
## 95% CI : (0.6972, 0.7964)
## No Information Rate : 0.6656
## P-Value [Acc > NIR] : 0.0008685
##
## Kappa : 0.4083
##
## Mcnemar's Test P-Value : 0.0314504
##
## Sensitivity : 0.8599
## Specificity : 0.5288
## Pos Pred Value : 0.7841
## Neg Pred Value : 0.6548
## Precision : 0.7841
## Recall : 0.8599
## F1 : 0.8203
## Prevalence : 0.6656
## Detection Rate : 0.5723
## Detection Prevalence : 0.7299
## Balanced Accuracy : 0.6944
##
## 'Positive' Class : verblieben
##
Obwohl GBM im Resampling die höchste durchschnittliche Genauigkeit und den besten Kappa-Wert erzielt, ist RF im Gesamtdatensatz überlegen, was darauf hindeutet, dass RF möglicherweise besser generalisiert. Für die Vorhersage der Mitarbeiter-Fluktuation wäre Random Forest (RF) 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 41.0694
## Salary 14.8862
## Absences 14.4718
## EngagementSurvey 13.9167
## EmpSatisfaction 7.9465
## SpecialProjectsCount 6.2565
## DaysLateLast30 4.3780
## perfromance_dummyPerformanceScoreNeeds Improvement 2.9608
## perfromance_dummyPerformanceScoreExceeds 2.2215
## perfromance_dummyPerformanceScoreFully Meets 2.2092
## perfromance_dummyPerformanceScorePIP 0.7963
Die Werte geben an, wie stark jedes Merkmal zur Vorhersage der Mitarbeiter-Fluktuation beiträgt.
Wichtige Merkmale
DaysSinceHire (29.177): Die Anstellungsdauer in Tagen ist das mit Abstand wichtigste Merkmal. Dies deutet darauf hin, dass die Länge der Betriebszugehörigkeit ein starker Indikator dafür ist, ob ein Mitarbeiter das Unternehmen verlässt.
Salary (14.333): Das Gehalt ist das zweitwichtigste Merkmal, was darauf hindeutet, dass die Bezahlung ebenfalls eine wesentliche Rolle bei der Entscheidung spielt, das Unternehmen zu verlassen.
EngagementSurvey (10.893): Die Ergebnisse der Engagement-Umfrage sind ebenfalls bedeutend, was darauf hinweist, dass das Engagement und die Zufriedenheit der Mitarbeiter eng mit der Fluktuation verbunden sind.