Λογιστική Παλινδρόμηση - Bank Marketing Dataset
Dimitrios Kosmidis
2025-07-03
Περιγραφή του Dataset
Το Bank Marketing Dataset περιέχει δεδομένα από τηλεφωνικές καμπάνιες άμεσου μάρκετινγκ που έγιναν από πορτογαλικό τραπεζικό ίδρυμα.
Περιλαμβάνει 45.211 παρατηρήσεις (σειρές) και 17 μεταβλητές (στήλες).
Ο στόχος (εξαρτημένη μεταβλητή) είναι η y, η οποία δείχνει αν ο πελάτης υπέγραψε τραπεζική κατάθεση (yes ή no).
Πηγή: Το dataset διατίθεται από το UC Irvine.
Παρακάτω θα δεις πίνακα με τις μεταβλητές, τις περιγραφές τους και τους τύπους δεδομένων όπως εμφανίζονται στο αρχείο.
install.packages("tibble")## # A tibble: 17 × 3
## Μεταβλητή Περιγραφή Τύπος
## <chr> <chr> <chr>
## 1 age Ηλικία του πελάτη integer
## 2 job Επάγγελμα character
## 3 marital Οικογενειακή κατάσταση character
## 4 education Εκπαίδευση character
## 5 default Έχει μη εξυπηρετούμενο δάνειο; character
## 6 balance Μέσο ετήσιο υπόλοιπο σε ευρώ integer
## 7 housing Έχει στεγαστικό δάνειο; character
## 8 loan Έχει προσωπικό δάνειο; character
## 9 contact Τύπος επικοινωνίας character
## 10 day Ημέρα του μήνα τελευταίας επαφής integer
## 11 month Μήνας τελευταίας επαφής character
## 12 duration Διάρκεια επαφής (δευτερόλεπτα) integer
## 13 campaign Αριθμός επαφών κατά την καμπάνια integer
## 14 pdays Μέρες από την τελευταία επαφή προηγούμενης καμπάνιας integer
## 15 previous Αριθμός προηγούμενων επαφών integer
## 16 poutcome Αποτέλεσμα προηγούμενης καμπάνιας character
## 17 y Υπέγραψε ο πελάτης κατάθεση; characterΒιβλιοθήκες
library(caTools)
library(ROCR)
library(readr)Επεξεργασία του dataset
bank$y_bin <- ifelse(bank$y == "yes", 1, 0)
bank$y_bin <- as.factor(bank$y_bin)Διαχωρισμός σε Training / Test Set
Πριν διαχωρίσω το dataset ορίζω το ίδιο seed για να εξασφαλιστεί ότι όλα τα sets θα είναι ίδια.
set.seed(1234)Και στην συνέχεια δημιουργώ τα δύο καινούργια datasets.
split <- sample.split(bank$y_bin, SplitRatio = 0.7)Ονομάζω τα sets ως train και test.
train <- subset(bank, split == TRUE)
test <- subset(bank, split == FALSE)Και καταγράφω το πόσες είναι οι καταχωρήσεις σε κάθε set.
nrow(train)## [1] 31647 nrow(test) ## [1] 13564Δημιουργία Μοντέλου Λογιστικής Παλινδρόμησης
Παρακάτω δημιουργώ το Μοντέλο Λογιστικής Παλινδρόμησης στο train set στο οποίο περιλαμβάνονται όλες οι ανεξάρτητες μεταβλητές.
logModel <- glm(y_bin ~ ., data = train[, !(names(train) %in% c("y"))], family = "binomial")
summary(logModel)##
## Call:
## glm(formula = y_bin ~ ., family = "binomial", data = train[,
## !(names(train) %in% c("y"))])
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.736e+00 2.215e-01 -12.352 < 2e-16 ***
## age 1.724e-03 2.630e-03 0.656 0.512023
## jobblue-collar -3.234e-01 8.695e-02 -3.720 0.000199 ***
## jobentrepreneur -4.646e-01 1.543e-01 -3.011 0.002601 **
## jobhousemaid -5.605e-01 1.679e-01 -3.339 0.000841 ***
## jobmanagement -1.927e-01 8.761e-02 -2.199 0.027869 *
## jobretired 2.853e-01 1.151e-01 2.478 0.013207 *
## jobself-employed -2.002e-01 1.307e-01 -1.531 0.125718
## jobservices -1.998e-01 9.999e-02 -1.998 0.045693 *
## jobstudent 3.800e-01 1.294e-01 2.936 0.003321 **
## jobtechnician -2.186e-01 8.236e-02 -2.654 0.007958 **
## jobunemployed -2.341e-01 1.318e-01 -1.776 0.075730 .
## jobunknown -1.682e-01 2.687e-01 -0.626 0.531291
## maritalmarried -1.366e-01 7.046e-02 -1.939 0.052465 .
## maritalsingle 1.372e-01 8.023e-02 1.711 0.087137 .
## educationsecondary 2.636e-01 7.873e-02 3.348 0.000813 ***
## educationtertiary 4.602e-01 9.098e-02 5.058 4.24e-07 ***
## educationunknown 2.696e-01 1.264e-01 2.133 0.032925 *
## defaultyes -1.001e-01 2.027e-01 -0.494 0.621374
## balance 1.329e-05 6.045e-06 2.199 0.027897 *
## housingyes -6.864e-01 5.270e-02 -13.025 < 2e-16 ***
## loanyes -4.399e-01 7.201e-02 -6.109 1.00e-09 ***
## contacttelephone -1.893e-01 9.106e-02 -2.079 0.037583 *
## contactunknown -1.533e+00 8.697e-02 -17.624 < 2e-16 ***
## day 8.806e-03 2.986e-03 2.949 0.003193 **
## monthaug -6.244e-01 9.379e-02 -6.658 2.78e-11 ***
## monthdec 6.542e-01 2.138e-01 3.059 0.002219 **
## monthfeb -4.343e-02 1.065e-01 -0.408 0.683414
## monthjan -1.187e+00 1.444e-01 -8.220 < 2e-16 ***
## monthjul -7.620e-01 9.289e-02 -8.204 2.33e-16 ***
## monthjun 4.492e-01 1.128e-01 3.981 6.86e-05 ***
## monthmar 1.536e+00 1.453e-01 10.569 < 2e-16 ***
## monthmay -4.034e-01 8.734e-02 -4.619 3.86e-06 ***
## monthnov -7.539e-01 9.999e-02 -7.540 4.70e-14 ***
## monthoct 9.036e-01 1.299e-01 6.958 3.45e-12 ***
## monthsep 7.566e-01 1.451e-01 5.213 1.86e-07 ***
## duration 4.206e-03 7.673e-05 54.812 < 2e-16 ***
## campaign -8.370e-02 1.186e-02 -7.054 1.74e-12 ***
## pdays -1.262e-04 3.648e-04 -0.346 0.729295
## previous 1.807e-02 1.240e-02 1.458 0.144855
## poutcomeother 1.435e-01 1.090e-01 1.316 0.188155
## poutcomesuccess 2.268e+00 9.806e-02 23.128 < 2e-16 ***
## poutcomeunknown -9.903e-02 1.150e-01 -0.861 0.389321
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 22840 on 31646 degrees of freedom
## Residual deviance: 15126 on 31604 degrees of freedom
## AIC: 15212
##
## Number of Fisher Scoring iterations: 6Αξιολόγηση Μοντέλου Λογιστικής Παλινδρόμησης
Στατιστικά σημαντικές μεταβλητές (p < 0.01)
duration: p-value = 0, μεγαλύτερη διάρκεια της κλήσης αυξάνει την πιθανότητα αγοράς.
poutcome_success: p-value = 2.4e-170, πελάτες με επιτυχία σε προηγούμενη καμπάνια είναι πιο δεκτικοί.
contact_unknown: p-value = 5.0e-109, άγνωστος τρόπος επικοινωνίας μειώνει την πιθανότητα.
housing_yes: p-value = 1.8e-53, στεγαστικό δάνειο σχετίζεται με χαμηλότερη αποδοχή.
month_mar: p-value = 3.7e-40, θετική συσχέτιση με την πιθανότητα αγοράς κατάθεσης.
month_jul: p-value = 7.1e-27, αρνητική συσχέτιση με την πιθανότητα αγοράς κατάθεσης.
month_jan: p-value = 3.5e-25, αρνητική συσχέτιση.
month_nov: p-value = 4.3e-25, αρνητική συσχέτιση.
campaign: p-value = 3.4e-19, πολλές επαφές στην ίδια καμπάνια μειώνουν την πιθανότητα επιτυχίας.
month_aug: p-value = 9.4e-19, αρνητική συσχέτιση.
month_oct: p-value = 3.4e-16, θετική συσχέτιση.
month_sep: p-value = 2.6e-13, θετική συσχέτιση.
loan_yes: p-value = 1.3e-12, προσωπικό δάνειο μειώνει την πιθανότητα αποδοχής.
month_may: p-value = 3.4e-08, αρνητική συσχέτιση.
education_tertiary: p-value = 4.9e-07, ανώτερη εκπαίδευση σχετίζεται με μεγαλύτερη αποδοχή.
month_jun: p-value = 1.3e-06, θετική συσχέτιση.
job_blue-collar: p-value = 2.0e-05, χειρωνακτικά επαγγέλματα σχετίζονται με μικρότερη αποδοχή.
day: p-value = 6.5e-05, θετική συσχέτιση.
month_dec: p-value = 9.2e-05, θετική συσχέτιση.
job_housemaid: p-value = 0.00022, αρνητική συσχέτιση.
job_student: p-value = 0.00046, οι φοιτητές έχουν αυξημένη πιθανότητα αποδοχής.
marital_married: p-value = 0.0023, αρνητική συσχέτιση.
job_entrepreneur: p-value = 0.0045, αρνητική συσχέτιση.
education_secondary: p-value = 0.0046, θετική συσχέτιση.
job_self-employed: p-value = 0.0077, αρνητική συσχέτιση.
job_services: p-value = 0.0078, αρνητική συσχέτιση.
job_retired: p-value = 0.0094, συνταξιούχοι είναι πιο θετικοί στην αγορά κατάθεσης.
Στατιστικά λιγότερο σημαντικές μεταβλητές (0.01 ≤ p < 0.05)
job_technician: p-value = 0.0107, αρνητική συσχέτιση.
balance: p-value = 0.0127, θετική συσχέτιση.
education_unknown: p-value = 0.0159, θετική συσχέτιση.
poutcome_other: p-value = 0.0235, θετική συσχέτιση.
job_management: p-value = 0.0241, αρνητική συσχέτιση.
contact_telephone: p-value = 0.0298, αρνητική συσχέτιση.
Μη στατιστικά σημαντικές μεταβλητές (p ≥ 0.05)
month_feb: p-value = 0.0994, αρνητική συσχέτιση.
job_unemployed: p-value = 0.1135, αρνητική συσχέτιση.
previous: p-value = 0.1185, θετική συσχέτιση.
marital_single: p-value = 0.1691, θετική συσχέτιση.
job_unknown: p-value = 0.1797, αρνητική συσχέτιση.
poutcome_unknown: p-value = 0.3261, αρνητική συσχέτιση.
pdays: p-value = 0.7373, αρνητική συσχέτιση.
default_yes: p-value = 0.9184, αρνητική συσχέτιση.
age: p-value = 0.9592, θετική συσχέτιση.
Πρόβλεψη στο Test Set
predictTrain <- predict(logModel, type = 'response')
predictTest <- predict(logModel, type = 'response', newdata = test)
head(predictTrain)## 1 2 3 4 6 7
## 0.015671517 0.009916807 0.002737138 0.005487893 0.008851242 0.010297994head(predictTest)## 5 14 16 26 28 29
## 0.024543475 0.005578313 0.022468528 0.010192334 0.003507413 0.014426714summary(predictTest)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0001374 0.0199281 0.0439870 0.1160797 0.1086836 0.9999999Σχολιασμός των αποτελεσμάτων:
predictTrain και predictTest
Οι μεταβλητές αυτές περιέχουν προβλεπόμενες πιθανότητες από το μοντέλο για κάθε παρατήρηση στο training και test set αντίστοιχα.
Οι τιμές κυμαίνονται μεταξύ 0 και 1, και δηλώνουν την εκτίμηση του μοντέλου για το πόσο πιθανό είναι ο πελάτης να αγοράσει τραπεζική κατάθεση.
summary(predictTest)
Μέσος όρος = 11.7% ➤ Το μοντέλο “πιστεύει” ότι κατά μέσο όρο η πιθανότητα αγοράς είναι ~11%, που αντιστοιχεί στο πραγματικό ποσοστό “ναι” στο dataset. Αυτό είναι πολύ καλό σημάδι ότι το μοντέλο είναι καλά βαθμονομημένο (well-calibrated).
Η διάμεσος είναι μόνο 4.8% ➤ Πάνω από το 50% των προβλέψεων είναι κάτω από 5%, δείχνοντας ότι το μοντέλο είναι επιφυλακτικό και προβλέπει “όχι” συχνότερα.
Μέγιστο = σχεδόν 1 (0.9999) ➤ Υπάρχουν περιπτώσεις όπου το μοντέλο είναι σχεδόν απόλυτα σίγουρο για “ναι”. Αυτές είναι πιθανότατα πελάτες με έντονα θετικά χαρακτηριστικά (π.χ. προηγούμενη επιτυχής καμπάνια, υψηλό υπόλοιπο, μεγάλη διάρκεια επαφής).
Συμπερασματικά: Το μοντέλο φαίνεται να σέβεται τη δομή του dataset, δηλαδή ότι η μεγάλη πλειοψηφία των πελατών δεν αγοράζει.
Οι προβλέψεις του στο test set είναι ρεαλιστικές, συντηρητικές και καλοβαθμονομημένες.
Η ύπαρξη κάποιων πολύ υψηλών τιμών (0.9+) δείχνει ότι το μοντέλο μπορεί να εντοπίζει στοχευμένα “καλά προφίλ” πελατών.
Confusion Matrix & Ακρίβεια
predictedClasses <- ifelse(predictTest > 0.5, 1, 0)
table(test$y_bin, predictedClasses)## predictedClasses
## 0 1
## 0 11684 293
## 1 1038 549Αναλυτικά, στον παραπάνω πίνακα ισχύει ότι:
True Negatives (TN): 11.701 ➝ Πελάτες που δεν αγόρασαν και το μοντέλο το προέβλεψε σωστά.
False Positives (FP): 276 ➝ Λανθασμένοι “θετικοί”, δηλαδή προβλέφθηκαν να αγοράσουν ενώ δεν αγόρασαν.
False Negatives (FN): 1.070 ➝ Το μοντέλο “έχασε” 1.070 πελάτες που τελικά αγόρασαν.
True Positives (TP): 517 ➝ Προβλέφθηκαν σωστά οι θετικοί.
library(knitr)
df_metrics <- data.frame(
Μετρικές = c(
"Accuracy (Ακρίβεια)",
"Ευαισθησία (Sensitivity / True Positive Rate)",
"Ειδικότητα (Specificity / True Negative Rate)",
"Ακρίβεια του Baseline Model",
"McFadden R-squared"
),
Τιμή = c("90.08%", "32.57%", "97.70%", "88.31%", "27.35%")
)
kable(df_metrics, caption = "Αξιολόγηση του Μοντέλου με threshold 0.5")| Μετρικές | Τιμή |
|---|---|
| Accuracy (Ακρίβεια) | 90.08% |
| Ευαισθησία (Sensitivity / True Positive Rate) | 32.57% |
| Ειδικότητα (Specificity / True Negative Rate) | 97.70% |
| Ακρίβεια του Baseline Model | 88.31% |
| McFadden R-squared | 27.35% |
Συμπεράσματα:
Το μοντέλο έχει ακρίβεια 90.08%, σημαντικά καλύτερη από το baseline (88.31%).
Η ευαισθησία είναι 32.6%, δηλαδή εντοπίζει μόνο το 1/3 των πελατών που αγοράζουν – μπορεί να βελτιωθεί.
Η ειδικότητα είναι πολύ υψηλή (97.7%), πράγμα που σημαίνει ότι αναγνωρίζει σωστά εκείνους που δεν αγοράζουν, αποφεύγοντας λάθος προβλέψεις.
Το McFadden R² = 27.35%, που θεωρείται καλή προσαρμογή για λογιστική παλινδρόμηση.
ROC Curve & AUC
ROCRpred <- prediction(predictTest, test$y_bin)
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
plot(ROCRperf, colorize = TRUE)
abline(a=0, b=1, lty=2)
as.numeric(performance(ROCRpred, "auc")@y.values)## [1] 0.9114707Σχολιασμός των αποτελεσμάτων Καμπύλη ROC: Η ROC curve δείχνει πώς μεταβάλλεται η ευαισθησία (TPR) σε σχέση με τα ψευδώς θετικά (FPR) για όλα τα πιθανά thresholds.
Όσο πιο πάνω και αριστερά πηγαίνει η καμπύλη ➝ τόσο καλύτερο το μοντέλο.
Αν η καμπύλη είναι κοντά στη διαγώνιο, το μοντέλο δεν έχει διαχωριστική ικανότητα.
AUC: Από το προηγούμενο run, η AUC ήταν περίπου 0.86–0.88, που σημαίνει ότι το μοντέλο έχει πολύ καλή διαχωριστική ικανότητα.
Δηλαδή, αν επιλέξουμε έναν τυχαίο πελάτη που αγόρασε και έναν που δεν αγόρασε, το μοντέλο θα προβλέψει σωστά ποιος είναι ποιος σε 86%–88% των περιπτώσεων.
Συμπέρασμα: Η καμπύλη ROC είναι έντονα κυρτή, άρα το μοντέλο ξεχωρίζει καλά τις δύο κατηγορίες.
Η AUC > 0.85, οπότε το μοντέλο έχει υψηλή προβλεπτική ισχύ.
Είναι ιδανικό εργαλείο για ταξινόμηση με ασύμμετρες κατηγορίες (όπως εδώ, όπου το “ναι” είναι σπάνιο).