Εντοπίζοντας πιθανούς ενδιαφερόμενους πελάτες

Εισαγωγή

Σε αυτό το άρθρο κατασκευάζουμε ένα μοντέλο μηχανικής μάθησης με στόχο την πρόβλεψη των πελατών μίας τράπεζας που ενδιαφέρονται να ανοίξουν λογαριασμό προθεσμιακής κατάθεσης. Για τον σκοπό αυτό συγκρίνουμε επτά αλγορίθμους ταξινόμησης, με έμφαση στα μοντέλα 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) που δίνει τη δυνατότητα διαγραμμάτων φιλικό για όλους τους τύπους των οθονών. Τέλος, αυτή η ανάλυση έχει ως στόχο να κατηγοριοποιήσει τους πελάτες της τράπεζας με βάση το ενδιαφέρον τους ή μη σε κάποιο τραπεζικό προϊόν, επομένως η χρήση του πακέτου tidymodels (Kuhn & Wickham, 2025) κρίνεται απαραίτητη, αφού θα χρειαστεί ένα μοντέλο ταξινόμησης.

Φόρτωση βιβλιοθηκών

# Γενική επεξεργασία δεδομένων
library(readr)
library(dplyr)
library(forcats)
library(tidyr)
library(glue)

# Παρουσίαση αποτελεσμάτων
library(kableExtra)
library(reactable)
library(gt)

# Διαδραστικά διαγράμματα
library(highcharter)

# Μοντέλα μηχανικής μάθησης
library(tidymodels)
library(bonsai)    # LightGBM μέσω tidymodels
library(themis)    # SMOTE για ανισόρροπα δεδομένα
library(stacks)    # Ensemble stacking
library(probably)
library(discrim)

# Επιμέρους αλγόριθμοι
library(kknn)
library(ranger)
library(naivebayes)
library(kernlab)
library(vip)       # Σπουδαιότητα μεταβλητών

Εισαγωγή δεδομένων

Αφού φορτώσουμε τις αναγκαίες βιβλιοθήκες, θα πρέπει να εισάγουμε και τα δεδομένα μας. Υπάρχουν αρκετές εκδόσεις των ίδιων δεδομένων, μία μεγαλύτερη και μία πιο συνοπτική έκδοση, η διαφορά τους έγκειται μόνο στον αριθμό των παρατηρήσεων. Για το συγκεκριμένο άρθρο θα επιλέξω την πιο συνοπτική μορφή μιας και η προσαρμογή 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")

Προεπισκόπηση δεδομένων

Παρακάτω παρουσιάζεται ένα μικρό δείγμα του συνόλου δεδομένων (οι πρώτες 6 παρατηρήσεις), ώστε να κατανοήσουμε τη δομή του και τον τύπο των μεταβλητών.

Δείξε τον κώδικα

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

Πίνακας 1: Προεπισκόπηση δεδομένων (πρώτες 6 παρατηρήσεις)

Προτού κάνουμε οποιαδήποτε ανάλυση είναι καλό να προσδιορίσουμε το τύπο των δεδομένων που έχουμε διαθέσιμα. Ως επί το πλείστον αυτό μπορούμε να το μάθουμε κοιτώντας τις τιμές που λαμβάνει μία μεταβλητή. Γενικότερα, οι μεταβλητές μπορούν να ταξινομηθούν με βάση τις τιμές που λαμβάνουν ως εξής:

graph TD;
  A(Τύπος μεταβλητών) --> B(Ποσοτική)
  A(Τύπος μεταβλητών) --> C(Ποιοτική)
  B --> D(Διακριτή)
  B --> E(Συνεχής)
  C --> J(Κατηγορική)
  C --> G(Διατάξιμη)

Σχήμα 1: Κατηγοριοποίηση μεταβλητής με βάση τις τιμές της

Πίνακας 2: Σύνοψη μεταβλητών δεδομένων

Μεταβλητή	Τύπος μεταβλητής	Περιγραφή
`Age`	ποσοτική (συνεχής)	Ηλικία ατόμου
`Job`	ποιοτική (κατηγορική)	Κλάδος απασχόλησης ατόμου
`Marital`	ποιοτική (κατηγορική)	Οικογενειακή κατάσταση
`Education`	ποιοτική (διατάξιμη)	Υψηλότερη βαθμίδα εκπαίδευσης
`Default`	ποιοτική (κατηγορική)	Έχει αθέτηση πιστωτικών υποχρεώσεων;
`Balance`	ποσοτική (συνεχής)	Μέσο ετήσιο υπόλοιπο λογαριασμού (σε €)
`Housing`	ποιοτική (κατηγορική)	Έχει στεγαστικό δάνειο;
`Loan`	ποιοτική (κατηγορική)	Έχει προσωπικό δάνειο;
`Contact`	ποιοτική (κατηγορική)	Μέσο επικοινωνίας
`Month`	ποιοτική (διατάξιμη)	Μήνας πιο πρόσφατης προσέγγισης
`Duration`	ποσοτική (συνεχής)	Διάρκεια (σε δευτερόλεπτα) τελευταίας επικοινωνίας
`Campaign`	ποσοτική	Αριθμός προσεγγίσεων σε ένα άτομο
`pdays`	ποσοτική	Αριθμός ημερών που μεσολάβησαν από τελευταία ενημέρωση
`pprevious`	ποσοτική	Αριθμός προσεγγίσεων του πελάτη
`poutcome`	ποιοτική (nominal)	Αποτέλεσμα προηγούμενης προωθητικής καμπάνιας
`Deposit`	ποιοτική (nominal)	Ο πελάτης άνοιξε προθεσμιακό λογαριασμό;

Το δείγμα μας αποτελείται από 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)
}

univariateQualitative <- function(data, column) {

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

 
  return(freq_table)
}

Αντίστοιχα, θα ορίσουμε και τη συνάρτηση univariateQuantitativePlot για την κατασκευή ραβδογραμμάτων για τις ποσοτικές μεταβλητές μας. Και οι δύο συναρτήσεις βασίζονται και κατασκευάζουν διαγράμματα χρησιμοποιώντας το πακέτο highcharter.

Περιγραφική Ανάλυση

Ελλειπούσες τιμές

Δείξε τον κώδικα

how_many_nas = sum(is.na(bank_dataset))

Στο δοσμένο σύνολο υπάρχουν συνολικά 0 ελλειπούσες τιμές. Αυτή βέβαια είναι μία σπάνια - ιδανική περίπτωση. Διαφορετικά, θα έπρεπε να γεμίσουμε τις κενές τιμές με κάποια μέθοδο εκτίμησης.

Μονομεταβλητή ανάλυση

Στη συνέχεια είναι σημαντικό να μελετήσουμε τις μεταβλητές μας, τις τιμές τους και τις κατανομές αυτών. Είναι ένα σημαντικό κομμάτι ώστε να κατανοήσουμε το δείγμα και να λάβουμε παραπάνω παραμέτρους υπόψιν μας στην κατασκευή του μοντέλου.

Όσον αφορά τον κλάδο της εργασίας, στο δείγμα παρατηρείται μία σημαντική συμμετοχή ατόμων με εργασίες που πιθανότατα συνδυάζονται με υψηλότερες σπουδές και συνεπακόλουθα υψηλότερες απολαβές, όπως τα διευθυντικά στελέχη, διοικητικοί υπάλληλοι, επιχειρηματίες κτλ. Περίπου το 40% των πελατών της τράπεζας απασχολούνται σε εργασίες «μπλε κολάρου» οι οποίες τις περισσότερες φορές συνδυάζονται με μειωμένη διάθεση δέσμευσης κεφαλαίου. Τέλος, στο πελατολόγιο της τράπεζας υπάρχει ένα ποσοστό περί το 10% που αφορά ομάδες πληθυσμού που για διάφορους λόγους δεν τους συμφέρει να δημιουργήσουν ένα τέτοιο λογαριασμό, όπως οι άνεργοι, οι σπουδαστές οι οποίοι βρίσκονται σε ευάλωτη περίοδο με αυξημένα έξοδα και περιορισμένες πηγές εισοδήματος καθώς και οι συνταξιούχοι που με τη σειρά τους θα χρειαστούν να καλύψουν έκτακτες ανάγκες σε παροχές υγείας. Ειδικά για τους τελευταίους που αποτελούν το 5% των πελατών της τράπεζας, υπάρχουν άλλα χρηματοδοτικά εργαλεία αν θέλουν να εξασφαλίσουν τα γηρατειά τους, όπως τα αντίστροφα στεγαστικά δάνεια.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, job, 
                          title = "Τομέας απασχόλησης του ερωτώμενων", 
                          subtitle = "Καθαρός αριθμός και ποσοστό (%) επί όλων των πελατών")

Σχήμα 2: Ραβδόγραμμα κλάδων απασχόλησης πελατών της τράπεζας

Πίνακας 3: Κλάδος απασχόλησης πελατών της τράπεζας

Επάγγελμα	Συχνότητα	Ποσοστό
διευθυντικό στέλεχος	969	21.4
χειρονακτική εργασία	946	20.9
τεχνικός	768	17.0
διοικητική εργασία	478	10.6
παροχή υπηρεσιών	417	9.2
συνταξιούχος	230	5.1
αυτοαπασχολούμενος	183	4.0
επιχειρηματίας	168	3.7
άνεργος	128	2.8
οικιακός βοηθός	112	2.5
σπουδαστής	84	1.9
άγνωστο	38	0.8

Άλλο ένα διαθέσιμο στοιχείο είναι η οικογενειακή κατάσταση η οποία μπορεί να συνδέεται με αυξημένες ανάγκες και έξοδα για το νοικοκυριό. Ενδεχομένως, ένας πελάτης που είναι παντρεμένος/η να έχει αυξημένα έξοδα για το νοικοκυριό του (π.χ. λόγω παιδιών). Άλλη μία οπτική θα ήταν ότι τα παντρεμένα άτομα ενδέχεται να έχουν μεγαλύτερη οικονομική σταθερότητα. Γενικά, δεν είναι ξεκάθαρη εκ των προτέρων η ερμηνεία του συγκεκριμένου δείκτη. Σε κάθε περίπτωση στο υπό εξέταση δείγμα έχουμε περί το 60% των ατόμων που είναι παντρεμένοι, το ένα τέταρτο των πελατών είναι ανύπαντροι και οι υπόλοιποι είναι διαζευγμένοι.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, marital, 
                          title = "Ποια είναι η οικογενειακή σου κατάσταση;", 
                          subtitle = "Οι περισσότεροι είναι παντρεμένοι.",
                          "pie")

Σχήμα 3: Κυκλικό διάγραμμα οικογενειακής κατάστασης πελατών τράπεζας

Πίνακας 4: Οικογενειακή κατάσταση πελατών τράπεζας

Οικ. Κατάσταση	Συχνότητα	Ποσοστό
παντρεμένο	2797	61.9
ανύπαντρο	1196	26.5
διαζευγμένο	528	11.7

Ένας δείκτης που, τουλάχιστον διαισθητικά, μπορεί να είναι από τους πιο σημαντικούς είναι το ανώτατο επίπεδο εκπαίδευσης του πελάτη. Είναι λογικό κάποιος που έχει υψηλότερου επιπέδου σπουδές να έχει τη δυνατότητα να απασχοληθεί σε εργασίες που απαιτούν εξειδίκευση η οποία να πληρώνεται αντίστοιχα της μειωμένης προσφοράς. Άρα έμμεσα μπορεί να καθορίσει τις επαγγελματικές δυνατότητες του ενδιαφερόμενου και συνεπακόλουθα το μισθό που θα μπορεί να διεκδικεί και το ποσό που περισσεύσει για αποταμίευση. Στο συγκεκριμένο σύνολο μόλις το 30% έχει πανεπιστημιακή εκπαίδευση.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, 
                          education, 
                          title = "Υψηλότερο επίπεδο εκπαίδευσης",
                          subtitle = "")

Σχήμα 4: Ραβδόγραμμα εκπαιδευτικού υποβάθρου πελατών τράπεζας

Πίνακας 5: Επίπεδο εκπαίδευσης

Οικ. Κατάσταση	Συχνότητα	Ποσοστό
δευτεροβάθμια	2306	51.0
τριτοβάθμια	1350	29.9
πρωτοβάθμια	678	15.0
άγνωστο	187	4.1

Εκτός από τις σπουδές, που αποτελούν ισχυρή ένδειξη, σημαντικό ρόλο διαδραματίζουν και οι υποχρεώσεις του ατόμου. Αυτές μπορούν να διακριθούν μέσα από τρεις μεταβλητές που μας παρέχονται και πιο συγκεκριμένα αν:

ο πελάτης έχει οφειλές
ο πελάτης έχει λάβει στεγαστικό δάνειο
ο πελάτης έχει λάβει προσωπικό - καταναλωτικό δάνειο

Είναι προφανές ότι αν έχει μη εξυπηρετούμενες οφειλές το τελευταίο πράγμα που θα σκεφτεί είναι να κάνει αποταμίευση, αλλά να ξεπληρώσει τα χρέη του. Στο δείγμα μόλις 76 άτομα που αντιστοιχούν στο 1.6% των πελατών εμπίπτουν σε αυτή την κατηγορία, γεγονός που καθιστά λογική την πρόταση για τη συντριπτική πλειοψηφία.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, default, 
                          title = "Έχετε μη εξυπηρετούμενες οφειλές;", 
                          subtitle = "Ποσοστό (%) ατόμων που δεν έχουν εκπληρώσει τις πιστωτικές τους υποχρεώσεις",  
                          "pie")

Σχήμα 5: Κυκλικό διάγραμμα πελατών τράπεζας αναλόγως του αν εξυπηρετούν τις οφειλές του ή όχι

Πίνακας 6: Πόσοι έχουν οφειλές;

Οικ. Κατάσταση	Συχνότητα	Ποσοστό
όχι	4445	98.3
ναι	76	1.7

Επιπλέον, σημαντικό ποσοστό των πελατών της τράπεζας έχουν ήδη σημαντικές υποχρεώσεις τόσο σε βραχυπρόθεσμο επίπεδο, όσο και μακροπρόθεσμα. Πάνω από τους μισούς έχουν λάβει στεγαστικό δάνειο που σημαίνει μία πάγια σταθερή και σε βάθος χρόνου υποχρέωση η οποία δεν πρέπει να αθετηθεί μιας και πολλές φορές συνδυάζεται με υποθήκη του ακινήτου για το οποίο έλαβε και το δάνειο. Από την άλλη βέβαια θα μπορούσε να θεωρηθεί ότι με αυτόν τον τρόπο έχει προϋπολογίσει το νοικοκυριό το κόστος της στέγασής τους και υπερτερεί της επιλογής του ενοικίου. Αυτό που κατά τη γνώμη μου ίσως να αποτελεί σημαντικότερο παράγοντα άρνησης είναι η λήψη καταναλωτικών δανείων. Αυτά τα δάνεια προορίζονται συνήθως για την κάλυψη βραχυπρόθεσμων - έκτακτων αναγκών και αυτό το χρηματοδοτικό προϊόν είναι διαβόητο για τα υψηλά επιτόκια καθιστώντας το μία ακριβή επιλογή. Η αποπληρωμή του ίσως είναι το πρώτο πράγμα που θα πρέπει να κάνει κάποιος και προφανώς το άνοιγμα ενός προθεσμιακού λογαριασμού δεν είναι λογική επιλογή. Στη δική μας περίπτωση περίπου το 15% έχει λάβει καταναλωτικό δάνειο στοιχείο που είναι ελαφρώς αισιόδοξο, αφού μας επιτρέπει να έχουμε βάσιμες ελπίδες εύρεσης ενδιαφερόμενων στο υπόλοιπο 85%.

Δείξε τον κώδικα

univariateQualitative(bank_dataset, housing) %>%
    rename("Έχει στεγαστικό;" = Variable,
           "Συχνότητα" = Frequency,
           "Ποσοστό" = pct) %>%
    gt_custom(head_max = Inf, use_labels = FALSE)
univariateQualitative(bank_dataset, loan) %>%
    rename("Έχει καταναλωτικό;" = Variable,
           "Συχνότητα" = Frequency,
           "Ποσοστό" = pct) %>%
    gt_custom(head_max = Inf, use_labels = FALSE)

Πίνακας 7: Είδη δανείων που έχουν λάβει πελάτες τράπεζας

(a) Στεγαστικό δάνειο

Έχει στεγαστικό;	Συχνότητα	Ποσοστό
ναι	2559	56.6
όχι	1962	43.4

(b) Καταναλωτικό δάνειο

Έχει καταναλωτικό;	Συχνότητα	Ποσοστό
όχι	3830	84.7
ναι	691	15.3

Ένα άλλο στοιχείο που δίνεται είναι το μέσο επικοινωνίας με τον πελάτη της τράπεζας. Πάνω από τους μισούς (64%) έχουν δηλώσει κινητό τηλέφωνο ως μέσο επικοινωνίας.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, contact, 
                          title = "Μέσο επικοινωνίας", 
                          subtitle = "Η προώθηση μέσω κινητού είναι πιο εκτεταμένη σε σχέση με το σταθερό",
                          "pie")

Σχήμα 6: Κυκλικό διάγραμμα τρόπων προσέγγισης ατόμων - πελατών

Πίνακας 8: Μέσο επικοινωνίας

Τρόπος επικοινωνίας	Συχνότητα	Ποσοστό
κινητό	2896	64.1
άγνωστο	1324	29.3
σταθερό	301	6.7

Άλλη μία ενδιαφέρουσα μεταβλητή είναι ο τελευταίος μήνας στον οποίο προσεγγίστηκε ένας πελάτης. Οι περισσότερες τελευταίες προσεγγίσεις φαίνεται να έγιναν καλοκαιρινούς μήνες. Βέβαια αυτό το στοιχείο θέλει προσοχή στην ερμηνεία του γιατί μπορεί η λήψη των δεδομένων να έγινε π.χ. τον Σεπτέμβριο και τότε να είναι λογικό οι τελευταίες προσεγγίσεις να έγιναν τους καλοκαιρινούς μήνες. Ενδεχομένως να χρειαστεί διμεταβλητή ανάλυση στην επόμενη ενότητα σχετικά με τις επιτυχίες ανά μήνα, προκειμένου να εξεταστεί με μεγαλύτερη ακρίβεια ο συγκεκριμένος δείκτης.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, month, 
                          title = "Προσεγγίσεις ανά μήνα", 
                          subtitle = "(#) Απόλυτος αριθμός επικοινωνίας / προώθησης")

Σχήμα 7: Ραβδόγραμμα προσεγγίσεων ανά μήνα

Σύμφωνα με τα στοιχεία και την περιγραφή αυτών, η τράπεζα θα είχε τρέξει και σε προηγούμενα χρόνια παρόμοιες καμπάνιες ενημέρωσης και προώθησης τραπεζικών προϊόντων και ειδικότερα προθεσμιακών λογαριασμών. Έτσι λοιπόν, έχουμε δεδομένα για όσους είχαν αποδεχτεί άνοιγμα λογαριασμού σε προηγούμενα χρόνια το οποίο μπορεί να είναι βοηθητικό και ενδεχομένως μεγάλο ποσοστό να έχει νόημα να επανεγγραφεί. Ως αποτέλεσμα των προηγούμενων καμπανιών είχαμε 129 ενδιαφερόμενους για κλειστούς λογαριασμούς, ενώ η κατάσταση πολλών είναι άγνωστη για τις προηγούμενες καμπάνιες.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, poutcome, 
                          title = "Ποιο ήταν το αποτέλεσμα προηγούμενης προσέγγισης?", 
                          subtitle = "Για κάθε πέντε αποτυχημένες προσεγγίσεις (αποτυχία ή άλλο), αντιστοιχεί μία επιτυχημένη", "pie")

Σχήμα 8: Κυκλικό διάγραμμα απόκρισης των ατόμων σε προηγούμενες καμπάνιες προώθησης προθεσμιακών λογαριασμών

Εδώ στην ουσία έχουμε το αποτέλεσμα το οποίο προσπαθούμε να προβλέψουμε. Αυτά τα στοιχεία είναι γνωστά από την τωρινή καμπάνια. Με βάση όμως αυτά και τις προηγούμενες μεταβλητές - χαρακτηριστικά θα κατασκευάσουμε ένα μοντέλο πρόβλεψης και αυτά τα μοντέλα θα αξιολογηθούν με βάση αυτά τα δοσμένα αποτελέσματα.

Δείξε τον κώδικα

univariateQualitativePlot(bank_dataset, y, 
                          title = "Πόσοι αποφάσισαν να φτιάξουν προθεσμιακό λογαριασμό;", 
                          subtitle = "Ποσοστό πελατών που αποφάσισαν να ανοίξουν
                          έναν προθεσμιακό λογαριασμό ως αποτέλεσμα της τωρινής καμπάνιας.",
                          "pie")

Σχήμα 9: Κυκλικό διάγραμμα απόκρισης των ατόμων στη τωρινή καμπάνια προώθησης προθεσμιακών λογαριασμών

Οι καταθέτες της τράπεζας είναι κυρίως νεότερης ηλικίας και η συντριπτική πλειοψηφία κάτω των 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)

Σχήμα 10: Ιστόγραμμα κατανομής ηλικιών πελατών τράπεζας

Δείξε τον κώδικα

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
)

Σχήμα 11: Ιστόγραμμα κατανομής ηλικιών πελατών τράπεζας

Άλλο ένα στοιχείο είναι η διάρκεια της κλήσης. Διαισθητικά, αν η κλήση διαρκεί πολύ λίγο εκτιμάται ότι ο πελάτης δεν ενδιαφέρεται. Σε αντίθετη περίπτωση, μία αυξημένη διάδραση μεταξύ του καλούντος εκ μέρους της εταιρείας και του πελάτη πιθανώς να δηλώνει αυξημένο ενδιαφέρον για το τραπεζικό προϊόν.

Δείξε τον κώδικα

hchart(bank_dataset$duration) %>%
    hc_title(text = "Διάρκεια κλήσης") %>%
    hc_subtitle(text = glue("Η μέση διάρκεια κλήσης είναι τα 4.4 λεπτά, ενώ η διάμεση τιμή αυτής είναι τα 3 λεπτά.")) %>%
    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)

Σχήμα 12: Ιστόγραμμα συνολικής διάρκειας κλήσης (σε δευτερόλεπτα)

Δείξε τον κώδικα

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("Πόσες φορές προσεγγίστηκε ο ίδιος πελάτης")) %>%
    hc_caption(text = "Bank Marketing Dataset from UCI") %>%
    hc_legend(enabled = FALSE) %>%
    hc_xAxis(
    title = list(text = "0")
)

Σχήμα 13: Ραβδόγραμμα αριθμού συνολικών προσεγγίσεων - επικοινωνιών που έγιναν σε έναν πελάτη

Πίνακας 9: Αριθμός προσεγγίσεων ανά πελάτη

Προσεγγίσεις (#)	Συχνότητα
1	1734
2	1264
3	558
4	325
5	167
6	155
7	75
8+	243

Διμεταβλητή ανάλυση

Στη προηγούμενη υπο-ενότητα εξετάστηκαν κάποια βασικά περιγραφικά στοιχεία ανά μεταβλητή τα οποία μπορούν να μας δώσουν μία αίσθηση για το πελατολόγιο της τράπεζας. Αν εξετάσουμε αυτά τα στοιχεία από μόνα τους ενδεχομένως να μην επαρκούν για να εξάγουμε επαρκή συμπεράσματα και η διμεταβλητή ανάλυση (σύγκριση δύο μεταβλητών) είναι αναγκαία. Μία προσέγγιση θα ήταν να διερευνήσουμε τη συσχέτιση (ή συνάφεια) μεταξύ των ποσοτικών (ποιοτικών) μεταβλητών. Στην προκειμένη περίπτωση θα είχε επιπλέον όφελος να συγκρίνουμε τις προηγούμενες μεταβλητές με τη μεταβλητή απόκρισης (δηλαδή με την επιθυμία ανοίγματος προθεσμιακού λογαριασμού).

Μία σημαντική σύγκριση είναι ο κλάδος εργασίας του πελάτη με την τελική του απόφαση - ενδιαφέρον. Με το παρακάτω σχήμα δηλώνεται η χαμηλότερη ποσοστιαία ζήτηση ατόμων με χειρονακτική εργασία, ενώ οι συνταξιούχοι είναι αυτή με την υψηλότερη.

Δείξε τον κώδικα

plotjob <- bank_dataset %>%
  group_by(job, y) %>%
  summarize(n = n(), .groups = "drop_last") %>% 
  mutate(pct = round(100*(n/sum(n)), digits = 1),
         lbl = scales::percent(pct)) %>%
  arrange(desc(pct))

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

Σχήμα 14: Ραβδόγραμμα αποτελεσμάτων καμπάνιας ανά επάγγελμα

Πίνακας 10: Αναλογίες επιτυχημένης καμπάνιας ανά επάγγελματική κατηγορία

Επάγγελμα	όχι	ναι
χειρονακτική εργασία	92.7	7.3
επιχειρηματίας	91.1	8.9
παροχή υπηρεσιών	90.9	9.1
άνεργος	89.8	10.2
τεχνικός	89.2	10.8
αυτοαπασχολούμενος	89.1	10.9
διοικητική εργασία	87.9	12.1
οικιακός βοηθός	87.5	12.5
διευθυντικό στέλεχος	86.5	13.5
άγνωστο	81.6	18.4
σπουδαστής	77.4	22.6
συνταξιούχος	76.5	23.5

Τα παραπάνω αποτελέσματα ίσως να ήταν αναμενόμενα ως ένα βαθμό εξετάζοντας τη δυνητική οικονομική κατάσταση κάποιου. Ενδιαφέρον παρουσιάζει η περίπτωση των συνταξιούχων: ενώ αρχικά υποθέσαμε ότι δεν αποτελούν κατάλληλο κοινό λόγω πιθανών έκτακτων αναγκών, τα δεδομένα δείχνουν ότι ανταποκρίνονται θετικά σε μεγαλύτερο ποσοστό. Αυτό μπορεί να εξηγηθεί από το γεγονός ότι πολλοί συνταξιούχοι διαθέτουν ήδη σταθερό εισόδημα χωρίς σημαντικές νέες υποχρεώσεις, καθιστώντας τους κατάλληλους υποψήφιους για δέσμευση κεφαλαίων.

Υπάρχουν όμως και μεταβλητές υπό εξέταση στις οποίες η απάντηση δεν είναι προφανής, όπως στην οικογενειακή κατάσταση. Στο σχήμα, εξετάζεται η σημαντικά μεγαλύτερη αναλογικά συμμετοχή ατόμων που είναι μόνοι τους (είτε ως ανύπαντροι είτε ως διαζευγμένοι), έχοντας σημαντική απόκλιση από την αντίστοιχη απόκριση ατόμων που έχουν παντρευτεί.

Δείξε τον κώδικα

plotmarital <- bank_dataset %>%
  group_by(marital, y) %>%
  summarize(n = n(), .groups = "drop_last") %>% 
  mutate(pct = round(100*(n/sum(n)), digits = 1),
         lbl = scales::percent(pct)) %>%
  arrange(desc(pct))

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 = "Αποκρίσεις ανά οικογενειακή κατάσταση") %>%
  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
            )
          )
        )
      )
    )
)

Σχήμα 15: Ραβδόγραμμα αριθμού συνολικών προσεγγίσεων - επικοινωνιών που έγιναν σε έναν πελάτη

Μία σύνοψη των παραπάνω μπορεί να γίνει και με το παρακάτω διάγραμμα αλληλουχιών. Με την πρώτη στήλη να δηλώνει την κατανομή στις οικογενειακές καταστάσεις συνδυαζόμενες από το εκπαιδευτικό υπόβαθρο των συμμετεχόντων και καταλήγουμε στην τρίτη στήλη που είναι και η τελική απάντηση του πελάτη (αν ενδιαφέρεται να ανοίξει προθεσμιακό λογαριασμό).

Δείξε τον κώδικα

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 = "Οικογενειακή κατάσταση -> Εκπαίδευση -> Έκβαση") %>%
  hc_subtitle(text = "Απεικόνιση της ροής πελατών ανά συνδυασμό δημογραφικών χαρακτηριστικών και τελικής απόφασης") %>%
  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 είναι αρκετά εύκολο στη χρήση, έχουν γραφτεί πολλά άρθρα σχετικά με αυτό όπως οδηγοί, επεξηγηματικά βίντεο - άρθρα. Από την άλλη μεριά, το tidymodels είναι μία «όλα σε ένα» λύση, αφού αποτελεί ένα μεταπακέτο, δηλαδή μία συλλογή πακέτων, που προσπαθεί να δώσει μια ολοκληρωμένη λύση, ωστόσο υπάρχει λιγότερη τεκμηρίωση και άρθρα λόγω του ότι έχει δημιουργηθεί πρόσφατα.

Διαχωρισμός συνόλου δεδομένων

Το πρώτο βήμα είναι να χωρίσουμε το αρχικό σύνολο δεδομένων. Στη συγκεκριμένη ανάλυση χρησιμοποιούμε τριμερή διαχωρισμό:

Training set (bank_train): χρησιμοποιείται για την εκπαίδευση όλων των μοντέλων και τη διασταυρωμένη επικύρωση.
Validation set (bank_val): ένα μικρό τμήμα του training set που κρατάμε κλειστό αποκλειστικά για την επιλογή του βέλτιστου ορίου ταξινόμησης (threshold) του Stack Ensemble.
Test set (bank_test): χρησιμοποιείται μόνο για την τελική αξιολόγηση — δεν το αγγίζουμε σε κανένα άλλο στάδιο.

Δείξε τον κώδικα

set.seed(123)

# Κύριος διαχωρισμός: 75% train, 25% test
bank_dataset_split <- initial_split(bank_dataset,
                                    prop   = 0.75,
                                    strata = y)
bank_trainval <- training(bank_dataset_split)
bank_test     <- testing(bank_dataset_split)

# Δευτερεύων διαχωρισμός: από το trainval παράγουμε
# bank_train (80%) και bank_val (20%)
set.seed(123)
trainval_split <- initial_split(bank_trainval,
                                prop   = 0.80,
                                strata = y)
bank_train <- training(trainval_split)
bank_val   <- testing(trainval_split)

graph TD;
  A(Σύνολο δεδομένων <br> 4521 παρατηρήσεις) --> B(bank_trainval <br> 3390 παρατηρήσεις)
  A --> C(bank_test <br> 1131 παρατηρήσεις)
  B --> D(bank_train <br> 2712 παρατηρήσεις)
  B --> E(bank_val <br> 678 παρατηρήσεις)
  D --> F(Εκπαίδευση μοντέλων)
  D --> G(Cross-validation)
  E --> H(Threshold Stack Ensemble)
  C --> I(Τελική αξιολόγηση)

Σχήμα 16: Τριμερής διαχωρισμός δεδομένων

Το bank_val περιέχει περίπου 678 παρατηρήσεις — αρκετές ώστε να δώσουν αξιόπιστη εκτίμηση του threshold, χωρίς να αφαιρούν σημαντικό μέρος από τα δεδομένα εκπαίδευσης.

Στο δικό μας παράδειγμα, έχουμε όπως αναφέραμε προηγούμενως 4521 παρατηρήσεις. Η πιο συνήθης είναι ο διαχωρισμός να γίνεται σε ένα ποσοστό 75% (80%) για να εκπαιδεύσουμε το μοντέλο μας και το άλλο 25% (20%) για την αξιολόγηση αυτού. Έτσι λοιπόν, καταλήγουμε με δύο νέα υποσύνολα με τον ίδιο αριθμό μεταβλητών, και το σύνολο εκπαίδευσης του μοντέλου αποτελείται από 3390 παρατηρήσεις και το σύνολο για την αξιολόγησή του αποτελείται από 1131.

Δεδομένα εκπαίδευσης

Δείξε τον κώδικα

bank_train %>%
  gt_custom(.)

Πίνακας 11: Προεπισκόπηση υποσυνόλου δεδομένων εκπαίδευσης μοντέλου (train dataset)

Α/Α ID	Ηλικία age	Επάγγελμα job	Οικογενειακή Κατάσταση marital	Εκπαίδευση education	Αθέτηση πληρωμών default	Υπόλοιπο balance	Στεγαστικό δάνειο housing	Προσωπικό δάνειο loan	Τρόπος επικοινωνίας contact	day	Μήνας month	Διάρκεια κλήσης duration	Αριθμός κλήσεων πελάτη campaign	Ημέρες από προηγ. κλήση pdays	NA previous	NA poutcome	NA y
34	32	διευθυντικό στέλεχος	ανύπαντρο	τριτοβάθμια	όχι	2536	ναι	όχι	κινητό	26	Αύγουστο	958	6	-1	0	άγνωστο	ναι
37	78	συνταξιούχος	διαζευγμένο	πρωτοβάθμια	όχι	229	όχι	όχι	σταθερό	22	Οκτώβριο	97	1	-1	0	άγνωστο	ναι
39	33	διευθυντικό στέλεχος	παντρεμένο	δευτεροβάθμια	όχι	3935	ναι	όχι	κινητό	6	Μάιο	765	1	342	2	αποτυχία	ναι
71	37	διευθυντικό στέλεχος	παντρεμένο	τριτοβάθμια	όχι	0	όχι	όχι	κινητό	16	Ιούλιο	268	2	182	3	επιτυχία	ναι
81	27	διοικητική εργασία	διαζευγμένο	δευτεροβάθμια	όχι	451	ναι	όχι	κινητό	16	Ιούλιο	652	1	-1	0	άγνωστο	ναι

Δεδομένα αξιολόγησης

Δείξε τον κώδικα

bank_test %>%
  gt_custom(.)

Πίνακας 12: Προεπισκόπηση υποσυνόλου δεδομένων αξιολόγησης μοντέλου (test dataset)

Α/Α 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)

Αξίζει να σημειωθεί ότι η μεταβλητή duration (διάρκεια κλήσης) αφαιρέθηκε σκοπίμως από τα μοντέλα. Ο λόγος είναι ότι η τιμή αυτής της μεταβλητής γίνεται γνωστή μόνο μετά την ολοκλήρωση της κλήσης, δηλαδή μετά το γεγονός που προσπαθούμε να προβλέψουμε. Αν τη συμπεριλαμβάναμε, θα δημιουργούσαμε πρόβλημα διαρροής δεδομένων (data leakage), καθιστώντας το μοντέλο τεχνητά ακριβές αλλά πρακτικά αχρησιμοποίητο. Επιπλέον αφαιρέθηκε και η μεταβλητή poutcome, καθώς αφορά προηγούμενες καμπάνιες για τις οποίες δεν υπάρχουν επαρκή δεδομένα για τη μεγάλη πλειοψηφία των πελατών.

Ας ρίξουμε τώρα μία ματιά στο σύνολο δεδομένων, αφού κάναμε κάποια βασική επεξεργασία των δεδομένων. Μία προεπισκόπηση των δεδομένων αφότου κάναμε τις απαραίτητες αλλαγές για γραμμικά μοντέλα:

Δείξε τον κώδικα

linear_recipe %>%
  prep() %>%
  juice() %>%
  head() %>%
  gt_custom()

Πίνακας 13: Σύνολο δεδομένων με εφαρμογή των 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
-0.8510	0.3899	1.22811	1.0994	-0.4136	-0.3212	-0.5123	-0.1905	-0.1627	1.9044	-0.2288	-0.2046	-0.32	-0.1299	-0.4578	-0.1698	-0.09644	-1.2707	1.6709	-1.0222	1.5334	-0.2056	-0.1254	0.8887	-0.4201	-0.2674	-0.6421	2.4693	-0.07202	-0.2385	-0.1852	-0.4244	-0.3657	-0.09644	-0.6709	-0.3029	-0.1328	-0.1057	ναι
3.5207	-0.4050	0.74413	-0.5884	-0.4136	-0.3212	-0.5123	-0.1905	-0.1627	-0.5249	4.3683	-0.2046	-0.32	-0.1299	-0.4578	-0.1698	-0.09644	-1.2707	-0.5983	-1.0222	-0.6519	-0.2056	-0.1254	-1.1248	-0.4201	3.7388	-0.6421	-0.4048	-0.07202	-0.2385	-0.1852	-0.4244	-0.3657	-0.09644	-0.6709	-0.3029	7.5287	-0.1057	ναι
-0.7559	0.8720	-1.19179	-0.5884	2.9627	0.8402	-0.5123	-0.1905	-0.1627	1.9044	-0.2288	-0.2046	-0.32	-0.1299	-0.4578	-0.1698	-0.09644	0.7867	-0.5983	0.9779	-0.6519	-0.2056	-0.1254	0.8887	-0.4201	-0.2674	-0.6421	-0.4048	-0.07202	-0.2385	-0.1852	-0.4244	-0.3657	-0.09644	1.4900	-0.3029	-0.1328	-0.1057	ναι
-0.3758	-0.4839	0.01816	-0.2508	1.3877	1.4208	-0.5123	-0.1905	-0.1627	1.9044	-0.2288	-0.2046	-0.32	-0.1299	-0.4578	-0.1698	-0.09644	0.7867	-0.5983	-1.0222	1.5334	-0.2056	-0.1254	-1.1248	-0.4201	-0.2674	-0.6421	-0.4048	-0.07202	-0.2385	-0.1852	2.3556	-0.3657	-0.09644	-0.6709	-0.3029	-0.1328	-0.1057	ναι
-1.3261	-0.3285	0.01816	-0.5884	-0.4136	-0.3212	-0.5123	-0.1905	-0.1627	-0.5249	-0.2288	-0.2046	-0.32	-0.1299	-0.4578	-0.1698	-0.09644	-1.2707	-0.5983	0.9779	-0.6519	-0.2056	-0.1254	0.8887	-0.4201	-0.2674	-0.6421	-0.4048	-0.07202	-0.2385	-0.1852	2.3556	-0.3657	-0.09644	-0.6709	-0.3029	-0.1328	-0.1057	ναι

και προεπισκόπηση των δεδομένων με εφαρμογή των απαραίτητων αλλαγών για μοντέλα δένδρων:

Δείξε τον κώδικα

tree_recipe %>%
  prep() %>%
  juice() %>%
  head() %>%
  gt_custom()

Πίνακας 14: Σύνολο δεδομένων με εφαρμογή των recipes για μοντέλα δένδρων

Ηλικία age	Υπόλοιπο balance	day	Αριθμός κλήσεων πελάτη campaign	Ημέρες από προηγ. κλήση pdays	NA previous	NA job_διευθυντικό.στέλεχος	NA job_συνταξιούχος	NA marital_παντρεμένο	NA marital_ανύπαντρο	NA education_δευτεροβάθμια	NA education_τριτοβάθμια	NA housing_ναι	NA contact_σταθερό	NA month_Αύγουστο	NA month_Ιούλιο	NA month_Μάιο	NA month_Οκτώβριο	NA y
32	2536	26	6	-1	0	1	0	0	1	0	1	1	0	1	0	0	0	ναι
78	229	22	1	-1	0	0	1	0	0	0	0	0	1	0	0	0	1	ναι
33	3935	6	1	342	2	1	0	1	0	1	0	1	0	0	0	1	0	ναι
37	0	16	2	182	3	1	0	1	0	0	1	0	0	0	1	0	0	ναι
27	451	16	1	-1	0	0	0	0	0	1	0	1	0	0	1	0	0	ναι

Διασταυρωμένη επικύρωση

Οκ, ήρθε η ώρα να κατασκευάσουμε το μοντέλο μας;

Όχι τόσο γρήγορα. Θεωρητικά θα μπορούσαμε να συνεχίσουμε, ωστόσο η ενδεδειγμένη μέθοδος είναι να μην λαμβάνουμε απλώς δύο μέρη καθώς η περαιτέρω αξιολογηση βασίζεται ως επί το πλείστον στο πώς έγινε ο διαχωρισμός και ποιες τιμές λήφθηκαν. Για να έχουμε μία πιο ακριβή εκτίμηση της απόδοσης του μοντέλου προτείνεται να κατασκευάσουμε υποσύνολα των δεδομένων μας, ώστε να εκτιμήσουμε την απόδοση του μοντέλου με μεγαλύτερη αξιοπιστία, κατά μέσο όρο σε 5 ή 10 υπό-δείγματα.

Η διασταυρωμένη επικύρωση (cross-validation) είναι μια τεχνική κατά την οποία το σύνολο εκπαίδευσης χωρίζεται σε k ίσα υποσύνολα (folds). Σε κάθε επανάληψη, ένα fold χρησιμοποιείται ως σύνολο αξιολόγησης και τα υπόλοιπα k-1 ως σύνολο εκπαίδευσης. Η διαδικασία επαναλαμβάνεται k φορές και τα αποτελέσματα μετρούνται κατά μέσο όρο, δίνοντάς μας μια πιο αξιόπιστη εκτίμηση της απόδοσης του μοντέλου. Στη δική μας περίπτωση, χρησιμοποιήσαμε 5-fold cross-validation με στρωματοποίηση (stratification) ώστε η αναλογία ενδιαφερόμενων / μη ενδιαφερόμενων να διατηρείται σε κάθε fold.

Δείξε τον κώδικα

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)
Τυχαίο Δάσος (Random Forest)
LightGBM
XGBoost

Το parsnip θα μας βοηθήσει μέσα από ένα ενοποιημένο περιβάλλον να καθορίσουμε τα προβλεπτικά μας μοντέλα. Στο πλαίσιο της ανάλυσης, αναπτύχθηκαν και συγκρίθηκαν επτά διαφορετικά μοντέλα ταξινόμησης χρησιμοποιώντας το οικοσύστημα tidymodels στην R. Συγκεκριμένα, υλοποιήθηκαν τα μοντέλα Λογιστικής Παλινδρόμησης (Logistic Regression), Κοντινότεροι Γείτονες (K-Nearest Neighbors - KNN), Τυχαίο Δάσος (Random Forest), Naive Bayes, SVM, 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")

# --- Naive Bayes ---

nb_model <- naive_Bayes(
  smoothness = tune(),
  Laplace    = tune()
) %>%
  set_engine("naivebayes") %>%
  set_mode("classification")

# --- SVM ---

svm_model <- parsnip::svm_linear(
  cost = tune()
) %>%
  set_engine("kernlab") %>%
  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)
nb_wf  <- workflow() %>% add_recipe(linear_recipe) %>% add_model(nb_model)
svm_wf <- workflow() %>% add_recipe(linear_recipe) %>% add_model(svm_model)
xgb_wf  <- workflow() %>% add_recipe(tree_recipe)   %>% add_model(xgb_model)
lgbm_wf <- workflow() %>% add_recipe(tree_recipe)   %>% add_model(lgbm_model)

Εφαρμόζοντας τα μοντέλα

Αφού ορίσαμε τα μοντέλα και τις αντίστοιχες ροές εργασίας (workflows), προχωρούμε στη βελτιστοποίηση των υπερπαραμέτρων τους. Για τα απλούστερα μοντέλα (Λογιστική Παλινδρόμηση, KNN, Naive Bayes, SVM και Random Forest) χρησιμοποιούμε αναζήτηση πλέγματος (tune_grid()), όπου δοκιμάζονται συστηματικά διάφοροι συνδυασμοί υπερπαραμέτρων. Για τα μοντέλα gradient boosting (XGBoost και LightGBM), τα οποία διαθέτουν περισσότερες υπερπαραμέτρους και κάθε εκτέλεσή τους είναι υπολογιστικά ακριβότερη, επιλέγω Μπεϋζιανή βελτιστοποίηση (tune_bayes()). Σε αυτήν την προσέγγιση, ο αλγόριθμος «μαθαίνει» από τις προηγούμενες δοκιμές και επιλέγει πιο στοχευμένα τον επόμενο συνδυασμό παραμέτρων, εξοικονομώντας χρόνο σε σχέση με την εξαντλητική αναζήτηση.

Δείξε τον κώδικα

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
)

nb_results <- tune_grid(
  nb_wf,
  resamples = cv_folds,
  grid      = 10,
  metrics   = metric_set(roc_auc, accuracy),
  control   = ctrl_grid
)

svm_results <- tune_grid(
  svm_wf,
  resamples = cv_folds,
  grid      = 10,
  metrics   = metric_set(roc_auc, accuracy),
  control   = ctrl_grid
)

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

Πέρα από τη μεμονωμένη αξιολόγηση κάθε μοντέλου, εφαρμόζουμε και μια τεχνική που ονομάζεται stacking. Η ιδέα πίσω από το stacking είναι ότι αντί να επιλέξουμε ένα μόνο μοντέλο ως τελικό, συνδυάζουμε τις προβλέψεις πολλών μοντέλων σε ένα μετα-μοντέλο που μαθαίνει ποιο αποδίδει καλύτερα και σε ποιες περιπτώσεις. Στην πράξη, τα μοντέλα που εκπαιδεύσαμε προηγουμένως (Λογιστική Παλινδρόμηση, KNN, Random Forest, XGBoost, LightGBM) τροφοδοτούν τις προβλέψεις τους σε ένα δεύτερο επίπεδο, όπου ένα γραμμικό μοντέλο με L1 κανονικοποίηση αναλαμβάνει να καθορίσει το βάρος που θα δοθεί στο κάθε ένα ή ακόμα και να το αποκλείσει εντελώς αν δεν συνεισφέρει. Με αυτόν τον τρόπο αξιοποιούμε τα πλεονεκτήματα κάθε αλγορίθμου χωρίς να δεσμευόμαστε σε μία μόνο προσέγγιση. Για την υλοποίηση αυτής της τεχνικής χρησιμοποιώ το πακέτο stacks, το οποίο ενσωματώνεται ομαλά στο οικοσύστημα tidymodels.

Δείξε τον κώδικα

bank_stack_v1 <- stacks() %>%
  add_candidates(log_results)  %>%
  add_candidates(knn_results)  %>%
  add_candidates(rf_results)   %>%
  add_candidates(xgb_results)  %>%
  add_candidates(lgbm_results)

bank_stack_v2 <- bank_stack_v1 %>%
    add_candidates(nb_results)   %>%
    add_candidates(svm_results)

# Υπολογισμός βαρών για κάθε μοντέλο
set.seed(123)
bank_stack_model_v1 <- bank_stack_v1 %>%
  blend_predictions(
    penalty = 10^(-2:0),       # L1 regularization για επιλογή μοντέλων
    metric  = metric_set(roc_auc)
  )

bank_stack_model_v2 <- bank_stack_v2 %>%
  blend_predictions(
    penalty = 10^(-2:0),       # L1 regularization για επιλογή μοντέλων
    metric  = metric_set(roc_auc)
  )

# Εκπαίδευση των επιλεγμένων μοντέλων
bank_stack_fit_v1 <- bank_stack_model_v1 %>%
  fit_members()

bank_stack_fit_v2 <- bank_stack_model_v2 %>%
  fit_members()

Σημείωση

Σημείωση για το threshold του Stack Ensemble

Σε αντίθεση με τα μεμονωμένα μοντέλα (LightGBM, XGBoost, Λογιστική Παλινδρόμηση) για τα οποία μπορούμε να αντλήσουμε out-of-fold προβλέψεις από τη διασταυρωμένη επικύρωση, το Stack Ensemble δεν διαθέτει αντίστοιχες προβλέψεις. Για τον λόγο αυτό δημιουργήσαμε νωρίτερα το bank_val που αποτελεί ένα υποσύνολο του train set, που το μοντέλο δεν έχει δει κατά την εκπαίδευση και χρησιμοποιείται αποκλειστικά για την επιλογή του threshold στην επόμενη ενότητα.

Επιλογή threshold

Κάθε μοντέλο παράγει για κάθε πελάτη μία πιθανότητα ενδιαφέροντος — όχι απευθείας μία απόφαση. Για να περάσουμε από την πιθανότητα στην ταξινόμηση («ναι» / «όχι») χρειαζόμαστε ένα όριο (threshold): αν η πιθανότητα ξεπεράσει αυτό το όριο, ο πελάτης κατατάσσεται ως ενδιαφερόμενος.

Η προεπιλεγμένη τιμή 0.5 σπάνια είναι η βέλτιστη επιλογή σε ανισόρροπα δεδομένα — στη δική μας περίπτωση μόλις το 11% των πελατών ανήκει στην κατηγορία «ναι». Αντί αυτού, επιλέγουμε το threshold που μεγιστοποιεί το F1, το οποίο ισορροπεί την ικανότητα εντοπισμού ενδιαφερόμενων (recall) με την αξιοπιστία των θετικών προβλέψεων (precision).

Ένα συνηθισμένο λάθος είναι να βρίσκει κανείς το threshold πάνω στο ίδιο test set που χρησιμοποιεί για την τελική αξιολόγηση. Με αυτόν τον τρόπο το μοντέλο «βλέπει» έμμεσα τα δεδομένα αξιολόγησης, οδηγώντας σε αισιόδοξα αποτελέσματα που δεν αντικατοπτρίζουν την πραγματική απόδοση. Για να αποφύγουμε αυτό ακολουθούμε διαφορετική προσέγγιση ανάλογα με το μοντέλο:

Για τα individual μοντέλα (LightGBM, XGBoost, Λογιστική Παλινδρόμηση) χρησιμοποιούμε τις out-of-fold (OOF) προβλέψεις από τη διασταυρωμένη επικύρωση. Σε κάθε fold, οι προβλέψεις γίνονται από μοντέλο που δεν έχει δει τις συγκεκριμένες παρατηρήσεις — άρα οι προβλέψεις είναι αμερόληπτες.
Για το Stack Ensemble χρησιμοποιούμε το bank_val, το οποίο δεσμεύσαμε από την αρχή αποκλειστικά για αυτόν τον σκοπό.

Δείξε τον κώδικα

# Βοηθητική συνάρτηση: βρίσκει threshold από OOF predictions
get_oof_threshold <- function(tune_results, model_name) {
  
  best_params <- select_best(tune_results, metric = "roc_auc")
  
  oof_preds <- tune_results %>%
    collect_predictions(
      summarize  = FALSE,
      parameters = best_params
    )
  
  # Δυναμικό upper bound: μέχρι το 95% της μέγιστης πιθανότητας
  # Αποφεύγουμε τιμές threshold όπου κανείς δεν προβλέπεται ως "ναι"
  upper_bound <- max(oof_preds$.pred_ναι, na.rm = TRUE) * 0.95
  
  oof_preds %>%
    threshold_perf(
      truth      = y,
      estimate   = .pred_ναι,
      thresholds = seq(0.005, upper_bound, length.out = 200),
      event_level = "second",
      metrics    = metric_set(f_meas)
    ) %>%
    filter(.metric == "f_meas", !is.na(.estimate)) %>%
    slice_max(.estimate, n = 1, with_ties = FALSE) %>%
    transmute(
      model     = model_name,
      threshold = .threshold,
      f1_oof    = round(.estimate, 3)
    )
}

thresholds_individual <- bind_rows(
  get_oof_threshold(lgbm_results, "LightGBM"),
  get_oof_threshold(xgb_results,  "XGBoost"),
  get_oof_threshold(log_results,  "Λογιστική Παλινδρόμηση"),
  get_oof_threshold(rf_results, "Random Forest"),
  get_oof_threshold(nb_results, "Naive Bayes"),
  get_oof_threshold(svm_results, "SVM")
)

# Προβλέψεις στο bank_val — το stack δεν το έχει δει
## Για πρώτο stack
stack_val_preds_v1 <- predict(bank_stack_fit_v1,
                           bank_val,
                           type = "prob") %>%
  bind_cols(bank_val %>% select(y))

upper_bound_stack_v1 <- max(stack_val_preds_v1$.pred_ναι, 
                         na.rm = TRUE) * 0.95

## Για δεύτερο stack

stack_val_preds_v2 <- predict(bank_stack_fit_v2,
                           bank_val,
                           type = "prob") %>%
  bind_cols(bank_val %>% select(y))

upper_bound_stack_v2 <- max(stack_val_preds_v2$.pred_ναι, 
                         na.rm = TRUE) * 0.95

stack_threshold_v1 <- stack_val_preds_v1 %>%
  threshold_perf(
    truth      = y,
    estimate   = .pred_ναι,
    thresholds = seq(0.005, upper_bound_stack_v1, length.out = 200),
    event_level = "second",
    metrics    = metric_set(f_meas)
  ) %>%
  filter(.metric == "f_meas", !is.na(.estimate)) %>%
  slice_max(.estimate, n = 1, with_ties = FALSE) %>%
  transmute(
    model     = "Stack Ensemble (v1)",
    threshold = .threshold,
    f1_oof    = round(.estimate, 3)
  )

stack_threshold_v2 <- stack_val_preds_v2 %>%
  threshold_perf(
    truth      = y,
    estimate   = .pred_ναι,
    thresholds = seq(0.005, upper_bound_stack_v2, length.out = 200),
    event_level = "second",
    metrics    = metric_set(f_meas)
  ) %>%
  filter(.metric == "f_meas", !is.na(.estimate)) %>%
  slice_max(.estimate, n = 1, with_ties = FALSE) %>%
  transmute(
    model     = "Stack Ensemble (v2)",
    threshold = .threshold,
    f1_oof    = round(.estimate, 3)
  )

all_thresholds <- bind_rows(thresholds_individual,
                            stack_threshold_v1,
                            stack_threshold_v2)

all_thresholds %>%
  arrange(desc(f1_oof)) %>%
  rename(
    "Μοντέλο"       = model,
    "Threshold"     = threshold,
    "F1 (εκτίμηση)" = f1_oof
  ) %>%
  gt_custom(head_max = Inf, use_labels = FALSE)

Πίνακας 15: Βέλτιστο threshold ανά μοντέλο

Μοντέλο	Threshold	F1 (εκτίμηση)
Stack Ensemble (v2)	0.2037	0.433
Stack Ensemble (v1)	0.1827	0.416
Random Forest	0.2777	0.360
LightGBM	0.2255	0.358
XGBoost	0.1967	0.353
SVM	0.6187	0.319
Naive Bayes	0.6033	0.306
Λογιστική Παλινδρόμηση	0.5856	0.293

Αξίζει να σημειωθεί ότι τα thresholds διαφέρουν σημαντικά μεταξύ των μοντέλων. Αυτό δεν σημαίνει ότι κάποιο μοντέλο είναι «λάθος» — απλώς κάθε μοντέλο βαθμονομεί διαφορετικά τις πιθανότητές του. Το σημαντικό είναι ότι κάθε threshold βρέθηκε σε δεδομένα που το αντίστοιχο μοντέλο δεν είχε χρησιμοποιήσει κατά την εκπαίδευση. Επιπροσθέτως, οι τιμές F1 στον παραπάνω πίνακα αποτελούν εκτιμήσεις που χρησιμοποιήθηκαν για την επιλογή threshold και δεν είναι άμεσα συγκρίσιμες μεταξύ τους. Τα μεμονωμένα μοντέλα χρησιμοποίησαν OOF predictions (2712 παρατηρήσεις) ενώ το συνδυαστικό (Stack Ensemble) χρησιμοποίησε το bank_val (678 παρατηρήσεις). Η οριστική σύγκριση γίνεται στο test set που ακολουθεί.

Αποτελέσματα

Δείξε τον κώδικα

# Ορισμός βοηθητικής συνάρτησης για παραγωγή προβλέψεων
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)
}

# Επιλογή βέλτιστων υπερπαραμέτρων για κάθε μοντέλο
best_lgbm <- select_best(lgbm_results, metric = "roc_auc")
best_lr   <- select_best(log_results,  metric = "roc_auc")
best_xgb  <- select_best(xgb_results,  metric = "roc_auc")
best_rf  <- select_best(rf_results,  metric = "roc_auc")
best_nb  <- select_best(nb_results,  metric = "roc_auc")
best_svm  <- select_best(svm_results,  metric = "roc_auc")

# Finalize και εκπαίδευση στο πλήρες train set
final_lgbm_wf <- finalize_workflow(lgbm_wf, best_lgbm) %>% fit(data = bank_train)
final_lr_wf   <- finalize_workflow(log_wf,  best_lr)   %>% fit(data = bank_train)
final_xgb_wf  <- finalize_workflow(xgb_wf,  best_xgb)  %>% fit(data = bank_train)
final_rf_wf  <- finalize_workflow(rf_wf,  best_rf)  %>% fit(data = bank_train)
final_nb_wf  <- finalize_workflow(nb_wf,  best_nb)  %>% fit(data = bank_train)
final_svm_wf  <- finalize_workflow(svm_wf,  best_svm)  %>% fit(data = bank_train)

stack_preds_v1 <- predict(bank_stack_fit_v1, bank_test, type = "prob") %>%
  bind_cols(predict(bank_stack_fit_v1, bank_test)) %>%
  bind_cols(bank_test %>% select(y)) %>%
  mutate(model = "Stack Ensemble (v1)")

stack_preds_v2 <- predict(bank_stack_fit_v2, bank_test, type = "prob") %>%
  bind_cols(predict(bank_stack_fit_v2, bank_test)) %>%
  bind_cols(bank_test %>% select(y)) %>%
  mutate(model = "Stack Ensemble (v2)")

# Παραγωγή προβλέψεων στο test set για όλα τα μοντέλα
all_preds <- bind_rows(
  get_preds(final_lgbm_wf, "LightGBM"),
  get_preds(final_lr_wf,   "Λογιστική Παλινδρόμηση"),
  get_preds(final_xgb_wf,  "XGBoost"),
  get_preds(final_rf_wf, "Random Forest"),
  get_preds(final_nb_wf, "Naive Bayes"),
  get_preds(final_svm_wf, "SVM"),
  stack_preds_v1,
  stack_preds_v2
)

Σπουδαιότητα μεταβλητών

Από την ανάλυση σπουδαιότητας μεταβλητών του μοντέλου LightGBM προκύπτει ότι οι πιο καθοριστικοί παράγοντες για την πρόβλεψη ενδιαφέροντος σε προθεσμιακό λογαριασμό είναι η ύπαρξη στεγαστικού δανείου (housing_ναι, 15.3%) και ο άγνωστος τρόπος επικοινωνίας (contact_άγνωστο, 14.0%), με την οικογενειακή κατάσταση “παντρεμένος” να ακολουθεί (marital_παντρεμένο, 11.7%). Αξιοσημείωτη είναι και η συμβολή του μήνα επικοινωνίας, με τον Μάιο να εμφανίζεται ως ο πιο σημαντικός μήνας (8.2%), ενώ το επίπεδο εκπαίδευσης συμμετέχει επίσης με αξιόλογο βάρος. Τα αποτελέσματα αυτά συνάδουν σε μεγάλο βαθμό με τα ευρήματα της περιγραφικής ανάλυσης, επιβεβαιώνοντας ότι δημογραφικά χαρακτηριστικά όπως η οικογενειακή κατάσταση και το εκπαιδευτικό υπόβαθρο, αλλά και επιχειρησιακές παράμετροι όπως ο τρόπος και η χρονική στιγμή επικοινωνίας, διαδραματίζουν καθοριστικό ρόλο στην απόφαση ενός πελάτη.

Πίνακας 16: Σπουδαιότητα μεταβλητών κατά φθίνουσα σειρά

Μεταβλητή	Σπουδαιότητα
Άγνωστος τρόπος επικοινωνίας	21.30
Στεγαστικό δάνειο	19.82
Έγγαμος	8.22
Μήνας: Μάιος	5.37
job_διευθυντικό.στέλεχος	5.28
Δευτεροβάθμια εκπαίδευση	4.25
Τριτοβάθμια εκπαίδευση	3.31
Μήνας: Αύγουστος	3.27
Μήνας: Ιούλιος	2.85
Επάγγελμα: Χειρονακτική εργασία	2.72

Σύγκριση μοντέλων

Πριν προχωρήσουμε στην τελική αξιολόγηση, αξίζει να συγκρίνουμε γραφικά την προβλεπτική ικανότητα των τεσσάρων κορυφαίων μοντέλων με τη βοήθεια των ROC καμπυλών (Receiver Operating Characteristic curves). Η ROC καμπύλη απεικονίζει την ευαισθησία (sensitivity) έναντι του ποσοστού ψευδών θετικών (false positive rate), σε όλα τα δυνατά threshold. Όσο πιο κοντά στην επάνω αριστερή γωνία βρίσκεται η καμπύλη, τόσο καλύτερη η συνολική προβλεπτική ικανότητα του μοντέλου.

Δείξε τον κώδικα

model_order <- c("Λογιστική Παλινδρόμηση", "XGBoost",
                 "Stack Ensemble (v1)", "Stack Ensemble (v2)")

roc_all <- all_preds %>%
  mutate(model = factor(model, levels = model_order)) %>%
  group_by(model) %>%
  roc_curve(truth = y, .pred_ναι, event_level = "second") %>%
  ungroup() %>%
  drop_na(model)

colors <- c(
  "Λογιστική Παλινδρόμηση" = "#009E73",
  "XGBoost"                = "#D55E00",
  "Stack Ensemble (v1)"    = "#CC79A7",
  "Stack Ensemble (v2)"    = "#E69F00"
)

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}") %>%
    hc_add_series(
        data = list(list(x = 0, y = 0), list(x = 1, y = 1)),
        type = "line",
        name = "Τυχαίο μοντέλο",
        color = "#888888",
        dashStyle = "Dash",
        lineWidth = 1.5,
        marker = list(enabled = FALSE),
        enableMouseTracking = FALSE
    )

Από το διάγραμμα φαίνεται καθαρά η υπεροχή των συνδυαστικών (Stack Ensemble) έναντι των άλλων μοντέλων.

Δείξε τον κώδικα

pr_all <- all_preds %>%
    mutate(model = factor(model, levels = model_order)) %>%
    group_by(model) %>%
    pr_curve(truth = y, .pred_ναι, event_level = "second") %>%
    ungroup() %>%
    drop_na(model)


# Baseline = ποσοστό θετικών στο test set
baseline <- mean(bank_test$y == "ναι")

hchart(pr_all, type = "line",
       hcaes(x = recall, y = precision, group = model)) %>%
    hc_title(text = "Precision-Recall Curves") %>%
    hc_subtitle(text = "Σύγκριση μοντέλων σε ανισόρροπα δεδομένα") %>%
    hc_xAxis(title = list(text = "Ανάκληση (Recall)"),
             min = 0.05, max = 1) %>%
    hc_yAxis(
        title = list(text = "Ακρίβεια θετικών (Precision)"),
        min = 0, max = 0.6,
        plotLines = list(
            list(value = baseline, color = "#888", dashStyle = "Dash", width = 1,
                 label = list(text = paste0("Baseline: ", round(baseline, 3))))
        )
    ) %>%
    hc_colors(unname(colors)) %>%
    hc_tooltip(headerFormat = "",
               pointFormat = "<b>{series.name}</b><br>Recall: {point.x:.3f}<br>Precision: {point.y:.3f}")

Συνολικά, παρατηρούμε ότι η ακρίβεια (accuracy) από μόνη της παραπλανά. Τα XGBoost που εμφανίζει μία από τις κορυφαίες, έχει σχεδόν μηδενικό F1. Αυτό συμβαίνει γιατί η ακρίβεια (accuracy) «ανταμείβει» κυρίως τις σωστές αρνητικές προβλέψεις και στα ανισόρροπα δεδομένα μας, το να λέμε «όχι» στη συντριπτική πλειοψηφία είναι εύκολο. Το F1 είναι το πιο έντιμο κριτήριο εδώ, γιατί τιμωρεί εξίσου τα ψευδώς θετικά και τα ψευδώς αρνητικά. Αξίζει επίσης να σημειώσουμε την ευαισθησία (sensitivity) του LightGBM: εντοπίζει το 51% των πραγματικά ενδιαφερόμενων πελατών, ποσοστό που παραδόξως δεν προσεγγίζεται ικανοποιητικά από τα συνδυαστικά μοντέλα (Stack Ensemble).

Δείξε τον κώδικα

threshold_lookup <- setNames(
    all_thresholds$threshold,
    all_thresholds$model
)

all_preds_custom <- all_preds %>%
    mutate(
        thr = threshold_lookup[model],
        .pred_class = factor(
            ifelse(.pred_ναι >= thr, "ναι", "όχι"),
            levels = c("όχι", "ναι")
        )
    )

all_preds_custom %>%
  group_by(model) %>%
  metric_set(accuracy, f_meas, sens, spec, precision)(
    truth = y, estimate = .pred_class,
    event_level = "second"
  ) %>%
  select(model, .metric, .estimate) %>%
  pivot_wider(names_from = .metric, values_from = .estimate) %>%
  mutate(across(where(is.numeric), ~ round(.x, 3))) %>%
  dplyr::arrange(-f_meas) %>%
  rename(
  "Μοντέλο"                    = model,
  "Ακρίβεια"                   = accuracy,
  "F1"                         = f_meas,
  "Ευαισθησία"                 = sens,
  "Ειδικότητα"                 = spec,
  "Θετική προγνωστική αξία"    = precision
) %>%
  gt_custom(head_max = Inf, use_labels = FALSE)

Μοντέλο	Ακρίβεια	F1	Ευαισθησία	Ειδικότητα	Θετική προγνωστική αξία
Naive Bayes	0.852	0.406	0.435	0.907	0.380
LightGBM	0.822	0.400	0.511	0.863	0.328
Stack Ensemble (v1)	0.862	0.395	0.389	0.924	0.402
Random Forest	0.832	0.379	0.443	0.883	0.331
SVM	0.790	0.354	0.496	0.829	0.275
Stack Ensemble (v2)	0.864	0.347	0.313	0.936	0.390
Λογιστική Παλινδρόμηση	0.844	0.289	0.275	0.918	0.305
XGBoost	0.861	0.037	0.023	0.971	0.094

Συμπεράσματα

Ο δεύτερος αυτός πίνακας μεταφράζει τα στατιστικά μεγέθη σε επιχειρησιακή πραγματικότητα και αναδεικνύει μια διαφορετική ιεράρχηση από αυτή που υπονοούσε το F1. Το Stack Ensemble v1 εμφανίζεται εδώ ως η πιο αποδοτική επιλογή με μόλις 127 κλήσεις επιτυγχάνει επιτυχία ανά κλήση 40.2%, δηλαδή 4 στις 10 επαφές αποδίδουν. Αν ο πόρος που δαπανάται είναι ο χρόνος του call center, αυτό το μοντέλο σέβεται περισσότερο αυτόν τον πόρο. Το τίμημα όμως είναι 80 χαμένοι ενδιαφερόμενοι. Από τους 131 εντοπίσαμε τους 51. Παραδόξως, το δεύτερο συνδυαστικό μοντέλο (Stack Ensemble v2) δεν έχει ξεπεράσει σε απόδοση το πρώτο μοντέλο, παρά το γεγονός ότι είναι συνδυασμός επτά μεμονομένων μοντέλων, έναντι πέντε του v1. Καταφέρνει ωστόσο, να μας δώσει έναν μικρότερο αριθμό προσεγγίσεων, αλλά αναλογικά χειρότερο σε σχέση με τη πρώτη έκδοση του συνδυαστικου μοντέλου. Το ατού του v2 είναι ότι είναι το λιγότερο ενοχλητικό μοντέλο μιας και κάνει τις λιγότερες λάθος προσεγγίσεις από τα κορυφαία μοντέλα μου, το οποίο έχει τη σημασία του.

Το LightGBM, από την άλλη, πιάνει τους 67, τους περισσότερους από όλα τα μοντέλα, αλλά απαιτεί 204 κλήσεις για να το κάνει, με ποσοστό επιτυχίας 32.8%. Χρειάζεται δηλαδή σχεδόν 60% περισσότερες κλήσεις από το Stack Ensemble v1 για να κερδίσει 16 επιπλέον θετικές περιπτώσεις. Επίσης, ενδιαφέρον παρουσιάζουν τα αποτελέσματα του Naive Bayes μοντέλου που είναι αρκετά κοντά στην απόδοση των συνδυαστικών μοντέλων. Τέλος, η απόλυτη έκπληξη ήταν τα αποτελέσματα του XGBoost με μόλις 3 σωστές προβλέψεις σε 131 πραγματικά θετικές περιπτώσεις.

Δείξε τον κώδικα

all_preds_custom %>%
  group_by(model) %>%
  summarise(
    `Σωστές θετικές προβλέψεις (TP)`  = sum(.pred_class == "ναι" & y == "ναι"),
    `Λάθος θετικές προβλέψεις (FP)`   = sum(.pred_class == "ναι" & y == "όχι"),
    `Χαμένοι ενδιαφερόμενοι (FN)`     = sum(.pred_class == "όχι" & y == "ναι"),
    `Σύνολο τηλεφωνημάτων`            = sum(.pred_class == "ναι"),
    `Επιτυχία ανά κλήση (%)`          = round(100 * `Σωστές θετικές προβλέψεις (TP)` / `Σύνολο τηλεφωνημάτων`, 1),
    .groups = "drop"
  ) %>%
  arrange(-`Επιτυχία ανά κλήση (%)`) %>%
  rename("Μοντέλο" = model) %>%
  gt_custom(head_max = Inf, use_labels = FALSE)

Μοντέλο	Σωστές θετικές προβλέψεις (TP)	Λάθος θετικές προβλέψεις (FP)	Χαμένοι ενδιαφερόμενοι (FN)	Σύνολο τηλεφωνημάτων	Επιτυχία ανά κλήση (%)
Stack Ensemble (v1)	51	76	80	127	40.2
Stack Ensemble (v2)	41	64	90	105	39.0
Naive Bayes	57	93	74	150	38.0
Random Forest	58	117	73	175	33.1
LightGBM	67	137	64	204	32.8
Λογιστική Παλινδρόμηση	36	82	95	118	30.5
SVM	65	171	66	236	27.5
XGBoost	3	29	128	32	9.4

Από τη παραπάνω παράγραφο γίνεται ξεκάθαρο ότι δεν υπάρχει το «σωστό» ή το καλύτερο μοντέλο, αλλά αυτό καλύπτει τον σκοπό μας. Αν ο στόχος της τράπεζας ήταν να μεγιστοποιήσει τα κέρδη της προωθόντας ένα νέο προϊόν, τότε η απάντηση είναι ξεκάθαρη το LightGBM, αφού εντοπίζει τους περισσότερους ενδιαφερόμενους. Θα μπορούσαν όμως οι στόχοι που έχουν τεθεί να είναι πιο συντηρητικοί, παραδείγματος χάριν να επεκτείνουμε τις υπηρεσίες στους υφιστάμενους πελάτες μας, αλλά να οχλήσουμε όσο το δυνατόν λιγότερους που δεν ενδιαφέρονται. Σε μία τέτοια περίπτωση το δεύτερο συνδυαστικό μοντέλο να είναι ιδανικό αφού οι λάθος οχλήσεις (άνθρωποι που δεν ενδιαφέρονται) είναι 21 λιγότεροι. Το ίδιο μοντέλο είναι ιδανικό σε περίπτωση περιορισμένου χρόνου για την πραγματοποίηση καμπάνιας μιας και οδηγεί σε χαμηλότερο αριθμό τηλεφωνημάτων. Βέβαια, αν θέλαμε μία πιο ισορροπημένη πρακτική ανάμεσα στις απαιτούμενες προσεγγίσεις και στα αναμενόμενα αποτελέσματα της καμπάνιας, ο νικητής είναι ξεκάθαρα το πρώτο συνδυαστικό μοντέλο.

Εν κατακλείδι, το ιδανικό μοντέλο δεν καθορίζεται αποκλειστικά από τις ιδανικές παραμέτρους, αλλά από την ίδια την ερώτηση και τον σκοπό του οργανισμού μας.

Αναφορές

Bray, A., Ismay, C., Chasnovski, E., Couch, S., Baumer, B., & Cetinkaya-Rundel, M. (2025). infer: Tidy Statistical Inference. Ανακτήθηκε από https://github.com/tidymodels/infer

Couch, S. P., Bray, A. P., Ismay, C., Chasnovski, E., Baumer, B. S., & Çetinkaya-Rundel, M. (2021). infer: An R package for tidyverse-friendly statistical inference. Journal of Open Source Software, 6(65), 3661. https://doi.org/10.21105/joss.03661

Couch, S., Frick, H., HvitFeldt, E., & Kuhn, M. (2025). tailor: Iterative Steps for Postprocessing Model Predictions. Ανακτήθηκε από https://github.com/tidymodels/tailor

Couch, S., & Kuhn, M. (2025). stacks: Tidy Model Stacking. Ανακτήθηκε από https://stacks.tidymodels.org/

Dua, D., & Graff, C. (2017). UCI Machine Learning Repository. University of California, Irvine, School of Information; Computer Sciences. Ανακτήθηκε από http://archive.ics.uci.edu/ml

Falbel, D., Damiani, A., Hogervorst, R. M., Kuhn, M., Couch, S., & Hvitfeldt, E. (2025). bonsai: Model Wrappers for Tree-Based Models. Ανακτήθηκε από https://bonsai.tidymodels.org/

Frick, H., Chow, F., Kuhn, M., Mahoney, M., Silge, J., & Wickham, H. (2025). rsample: General Resampling Infrastructure. Ανακτήθηκε από https://rsample.tidymodels.org

Frick, H., Kuhn, M., & Couch, S. (2025). workflowsets: Create a Collection of tidymodels Workflows. Ανακτήθηκε από https://github.com/tidymodels/workflowsets

Greenwell, B. M., & Boehmke, B. (2025). vip: Variable Importance Plots. Ανακτήθηκε από https://github.com/koalaverse/vip/

Greenwell, B. M., & Boehmke, B. C. (2020). Variable Importance Plots—An Introduction to the vip Package. The R Journal, 12(1), 343–366. Ανακτήθηκε από https://doi.org/10.32614/RJ-2020-013

Hester, J., & Bryan, J. (2024). glue: Interpreted String Literals. Ανακτήθηκε από https://glue.tidyverse.org/

Hvitfeldt, E. (2025). themis: Extra Recipes Steps for Dealing with Unbalanced Data. Ανακτήθηκε από https://github.com/tidymodels/themis

Hvitfeldt, E., & Kuhn, M. (2025). discrim: Model Wrappers for Discriminant Analysis. Ανακτήθηκε από https://github.com/tidymodels/discrim

Iannone, R., Cheng, J., Schloerke, B., Haughton, S., Hughes, E., Lauer, A., … Roy, O. (2025). gt: Easily Create Presentation-Ready Display Tables. Ανακτήθηκε από https://gt.rstudio.com

Kabacoff, R. (2019). Data visualization with R. URL https://rkabacoff. github. io/datavis.

Karatzoglou, A., Smola, A., & Hornik, K. (2024). kernlab: Kernel-Based Machine Learning Lab. https://doi.org/10.32614/CRAN.package.kernlab

Karatzoglou, A., Smola, A., Hornik, K., & Zeileis, A. (2004). kernlab – An S4 Package for Kernel Methods in R. Journal of Statistical Software, 11(9), 1–20. https://doi.org/10.18637/jss.v011.i09

Kirenz, J. (2021). Classification with Tidymodels, Workflows and Recipes. Ανακτήθηκε 22 Νοέμβριος 2022, από https://www.kirenz.com/post/2021-02-17-r-classification-tidymodels/#data-preparation

Kuhn, M. (2025a). modeldata: Data Sets Useful for Modeling Examples. Ανακτήθηκε από https://modeldata.tidymodels.org

Kuhn, M. (2025b). tune: Tidy Tuning Tools. Ανακτήθηκε από https://tune.tidymodels.org/

Kuhn, M., & Frick, H. (2025). dials: Tools for Creating Tuning Parameter Values. Ανακτήθηκε από https://dials.tidymodels.org

Kuhn, M., & Vaughan, D. (2026). parsnip: A Common API to Modeling and Analysis Functions. Ανακτήθηκε από https://github.com/tidymodels/parsnip

Kuhn, M., Vaughan, D., & Hvitfeldt, E. (2025). yardstick: Tidy Characterizations of Model Performance. Ανακτήθηκε από https://github.com/tidymodels/yardstick

Kuhn, M., Vaughan, D., & Ruiz, E. (2025). probably: Tools for Post-Processing Predicted Values. Ανακτήθηκε από https://github.com/tidymodels/probably

Kuhn, M., & Wickham, H. (2020). Tidymodels: a collection of packages for modeling and machine learning using tidyverse principles. Ανακτήθηκε από https://www.tidymodels.org

Kuhn, M., & Wickham, H. (2025). tidymodels: Easily Install and Load the Tidymodels Packages. Ανακτήθηκε από https://tidymodels.tidymodels.org

Kuhn, M., Wickham, H., & Hvitfeldt, E. (2025). recipes: Preprocessing and Feature Engineering Steps for Modeling. Ανακτήθηκε από https://github.com/tidymodels/recipes

Kunst, J. (2022). highcharter: A Wrapper for the Highcharts Library. Ανακτήθηκε από https://jkunst.com/highcharter/

Lin, G. (2025). reactable: Interactive Data Tables for R. Ανακτήθηκε από https://glin.github.io/reactable/

Majka, M. (2024). naivebayes: High Performance Implementation of the Naive Bayes Algorithm. Ανακτήθηκε από https://github.com/majkamichal/naivebayes

Moro, S., Cortez, P., & Rita, P. (2014). A data-driven approach to predict the success of bank telemarketing. Decision Support Systems, 62, 22–31.

R Core Team. (2025). R: A Language and Environment for Statistical Computing. Vienna, Austria: R Foundation for Statistical Computing. Ανακτήθηκε από https://www.R-project.org/

R-Bloggers. (2017). 5 ways to measure running time of R code. Ανακτήθηκε 20 Νοέμβριος 2022, από https://www.r-bloggers.com/2017/05/5-ways-to-measure-running-time-of-r-code/

R-Bloggers. (2020). How to Use Lightgbm with Tidymodels. Ανακτήθηκε 20 Νοέμβριος 2022, από https://www.r-bloggers.com/2020/08/how-to-use-lightgbm-with-tidymodels/

Robinson, D., Hayes, A., Couch, S., & Hvitfeldt, E. (2025). broom: Convert Statistical Objects into Tidy Tibbles. Ανακτήθηκε από https://broom.tidymodels.org/

Schliep, K., & Hechenbichler, K. (2025). kknn: Weighted k-Nearest Neighbors. Ανακτήθηκε από https://github.com/KlausVigo/kknn

Vaughan, D., Couch, S., & Frick, H. (2025). workflows: Modeling Workflows. Ανακτήθηκε από https://github.com/tidymodels/workflows

Wickham, H. (2016). ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York. Ανακτήθηκε από https://ggplot2.tidyverse.org

Wickham, H. (2025). forcats: Tools for Working with Categorical Variables (Factors). Ανακτήθηκε από https://forcats.tidyverse.org/

Wickham, H., Chang, W., Henry, L., Pedersen, T. L., Takahashi, K., Wilke, C., … van den Brand, T. (2025). ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics. Ανακτήθηκε από https://ggplot2.tidyverse.org

Wickham, H., François, R., Henry, L., Müller, K., & Vaughan, D. (2023). dplyr: A Grammar of Data Manipulation. Ανακτήθηκε από https://dplyr.tidyverse.org

Wickham, H., & Henry, L. (2026). purrr: Functional Programming Tools. Ανακτήθηκε από https://purrr.tidyverse.org/

Wickham, H., Hester, J., & Bryan, J. (2025). readr: Read Rectangular Text Data. Ανακτήθηκε από https://readr.tidyverse.org

Wickham, H., Pedersen, T. L., & Seidel, D. (2025). scales: Scale Functions for Visualization. Ανακτήθηκε από https://scales.r-lib.org

Wickham, H., Vaughan, D., & Girlich, M. (2025). tidyr: Tidy Messy Data. Ανακτήθηκε από https://tidyr.tidyverse.org

Wright, M. N. (2026). ranger: A Fast Implementation of Random Forests. Ανακτήθηκε από https://imbs-hl.github.io/ranger/

Wright, M. N., & Ziegler, A. (2017). ranger: A Fast Implementation of Random Forests for High Dimensional Data in C++ and R. Journal of Statistical Software, 77(1), 1–17. https://doi.org/10.18637/jss.v077.i01

Zhu, H. (2024). kableExtra: Construct Complex Table with kable and Pipe Syntax. Ανακτήθηκε από http://haozhu233.github.io/kableExtra/

Αναφορά

Αναφορά BibTeX:

@online{2022,
  author = {, stesiam},
  title = {Εντοπίζοντας πιθανούς ενδιαφερόμενους πελάτες},
  date = {2022-11-24},
  url = {https://stesiam.com/el/posts/predict-possible-clients/},
  langid = {el}
}

Για απόδοση ευγνωμοσύνης, παρακαλούμε αναφερθείτε σε αυτό το έργο ως:

stesiam. (2022, November 24). Εντοπίζοντας πιθανούς ενδιαφερόμενους πελάτες. Retrieved from https://stesiam.com/el/posts/predict-possible-clients/