HR Analytics Tutorial

von Tobias Senger


3 Vorhersage der Fluktuation II

3.1 Einführung

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.

3.2 Pakete installieren und laden

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

3.3 Arbeitsverzeichnis festlegen

here::here()

3.4 Datenimport

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

3.5 Pre-Processing

Anstellungsdatum in „Anstellungsdauer (in Tagen)“ umwandeln

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
Outcome-Variable faktorisieren

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"))
Variable von character-Format in numerisches Format umwandeln

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)
Dummy-Variablen erstellen

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"
Trainings- und Testdaten aufteilen

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,]
Bootstrap resampling mit 10-fold Kreuzvalidierung

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

3.6 Modelltraining

Training: Gradient-boosting Machine

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)

Training: Support-Vector-Machine mit linearem Kernel

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)

Training: Random Forest

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)

3.7 Modellvergleich

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.

3.8 Modellevaluation

Evaluation in Testdatensatz

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

Evaluation im gesamten Datensatz

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.

3.9 Feature Importance für das akkurateste Modell berechnen und darstellen

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.