Το Dataset με το οποίο θα ασχοληθούμε, αξιποιήθηκε και σε Case study για λογιστική παλινδρόμηση, το οποίο μπορείτε να δείτε εδώ. Οι ενότητες που αφορούν το Dataset Walkthrough αντλήθηκαν από το εν λόγω case study.
Το συγκεκριμένο σύνολο δεδομένων αφορά την ανάλυση του ανθρώπινου δυναμικού μιας εταιρείας και στοχεύει στην κατανόηση των παραγόντων που οδηγούν στην αποχώρηση των εργαζομένων (Employee Churn).
Ο κύριος στόχος είναι η δημιουργία ενός μοντέλου Λογιστικής
Παλινδρόμησης που θα προβλέπει την πιθανότητα ένας υπάλληλος να
εγκαταλείψει την εταιρεία (εξαρτημένη μεταβλητή: Left ή
Retention), επιτρέποντας στη διοίκηση να λάβει προληπτικά
μέτρα.
salary: Το επίπεδο του μισθού κατηγοριοποιημένο σε low, medium, και high.
left (Target Variable): Η μεταβλητή που θέλουμε να προβλέψουμε. Δείχνει αν ο υπάλληλος αποχώρησε (1) ή παρέμεινε (0) στην εταιρεία.
Σε πρώτο επίπεδο, έχει σημασία να εντοπίσουμε μεταβλητές που δείχνουν να σχετίζονται κατά πολύ με την εξαρτημένη μας μεταβλητή (left - αποχώρηση).
Συσχετίσεις με Μετρήσιμες Ανεξάρτητες Μεταβλητές
Από τις ποσοτικές μεταβλητές, επιλέγουμε να διερευνήσουμε το επίπεδο ικανοποίησης εργαζομένου (satisfaction_level) και την τελευταία βαθμολογία αξιολόγησης του (last_evaluation), καθώς μπορεί να υποτεθεί ότι καθορίζουν το εάν ένας υπάλληλος θα μείνει σε μία εταιρεία ή όχι.
library(ggplot2)
# Boxplot για το Last Evaluation
ggplot(hr_data, aes(x = as.factor(left), y = last_evaluation, fill = as.factor(left))) +
geom_boxplot(alpha = 0.7) +
scale_fill_manual(values = c("#3498db", "#e67e22"), labels = c("Παρέμεινε", "Αποχώρησε")) +
labs(title = "Κατανομή Βαθμολογίας Αξιολόγησης ανά Κατάσταση Παραμονής",
x = "Κατάσταση (0: Παρέμεινε, 1: Αποχώρησε)",
y = "Score Τελευταίας Αξιολόγησης",
fill = "Κατηγορία") +
theme_minimal()Όπως φαίνεται παραπάνω, τα υψηλότερα σκορ στις αξιολογήσεις τα φέρουν αυτοί οι οποίοι τελικά αποχωρούν από την εταιρεία, καθώς οι μισοί εκ των αποχωρούντων λαμβάνουν βαθμολογίες από 0.8 περίπου και άνω, ενώ οι αντίστοιχες βαθμολογίες όσων παραμένουν κυμάινονατι περί το ένα δέκατο της μονάδας πιο χαμηλά. Η μέση βαθμολογία είναι παρόμοια και για τις δύο ομάδες, γεγονός που δείχνει ότι η απόδοση από μόνη της δεν προεξοφλεί την αποχώρηση.Επιπλέον, παρατηρείται αυξημένη διασπορά στους υπαλλήλους που έφυγαν. Αυτό υποδηλώνει ότι η εταιρεία χάνει δύο τύπους εργαζομένων: τους Low Performers (πιθανή απομάκρυνση λόγω απόδοσης) και τους High Performers (πιθανή αναζήτηση καλύτερων ευκαιριών). Τέλος μπορούμε να πούμε βάσει του διαγράμματος ότι οι υπάλληλοι που παραμένουν έχουν πιο συγκεντρωμένες βαθμολογίες γύρω από τον μέσο όρο.
ggplot(hr_data, aes(x = satisfaction_level, fill = as.factor(left))) +
geom_density(alpha = 0.5) + # Το alpha κάνει τα χρώματα ημιδιαφανή για να φαίνεται η επικάλυψη
scale_fill_manual(values = c("#3498db", "#e67e22"),
labels = c("Παρέμεινε", "Αποχώρησε")) +
labs(title = "Κατανομή Πυκνότητας Ικανοποίησης",
x = "Επίπεδο Ικανοποίησης",
y = "Πυκνότητα",
fill = "Κατάσταση") +
theme_minimal()Το διάγραμμα πυκνότητας (Density Plot) αποκαλύπτει μια ξεκάθαρη πόλωση μεταξύ των δύο ομάδων. Για την Ομάδα Παραμονής (Πράσινο), η κατανομή συγκεντρώνεται σε υψηλά επίπεδα ικανοποίησης (0.6-0.9), υποδηλώνοντας ότι η σταθερότητα συνδέεται άμεσα με τη θετική εργασιακή εμπειρία. Στην Ομάδα Αποχώρησης (Κόκκινο): εντοπίζουμε τρεις διακριτές κορυφές. Η κυρίαρχη εντοπίζεται σε εξαιρετικά χαμηλά επίπεδα (<0.15) ενώ μια δεύτερη γύρω στο 0.4, επιβεβαιώνοντας ότι η χαμηλή ικανοποίηση είναι ο βασικός μοχλός φυγής. Συνεπώς, αντιλαμβανόμαστε ότι η επικάλυψη των δύο κατανομών είναι μικρή, καθιστώντας το επίπεδο ικανοποίησης των εργαζομένων ως την πιο αξιόπιστη μεταβλητή για το μοντέλο μας, καθώς διαχωρίζει με μεγάλη ακρίβεια τις δύο κατηγορίες υπαλλήλων.
Διερεύνηση μη Ποσοτικών Μεταβλητών
Παρατηρώντας τις εν λόγω μεταβλητές, μπορούμε να διακρίνουμε ως πιο ενδιαφέρουσες για την εταιρεία που διερευνούμε τον μισθό και το τμήμα απασχόλησης των υπαλλήλων.
ggplot(hr_data, aes(x = salary, fill = as.factor(left))) +
geom_bar(position = "fill") +
scale_y_continuous(labels = scales::percent) +
scale_fill_manual(values = c("#3498db", "#e67e22"),
labels = c("Παρέμεινε", "Αποχώρησε")) +
labs(title = "Ανάλυση Αποχώρησης ανά Επίπεδο Μισθού",
x = "Μισθός",
y = "Ποσοστό (%)",
fill = "Κατάσταση") +
theme_minimal()Η ανάλυση του γραφήματος για τον μισθό (salary)
αναδεικνύει την ισχυρή επίδραση των οικονομικών απολαβών στην παραμονή
του προσωπικού:
Χαμηλός Μισθός (Low): Παρουσιάζει το μεγαλύτερο ποσοστό αποχώρησης (σχεδόν 30%). Οι υπάλληλοι σε αυτή την κατηγορία είναι οι πλέον ευάλωτοι στην έξοδο, πιθανώς λόγω αναζήτησης καλύτερων οικονομικών όρων.
Υψηλός Μισθός (High): Η αποχώρηση είναι ελάχιστη (κάτω από 10%), αποδεικνύοντας ότι οι υψηλές απολαβές λειτουργούν ως ισχυρός παράγοντας συγκράτησης (retention factor).
Συμπέρασμα: Ο μισθός αποτελεί καθοριστική κατηγορική μεταβλητή. Η σταδιακή μείωση του ποσοστού αποχώρησης όσο αυξάνεται το μισθολογικό επίπεδο επιβεβαιώνει την ανάγκη συμπερίληψής του στο μοντέλο λογιστικής παλινδρόμησης για την ακριβή πρόβλεψη του κινδύνου φυγής.
library(ggplot2)
ggplot(hr_data, aes(y = Department, fill = as.factor(left))) +
geom_bar(position = "fill") +
scale_x_continuous(labels = scales::percent) +
scale_fill_manual(values = c("#3498db", "#e67e22"),
labels = c("Παρέμεινε", "Αποχώρησε")) +
labs(title = "Ποσοστό Αποχώρησης ανά Τμήμα",
x = "Ποσοστό (%)",
y = "Τμήμα",
fill = "Κατάσταση") +
theme_minimal()Η ανάλυση ανά τμήμα δείχνει ότι η αποχώρηση δεν κατανέμεται ομοιόμορφα, αναδεικνύοντας διαφορετικές εργασιακές δυναμικές:
Τμήματα Υψηλού Κινδύνου: Τα τμήματα Sales, Technical και Support παρουσιάζουν τα υψηλότερα ποσοστά αποχώρησης. Η φύση αυτών των ρόλων, που συχνά συνδέεται με υψηλή πίεση και άμεση επαφή με πελάτες, φαίνεται να ενισχύει την τάση φυγής.
Τμήματα Σταθερότητας: Το Management και το RandD εμφανίζουν τη μεγαλύτερη συγκράτηση προσωπικού, γεγονός που υποδηλώνει υψηλότερη ικανοποίηση ή ισχυρότερα κίνητρα παραμονής.
Συμπέρασμα: Η μεταβλητή Department λειτουργεί ως δείκτης του εργασιακού περιβάλλοντος. Η διαφοροποίηση των ποσοστών επιβεβαιώνει ότι ο κίνδυνος αποχώρησης επηρεάζεται σημαντικά από το τμήμα στο οποίο ανήκει ο υπάλληλος, καθιστώντας την απαραίτητη για το μοντέλο μας.
Στο Case Study μας, θα κάνουμε Classification με τον αλγόριθμο CART.
Σε πρώτη φάση, θα διασπάσουμε το dataset σε δύο μέρη, το Training Set
(για την εξαγωγή των κανόνων κατηγοριοποίησης με βάση τον CART) και το
Testing Set (για την διενέργεια των δοκιμών που ελέγχουν την αξιοπιστία
των κανόνων που ορίστηκαν). Η αναλογία training-testing θα είναι 70%-30%
προς το συνολικό dataset αντιστοίχως. Ακολουθεί ο κώδικας
διάσπασης:
library(caTools)
set.seed(914)
sampleSplit <- sample.split(hr_data$left, SplitRatio = 0.7)
train <- subset(hr_data, sampleSplit==TRUE)
test <- subset(hr_data, sampleSplit==FALSE)
split_summary <- data.frame(
Dataset = c("Training Set", "Test Set", "Total"),
Records = c(nrow(train), nrow(test), nrow(hr_data)),
Percentage = c("70%", "30%", "100%")
)
knitr::kable(split_summary,
caption = "Σύνοψη Διαχωρισμού Δεδομένων (Train/Test Split)",
align = "clc")| Dataset | Records | Percentage |
|---|---|---|
| Training Set | 10500 | 70% |
| Test Set | 4499 | 30% |
| Total | 14999 | 100% |
Στη συνέχεια θα προβούμε στην δημιουργία του CART μοντέλου μας, το οποίο θα αξιολογήσουμε και έπειτα θα συγκρίνουμε την ερμηνευσιμότητα και προβλεπτική ικανότητά του με αυτή της μεθόδου της λογιστικής παλινδρόμησης (Logistic Regression). Τέλος, θα καταλήξουμε σε κάποια συμπεράσματα και επισημάνσεις σχετικά με τις δύο μεθόδους, βάσει των πορισμάτων της παρούσας μελέτης περίπτωσης.
Ακολουθεί η διαδικασία της κατηγοριοποίησης με CART. Ως ελάχιστο
αριθμό παρατηρήσεων για ένα φύλλο (minbucket), ορίζουμε τις
105 παρατηρήσεις, που αντιστοιχούν στο 1% του Train Set. Στο μοντέλο
συμπεριλαμβάνουμε όλες τις στήλες του Dataset:
library(rpart)
library(rpart.plot)
hrTree <- rpart(left ~ satisfaction_level + last_evaluation + number_project + average_montly_hours + time_spend_company + Work_accident + promotion_last_5years + Department + salary, data = train, method="class", minbucket=105)
summary(hrTree)## Call:
## rpart(formula = left ~ satisfaction_level + last_evaluation +
## number_project + average_montly_hours + time_spend_company +
## Work_accident + promotion_last_5years + Department + salary,
## data = train, method = "class", minbucket = 105)
## n= 10500
##
## CP nsplit rel error xerror xstd
## 1 0.2368 0 1.0000 1.0000 0.017457431
## 2 0.1922 1 0.7632 0.7632 0.015805261
## 3 0.0740 3 0.3788 0.3788 0.011741139
## 4 0.0524 5 0.2308 0.2316 0.009355831
## 5 0.0148 6 0.1784 0.1804 0.008310268
## 6 0.0100 7 0.1636 0.1656 0.007976732
##
## Variable importance
## satisfaction_level average_montly_hours number_project
## 36 19 18
## last_evaluation time_spend_company
## 15 13
##
## Node number 1: 10500 observations, complexity param=0.2368
## predicted class=0 expected loss=0.2380952 P(node) =1
## class counts: 8000 2500
## probabilities: 0.762 0.238
## left son=2 (7520 obs) right son=3 (2980 obs)
## Primary splits:
## satisfaction_level < 0.465 to the right, improve=1085.9110, (0 missing)
## number_project < 2.5 to the right, improve= 672.0422, (0 missing)
## average_montly_hours < 275.5 to the left, improve= 294.6772, (0 missing)
## time_spend_company < 2.5 to the left, improve= 282.2040, (0 missing)
## last_evaluation < 0.575 to the right, improve= 152.7291, (0 missing)
## Surrogate splits:
## number_project < 2.5 to the right, agree=0.786, adj=0.246, (0 split)
## average_montly_hours < 275.5 to the left, agree=0.748, adj=0.113, (0 split)
## last_evaluation < 0.485 to the right, agree=0.734, adj=0.062, (0 split)
##
## Node number 2: 7520 observations, complexity param=0.074
## predicted class=0 expected loss=0.09494681 P(node) =0.7161905
## class counts: 6806 714
## probabilities: 0.905 0.095
## left son=4 (6136 obs) right son=5 (1384 obs)
## Primary splits:
## time_spend_company < 4.5 to the left, improve=447.36330, (0 missing)
## last_evaluation < 0.825 to the left, improve=148.88380, (0 missing)
## average_montly_hours < 216.5 to the left, improve=120.42820, (0 missing)
## number_project < 4.5 to the left, improve= 69.88079, (0 missing)
## satisfaction_level < 0.715 to the left, improve= 61.35930, (0 missing)
## Surrogate splits:
## last_evaluation < 0.995 to the left, agree=0.822, adj=0.034, (0 split)
## average_montly_hours < 298 to the left, agree=0.816, adj=0.002, (0 split)
##
## Node number 3: 2980 observations, complexity param=0.1922
## predicted class=1 expected loss=0.4006711 P(node) =0.2838095
## class counts: 1194 1786
## probabilities: 0.401 0.599
## left son=6 (1776 obs) right son=7 (1204 obs)
## Primary splits:
## number_project < 2.5 to the right, improve=322.9806, (0 missing)
## satisfaction_level < 0.115 to the right, improve=259.0916, (0 missing)
## time_spend_company < 4.5 to the right, improve=249.6250, (0 missing)
## last_evaluation < 0.575 to the right, improve=119.0833, (0 missing)
## average_montly_hours < 125.5 to the left, improve=112.6738, (0 missing)
## Surrogate splits:
## satisfaction_level < 0.355 to the left, agree=0.884, adj=0.713, (0 split)
## average_montly_hours < 161.5 to the right, agree=0.854, adj=0.639, (0 split)
## last_evaluation < 0.575 to the right, agree=0.852, adj=0.635, (0 split)
## time_spend_company < 3.5 to the right, agree=0.838, adj=0.599, (0 split)
##
## Node number 4: 6136 observations
## predicted class=0 expected loss=0.01303781 P(node) =0.584381
## class counts: 6056 80
## probabilities: 0.987 0.013
##
## Node number 5: 1384 observations, complexity param=0.074
## predicted class=0 expected loss=0.4580925 P(node) =0.1318095
## class counts: 750 634
## probabilities: 0.542 0.458
## left son=10 (536 obs) right son=11 (848 obs)
## Primary splits:
## last_evaluation < 0.815 to the left, improve=296.1902, (0 missing)
## average_montly_hours < 215.5 to the left, improve=264.4048, (0 missing)
## time_spend_company < 6.5 to the right, improve=183.3136, (0 missing)
## satisfaction_level < 0.715 to the left, improve=170.8179, (0 missing)
## number_project < 3.5 to the left, improve=149.9827, (0 missing)
## Surrogate splits:
## average_montly_hours < 215.5 to the left, agree=0.752, adj=0.360, (0 split)
## number_project < 3.5 to the left, agree=0.710, adj=0.250, (0 split)
## satisfaction_level < 0.715 to the left, agree=0.704, adj=0.237, (0 split)
## time_spend_company < 6.5 to the right, agree=0.688, adj=0.194, (0 split)
## Work_accident < 0.5 to the right, agree=0.646, adj=0.086, (0 split)
##
## Node number 6: 1776 observations, complexity param=0.1922
## predicted class=0 expected loss=0.4076577 P(node) =0.1691429
## class counts: 1052 724
## probabilities: 0.592 0.408
## left son=12 (1143 obs) right son=13 (633 obs)
## Primary splits:
## satisfaction_level < 0.115 to the right, improve=690.2017, (0 missing)
## average_montly_hours < 243.5 to the left, improve=409.6444, (0 missing)
## number_project < 5.5 to the left, improve=369.4643, (0 missing)
## last_evaluation < 0.765 to the left, improve=285.4108, (0 missing)
## time_spend_company < 3.5 to the left, improve=112.9987, (0 missing)
## Surrogate splits:
## average_montly_hours < 243.5 to the left, agree=0.867, adj=0.626, (0 split)
## number_project < 5.5 to the left, agree=0.836, adj=0.540, (0 split)
## last_evaluation < 0.765 to the left, agree=0.779, adj=0.379, (0 split)
##
## Node number 7: 1204 observations, complexity param=0.0148
## predicted class=1 expected loss=0.1179402 P(node) =0.1146667
## class counts: 142 1062
## probabilities: 0.118 0.882
## left son=14 (123 obs) right son=15 (1081 obs)
## Primary splits:
## average_montly_hours < 159.5 to the right, improve=77.681960, (0 missing)
## last_evaluation < 0.565 to the right, improve=59.378770, (0 missing)
## satisfaction_level < 0.365 to the left, improve=52.569000, (0 missing)
## Department splits as RRRLRLLRRR, improve= 2.738013, (0 missing)
## salary splits as LRL, improve= 1.484086, (0 missing)
## Surrogate splits:
## last_evaluation < 0.575 to the right, agree=0.921, adj=0.228, (0 split)
## satisfaction_level < 0.345 to the left, agree=0.917, adj=0.187, (0 split)
## time_spend_company < 3.5 to the right, agree=0.909, adj=0.106, (0 split)
##
## Node number 10: 536 observations
## predicted class=0 expected loss=0.04664179 P(node) =0.05104762
## class counts: 511 25
## probabilities: 0.953 0.047
##
## Node number 11: 848 observations, complexity param=0.0524
## predicted class=1 expected loss=0.2818396 P(node) =0.0807619
## class counts: 239 609
## probabilities: 0.282 0.718
## left son=22 (157 obs) right son=23 (691 obs)
## Primary splits:
## average_montly_hours < 216.5 to the left, improve=155.55510, (0 missing)
## time_spend_company < 6.5 to the right, improve=135.85560, (0 missing)
## satisfaction_level < 0.715 to the left, improve=121.43320, (0 missing)
## number_project < 3.5 to the left, improve= 88.66880, (0 missing)
## salary splits as LRL, improve= 26.05427, (0 missing)
## Surrogate splits:
## time_spend_company < 6.5 to the right, agree=0.853, adj=0.204, (0 split)
## satisfaction_level < 0.715 to the left, agree=0.847, adj=0.172, (0 split)
## number_project < 3.5 to the left, agree=0.831, adj=0.089, (0 split)
##
## Node number 12: 1143 observations
## predicted class=0 expected loss=0.07961505 P(node) =0.1088571
## class counts: 1052 91
## probabilities: 0.920 0.080
##
## Node number 13: 633 observations
## predicted class=1 expected loss=0 P(node) =0.06028571
## class counts: 0 633
## probabilities: 0.000 1.000
##
## Node number 14: 123 observations
## predicted class=0 expected loss=0.3495935 P(node) =0.01171429
## class counts: 80 43
## probabilities: 0.650 0.350
##
## Node number 15: 1081 observations
## predicted class=1 expected loss=0.0573543 P(node) =0.1029524
## class counts: 62 1019
## probabilities: 0.057 0.943
##
## Node number 22: 157 observations
## predicted class=0 expected loss=0.08280255 P(node) =0.01495238
## class counts: 144 13
## probabilities: 0.917 0.083
##
## Node number 23: 691 observations
## predicted class=1 expected loss=0.1374819 P(node) =0.06580952
## class counts: 95 596
## probabilities: 0.137 0.863
Μέσα από την summary παρατηρούμε τα εξής:
rel error (0.1636): Το σφάλμα πάνω στα δεδομένα εκπαίδευσης.
xerror (0.1656): Το σφάλμα μέσω cross-validation (πρόβλεψη σε “άγνωστα” δεδομένα).
Το γεγονός ότι οι δύο τιμές είναι σχεδόν ίδιες σημαίνει ότι το
μοντέλο δεν κάνει overfitting. Έχει μάθει τα πραγματικά μοτίβα και όχι
τον “θόρυβο” των δεδομένων. Το minbucket = 105 διασφάλισε
ότι κανένα συμπέρασμα δεν βγήκε από πολύ μικρή ομάδα ανθρώπων, εφόσον το
μικρότερο φύλλο (Node 14) έχει 123 παρατηρήσεις.
Δοκιμάζοντας να προβλέψουμε την αποχώρηση των εργαζομένων στο Test Set με βάση τους κανόνες το Decision Tree που δημιουργήσαμε με το CART model μας, βλέπουμε τα εξής αποτελέσματα:
library(knitr)
library(kableExtra)
PredictCART <- predict (hrTree, newdata=test, type='class')
conf_matrix <- table(Actual = test$left, Predicted = PredictCART)
conf_matrix_df <- as.data.frame.matrix(conf_matrix)
rownames(conf_matrix_df) <- c("Πραγματικά Έμειναν (0)", "Πραγματικά Έφυγαν (1)")
colnames(conf_matrix_df) <- c("Πρόβλεψη: Έμειναν (0)", "Πρόβλεψη: Έφυγαν (1)")
knitr::kable(conf_matrix_df,
caption = "Confusion Matrix (Κατώφλι 0.5)",
align = "c")| Πρόβλεψη: Έμειναν (0) | Πρόβλεψη: Έφυγαν (1) | |
|---|---|---|
| Πραγματικά Έμειναν (0) | 3365 | 63 |
| Πραγματικά Έφυγαν (1) | 118 | 953 |
Για την ερμηνεία της απόδοσης του μοντέλου, έχει αρκετή σημασία να
δούμε και τα σκορ του σε βασικές μετρικές όπως φαίνεται παρακάτω:
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
sensitivity <- conf_matrix[2,2] / sum(conf_matrix[2,])
specificity <- conf_matrix[1,1] / sum(conf_matrix[1,])
baseline_accuracy <- max(table(test$left)) / nrow(test)
metrics_summary <- data.frame(
Μετρική = c("Accuracy (Ακρίβεια)", "Sensitivity (Ευαισθησία)",
"Specificity (Εξειδίκευση)", "Baseline Accuracy"),
Τιμή = c(accuracy, sensitivity, specificity, baseline_accuracy)
)
knitr::kable(metrics_summary, digits = 4,
caption = "Αξιολόγηση Επιδόσεων Μοντέλου",
align = "lc")| Μετρική | Τιμή |
|---|---|
| Accuracy (Ακρίβεια) | 0.9598 |
| Sensitivity (Ευαισθησία) | 0.8898 |
| Specificity (Εξειδίκευση) | 0.9816 |
| Baseline Accuracy | 0.7619 |
Το μοντέλο CART παρουσιάζει εξαιρετική ακρίβεια 96% !!!, υπερέχοντας κατά 20% του baseline. Η υψηλή εξειδίκευση (98%) και η ευαισθησία (89%) διασφαλίζουν τον ακριβή εντοπισμό των υπαλλήλων που παραμένουν ή αποχωρούν αντίστοιχα. Αυτή η ισορροπία, σε συνδυασμό με την ερμηνευσιμότητα του δέντρου, το καθιστά ένα πάρα πολύ αξιόπιστο και στιβαρό εργαλείο για τη πρόβλεψη του churn rate που διερευνούμε.
Για μία καλύτερη οπτική αναπαράσταση της επίδοσης του μοντέλου μας,
παράγουμε το διάγραμμα της ROC Curve και δίνουμε έμφαση στη μετρική AUC
που μας υποδεικνύει τη συνολική ικανότητα διάκρισης του μοντέλου ανάμεσα
στις δύο κλάσεις (left-stayed):
library(ROCR)
pred <- predict(hrTree, newdata = test)
ROCRpred <- prediction(pred[,2], test$left)
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
plot(ROCRperf, colorize = TRUE,
print.cutoffs.at = seq(0, 1, by = 0.1),
text.adj = c(-0.2, 1.7),
main = "ROC Curve for Employee Churn")
abline(a = 0, b = 1, lty = 2) auc_val <- performance(ROCRpred, measure = "auc")
auc_value <- auc_val@y.values[[1]]
# Δημιουργία πίνακα για την AUC
auc_display <- data.frame(
Δείκτης = "AUC (Area Under the Curve)",
Τιμή = round(auc_value, 4),
Ερμηνεία = ifelse(auc_value > 0.8, "Πολύ Καλή Προβλεπτική Ικανότητα", "Ικανοποιητική Προβλεπτική Ικανότητα")
)
# Εμφάνιση όμορφου πίνακα
knitr::kable(auc_display, align = "clc", caption = "Συνολική Αξιολόγηση Μοντέλου")| Δείκτης | Τιμή | Ερμηνεία |
|---|---|---|
| AUC (Area Under the Curve) | 0.9617 | Πολύ Καλή Προβλεπτική Ικανότητα |
Η καμπύλη ROC και η εξαιρετικά υψηλή τιμή AUC (0,96) υποδεικνύουν ένα μοντέλο με κορυφαία ικανότητα διάκρισης μεταξύ των δύο ενδεχομένων (παραμονή-αποχώρηση). Η θέση της καμπύλης στην πάνω αριστερή γωνία επιβεβαιώνει ότι το μοντέλο επιτυγχάνει ταυτόχρονα υψηλή ευαισθησία και χαμηλό ποσοστό false positives. Με την τιμή AUC να πλησιάζει τη μονάδα, τεκμηριώνεται η στατιστική στιβαρότητα και η αξιοπιστία του αλγορίθμου CART στον εντοπισμό των υπαλλήλων που σκοπεύουν να αποχωρήσουν, καθιστώντας τον ιδανικό για την επιχειρηματική λήψη αποφάσεων, με βάση το παρόν Dataset.
Σε αυτό το σημείο, έχει μεγάλη ερευνητική αξία να εξετάσουμε την απόδοση του μοντέλου κατηγοριοποίησης που δημιουργήσαμε σε αντιδιαστολή με αυτή ενός μοντέλου λογιστικής παλινδρόμησης. Θα ακολουθηθεί η ίδια μεθοδολογία όπως και νωρίτερα πάνω στο ίδιο Train και Test set.
movement_model<- glm(left~satisfaction_level + last_evaluation + number_project + average_montly_hours + time_spend_company + Work_accident + promotion_last_5years + Department + salary,data=train,family = "binomial")
summary(movement_model)##
## Call:
## glm(formula = left ~ satisfaction_level + last_evaluation + number_project +
## average_montly_hours + time_spend_company + Work_accident +
## promotion_last_5years + Department + salary, family = "binomial",
## data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.4720413 0.2371782 -6.206 5.42e-10 ***
## satisfaction_level -4.1373598 0.1170808 -35.338 < 2e-16 ***
## last_evaluation 0.5324378 0.1776842 2.997 0.00273 **
## number_project -0.3120013 0.0254377 -12.265 < 2e-16 ***
## average_montly_hours 0.0052148 0.0006167 8.456 < 2e-16 ***
## time_spend_company 0.2586059 0.0185825 13.917 < 2e-16 ***
## Work_accident -1.4912004 0.1059474 -14.075 < 2e-16 ***
## promotion_last_5years -1.2348274 0.2919361 -4.230 2.34e-05 ***
## Departmenthr 0.1436925 0.1568833 0.916 0.35971
## DepartmentIT -0.3780693 0.1475263 -2.563 0.01039 *
## Departmentmanagement -0.6173000 0.1954582 -3.158 0.00159 **
## Departmentmarketing -0.0903141 0.1563771 -0.578 0.56357
## Departmentproduct_mng -0.2375523 0.1567930 -1.515 0.12975
## DepartmentRandD -0.7406996 0.1723540 -4.298 1.73e-05 ***
## Departmentsales -0.1527497 0.1224100 -1.248 0.21209
## Departmentsupport -0.0085947 0.1303623 -0.066 0.94743
## Departmenttechnical -0.0110513 0.1274625 -0.087 0.93091
## salarylow 2.0447910 0.1606336 12.730 < 2e-16 ***
## salarymedium 1.4820962 0.1614791 9.178 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 11526.4 on 10499 degrees of freedom
## Residual deviance: 8961.3 on 10481 degrees of freedom
## AIC: 8999.3
##
## Number of Fisher Scoring iterations: 5
Ακολουθεί αντίστοιχο Confusion Matrix με προηγουμένως:
predictClass <- ifelse(predictTest > 0.5, 1, 0)
# 2. Δημιουργία και εμφάνιση Confusion Matrix σε πίνακα
conf_matrix <- table(Actual = test$left, Predicted = predictClass)
conf_matrix_df <- as.data.frame.matrix(conf_matrix)
# Ονοματοδοσία για σαφήνεια
rownames(conf_matrix_df) <- c("Πραγματικά Έμειναν (0)", "Πραγματικά Έφυγαν (1)")
colnames(conf_matrix_df) <- c("Πρόβλεψη: Έμειναν (0)", "Πρόβλεψη: Έφυγαν (1)")
knitr::kable(conf_matrix_df,
caption = "Confusion Matrix (Κατώφλι 0.5)",
align = "c")| Πρόβλεψη: Έμειναν (0) | Πρόβλεψη: Έφυγαν (1) | |
|---|---|---|
| Πραγματικά Έμειναν (0) | 3198 | 230 |
| Πραγματικά Έφυγαν (1) | 715 | 356 |
Οι τιμές των μετρικών για το νέο μοντέλο Λογιστικής Παλινδρόμησης
έχουν ως εξής:
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
sensitivity <- conf_matrix[2,2] / sum(conf_matrix[2,])
specificity <- conf_matrix[1,1] / sum(conf_matrix[1,])
baseline_accuracy <- max(table(test$left)) / nrow(test)
metrics_summary <- data.frame(
Μετρική = c("Accuracy (Ακρίβεια)", "Sensitivity (Ευαισθησία)",
"Specificity (Εξειδίκευση)", "Baseline Accuracy"),
Τιμή = c(accuracy, sensitivity, specificity, baseline_accuracy)
)
knitr::kable(metrics_summary, digits = 4,
caption = "Αξιολόγηση Επιδόσεων Μοντέλου",
align = "lc")| Μετρική | Τιμή |
|---|---|
| Accuracy (Ακρίβεια) | 0.7900 |
| Sensitivity (Ευαισθησία) | 0.3324 |
| Specificity (Εξειδίκευση) | 0.9329 |
| Baseline Accuracy | 0.7619 |
Τέλος, παράγουμε το διάγραμμα της καμπύλης ROC για το μοντέλο και εξετάζουμε την AUC τιμή που του αντιστοιχεί.
library(ROCR)
ROCRpredLR <- prediction(predictTest, test$left)
ROCRperfLR <- performance(ROCRpredLR, "tpr", "fpr")
plot(ROCRperfLR, colorize = TRUE,
print.cutoffs.at = seq(0, 1, by = 0.1),
text.adj = c(-0.2, 1.7),
main = "ROC Curve for Employee Churn")
abline(a = 0, b = 1, lty = 2) auc_valLR <- performance(ROCRpredLR, measure = "auc")
auc_valueLR <- auc_valLR@y.values[[1]]
# Δημιουργία πίνακα για την AUC
auc_displayLR <- data.frame(
Δείκτης = "AUC (Area Under the Curve)",
Τιμή = round(auc_valueLR, 4),
Ερμηνεία = ifelse(auc_valueLR > 0.8, "Πολύ Καλή Προβλεπτική Ικανότητα", "Ικανοποιητική Προβλεπτική Ικανότητα")
)
# Εμφάνιση όμορφου πίνακα
knitr::kable(auc_displayLR, align = "clc", caption = "Συνολική Αξιολόγηση Μοντέλου")| Δείκτης | Τιμή | Ερμηνεία |
|---|---|---|
| AUC (Area Under the Curve) | 0.8142 | Πολύ Καλή Προβλεπτική Ικανότητα |
Η σύγκριση ανάμεσα στα δύο μοντέλα μας οδηγεί σε αρκετά ξεκάθαρα συμπεράσματα και μας λέει με ρητό τρόπο ποια από τις δύο μεθόδους υπερτερεί.
Με την τιμή AUC που είναι θεμελιώδης μετρική για την αξιολόγηση των προβλεπτικών μοντέλων, το 0.96 του Decision Tree έναντι του 0.81 του μοντέλου Λογιστικής Παλινδρόμησης, δείχνει ότι το πρώτο είναι αρκετά ικανότερο.
Επιπλέον, για επιχειρηματικούς λόγους, μας ενδιαφέρει να έχουμε ένα μοντέλο με υψηλό sensitivity, καθώς σε μία εταιρεία πιθανότατα κοστίζει περισσότερο να μην προβλέψει ότι κάποιος εργαζόμενος θα φύγει παρά να ποβλέψει λάθος ότι κάποιοςθα φύγει ενώ τελικά θα παραμείνει. Ακόμα και σε αυτό το κριτήριο, το Δέντρο Απόφασης είναι συντριπτικά ικανότερο, εφόσον παρουσιάζει Sensitivity 0.88 έναντι του 0.33 της λογιστικής παλινδρόμησης
Επιπλέον, αξίζει να λάβουμε υπόψιν ότι τα δέντρα απόφασης έχουν σαφώς μεγαλύτερη ερμηνευσιμότητα από τα μοντέλα λογιστικής παλινδρόμησης, καθώς μπορεί κανείς να δει με σαφήνεια τους παράγοντες που συντελούν σε ένα ενδεχόμενο, ενώ με τη λογιστική παλινδρόμηση λαμβάνει απλώς μια τιμή που αντιπροσωπεύει πιθανότητα για κάποιο ενδεχόμενο.
Εντούτοις, το συμπέρασμα αυτό αφορά καθαρά το παρόν dataset, καθώς και σύνολα δεδομένων με παρόμοια σύνθεση. Τα Decision Trees είναι αποτελεσματικά σε προβλέψεις για μη γραμμικές σχέσεις μεταβλητών, όπου για ένα ενδεχόμενο συνεπικουρούν πολλοί παράγοντες. Σε datasets όπως αυτά, τα μοντέλα Λογιστικής Παλινδρόμησης είναι πιο αδύνατα, καθώς η επίδοση τους είναι μεγαλύτερη όταν έχουμε γραμμικές, αναλογικές σχέσεις στις μεταβλητές.