Εισαγωγή
Σε αυτό το άρθρο θα κατασκευάσω ένα μοντέλο μηχανικής μάθησης για να προβλέψω ποιοι από τους πελάτες μίας τράπεζας ενδιαφέρονται να ανοίξουν έναν λογαριασμό προθεσμικής κατάθεσης. Για το σκοπό αυτό θα χρησιμοποιήσουμε μοντέλα 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, 2024), και τη μορφοποίηση αυτών με το 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
η οποία χρησιμοποιείται για τη κατασκευή κυκλικών διαγραμμάτων για τις ποιοτικές μεταβλητές μου.
Δείξε τον κώδικα
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 = "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
)
)
)
)
)
)
Τα παραπάνω αποτελέσματα ίσως να ήταν αναμενόμενα ως ένα βαθμό εξετάζοντας τη δυνητική οικονομική κατάσταση κάποιου. Υπάρχουν όμως και μεταβλητές υπό εξέταση στις οποίες η απάντηση δεν είναι προφανής, όπως στην οικογενειακή κατάσταση. Στο σχήμα, εξετάζεται η σημαντικά μεγαλύτερη αναλογικά συμμετοχή ατόμων που είναι μόνοι τους (είτε ως ανύπαντροι είτε ως διαζευγμένοι), έχοντας σημαντική απόκλιση από την αντίστοιχη απόκριση ατόμων που έχουν παντρευτεί.
Δείξε τον κώδικα
`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.
Δεδομένα εκπαίδευσης
Δείξε τον κώδικα
reactable(
head(bank_train, 5),
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"
)
)
)
Δεδομένα αξιολόγησης
Δείξε τον κώδικα
reactable(
head(bank_test, 5),
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"
)
)
)
Επεξεργασία δεδομένων
Βέβαια η κατασκευή των μοντέλων δεν είναι τόσο εύκολη υπόθεση. Ανάμεσα στο διαχωρισμό του συνόλου δεδομένων και τη κατασκευή των μοντέλων παρεμβάλεται η επεξεργασία των δεδομένων. Τα βήματα αυτού του σταδίου δεν είναι δεδομένα και ποικίλουν αναλόγως το είδος του προβλήματος (ταξινόμησης ή πρόβλεψης τιμής) αλλά και το ποιο μοντέλο θα επιλέξω. Ευτυχώς, για εμάς το πακέτο tidymodels
προσφέρει έτοιμες εντολές προκειμένου να κάνει ανάλυσή μας ευκολότερη και ιδιαίτερα εντολές του πακέτου recipes, που αποτελούν μέρος του tidymodels μπορούν να φανούν ιδιαίτερα χρήσιμες σε αυτό το στάδιο. Βέβαια, υπάρχουν και άλλα πακέτα που συμπληρώνουν - λύνουν συνήθη προβλήματα στα δεδομένα. Για παράδειγμα, στα δεδομένα μας αναμένεται και είδαμε και στο παραπάνω σχήμα ότι οι περισσότεροι δεν επιθυμούν να ανοίξουν προθεσμιακό λογιαριασμό. Τα δεδομένα μας χαρακτηρίζονται ως ανισσόροπα (imbalanced) όταν η μεταβλητή την οποία προσπαθώ να προβλέψω δεν έχω επαρκείς τιμές αλλά αρκετά μεγάλη διαφορά (90% δεν επιθυμούν / 10%) Σε αυτή τη περίπτωση μπορώ να χρησιμοποιήσω την εντολή step_smote()
από το πακέτο themis, προκειμένου να ισορροπήσω τη μεταβλητή που προσπαθώ να προβλέψω.
Δείξε τον κώδικα
bank_recipe <- recipes::recipe(y~.,
data = bank_train) %>%
step_rm(poutcome, ID) %>%
step_corr(all_numeric(), threshold = 0.75) %>%
step_dummy(all_nominal(), -all_outcomes()) %>%
step_smote(y)
Ας ρίξουμε τώρα μία ματιά στο σύνολο δεδομένων, αφού κάναμε κάποια βασική επεξεργασία των δεδομένων:
Δείξε τον κώδικα
bank_recipe %>%
prep() %>%
juice() %>%
head() %>%
reactable(.,
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"
)
)
)
recipes
Διασταυρωμένη επικύρωση
Οκ, ήρθε η ώρα να κατασκευάσουμε το μοντέλο μας;
Όχι τόσο γρήγορα. Θεωρητικά θα μπορούσαμε να συνεχίσουμε, ωστόσο η ενδεδειγμένη μέθοδος είναι να μην λαμβάνω απλώς δύο μέρη καθώς η περαιτέρω αξιολογηση βασίζεται ως επί το πλείστον στο πώς έγινε ο διαχωρισμός και ποιες τιμές λήφθηκαν. Για να έχουμε μία πιο ακριβή εκτίμηση της απόδοσης του μοντέλου προτείνετε να κατασκευάσουμε υποσύνολα των δεδομένων μου με σκοπό να βρω τις παραμέτρους οι οποίες οδηγούν συστηματικά, κατά μέσο όρο σε 5 ή 10 υπό-δείγματα σε καλύτερη ακρίβεια.
Δείξε τον κώδικα
#cv_folds <- vfold_cv(v = 5, strata = y)
Κατασκευάζοντας το μοντέλο μου
Στη συνέχεια, με το πακέτο parsnip μπορώ να ορίσω τα χαρακτηριστικά των διάφορων μοντέλων που θέλω να κατασκευάσω. Στη συγκεκριμένη περίπτωση θα ήθελα να ελέγξω διάφορα μοντέλα και αν ελέγξω την απόδοσή τους. Επομένως, θα ορίσω μοντέλα:
- k Κοντινότερων Γειτόνων (k - Nearest Neighbors)
- Λογιστική Παλινδρόμηση (Logistic Regression)
- Ταξινόμηση Naive Bayes
- Τυχαίου δάσους (Random Forest)
- LightGBM
Next, parsnip helps us to specify our models. Initially, I will define a LightGBM model,
Δείξε τον κώδικα
lightgbm_model<- parsnip::boost_tree(
mode = "classification",
trees = 50,
min_n = tune(),
learn_rate = tune(),
tree_depth = tune()) %>%
set_engine("lightgbm")
Αναφορές
Αναφορά
@online{2022,
author = {, stesiam},
title = {Εντοπίζοντας πιθανούς ενδιαφερόμενους πελάτες},
date = {2022-11-24},
url = {https://stesiam.com/el/posts/predict-possible-clients/},
langid = {el}
}