Εισαγωγή
Σε αυτό το άρθρο θα κατασκευάσω ένα μοντέλο μηχανικής μάθησης για να προβλέψω ποιοι από τους πελάτες μίας τράπεζας ενδιαφέρονται να ανοίξουν έναν λογαριασμό προθεσμικής κατάθεσης. Για το σκοπό αυτό θα χρησιμοποιήσουμε μοντέλα Boosting (XGBoost και LightGBM) για να ταξινομήσουμε τις περιπτώσεις πιθανές αποκρίσεις σε ενδιαφερόμενους και μη ενδιαφερόμενους. Τα δεδομένα προέρχονται από την ιστοσελίδα «UCI Machine Learning Repository» (Dua & Graff, 2017) και χρησιμοποίησα τη βάση δεδομένων που τιτλοφορείται ως Bank Marketing (Moro, Cortez, & Rita, 2014).
Πριν ξεκινήσουμε την ανάλυσή μας, ας κάνουμε μία νύξη σε κάποιους βασικούς όρους.
Τι είναι η προθεσμιακή κατάθεση;
Όταν θέλουμε να καταθέσουμε χρήματα στη τράπεζα συνήθως οι περισσότεροι έχουν έναν απλό λογαριασμό ταμιευτηρίου ή αποταμίευσης. Ένα διαφορετικό είδος λογαριασμού είναι ο προθεσμιακός, όπου σε αυτή τη περίπτωση δεσμεύεται ο πελάτης της τράπεζας ότι δεν θα κάνει ανάληψη στον λογαριασμό για ένα προκαθορισμένο χρονικό διάστημα (π.χ. για ένα έτος δεν θα κάνει ανάληψη).
Και για ποιο λόγο να επιλέξουμε έναν τέτοιο λογαριασμό;
Είναι προφανές ότι οι προθεσμιακές καταθέσεις έχουν ένα βασικό μειονέκτημα έναντι των τυπικών λογαριασμών σε όρους πρόσβασης στα κεφάλαιά μας. Φυσικά, κανένας δεν θα έκανε κάποια τέτοια κίνηση αν δεν έχει κάποιο αντάλλαγμα. Έτσι λοιπόν οι τράπεζες συνήθως σε αυτά τα προγράμματα προσφέρουν υψηλότερα επιτόκια σε σχέση με αυτά των λογαριασμών ταμιευτηρίου / αποταμίευσης. Αξίζει να δώσουμε μερικά παραδείγματα τραπεζών, συγκρίνοντας τα τραπεζικά επιτόκια των τυπικών και προθεσμιακών λογιαριασμών.
Η Πειραιώς, μία εκ των συστημικών τραπεζών της χώρας μας, προσφέρει διπλάσιο επιτόκιο στους προθεσμιακούς λογαριασμούς της.
Η Eurobank, προσφέρει μηδενικό επιτόκιο σε λογαριασμούς ταμιευτηρίου, 0.01% μέχρι και 0.35% σε λογαριασμού αποταμίευσης και στις προθεσμιακές ποικίλει αναλόγως του προγράμματος και του ύψους της κατάθεσης από 0.1% μέχρι και 1%.
Γενικότερα, σύμφωνα με την πρόσφατη έκθεση της Τράπεζας της Ελλάδας, τα επιτόκια των προθεσμιακών κυμαίνονται από 1.2% με 1.4%, ενώ οι τυπικοί λογαριασμοί για τα νοικοκυριά είναι στο 0.03%.
Με βάση τα παραπάνω μπορούμε να υποθέσουμε ότι δεν θα είναι όλοι κατάλληλοι για αυτά τα προϊόντα. Με βάση τη λογική, το κατάλληλο προφίλ των ατ κατάλληλο προφίλ των ατόμων που να βρεθούν άτομα με σημαντικό ύψος καταθέσεων και να μην έχουν άλλα σημαντικά βάρη, όπως δάνεια ή χρέη σε τρίτους.
Προαπαιτούμενα
Εισαγωγή βιβλιοθηκών
Για αυτή την ανάλυση θα χρειαστούμε τυπικές βιβλιοθήκες της R για την εισαγωγή των δεδομένων, μέσω του readr πακέτου (Wickham, Hester, & Bryan, 2025), και τη μορφοποίηση αυτών με το dplyr πακέτο (Wickham, François, Henry, Müller, & Vaughan, 2023). Το kableExtra πακέτο (Zhu, 2024) αποτελεί σημαντική προσθήκη ώστε να τυπώσω τα αποτελέσματά μου σε μία μορφή πίνακα. Ένα σημαντικό κομμάτι που θα πρέπει να αποφασίσω πώς να λύσω είναι αυτό της οπτικοποίησης των δεδομένων. Αρχικά χρησιμοποιούσα το πακέτο ggplot2 προκειμένου να δημιουργήσω τα όποια διαγράμματα, πράγμα που είναι αρκετά περιοριστικό για μία ιστοσελίδα καθώς το ggplot2 δημιουργεί στατικά διαγράμματα. Έτσι λοιπόν για τα άρθρα μου χρησιμοποιώ το πακέτο highcharter (Kunst, 2022) όπου είναι ένα R πακέτο που δίνει τη δυνατότητα διαγραμμάτων φιλικό για όλους τους τύπους των οθονών. Τέλος, αυτή η ανάλυση έχει ως στόχο να ταξινομήσει τους πελάτες της τράπεζας, επομένως θα κατασκευάσω ένα μοντέλο ταξινόμησης, και η χρήση του πακέτου tidymodels (Kuhn & Wickham, 2025) κρίνεται απαραίτητη.
Εισαγωγή δεδομένων
Αφού φορτώσουμε τις αναγκαίες βιβλιοθήκες, θα φορτώσουμε τα δεδομένα μας. Η βάση των δεδομένων μου έχει αρκετές εκδόσεις των ίδιων δεδομένων, μία μεγαλύτερη και μία πιο συνοπτική έκδοση, η διαφορά τους έγκειται μόνο στον αριθμό των παρατηρήσεων. Για το συγκεκριμένο άρθρο θα επιλέξω τη πιο συνοπτική μορφή μιας και η προσαρμογή Boosting μοντέλων είναι αρκετά χρονοβόρα σε σύγκριση με τη κατασκευή πιο απλώς μοντέλων ταξινόμησης (π.χ. Λογιστική Παλινδρόμηση, k Πλησιέστερων Γειτόνων).
Δείξε τον κώδικα
bank_dataset <- read_delim("bank_dataset_files/bank.csv",
delim = ";",
escape_double = FALSE,
trim_ws = TRUE)
bank_dataset = bank_dataset %>% tibble::rowid_to_column("ID")Προεπισκόπηση δεδομένων
Here we can see a small chunk of my dataset (first 10 rows / observations) just to understand the dataset’s structure and type of variables.
Δείξε τον κώδικα
preview_bank_dataset = head(bank_dataset, 6)
reactable(
preview_bank_dataset,
bordered = FALSE, # No borders (booktabs style)
striped = FALSE, # No stripes for a clean look
highlight = FALSE, # No hover highlighting
defaultColDef = colDef(align = "center"),
style = list(fontSize = "14px", border = "none"),
theme = reactableTheme(
borderColor = "transparent", # Remove border
cellStyle = list(
borderBottom = "transparent" # Subtle line between rows
),
headerStyle = list(
borderBottom = "2px solid rgb(117, 117, 117)", # Thick top rule
borderTop = "2px solid rgb(117, 117, 117)",
fontWeight = "bold"
)
)
)Προτού κάνουμε οποιαδήποτε ανάλυση είναι καλό να προσδιορίσουμε το τύπο των δεδομένων που έχουμε διαθέσιμα. Ως επί το πλεείστον αυτό μπορούμε να το μάθουμε κοιτώντας τις τιμές που λαμβάνει μία μεταβλητή. Γενικότερα, οι μεταβλητές μπορούν να ταξινομηθούν με βάση τις τιμές που λαμβάνουν ως εξής:
graph TD; A(Τύπος μεταβλητών) --> B(Ποσοτική) A(Τύπος μεταβλητών) --> C(Ποιοτική) B --> D(Διακριτή) B --> E(Συνεχής) C --> J(Κατηγορική) C --> G(Διατάξιμη)
| Μεταβλητή | Τύπος μεταβλητής | Περιγραφή |
|---|---|---|
Age |
ποσοτική (συνεχής) |
Ηλικία ατόμου |
Job |
ποιοτική (κατηγορική) |
Κλάδος απασχόλησης ατόμου |
Marital |
ποιοτική (κατηγορική) |
Οικογενειακή κατάσ |
Education |
ποιοτική (διατάξιμη) |
Υψηλότερη βαθμίδα εκπαίδευσης |
Default |
ποιοτική (κατηγορική) |
has credit in default? |
Balance |
ποσοτική (συνεχής) |
Average yearly balance, in euros |
Housing |
ποιοτική (κατηγορική) |
Έχει στεγαστικό δάνειο; |
Loan |
ποιοτική (κατηγορική) |
Έχει προσωπικό δάνειο; |
Contact |
ποιοτική (κατηγορική) |
Μέσο επικοινωνίας |
Month |
ποιοτική (διατάξιμη) |
Μήνας πιο πρόσφατης προσέγγισης |
Duration |
ποσοτική (continuous) |
Διάρκεια (σε δευτερόλεπτα) τελευταίας επικοινωνίας |
Campaign |
quantitative | Αριθμός προσεγγίσεων σε ένα άτομο |
pdays |
quantitative | Αριθμός ημερών που μεσολάβησαν από τελευταία ενημέρωση |
pprevious |
quantitative | Αριθμός προσεγγίσεων του πελάτη |
poutcome |
qualitative (nominal) | Αποτέλεσμα πορηγούμενης προωθητικής καμπάνιας |
Deposit |
qualitative (nominal) |
Has the client subscribed a term deposit? |
Το δείγμα μου αποτελείται από 18 μεταβλητές (στήλες), εκ των οποίων οι 7 είναι ποσοτικές και οι υπόλοιπες 10 ποιοτικές. Όσον αφορά τις ποιοτικές μεταβλητές, 8 από αυτές είναι κατηγορικές και μόλις δύο είναι διατάξιμες (Μήνας προώθησης και Επίπεδο εκπαίδευσης).
Ορισμός συναρτήσεων
Οκ, είδαμε κάποια βασικά στοιχεία των δεδομένων μου και τη δομή αυτών. Μπορώ τώρα να ξεκινήσω την ανάλυσή μου;
Εξαρτάται. Σε περίπτωση που θέλεις να πάρεις μία γρήγορη ανάλυση προκειμένου να λάβεις ένα συκγκεκριμένο αποτέλεσμα πιθανότατα να είναι εντάξει. Βέβαια, τις περισσότερες φορές απαιτείται προσεκτικότερος σχεδιασμός της μελέτης. Ένας αρκετά συχνό λάθος στο οποίο έχω υποπέσει και εγώ στο παρελθόν είναι ο κίνδυνος της επαναληψιμότητας ορισμένων διαδικασιών. Προκειμένου να αποτρέψουμε να γράφουμε τα ίδια πράγματα πολλές φορές κρίνεται απαραίτητη η συγγραφή ορισμένων συναρτήσεων. Για παράδειγμα στη συγκεκριμένη άσκηση παρατηρώ ότι έχω αρκετές μεταβλητές του ίδιου τύπου, τόσο ποιοτικές όσο και ποσοτικές. Για ποιο λόγο λοιπόν να γράψω 10 φορές παρόμοιο κώδικα όταν μπορώ να εσωκλείσω τα βασικά χαρακτηριστικά σε μία συνάρτηση.
Έτσι λοιπόν έχω ορίσει δύο μεταβλητές. Αρχικά την univariateQualitativePlot η οποία χρησιμοποιείται για τη κατασκευή κυκλικών διαγραμμάτων για τις ποιοτικές μεταβλητές μου.
Δείξε τον κώδικα
gt_custom <- function(data, head_max = 5, use_labels = TRUE) {
data_subset <- as.data.frame(data) %>% head(head_max)
gt_tbl <- data_subset %>%
gt::gt(groupname_col = "model") %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = cell_text(
v_align = "middle",
weight = "bold",
whitespace = "normal"
),
locations = cells_column_labels()
) %>%
tab_options(
row.striping.include_table_body = FALSE,
table.background.color = "transparent",
column_labels.background.color = "transparent",
table.width = pct(100),
table.font.size = px(13),
data_row.padding = px(15),
column_labels.padding = px(15),
table.border.top.style = "none",
table.border.bottom.style = "none",
table_body.hlines.style = "none",
column_labels.border.top.width = px(2),
column_labels.border.top.color = "#757575",
column_labels.border.bottom.width = px(2),
column_labels.border.bottom.color = "#757575",
table_body.border.bottom.width = px(2),
table_body.border.bottom.color = "#757575"
) %>%
opt_css(css = "
.gt_table th, .gt_table td {
text-align: center !important;
vertical-align: middle !important;
}
.gt_table {
margin-left: auto !important;
margin-right: auto !important;
width: 100% !important;
}
.gt_table tr { background-color: transparent !important; }
.gt_row { background-color: transparent !important; }
")
# Apply labels only if requested
if (use_labels) {
gt_tbl <- gt_tbl %>%
cols_label_with(
fn = function(x) {
html(paste0(
"<b>", greek_labels[x], "</b>",
"<br><span style='font-size:10px; color:#777; font-style:italic;'>",
x,
"</span>"
))
}
)
}
return(gt_tbl)
}Δείξε τον κώδικα
univariateQualitativePlot <- function(data, column, title, subtitle, chart_type = "bar") {
# Compute frequency table
freq_table <- data %>%
count({{ column }}, name = "Frequency") %>%
arrange(desc(Frequency)) %>%
rename(Variable = {{ column }}) %>%
mutate(pct = round((Frequency / sum(Frequency) *100), digits = 1))
# Define common chart properties
hc <- highchart() %>%
hc_title(text = title) %>%
hc_subtitle(text = subtitle) %>%
hc_tooltip(pointFormat = "{point.name}: {point.y}") %>%
hc_legend(enabled = chart_type == "pie") # Enable legend only for pie chart
# Choose chart type
hc <- if (chart_type == "bar") {
hc %>%
hc_chart(type = "bar") %>%
hc_xAxis(categories = freq_table$Variable, title = list(text = "Job Category")) %>%
hc_yAxis(title = list(text = "Frequency")) %>%
hc_series(list(name = "Frequency", data = freq_table$Frequency))
} else if (chart_type == "pie") {
pie_data <- lapply(1:nrow(freq_table), function(i) {
list(name = freq_table$Variable[i], y = freq_table$Frequency[i])
})
hc %>%
hc_chart(type = "pie") %>%
hc_series(list(name = "Frequency", data = pie_data))
} else {
stop("Invalid chart type. Use 'bar' or 'pie'.")
}
return(hc)
}Αντίστοιχα, θα ορίσω και τη συνάρτηση univariateQuantitativePlot για τη κατασκευή ραβδογραμμάτων για τις ποσοτικές μεταβλητές μου. Και οι δύο συναρτήσεις βασίζονται και κατασκευάσουν διαγράμματα χρησιμοποιώντας το πακέτο highcharter.
Περιγραφική Ανάλυση
Ελλειπούσες τιμές
Στα δοσμένα δεδομένα υπάρχουν συνολικά 0 ελλειπούσες τιμές. Αυτή βέβαια είναι μία σπάνια - ιδανική περίπτωση. Σε διαφορετική περίπτωση θα έπρεπε να γεμίσουμε τις κενές τιμές με κάποια μέθοδο εκτίμησης.
Μονομεταβλητή ανάλυση
Στη συνέχεια είναι σημαντικό να μελετήσουμε τις μεταβλητές μου, τις τιμές τους και τις κατανομές αυτών. Είναι ένα σημαντικό κομμάτι ώστε να κατανοήσω το δείγμα και να λάβω παραπάνω παραμέτρους υπόψιν μου στη κατασκευή του μοντέλου.
Όσον αφορά τον κλάδο της εργασίας, στο δείγμα παρατηρείται μία σημαντική συμμετοχή ατόμων με εργασίες που πιθανότατα συνδυάζονται με υψηλότερες σπουδές και συνεπακόλουθα υψηλότερες απολαβές, όπως τα διευθυντικά στελέχη, διοικητικοί υπάλληλοι, επιχειρηματίες κτλ. Περίπου το 40% των πελατών της τράπεζας απασχολούνται σε εργασίες μπλέ κολάρου οι οποίες τις περισσότερες φορές να συνδυάζονται με και να δημιουργήσει μη επιθυμία δέσμευσης σε ένα τραπεζικό προϊόν που θα δεσμεύει χρηματικό κεφάλαιο. Τέλος, στο πελατολόγιο της τράπεζας ένα ποσοστό περί το 10% που αποτελείται από ομάδες πληθυσμού που για διάφορους λόγους δεν τους συμφέρει να δημιουργήσουν ένα τέτοιο λογαριασμό, όπως οι άνεργοι, οι σπουδαστές μιας και βρίσκονται σε ευάλωτη περίοδο με αυξημένα έξοδα και περιορισμένες πηγές εισοδήματος καθώς και οι συνταξιούχοι μιας και θα χρειαστούν να καλύψουν έκτακτες ανάγκες σε παροχές υγείας. Ειδικά για τους τελευταίους που αποτελούν το 5% των πελατών της τράπεζας, υπάρχουν άλλα χρηματοδοτικά εργαλεία αν θέλουν να εξασφαλίσουν τα γηρατειά τους, όπως τα αντίστροφα στεγαστικά δάνεια.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, job,
title = "Τομέας απασχόλησης του ερωτώμενων",
subtitle = "Καθαρός αριθμός και ποσοστό (%) επί όλων των πελατών")Άλλο ένα διαθέσιμο στοιχείο είναι η οικογενειακή κατάσταση καθώς μπορεί να συνδέεται με αυξημένες ανάγκες και έξοδα για το νοικοκυριό. Ενδεχομένως, ένας πελάτης που είναι παντρεμένο να έχει αυξημένα έξοδα για το νοικοκυριό του (π.χ. λόγω παιδιών). Άλλη μία οπτική θα ήταν . Γενικά, δεν είναι ξεκάθαρη εκ των προτέρων η ερμηνεία του συγκεκριμένου δείκτη. Σε κάθε περίπτωση στο υπό εξέταση δείγμα έχουμε περί το 60% των ατόμων που είναι παντρεμένοι, το ένα τέταρτο των πελατών είναι ανύπαντροι και οι υπόλοιποι είναι διαζευγμένοι.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, marital,
title = "Ποια είναι η οικογενειακή σου κατάσταση;",
subtitle = "Οι περισσότεροι είναι παντρεμένοι.",
"pie")Ένας δείκτης που, τουλάχιστον διαισθητικά, μπορεί να είναι από τους πιο σημαντικούς είναι το ανώτατο επίπεδο εκπαίδευσης του πελάτη. Είναι λογικό κάποιος που έχει υψηλότερου επιπέδου σπουδές να έχει τη δυνατότητα να απασχοληθεί σε εργασίες που απαιτούν εξειδίκευση η οποία να πληρώνεται αντίστοιχα της μειωμένης προσφοράς. Άρα έμμεσα μπορεί να καθορίσει τις επαγγελματικές δυνατότητες του ενδιαφερόμενου και συνεπακόλουθα το μισθό που θα μπορεί να διεκδικεί και το ποσό που περισσεύσει για αποταμίευση. Στο συγκεκριμένο δείγμα μόλις το 30% έχει πανεπιστημιακή εκπαίδευση.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset,
education,
title = "Υψηλότερο επίπεδο εκπαίδευσης",
subtitle = "")Έκτός όμως από τις σπουδές που είναι μία ισχυρή ένδειξη σημαντικό ρόλο στη δημιουργία μιας προθεσμιακής κατάθεσης είναι οι υποχρεώσεις του ατόμου. Αυτές μπορούν να διακριθούν μέσα από τρεις μεταβλητές που μας παρέχονται και πιο συγκεκριμένα αν:
- ο πελάτης έχει οφειλές
- ο πελάτης έχει λάβει κάποιο δάνειο (στεγαστικό / προσωπικό)
Είναι προφανές ότι αν έχει μη εξυπηρετούμενες οφειλές το τελευταίο πράγμα που θα σκεφτεί είναι να κάνει αποταμίευση, αλλά να ξεπληρώσει τα χρέη του. Στο δείγμα μόλις 76 άτομα που αντιστοιχούν στο 1.6% των πελατών εμπίπτει σε αυτή τη κατηγορία, γεγονός που καθιστά να έχει νόημα η πρόταση για τη συντριπτική πλειοψηφία.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, default,
title = "Έχετε μη εξυπηρετούμενες οφειλές;",
subtitle = "Ποσοστό (%) ατόμων που δεν έχουν εκπληρώσει τις πιστωτικές τους υποχρεώσεις",
"pie")Επιπλέον, σημαντικό ποσοστό των πελατών της τράπεζας έχουν ήδη σημαντικές υποχρεώσεις τόσο σε βραχυπρόθεσμο επίπεδο, όσο και μακροπρόθεσμα. Πάνω από τους μισούς έχουν λάβει στεγαστικό δάνειο που σημαίνει μία πάγια σταθερή και σε βάθος χρόνου υποχρέωση η οποία δεν πρέπει να αθετηθεί μιας και πολλές φορές συνδυάζεται με υποθήκη του ακινήτου για το οποίο έλαβε και το δάνειο. Από την άλλη βέβαια θα μπορούσε να θεωρηθεί ότι με αυτό το τρόπο έχει προυπολογίσει το νοικοκυριό το κόστος της στέγασής τους και υπερτερεί της επιλογής του ενοικίου. Αυτό που κατά τη γνώμη μου ίσως να αποτελεί σημαντικότερο παράγοντα άρνησης είναι η λήψη καταναλωτικών δανείων. Αυτά τα δάνεια προορίζονται συνήθως για τη κάλυψη βραχυπρόθεσμων - έκτακτων αναγκών και αυτό το χρηματοδοτικό προιόν είναι διαβόητο για τα υψηλά επιτόκια καθιστώντας το μία ακιρβή επιλογή. Έτσι λοιπόν η αποπληρωμή του ίσως είναι το πρώτο πράγμα που θα πρέπει να κάνει κάποιος και προφανώς το άνοιγμα ενός προθεσμιακού λογαριασμού δεν είναι λογική. Στη δική μας περίπτωση περίπου το 15% έχει λάβει καταναλωτικό δάνειο γεγονός που είναι ελαφρώς αισιόδοξο μιας και μας επιτρέπει να έχουμε βάσιμες ελπίδες εύρεσης ενδιαφερόμενων στο υπόλοιπο 85%.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, housing,
title = "Έχετε λάβει στεγαστικό δάνειο;",
subtitle = "Ποσοστό (%) ατόμων που έχει λάβει στεγαστικό δάνειο", "pie")
univariateQualitativePlot(bank_dataset, loan,
title = "Έχετε λάβει καταναλωτικό δάνειο;",
subtitle = "Ποσοστό (%) ατόμων που έχει λάβει προσωπικό - καταναλωτικό δάνειο", "pie")Ένα άλλο στοιχείο που δίνεται είναι το μέσο επικοινωνίας με τον πελάτη της τράπεζας. Πάνω από τους μισούς έχουν σταθερό τηλέφωνο ως μέσο επικοινωνίας.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, contact,
title = "Μέσο επικοινωνίας",
subtitle = "Η προώθηση μέσω κινητού είναι πιο εκτεταμένη σε σχέση με το σταθερό",
"pie")Άλλη μία ενδιαφέρουσα μεταβλητή είναι ο τελευταίος μήνας στον οποίο προσεγγίστηκε ένας πελάτης. Οι περισσότερες τελευταίες προσεγγίσεις φαίνεται να έγιναν καλοκαιρινούς μήνες. Βέβαια αυτό το στοιχείο θέλει προσοχή στην ερμηνεία του γιατί μπορεί η λήψη των δεδομένων να έγινε π.χ. τον Σεπτέμβριο και τότε να είναι λογικό οι τελευταίες προσεγγίσεις να έγιναν τους καλοκαιρινούς μήνες. Ενδεχομένως να χρειαστεί διμεταβλητή ανάλυση στην επόμενη ενότητα σχετικά με τις επιτυχίες ανά μήνα, προκειμένου να εξεταστεί με μεγαλύτερη ακρίβεια ο συγκεκριμένος δείκτης.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, month,
title = "Μέσο επικοινωνίας",
subtitle = "Η προώθηση μέσω κινητού είναι πιο εκτεταμένη σε σχέση με το σταθερό")Σύμφωνα με τα δεδομένα και τη περιγραφή των δεδομένων η τράπεζα θα είχε τρέξει και σε προηγούμενα χρόνια παρόμοιες καμπάνιες ενημέρωσης και πρώθησης τραπεζικών προϊόντων και συγκεκριμένα προθεσμιακών λογαριασμών. Έτσι λοιπόν, έχουμε δεδομένα για όσους είχαν αποδεχτεί άνοιγμα λογαριασμού σε προηγούμενα χρόνια το οποίο μπορεί να είναι αρκετά βοηθητικό και ενδεχομένως μεγάλο ποσοστό να έχει νόημα να επανεγγραφεί. Ως αποτέλεσματ των προηγούμενων καμπάνιων είχαμε 129 ενδιαφερόμενους για κλειστούς λογαριασμούς, ενώ η κατάσταση πολλών είναι άγνωστη για τις προηγούμενες καμπάνιες.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, poutcome,
title = "Ποιο ήταν το αποτέλεσμα προηγούμενης προσέγγισης?",
subtitle = "For every five failed approaches there was one succussful.", "pie")Εδώ στην ουσία έχω το αποτέλεσμα το οποίο προσπαθώ να προβλέψω. Αυτά τα δεδομένα είναι γνωστά από τη τωρινή καμπάνια. Με βάση όμως αυτά τις προηγούμενες μεταβλητές - χαρακτηριστικά θα κατασκευάσω ένα μοντέλο πρόβλεψης και αυτά τα μοντέλα θα αξιολογηθούν με βάση αυτά τα δοσμένα αποτελέσματα.
Δείξε τον κώδικα
univariateQualitativePlot(bank_dataset, y,
title = "Πόσοι αποφάσισαν να φτιάξουν προθεσμιακό λογαριασμό;",
subtitle = "Ποσοστό πελατών που αποφάσισαν να ανοίξουν
έναν προθεσμιακό λογαριασμό ως αποτέλεσμα της τωρινής καμπάνιας.",
"pie")Οι καταθέτες της τράπεζας είναι κυρίως νεότερης ηλικίας και η συντριπτική πλειοψηφία κάτω των 60 ετών. Το ιστόγραμμα φαίνεται να έχει ένα σχήμα καμπάνας που προσοιδιάζει στη κανονική κατανομή, αλλά υπάρχει μία ελαφριά θετική ασυμμετρία.
Δείξε τον κώδικα
hchart(bank_dataset$age) %>%
hc_title(text = "Κατανομή ηλικιών") %>%
hc_subtitle(text = glue("Η διάμεση ηλικία είναι τα <b>{median(bank_dataset$age)}</b> έτη.")) %>%
hc_caption(text = "Bank Marketing Dataset from UCI") %>%
hc_tooltip(pointFormat = "{point.name}: {point.y}") %>%
hc_legend(enabled = FALSE)Δείξε τον κώδικα
hchart(bank_dataset$balance) %>%
hc_title(text = "Κατανομή καταθέσεων") %>%
hc_subtitle(text = glue("Οι περισσότερες καταθέσεις κυμαίνονται μεταξύ των 0$ και 200$ δολαρίων. Το διάμεσο υπόλοιπο λογαριασμού είναι {median(bank_dataset$balance)} $. Το 75ο τεταρτημόριο είναι τα 1480$, άρα το ένα τέταρτο των πελατών έχει καταθέσεις υψηλότερες αυτού του ποσού. Τα ύψη των λογαριασμών κυμαίνονται από {min(bank_dataset$balance)} μέχρι και τα {max(bank_dataset$balance)} $")) %>%
hc_caption(text = "Bank Marketing Dataset from UCI") %>%
hc_tooltip(pointFormat = "{point.name}: {point.y}") %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(
title = list(text = "Ύψος καταθέσεων σε δολαρια ΗΠΑ $"),
max = 10000
)Άλλο ένα στοιχείο είναι η διάρκεια της κλήσης. Διαισθητικά, αν η κλήση διαρκεί πολύ λίγο πιθανότατα να σημαίνει ότι ο πελάτης δεν ενδιαφέρεται. Σε αντίθετη περίπτωση
Δείξε τον κώδικα
hchart(bank_dataset$duration) %>%
hc_title(text = "Διάρκεια κλήσης") %>%
hc_subtitle(text = glue("Οι περισσότερες καταθέσεις κυμαίνονται μεταξύ των 0$ και 200$ δολαρίων. Το διάμεσο υπόλοιπο λογαριασμού είναι {median(bank_dataset$balance)} $. Το 75ο τεταρτημόριο είναι τα 1480$, άρα το ένα τέταρτο των πελατών έχει καταθέσεις υψηλότερες αυτού του ποσού. Τα ύψη των λογαριασμών κυμαίνονται από {min(bank_dataset$balance)} μέχρι και τα {max(bank_dataset$balance)} $")) %>%
hc_caption(text = "Bank Marketing Dataset from UCI") %>%
hc_tooltip(pointFormat = "{point.name}: {point.y}") %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(
title = list(text = "Διάρκεια κλήσης (σε δευτερόλεπτα)"),
max = 1000)Δείξε τον κώδικα
s = bank_dataset %>%
mutate(category = case_when(
campaign >= 1 & campaign <= 7 ~ as.character(campaign),
campaign > 7 ~ "8+",
TRUE ~ NA_character_
)) %>%
mutate(category = factor(category, levels = c(as.character(1:7), "8+"), ordered = TRUE))Δείξε τον κώδικα
hchart(s$category) %>%
hc_title(text = "Αριθμός προσεγγίσεων") %>%
hc_subtitle(text = glue("Οι περισσότερες καταθέσεις κυμαίνονται μεταξύ των 0€ και 200€ ευρώ. Το διάμεσο υπόλοιπο λογαριασμού είναι {median(bank_dataset$balance)} €. Το 75ο τεταρτημόριο είναι τα 1480€, άρα το ένα τέταρτο των πελατών έχει καταθέσεις υψηλότερες αυτού του ποσού. Τα ύψη των λογαριασμών κυμαίνονται από {min(bank_dataset$balance)} μέχρι και τα {max(bank_dataset$balance)} $")) %>%
hc_caption(text = "Bank Marketing Dataset from UCI") %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(
title = list(text = "Ύψος καταθέσεων σε ευρώ €")
)Διμεταβλητή ανάλυση
Στη προηγούμενη υπο-ενότητα εξετάστηκαν κάποια βασικά περιγραφικά στοιχεία ανά μεταβλητή τα οποία μπορούν να μας δώσουν μία αίσθηση για το πελατολόγιο της τράπεζας. Αν εξετάσω αυτά τα στοιχεία από μόνα τους ενδεχομένως να μην επαρκούν για να βγάλω αρκετά συμπεράσματα και η διμεταβλητή ανάλυση (σύγκριση δύο μεταβλητών) είναι αναγκαία. Μία προσέγγιση θα ήταν να εξετάσω τη συσχέτιση (ή συνάφεια) μεταξύ των ποσοτικών (ποιοτικών) μεταβλητών. Στη προκειμένη περίπτωση θα είχε επιπλέον όφελος να συγκρίνουμε τις προηγούμενες μεταβλητές με τη μεταβλητή απόκρισης (δηλαδή με την επιθυμία ανοίγματος προθεσμιακού λογαριασμού).
Μία σημαντική σύγκριση είναι ο κλάδος εργασίας του πελάτη με την τελική του απόφαση - ενδιαφέρον. Με το παρακάτω σχήμα δηλώνεται η χαμηλότερη ποσοστιαία ζήτηση ατόμων με χειρονακτική εργασία, ενώ οι συνταξιούχοι είναι αυτή μρ την υψηλότερη.
Δείξε τον κώδικα
`summarise()` has grouped output by 'job'. You can override using the `.groups`
argument.Δείξε τον κώδικα
highchart() %>%
hc_chart(type = "column") %>%
hc_xAxis(categories = plotjob$job) %>%
hc_yAxis(
min = 0,
max = 100,
title = list(text = "Percentage"),
labels = list(format = "{value}%")
) %>%
hc_plotOptions(
column = list(
stacking = "percent",
dataLabels = list(
enabled = TRUE,
format = "{point.y:.0f}%"
)
)
) %>%
hc_series(
list(name = "Όχι", data = plotjob$pct[plotjob$y == "όχι"], color = "#AA5733"),
list(name = "Ναι", data = sort(plotjob$pct[plotjob$y == "ναι"]), color = "#33bb57")
) %>%
hc_tooltip(pointFormat = "<b>{series.name}</b>: {point.y}%") %>%
hc_title(text = "Αποκρίσεις τωρινής καμπάνιας ανά επάγγελμα") %>%
hc_subtitle(text = "Μαθητές και συνταξιούχοι είναι οι πληθυσμιακές ομάδες όπου συμμετέχουν ποσοστιαία περισσότερο από τους υπόλοιπους σε ανοίγματα προθεσμιακών λογαριασμών.") %>%
hc_responsive(
rules = list(
list(
condition = list(
maxWidth = 500 # Hide labels when screen width is ≤500px
),
chartOptions = list(
plotOptions = list(
column = list(
dataLabels = list(enabled = FALSE) # Disable labels
)
)
)
)
)
)Τα παραπάνω αποτελέσματα ίσως να ήταν αναμενόμενα ως ένα βαθμό εξετάζοντας τη δυνητική οικονομική κατάσταση κάποιου. Υπάρχουν όμως και μεταβλητές υπό εξέταση στις οποίες η απάντηση δεν είναι προφανής, όπως στην οικογενειακή κατάσταση. Στο σχήμα, εξετάζεται η σημαντικά μεγαλύτερη αναλογικά συμμετοχή ατόμων που είναι μόνοι τους (είτε ως ανύπαντροι είτε ως διαζευγμένοι), έχοντας σημαντική απόκλιση από την αντίστοιχη απόκριση ατόμων που έχουν παντρευτεί.
Δείξε τον κώδικα
`summarise()` has grouped output by 'marital'. You can override using the
`.groups` argument.Δείξε τον κώδικα
highchart() %>%
hc_chart(type = "column") %>%
hc_xAxis(categories = plotmarital$marital) %>%
hc_yAxis(
min = 0,
max = 100,
title = list(text = "Percentage"),
labels = list(format = "{value}%")
) %>%
hc_plotOptions(
column = list(
stacking = "percent",
dataLabels = list(
enabled = TRUE,
format = "{point.y:.0f}%"
)
)
) %>%
hc_series(
list(name = "Όχι", data = plotmarital$pct[plotmarital$y == "όχι"], color = "#AA5733"),
list(name = "Ναι", data = sort(plotmarital$pct[plotmarital$y == "ναι"]), color = "#33bb57")
) %>%
hc_tooltip(pointFormat = "<b>{series.name}</b>: {point.y}%") %>%
hc_title(text = "Job of Respondent by Interest to Term Deposit") %>%
hc_subtitle(text = "Students and retirees are the population groups with a proportionally lower interest in term deposits compared to other groups.") %>%
hc_responsive(
rules = list(
list(
condition = list(
maxWidth = 500 # Hide labels when screen width is ≤500px
),
chartOptions = list(
plotOptions = list(
column = list(
dataLabels = list(enabled = FALSE) # Disable labels
)
)
)
)
)
)Μία σύνοψη των παραπάνω μπορεί να γίνει και με το παρακάτω διάγραμμα αλληλουχιών. Με τη πρώτη στήλη να δηλώνει τη κατανομή στις οικογενειακές καταστάσεις συνδυαζόμενες από το εκπαιδευτικό υπόβαθρο των συμμετεχόντων και καταλήγω στη τρίτη στήλη που είναι και η τελική απάντηση του πελάτη (αν ενδιαφέρεται να ανοίξει προθεσμιακό λογαριασμό).
Δείξε τον κώδικα
custom_df =
tibble(
r = bank_dataset$education,
t = bank_dataset$marital,
m = bank_dataset$y
)
df_sankey = custom_df %>%
group_by(r, t ,m) %>%
summarise(weight = n(), .groups = "drop")
links2 = df_sankey %>%
group_by(t, r) %>%
summarise(weight = sum(weight), .groups = "drop") %>%
rename(from = t, to = r)
links3 = df_sankey %>%
group_by(r, m) %>%
summarise(weight = sum(weight), .groups = "drop") %>%
rename(from = r, to = m)
links_all <- bind_rows(links2, links3)
highchart() %>%
hc_chart(type = "sankey") %>%
hc_title(text = "Alluvial Chart: Gender → Preference → Region") %>%
hc_add_series(
keys = c("from", "to", "weight"),
data = list_parse(links_all),
name = "Flow"
) %>%
hc_tooltip(pointFormat = "{point.from} → {point.to}: <b>{point.weight}</b>")Έκρινα σημαντικό να συγκρίνω την διαφορά μεταξύ των προηγούμενων και της τωρινής καμπάνιας και τελικά από που προκύπτουν οι ενδιαφερόμενοι. Έχουν κάνει εκ νέου χρήση των προιόντων ή η τράπεζα κατάφερε να εδραιώσει το πελατολόγιό της / το εύρος των υπηρεσιών προϊόντων που προσφέρει στους πελάτες της; Αυτό θα μελετήσω με άλλο ένα διάγραμμα αλληλουχίας. Αρχικά η τράπεζα διατηρεί μεγάλο μέρος της εμπιστοσύνης των προηγούμενων χρηστών της υπηρεσίας μιας και το 64% αυτών που είχαν συμφωνήσει να ανοίξουν προθεσμιακό λογαριασμό το πράττουν και με τη νέα καμπάνια. Το κρίσιμο δεδομένο βέβαια σε αυτή τη διμεταβλητή ανάλυση είναι το κατά πόσο έπεισε τους πελάτες που αρνήθηκαν την υπηρεσία. Αυτό το νούμερο προσεγγίζει το 13% που είναι μία αρκετά ικανοποιητική επίδοση με βάση ότι είχαν αρνηθεί προηγουμένως.
Δείξε τον κώδικα
custom_df =
tibble(
t = bank_dataset$poutcome,
l = bank_dataset$y
)
df_sankey = custom_df %>%
group_by(t , l) %>%
summarise(weight = n(), .groups = "drop")
# links2 = df_sankey %>%
# group_by(r, t) %>%
# summarise(weight = sum(weight), .groups = "drop") %>%
# rename(from = r, to = t)
links3 = df_sankey %>%
group_by(t, l) %>%
summarise(weight = sum(weight), .groups = "drop") %>%
rename(from = t, to = l)
links_all <- bind_rows(links3)
highchart() %>%
hc_chart(type = "sankey") %>%
hc_title(text = "Διάγραμμα αλληλουχιών: Σύγκριση παλιών και νέας καμπάνιας") %>%
hc_subtitle(text = "Στο διάγραμμα τονίζεται τα καλύτερα αποτελέσματα της τωρινής καμπάνιας (δεύτερη στήλη) σε σχέση με τις προηγούμενες. Περίπου 12% (63 άτομα) όσων απέρριψαν το ενδιαφέρον τους για τέτοια προιόντα πείστηκαν με τη τωρινή καμπάνια να ανοίξουν τέτοιο λογαριασμό.") %>%
hc_add_series(
keys = c("from", "to", "weight"),
data = list_parse(links_all),
name = "Flow"
) %>%
hc_tooltip(pointFormat = "{point.from} → {point.to}: <b>{point.weight}</b>")Κατασκευή μοντέλου
Στην R υπάρχουν υπάρχουν δύο αρκετά διαδεδομένοι τρόποι για τη κατασκευή μοντέλων, το caret και το tidymodels. Από τη μία μεριά, το πακέτο caret είναι αρκετά εύκολο στη χρήση, υπάρχουν αρκετά άρθα σχετικά με αυτό όπως οδηγοί - tutorials, επεξηγηματικά βίντεο - άρθρα. Από την άλλη μεριά, το tidymodels είναι μία <<όλα σε ένα>> λύση μιας και αποτελεί ένα μεταπακέτο, δηλαδή μία συλλογή πακέτων, που προσπαθεί να δώσει , ωστόσο υπάρχει λιγότερη τεκμηρίωση και άρθρα μιας και έχει δημιουργηθεί αρκετά πρόσφατα.
Διαχωρισμός συνόλου δεδομένων
Το πρώτο βήμα είναι να χωρίσουμε το αρχικό σύνολο δεδομένων σε δύο μέρη, όπου το καθένα θα χρησιμοποιηθεί για ένα ξεχωριστό σκοπό. Το πρώτο υποσύνολο χρησιμοποιείται για να εκπαιδεύσω - κατασκευάσω το μοντέλο μου, ενώ το δεύτερο μέρος (test dataset) είναι αναγκαίο ώστε να ελέγξουμε την ακρίβεια του μοντέλου που προέκυψε από το πρώτο υποσύνολο.
graph TD; A(Σύνολο δεδομένων <br> 4521 παρατηρήσεις) --> B(Σύνολο εκπαίδευσης <br> 3390 παρατηρήσεις) A(Σύνολο δεδομένων <br> 4521 παρατηρήσεις) --> C(Σύνολο αξιολόγησης <br> 1131 παρατηρήσεις)
Στο δικό μας παράδειγμα, έχουμε όπως αναφέραμε προηγούμενως 4521 παρατηρήσεις. Η πιο συνήθης είναι ο διαχωρισμός να γίνεται σε ένα ποσοστό 75% (80%) για να εκπαιδεύσω το μοντέλο μου και το άλλο 25% (20%) για την αξιολόγηση αυτού. Έτσι λοιπόν, καταλήγω με δύο νέα υποσύνολα με τον ίδιο αριθμό μεταβλητών, και το σύνολο εκπαίδευσης του μοντέλου αποτελείται από 3390 παρατηρήσεις και το σύνολο για την αξιολόγησή του αποτελείται από 1131.
Δεδομένα εκπαίδευσης
Δείξε τον κώδικα
bank_train %>%
gt_custom(.)|
Α/Α ID |
Ηλικία age |
Επάγγελμα job |
Οικογενειακή Κατάσταση marital |
Εκπαίδευση education |
Αθέτηση πληρωμών default |
Υπόλοιπο balance |
Στεγαστικό δάνειο housing |
Προσωπικό δάνειο loan |
Τρόπος επικοινωνίας contact |
day |
Μήνας month |
Διάρκεια κλήσης duration |
Αριθμός κλήσεων πελάτη campaign |
Ημέρες από προηγ. κλήση pdays |
NA previous |
NA poutcome |
NA y |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 31 | 68 | συνταξιούχος | διαζευγμένο | δευτεροβάθμια | όχι | 4189 | όχι | όχι | κινητό | 14 | Ιούλιο | 897 | 2 | -1 | 0 | άγνωστο | ναι |
| 34 | 32 | διευθυντικό στέλεχος | ανύπαντρο | τριτοβάθμια | όχι | 2536 | ναι | όχι | σταθερό | 26 | Αύγουστο | 958 | 6 | -1 | 0 | άγνωστο | ναι |
| 35 | 49 | τεχνικός | παντρεμένο | τριτοβάθμια | όχι | 1235 | όχι | όχι | σταθερό | 13 | Αύγουστο | 354 | 3 | -1 | 0 | άγνωστο | ναι |
| 37 | 78 | συνταξιούχος | διαζευγμένο | πρωτοβάθμια | όχι | 229 | όχι | όχι | κινητό | 22 | Οκτώβριος | 97 | 1 | -1 | 0 | άγνωστο | ναι |
| 39 | 33 | διευθυντικό στέλεχος | παντρεμένο | δευτεροβάθμια | όχι | 3935 | ναι | όχι | σταθερό | 6 | Μάιο | 765 | 1 | 342 | 2 | αποτυχία | ναι |
Δεδομένα αξιολόγησης
Δείξε τον κώδικα
bank_test %>%
gt_custom(.)|
Α/Α ID |
Ηλικία age |
Επάγγελμα job |
Οικογενειακή Κατάσταση marital |
Εκπαίδευση education |
Αθέτηση πληρωμών default |
Υπόλοιπο balance |
Στεγαστικό δάνειο housing |
Προσωπικό δάνειο loan |
Τρόπος επικοινωνίας contact |
day |
Μήνας month |
Διάρκεια κλήσης duration |
Αριθμός κλήσεων πελάτη campaign |
Ημέρες από προηγ. κλήση pdays |
NA previous |
NA poutcome |
NA y |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 6 | 35 | διευθυντικό στέλεχος | ανύπαντρο | τριτοβάθμια | όχι | 747 | όχι | όχι | σταθερό | 23 | Φεβρουάριο | 141 | 2 | 176 | 3 | αποτυχία | όχι |
| 10 | 43 | παροχή υπηρεσιών | παντρεμένο | πρωτοβάθμια | όχι | -88 | ναι | ναι | σταθερό | 17 | Απρίλιο | 313 | 1 | 147 | 2 | αποτυχία | όχι |
| 14 | 20 | σπουδαστής | ανύπαντρο | δευτεροβάθμια | όχι | 502 | όχι | όχι | σταθερό | 30 | Απρίλιο | 261 | 1 | -1 | 0 | άγνωστο | ναι |
| 15 | 31 | χειρονακτική εργασία | παντρεμένο | δευτεροβάθμια | όχι | 360 | ναι | ναι | σταθερό | 29 | Ιανουάριο | 89 | 1 | 241 | 1 | αποτυχία | όχι |
| 17 | 56 | τεχνικός | παντρεμένο | δευτεροβάθμια | όχι | 4073 | όχι | όχι | σταθερό | 27 | Αύγουστο | 239 | 5 | -1 | 0 | άγνωστο | όχι |
Επεξεργασία δεδομένων
Βέβαια η κατασκευή των μοντέλων δεν είναι τόσο εύκολη υπόθεση. Ανάμεσα στο διαχωρισμό του συνόλου δεδομένων και τη κατασκευή των μοντέλων παρεμβάλεται η επεξεργασία των δεδομένων. Τα βήματα αυτού του σταδίου δεν είναι δεδομένα και ποικίλουν αναλόγως το είδος του προβλήματος (ταξινόμησης ή πρόβλεψης τιμής) αλλά και το ποιο μοντέλο θα επιλέξω. Ευτυχώς, για εμάς το πακέτο tidymodels προσφέρει έτοιμες εντολές προκειμένου να κάνει ανάλυσή μας ευκολότερη και ιδιαίτερα εντολές του πακέτου recipes, που αποτελούν μέρος του tidymodels μπορούν να φανούν ιδιαίτερα χρήσιμες σε αυτό το στάδιο. Βέβαια, υπάρχουν και άλλα πακέτα που συμπληρώνουν - λύνουν συνήθη προβλήματα στα δεδομένα. Για παράδειγμα, στα δεδομένα μας αναμένεται και είδαμε και στο παραπάνω σχήμα ότι οι περισσότεροι δεν επιθυμούν να ανοίξουν προθεσμιακό λογιαριασμό. Τα δεδομένα μας χαρακτηρίζονται ως ανισσόροπα (imbalanced) όταν η μεταβλητή την οποία προσπαθώ να προβλέψω δεν έχω επαρκείς τιμές αλλά αρκετά μεγάλη διαφορά (90% δεν επιθυμούν / 10%) Σε αυτή τη περίπτωση μπορώ να χρησιμοποιήσω την εντολή step_smote() από το πακέτο themis, προκειμένου να ισορροπήσω τη μεταβλητή που προσπαθώ να προβλέψω.
Δείξε τον κώδικα
# Recipe για tree-based μοντέλα (RF, XGBoost, LightGBM)
tree_recipe <- recipe(y ~., data = bank_train) %>%
step_rm(poutcome, ID, duration) %>%
step_corr(all_numeric(), threshold = 0.75) %>%
step_dummy(all_nominal(), -all_outcomes()) %>%
step_smote(y)
# Recipe για distance/linear μοντέλα (Logistic Regression, KNN)
linear_recipe <- recipe(y ~., data = bank_train) %>%
step_rm(poutcome, ID, duration) %>%
step_corr(all_numeric(), threshold = 0.75) %>%
step_dummy(all_nominal(), -all_outcomes()) %>%
step_normalize(all_numeric_predictors()) %>% # <-- επιπλέον βήμα
step_smote(y)Ας ρίξουμε τώρα μία ματιά στο σύνολο δεδομένων, αφού κάναμε κάποια βασική επεξεργασία των δεδομένων. Μία προεπισκόπηση των δεδομένων μου αφότου κάναμε τις απαραίτητες αλλαγές για γραμμικά μοντέλα:
recipes για γραμμικά μοντέλα
|
Ηλικία age |
Υπόλοιπο balance |
day |
Αριθμός κλήσεων πελάτη campaign |
Ημέρες από προηγ. κλήση pdays |
NA previous |
NA job_χειρονακτική.εργασία |
NA job_επιχειρηματίας |
NA job_οικιακός.βοηθός |
NA job_διευθυντικό.στέλεχος |
NA job_συνταξιούχος |
NA job_αυτοαπασχολούμενος |
NA job_παροχή.υπηρεσιών |
NA job_σπουδαστής |
NA job_τεχνικός |
NA job_άνεργος |
NA job_άγνωστο |
NA marital_παντρεμένο |
NA marital_ανύπαντρο |
NA education_δευτεροβάθμια |
NA education_τριτοβάθμια |
NA education_άγνωστο |
NA default_ναι |
NA housing_ναι |
NA loan_ναι |
NA contact_κινητό |
NA contact_άγνωστο |
NA month_Αύγουστο |
NA month_Δεκέμβριο |
NA month_Φεβρουάριο |
NA month_Ιανουάριο |
NA month_Ιούλιο |
NA month_Ιούνιο |
NA month_Μάρτιο |
NA month_Μάιο |
NA month_Νοέμβριο |
NA month_Οκτώβριος |
NA month_Σεπτέμβριος |
NA y |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2.5273 | 0.89308 | -0.2259 | -0.25595 | -0.4102 | -0.3164 | -0.5128 | -0.1915 | -0.1632 | -0.5279 | 4.273 | -0.202 | -0.3183 | -0.1284 | -0.4557 | -0.1679 | -0.09448 | -1.2670 | -0.5988 | 0.9846 | -0.6555 | -0.2044 | -0.1308 | -1.1365 | -0.4208 | 3.8046 | -0.6435 | -0.4071 | -0.06666 | -0.234 | -0.184 | 2.3760 | -0.3657 | -0.09605 | -0.6721 | -0.3064 | -0.142 | -0.1065 | ναι |
| -0.8580 | 0.35750 | 1.2281 | 1.09187 | -0.4102 | -0.3164 | -0.5128 | -0.1915 | -0.1632 | 1.8937 | -0.234 | -0.202 | -0.3183 | -0.1284 | -0.4557 | -0.1679 | -0.09448 | -1.2670 | 1.6694 | -1.0153 | 1.5252 | -0.2044 | -0.1308 | 0.8796 | -0.4208 | -0.2628 | -0.6435 | 2.4559 | -0.06666 | -0.234 | -0.184 | -0.4208 | -0.3657 | -0.09605 | -0.6721 | -0.3064 | -0.142 | -0.1065 | ναι |
| 0.7406 | -0.06404 | -0.3471 | 0.08101 | -0.4102 | -0.3164 | -0.5128 | -0.1915 | -0.1632 | -0.5279 | -0.234 | -0.202 | -0.3183 | -0.1284 | 2.1939 | -0.1679 | -0.09448 | 0.7891 | -0.5988 | -1.0153 | 1.5252 | -0.2044 | -0.1308 | -1.1365 | -0.4208 | -0.2628 | -0.6435 | 2.4559 | -0.06666 | -0.234 | -0.184 | -0.4208 | -0.3657 | -0.09605 | -0.6721 | -0.3064 | -0.142 | -0.1065 | ναι |
| 3.4677 | -0.38999 | 0.7434 | -0.59290 | -0.4102 | -0.3164 | -0.5128 | -0.1915 | -0.1632 | -0.5279 | 4.273 | -0.202 | -0.3183 | -0.1284 | -0.4557 | -0.1679 | -0.09448 | -1.2670 | -0.5988 | -1.0153 | -0.6555 | -0.2044 | -0.1308 | -1.1365 | -0.4208 | 3.8046 | -0.6435 | -0.4071 | -0.06666 | -0.234 | -0.184 | -0.4208 | -0.3657 | -0.09605 | -0.6721 | -0.3064 | 7.041 | -0.1065 | ναι |
| -0.7639 | 0.81078 | -1.1953 | -0.59290 | 3.0172 | 0.8067 | -0.5128 | -0.1915 | -0.1632 | 1.8937 | -0.234 | -0.202 | -0.3183 | -0.1284 | -0.4557 | -0.1679 | -0.09448 | 0.7891 | -0.5988 | 0.9846 | -0.6555 | -0.2044 | -0.1308 | 0.8796 | -0.4208 | -0.2628 | -0.6435 | -0.4071 | -0.06666 | -0.234 | -0.184 | -0.4208 | -0.3657 | -0.09605 | 1.4875 | -0.3064 | -0.142 | -0.1065 | ναι |
και προεπισκόπηση των δεδομένων με εφαρμογή των απαραίτητων αλλαγών για μοντέλα δένδρων:
recipes για μοντέλα δένδρων
|
Ηλικία age |
Υπόλοιπο balance |
day |
Αριθμός κλήσεων πελάτη campaign |
Ημέρες από προηγ. κλήση pdays |
NA previous |
NA job_χειρονακτική.εργασία |
NA job_επιχειρηματίας |
NA job_οικιακός.βοηθός |
NA job_διευθυντικό.στέλεχος |
NA job_συνταξιούχος |
NA job_αυτοαπασχολούμενος |
NA job_παροχή.υπηρεσιών |
NA job_σπουδαστής |
NA job_τεχνικός |
NA job_άνεργος |
NA job_άγνωστο |
NA marital_παντρεμένο |
NA marital_ανύπαντρο |
NA education_δευτεροβάθμια |
NA education_τριτοβάθμια |
NA education_άγνωστο |
NA default_ναι |
NA housing_ναι |
NA loan_ναι |
NA contact_κινητό |
NA contact_άγνωστο |
NA month_Αύγουστο |
NA month_Δεκέμβριο |
NA month_Φεβρουάριο |
NA month_Ιανουάριο |
NA month_Ιούλιο |
NA month_Ιούνιο |
NA month_Μάρτιο |
NA month_Μάιο |
NA month_Νοέμβριο |
NA month_Οκτώβριος |
NA month_Σεπτέμβριος |
NA y |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 68 | 4189 | 14 | 2 | -1 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | ναι |
| 32 | 2536 | 26 | 6 | -1 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 0 | 1 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | ναι |
| 49 | 1235 | 13 | 3 | -1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 1 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | ναι |
| 78 | 229 | 22 | 1 | -1 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | ναι |
| 33 | 3935 | 6 | 1 | 342 | 2 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 0 | 0 | 0 | ναι |
Διασταυρωμένη επικύρωση
Οκ, ήρθε η ώρα να κατασκευάσουμε το μοντέλο μας;
Όχι τόσο γρήγορα. Θεωρητικά θα μπορούσαμε να συνεχίσουμε, ωστόσο η ενδεδειγμένη μέθοδος είναι να μην λαμβάνω απλώς δύο μέρη καθώς η περαιτέρω αξιολογηση βασίζεται ως επί το πλείστον στο πώς έγινε ο διαχωρισμός και ποιες τιμές λήφθηκαν. Για να έχουμε μία πιο ακριβή εκτίμηση της απόδοσης του μοντέλου προτείνετε να κατασκευάσουμε υποσύνολα των δεδομένων μου με σκοπό να βρω τις παραμέτρους οι οποίες οδηγούν συστηματικά, κατά μέσο όρο σε 5 ή 10 υπό-δείγματα σε καλύτερη ακρίβεια.
Δείξε τον κώδικα
set.seed(123)
cv_folds <- vfold_cv(bank_train, v = 5, strata = y)
# Control objects
ctrl_grid <- control_stack_grid()
ctrl_bayes <- control_stack_bayes() # αντί για control_grid(), για stackingΚατασκευάζοντας το μοντέλο μου
Στη συνέχεια, με το πακέτο parsnip μπορώ να ορίσω τα χαρακτηριστικά των διάφορων μοντέλων που θέλω να κατασκευάσω. Στη συγκεκριμένη περίπτωση θα ήθελα να ελέγξω διάφορα μοντέλα και αν ελέγξω την απόδοσή τους. Επομένως, θα ορίσω μοντέλα:
- k Κοντινότερων Γειτόνων (k - Nearest Neighbors)
- Λογιστική Παλινδρόμηση (Logistic Regression)
- Ταξινόμηση Naive Bayes
- Τυχαίου δάσους (Random Forest)
- LightGBM
- XGBoost
Το {parnsnip} θα μας βοηθήσει μέσα από ένα ενοποιημένο περιβάλλον να καθορίσουμε τα προβλεπτικά μας μοντέλα. Στο πλαίσιο της ανάλυσης, αναπτύχθηκαν και συγκρίθηκαν πέντε διαφορετικά μοντέλα ταξινόμησης χρησιμοποιώντας το οικοσύστημα tidymodels στην R. Συγκεκριμένα, υλοποιήθηκαν τα μοντέλα Λογιστικής Παλινδρόμησης (Logistic Regression), Κοντινότεροι Γείτονες (K-Nearest Neighbors - KNN), Τυχαίο Δάσος (Random Forest), XGBoost και LightGBM, ώστε να αξιολογηθεί η απόδοσή τους στο πρόβλημα πρόβλεψης. Για τη Logistic Regression, χρησιμοποιήθηκε υλοποίηση με κανονικοποίηση μέσω της βιβλιοθήκης glmnet, επιτρέποντας τη βελτιστοποίηση των υπερπαραμέτρων που σχετίζονται με την ένταση της κανονικοποίησης (penalty) και τον τύπο κανονικοποίησης (mixture), που αντιστοιχούν στους μηχανισμούς Ridge και Lasso. Το μοντέλο K-Nearest Neighbors βασίστηκε στον αλγόριθμο kknn, με παραμετροποίηση του αριθμού των γειτόνων (neighbors) και της συνάρτησης στάθμισης των αποστάσεων (weight_func). Για το Random Forest, χρησιμοποιήθηκε η υλοποίηση ranger με 200 δέντρα απόφασης. Οι υπερπαράμετροι που ρυθμίστηκαν περιλάμβαναν τον αριθμό μεταβλητών που εξετάζονται σε κάθε διαχωρισμό (mtry) και το ελάχιστο πλήθος παρατηρήσεων σε κάθε κόμβο (min_n). Παράλληλα, εφαρμόστηκαν δύο μέθοδοι gradient boosting, XGBoost και LightGBM. Και στις δύο περιπτώσεις, το μοντέλο ορίστηκε με 200 δέντρα, ενώ πραγματοποιήθηκε βελτιστοποίηση των υπερπαραμέτρων που σχετίζονται με το βάθος των δέντρων (tree_depth), τον ρυθμό μάθησης (learn_rate) και το ελάχιστο πλήθος παρατηρήσεων ανά κόμβο (min_n). Οι υπερπαράμετροι των μοντέλων που σημειώνονται με tune() επιλέχθηκαν μέσω διαδικασίας βελτιστοποίησης, με στόχο την εύρεση του συνδυασμού που μεγιστοποιεί την προγνωστική απόδοση των μοντέλων. Τέλος, καθορίζεται η κατάλληλη διαδικασία προεπεξεργασίας των δεδομένων μέσω μιας «συνταγής» (recipe) για κάθε ένα από τα οριζόμενα μοντέλα. Οι συνταγές αποτελούν μηχανισμό μετασχηματισμού και προετοιμασίας των δεδομένων, ο οποίος εφαρμόζεται πριν από την εκπαίδευση του μοντέλου. Για τα γραμμικά μοντέλα, όπως η Λογιστική Παλινδρόμηση (Logistic Regression) και οι Κοντινότεροι Γείτονες (k-Nearest Neighbors), χρησιμοποιείται η συνταγή που προορίζεται για γραμμικά μοντέλα. Αντίθετα, για τα δενδροειδή μοντέλα (tree-based models), όπως τα XGBoost, LightGBM και το Τυχαίο Δάσος (Random Forest), εφαρμόζεται η συνταγή που έχει σχεδιαστεί για μοντέλα δέντρων.
Δείξε τον κώδικα
# --- Logistic Regression ---
log_reg_model <- parsnip::logistic_reg(
penalty = tune(),
mixture = tune()
) %>%
set_engine("glmnet") %>%
set_mode("classification")
# --- K-Nearest Neighbors ---
knn_model <- parsnip::nearest_neighbor(
neighbors = tune(),
weight_func = tune()
) %>%
set_engine("kknn") %>%
set_mode("classification")
# --- Random Forest ---
rf_model <- parsnip::rand_forest(
trees = 200,
mtry = tune(),
min_n = tune()
) %>%
set_engine("ranger") %>%
set_mode("classification")
# --- XGBoost ---
xgb_model <- parsnip::boost_tree(
trees = 200,
min_n = tune(),
learn_rate = tune(),
tree_depth = tune()
) %>%
set_engine("xgboost") %>%
set_mode("classification")
# --- LightGBM ---
lgbm_model <- parsnip::boost_tree(
trees = 200,
min_n = tune(),
learn_rate = tune(),
tree_depth = tune()
) %>%
set_engine("lightgbm") %>%
set_mode("classification")
log_wf <- workflow() %>% add_recipe(linear_recipe) %>% add_model(log_reg_model)
knn_wf <- workflow() %>% add_recipe(linear_recipe) %>% add_model(knn_model)
rf_wf <- workflow() %>% add_recipe(tree_recipe) %>% add_model(rf_model)
xgb_wf <- workflow() %>% add_recipe(tree_recipe) %>% add_model(xgb_model)
lgbm_wf <- workflow() %>% add_recipe(tree_recipe) %>% add_model(lgbm_model)Εφαρμόζωντας
Δείξε τον κώδικα
set.seed(123)
log_results <- tune_grid(
log_wf,
resamples = cv_folds,
grid = 10,
metrics = metric_set(roc_auc, accuracy),
control = ctrl_grid
)
# KNN — tune_grid
knn_results <- tune_grid(
knn_wf,
resamples = cv_folds,
grid = 10,
metrics = metric_set(roc_auc, accuracy),
control = ctrl_grid
)
# Random Forest — tune_grid (μέτριο κόστος)
rf_results <- tune_grid(
rf_wf,
resamples = cv_folds,
grid = 15,
metrics = metric_set(roc_auc, accuracy),
control = ctrl_grid
)i Creating pre-processing data to finalize 1 unknown parameter: "mtry"Δείξε τον κώδικα
# XGBoost — tune_bayes
xgb_results <- tune_bayes(
xgb_wf,
resamples = cv_folds,
initial = 5,
iter = 25,
metrics = metric_set(roc_auc, accuracy),
control = ctrl_bayes
)
# LightGBM — tune_bayes
lgbm_results <- tune_bayes(
lgbm_wf,
resamples = cv_folds,
initial = 5,
iter = 25,
metrics = metric_set(roc_auc, accuracy),
control = ctrl_bayes
)! No improvement for 10 iterations; returning current results.Δείξε τον κώδικα
bank_stack <- stacks() %>%
add_candidates(log_results) %>%
add_candidates(knn_results) %>%
add_candidates(rf_results) %>%
add_candidates(xgb_results) %>%
add_candidates(lgbm_results)
# Υπολογισμός βαρών για κάθε μοντέλο
set.seed(123)
bank_stack_model <- bank_stack %>%
blend_predictions(
penalty = 10^(-2:0), # L1 regularization για επιλογή μοντέλων
metric = metric_set(roc_auc)
)
# Εκπαίδευση των επιλεγμένων μοντέλων
bank_stack_fit <- bank_stack_model %>%
fit_members()Αξιολόγηση μοντέλων
Συγκρίνοντας τα μοντέλα μας με βάση το κριτήριο ROC συμπεραίνω ότι το LightGBM είναι αυτό που έχει τη μεγαλύτερη προβλεπτική ισχύ. Συνεπώς, οι όποιες προβλέψεις μας για το ποιοι ενδέχται να εδιαφέρονται για προγράμματα τραπεζικής και ιδιαίτερα για προγράμματα προθεσμιακών καταθέσεων θα πρέπει να βασιστούν στο καλύτερο μας μοντέλο.
Δείξε τον κώδικα
# Finalize και last_fit για τα επί μέρους μοντέλα
final_results <- list(
"Λογιστική Παλινδρόμηση" = log_results,
"kNN" = knn_results,
"Random Forest" = rf_results,
"XGBoost" = xgb_results,
"LightGBM" = lgbm_results
) %>%
purrr::imap_dfr(function(res, name) {
best <- select_best(res, metric = "roc_auc")
wf <- switch(name,
"Λογιστική Παλινδρόμηση" = log_wf,
"kNN" = knn_wf,
"Random Forest" = rf_wf,
"XGBoost" = xgb_wf,
"LightGBM" = lgbm_wf
)
last_fit(finalize_workflow(wf, best), split = bank_dataset_split,
metrics = metric_set(roc_auc, accuracy, f_meas)) %>%
collect_metrics() %>%
mutate(model = name)
})
# Stack predictions στο test set
stack_preds <- bank_test %>%
bind_cols(predict(bank_stack_fit, bank_test, type = "prob")) %>%
bind_cols(predict(bank_stack_fit, bank_test))
stack_metrics <- stack_preds %>%
metrics(truth = y, estimate = .pred_class, .pred_ναι) %>%
mutate(model = "Stack Ensemble")
# Σύγκριση όλων σε έναν πίνακα
bind_rows(final_results, stack_metrics) %>%
select(model, .metric, .estimate) %>%
pivot_wider(names_from = .metric, values_from = .estimate) %>%
arrange(desc(roc_auc)) %>%
select(model, accuracy, roc_auc) %>%
rename(.,
"Μοντέλο" = model,
"Ακρίβεια" = accuracy,
"ROC AUC" = roc_auc) %>%
gt_custom(head_max = 8, use_labels = FALSE)| Μοντέλο | Ακρίβεια | ROC AUC |
|---|---|---|
| LightGBM | 0.8798 | 0.7730 |
| Random Forest | 0.8753 | 0.7652 |
| XGBoost | 0.8780 | 0.7403 |
| Λογιστική Παλινδρόμηση | 0.6180 | 0.7368 |
| kNN | 0.6092 | 0.6539 |
| Stack Ensemble | 0.8780 | 0.2402 |
Αποτελέσματα
Το βέλτιστο μοντέλο LightGBM που προέκυψε από τη διαδικασία βελτιστοποίησης χαρακτηρίζεται από τρεις βασικές υπερπαραμέτρους. Η παράμετρος min_n (minimum node size), που ισούται με 1, ορίζει τον ελάχιστο αριθμό παρατηρήσεων που απαιτείται σε κάθε τελικό κόμβο του δέντρου — η τιμή 1 επιτρέπει στο μοντέλο να δημιουργεί πολύ εξειδικευμένους κανόνες, κάτι που μπορεί να είναι αποτελεσματικό όταν συνδυάζεται με κατάλληλη ρύθμιση των υπολοίπων παραμέτρων. Η παράμετρος tree_depth (βάθος δέντρου), που ισούται με 2, καθορίζει πόσα επίπεδα διαχωρισμών μπορεί να έχει κάθε δέντρο· μία τιμή 2 σημαίνει σχετικά απλά δέντρα, τα οποία αποφεύγουν την υπερπροσαρμογή (overfitting) στα δεδομένα εκπαίδευσης. Τέλος, ο ρυθμός μάθησης (learn_rate) ισούται με 0.047, και ελέγχει πόσο «βήμα» κάνει το μοντέλο σε κάθε επανάληψη — μικρότερες τιμές οδηγούν σε πιο σταδιακή και συνήθως πιο σταθερή σύγκλιση, αλλά απαιτούν περισσότερα δέντρα για να αποδώσουν πλήρως.
Από την ανάλυση σπουδαιότητας μεταβλητών του μοντέλου LightGBM προκύπτει ότι οι πιο καθοριστικοί παράγοντες για την πρόβλεψη ενδιαφέροντος σε προθεσμιακό λογαριασμό είναι η ύπαρξη στεγαστικού δανείου (housing_ναι, 15.3%) και ο άγνωστος τρόπος επικοινωνίας (contact_άγνωστο, 14.0%), με την οικογενειακή κατάσταση “παντρεμένος” να ακολουθεί (marital_παντρεμένο, 11.7%). Αξιοσημείωτη είναι και η συμβολή του μήνα επικοινωνίας, με τον Μάιο να εμφανίζεται ως ο πιο σημαντικός μήνας (8.2%), ενώ το επίπεδο εκπαίδευσης συμμετέχει επίσης με αξιόλογο βάρος. Τα αποτελέσματα αυτά συνάδουν σε μεγάλο βαθμό με τα ευρήματα της περιγραφικής ανάλυσης, επιβεβαιώνοντας ότι δημογραφικά χαρακτηριστικά όπως η οικογενειακή κατάσταση και το εκπαιδευτικό υπόβαθρο, αλλά και επιχειρησιακές παράμετροι όπως ο τρόπος και η χρονική στιγμή επικοινωνίας, διαδραματίζουν καθοριστικό ρόλο στην απόφαση ενός πελάτη.
| Μεταβλητή | Σπουδαιότητα |
|---|---|
| Έγγαμος | 15.04 |
| Άγνωστος τρόπος επικοινωνίας | 14.05 |
| Στεγαστικό δάνειο | 11.65 |
| Μήνας: Μάιος | 9.73 |
| Τριτοβάθμια εκπαίδευση | 7.56 |
| Δευτεροβάθμια εκπαίδευση | 3.76 |
| pdays | 3.39 |
| Μήνας: Ιούλιος | 3.31 |
| month_Οκτώβριος | 2.72 |
| Επάγγελμα: Χειρονακτική εργασία | 2.63 |
Επιπλέον, θα ήθελα να συγκρίνω την απόδοση των τριών καλύτερών μου μοντέλων γραφικά με ένα γράφημα AUC (Area under the curve). Επιπλέον του μοντέλου lightgbm που προσάρμοσα προηγουμένως διάλεξα το μοντέλο λογιστικής παλινδρόμησης και το μοντέλο XGBoost.
Δείξε τον κώδικα
# Για αξιολόγηση / ROC / confusion matrix → fit μόνο στο train
final_lr <- finalize_workflow(log_wf, select_best(log_results, metric = "roc_auc")) %>%
fit(data = bank_train)
final_xgb <- finalize_workflow(xgb_wf, select_best(xgb_results, metric = "roc_auc")) %>%
fit(data = bank_train)
get_preds <- function(fitted_wf, model_name) {
predict(fitted_wf, bank_test, type = "prob") %>%
bind_cols(predict(fitted_wf, bank_test)) %>%
bind_cols(bank_test %>% select(y)) %>%
mutate(model = model_name)
}
all_preds <- bind_rows(
get_preds(final_lgbm_wf, "LightGBM"),
get_preds(final_lr, "Λογιστική Παλινδρόμηση"),
get_preds(final_xgb, "XGBoost")
)
roc_all <- all_preds %>%
group_by(model) %>%
roc_curve(truth = y, .pred_ναι, event_level = "second") %>%
ungroup()
colors <- c("LightGBM" = "#2196F3", "Random Forest" = "#4CAF50", "XGBoost" = "#FF5722")
hchart(roc_all, type = "line", hcaes(x = 1 - specificity, y = sensitivity, group = model)) %>%
hc_title(text = "ROC Curves") %>%
hc_subtitle(text = "Σύγκριση LightGBM, XGBoost και Λογιστικής Παλινδρόμησης") %>%
hc_xAxis(title = list(text = "1 - Ειδικότητα (False Positive Rate)"), min = 0, max = 1) %>%
hc_yAxis(title = list(text = "Ευαισθησία (True Positive Rate)"), min = 0, max = 1) %>%
hc_colors(unname(colors)) %>%
hc_tooltip(headerFormat = "",
pointFormat = "<b>{series.name}</b><br>TPR: {point.y:.3f}<br>FPR: {point.x:.3f}")Τέλος, η υπεροχή του μοντέλου LightGBM έχει αποδειχτεί όμως κρίνω απαραίτητη την προσθήκη ενός ακόμη εργαλείου για να κάνει ξεκάθαρη όχι απλώς τη διαφορά στην προβλεπτική τους απόδοση, αλλά κυριώς στ αποιοτικά χαρακτηριστικά αυτής. Βλέπεται το κάθε μοντέλο έχει τις δικές του δυνάμεις και συνάμα αδυναμίες. Άλλο μοντέλο μπορεί να είναι πιο ευαίσθητο σε κάποιες τιμές και άλλο να κτηγοριοποιεί πιο δύσκολα.
Δείξε τον κώδικα
all_preds %>%
group_by(model) %>%
conf_mat(truth = y, estimate = .pred_class) %>%
mutate(tidied = purrr::map(conf_mat, tidy)) %>%
unnest(tidied) %>%
mutate(
Προβλεφθέν = case_when(
name %in% c("cell_1_1", "cell_1_2") ~ "Όχι",
name %in% c("cell_2_1", "cell_2_2") ~ "Ναι"
),
Πραγματικό = case_when(
name %in% c("cell_1_1", "cell_2_1") ~ "Όχι",
name %in% c("cell_1_2", "cell_2_2") ~ "Ναι"
)
) %>%
group_by(model) %>%
mutate(pct = round(100 * value / sum(value), 1),
display = glue("{value} ({pct}%)")) %>%
select(model, Πραγματικό, Προβλεφθέν, display) %>%
pivot_wider(names_from = Προβλεφθέν, values_from = display) %>%
gt_custom(head_max = 10, use_labels = FALSE) %>%
tab_header(title = "Confusion Matrices") %>%
tab_spanner(label = "Προβλεφθέν", columns = c("Όχι", "Ναι")) %>%
cols_align(align = "center") %>%
tab_options(
table.background.color = "transparent",
row_group.font.weight = "bold",
column_labels.border.top.width = px(2),
column_labels.border.top.color = "#757575",
column_labels.border.bottom.width = px(2),
column_labels.border.bottom.color = "#757575",
table_body.border.bottom.width = px(2),
table_body.border.bottom.color = "#757575"
)| Confusion Matrices | ||
| Πραγματικό |
Προβλεφθέν
|
|
|---|---|---|
| Όχι | Ναι | |
| LightGBM | ||
| Όχι | 973 (86%) | 27 (2.4%) |
| Ναι | 109 (9.6%) | 22 (1.9%) |
| XGBoost | ||
| Όχι | 1000 (88.4%) | 0 (0%) |
| Ναι | 131 (11.6%) | 0 (0%) |
| Λογιστική Παλινδρόμηση | ||
| Όχι | 601 (53.1%) | 399 (35.3%) |
| Ναι | 33 (2.9%) | 98 (8.7%) |
Ο παραπάνω πίνακας είναι άκρως αποκαλύπτικός για αυτό που θέλω να περιγράψω. Δεν αρκεί η ακρίβεια ως μέτρο ´συγκρισης. Σκεφτείτε τι θέλαμε, να βρούμε τους πελάτες που ενδαιφέρονται. Στο κομμάτι των δεδομένων που απομονώσαμε για να ελέγξουμε την ισχύ των μοντέλων υπάρχουν 1000 αρνήσεις και 131 θετικές εκβάσεις. Εγώ θεωρητικά ψάχνω το μοντέλο με τη μεγαλύτερη ακρίβεια, δηλαδή το μεγαλύτερο ποσοστό στα διαγώνια κελιά, όπου για το LightGBM είναι 87.8%, για το XGBoost 88.4% και για τη Λογιστική Παλινδρόμηση 61.8%. Μία βιαστική επιλογή θα ήταν το XGBoost. Ωστόσο, παρατηρώ το εξής ενδιφέρον ότι αυτό το μμοντέλο προβλέπει ότι κανένας δεν ενδιαφέρεται, άρα χάνονται και οι 131 δυντικοί πελάτες. Επομένως η επιλογή του μοντέλου δεν θα πρέπει να βασιστεί στην καλύτερη ταξινόμηση αλλά στην αποδοτικότερη εύρεση των ενδιαφερόμενων (ταύτιση των Ναι, πρόβλεψης και πραγματικότητας). Αν δούμε προσεχτικότερα το ίδιο πρόβλημα έχει και το LightGBM μοντέλο με μόλις 22 θετικές προβλέψεις από τις 131 και το μοντέλο λογιστικής παλινδρόμησης να δίνει μία ανέλπιστα καλή απόδοση βρίσκοντας τα 2/3 των ενδιαφερόμενων. Κάπου εδώ βέβαια έχει σημασία να παρατηρήσουμε και πόσο θα πρέπει να απασχολθούμε για να αντλήσουμε αυτούς τους πελάτες. Το μοντέλο LightGBM προβλέπει 49 δυνητικούς πελάτες - άρα οι οχλήσεις είναι αρκετά μειωμένες σε σχέση με αυτές τις λογιστικής παλινδρόμησης που προσεγγίζουν τις 500.
Αναφορές
Αναφορά
@online{2022,
author = {, stesiam},
title = {Εντοπίζοντας πιθανούς ενδιαφερόμενους πελάτες},
date = {2022-11-24},
url = {https://stesiam.com/el/posts/predict-possible-clients/},
langid = {el}
}