Bank Customer Churn Prediction

1 Περιγραφή dataset
2 Περιγραφή Μεταβλητών
3 Εξερεύνηση Δομής Dataset
4 Προεπεξεργασία Δεδομένων
5 Λογιστική Παλινδρόμηση
6 Δένδρο Απόφασης

1 Περιγραφή dataset

Το dataset προέρχεται από το Kaggle και αφορά πελάτες τραπεζών. Περιλαμβάνει 10000 εγγραφές/πελάτες τράπεζας το οποίο αποτελείται από 12 ανεξάρτητες μεταβλητές (χαρακτηριστικά πελατών) και 1 εξαρτημένη μεταβλητή, που δείχνει αν ένας πελάτης αποχωρεί (churn) ή παραμένει.

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

2 Περιγραφή Μεταβλητών

Παρακάτω περιγράφονται οι μεταβλητές του dataset, μαζί με τους τύπους τους:

CustomerId (Numeric): Μοναδικό αναγνωριστικό για κάθε πελάτη
SurName (Character): Επίθετο πελάτη
CreditScore (Numeric): Πιστωτικό score δανειοληπτικής ικανότητας
Geography (Character): Χώρα διαμονής
Gender (Character): Φύλο πελάτη
Age (Numeric): Ηλικία πελάτη
Tenure (Numeric): Χρόνια ως πελάτης
Balance (Numeric): Υπόλοιπο λογαριασμού
NumOfProducts (Numeric): Αριθμός προϊόντων
HasCrCard (Numeric): Υπάρχει πιστωτική κάρτα
IsActiveMember (Numeric): Είναι δραστήριο μέλος
EstimatedSalary (Numeric): Εκτιμώμενος μισθός
Exited (Numeric): Έχει αποχωρήσει ο πελάτης (1 = ναι, 0 = όχι)

3 Εξερεύνηση Δομής Dataset

library(ggplot2)
#Εισαγωγή dataset
Churn_Modeling <- read.csv("C:/Users/dadak/Documents/sxoli/Business_Analytics/Assignment2/Churn_Modelling.csv")

# Προβολή δομής dataset
str(Churn_Modeling)

## 'data.frame':    10002 obs. of  14 variables:
##  $ RowNumber      : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ CustomerId     : int  15634602 15647311 15619304 15701354 15737888 15574012 15592531 15656148 15792365 15592389 ...
##  $ Surname        : chr  "Hargrave" "Hill" "Onio" "Boni" ...
##  $ CreditScore    : int  619 608 502 699 850 645 822 376 501 684 ...
##  $ Geography      : chr  "France" "Spain" "France" "France" ...
##  $ Gender         : chr  "Female" "Female" "Female" "Female" ...
##  $ Age            : num  42 41 42 39 43 44 50 29 44 NA ...
##  $ Tenure         : int  2 1 8 1 2 8 7 4 4 2 ...
##  $ Balance        : num  0 83808 159661 0 125511 ...
##  $ NumOfProducts  : int  1 1 3 2 1 2 2 4 2 1 ...
##  $ HasCrCard      : int  1 0 1 0 NA 1 1 1 0 1 ...
##  $ IsActiveMember : int  1 1 0 0 1 0 1 0 NA 1 ...
##  $ EstimatedSalary: num  101349 112543 113932 93827 79084 ...
##  $ Exited         : int  1 0 1 0 0 1 0 1 0 0 ...

# Προβολή μεγέθους dataset
dim(Churn_Modeling)

## [1] 10002    14

4 Προεπεξεργασία Δεδομένων

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

#Οπτικοποίηση ελλιπών τιμών
library(naniar)
gg_miss_var(Churn_Modeling)

Figure1: Εμφάνιση ελλιπών τιμών ανά μεταβλητή

# Εύρεση και αφαίρεση διπλότυπων
# Πλήθος συνολικών γραμμών πριν
nrow_before <- nrow(Churn_Modeling)

# Πόσες διπλότυπες γραμμές υπάρχουν;
duplicates_found <- sum(duplicated(Churn_Modeling))

# Αφαίρεση διπλότυπων
Churn_Modeling <- Churn_Modeling[!duplicated(Churn_Modeling), ]

# Πλήθος συνολικών γραμμών μετά
nrow_after <- nrow(Churn_Modeling)

# Εκτύπωση αποτελεσμάτων
cat("Διπλότυπες εγγραφές που εντοπίστηκαν και αφαιρέθηκαν:", duplicates_found, "\n")

## Διπλότυπες εγγραφές που εντοπίστηκαν και αφαιρέθηκαν: 2

cat("Γραμμές πριν:", nrow_before, "- Γραμμές μετά:", nrow_after, "\n")

## Γραμμές πριν: 10002 - Γραμμές μετά: 10000

5 Λογιστική Παλινδρόμηση

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

table(Churn_Modeling$Exited)

## 
##    0    1 
## 7963 2037

5.1 Διαχωρισμός dataset

Πριν από την εκπαίδευση του μοντέλου, το αρχικό dataset διαχωρίζεται σε δύο σύνολα: training set (65%) και test set (35%), με τυχαία κατανομή.
Αυτός ο διαχωρισμός εξασφαλίζει μια ισορροπία: επαρκή δεδομένα για την εκπαίδευση του μοντέλου, αλλά και σημαντικό ποσοστό για την αξιόπιστη αξιολόγησή του.
Ο διαχωρισμός πραγματοποιήθηκε με χρήση σταθερού seed ώστε τα αποτελέσματα να είναι αναπαραγώγιμα σε μελλοντικές εκτελέσεις του κώδικα.

library(caTools)

# Ορισμός seed 
set.seed(927)

# Διαχωρισμός με βάση τη μεταβλητή στόχο Exited (1 ή 0)
split <- sample.split(Churn_Modeling$Exited, SplitRatio = 0.65)

# Δημιουργία training και testing sets
dataTrain <- subset(Churn_Modeling, split == TRUE)
dataTest  <- subset(Churn_Modeling, split == FALSE)

# Εμφάνιση αριθμού εγγραφών
cat("Training set:", nrow(dataTrain), "εγγραφές\n")

## Training set: 6500 εγγραφές

cat("Test set:", nrow(dataTest), "εγγραφές\n")

## Test set: 3500 εγγραφές

Επιπρόσθετα, δημιουργήθηκαν διαγράμματα ράβδων (bar charts) προκειμένου να επιβεβαιωθεί ότι τόσο το training όσο και το test set διατηρούν παρόμοια κατανομή μεταξύ των δύο κατηγοριών της μεταβλητής Exited.
Η επιβεβαίωση αυτής της ισορροπίας είναι σημαντική για την αποφυγή bias κατά την εκπαίδευση και αξιολόγηση του μοντέλου.

# Προσθέτουμε νέα στήλη "Set" για να ενοποιήσουμε τα dataTrain και dataTest
dataTrain$Set <- "Train"
dataTest$Set  <- "Test"

# Ενοποίηση των δύο συνόλων για plotting
combined_data <- rbind(dataTrain, dataTest)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

# Υπολογισμός ποσοστών
churn_percent <- combined_data %>%
  group_by(Set, Exited) %>%
  summarise(Count = n()) %>%
  mutate(Percentage = round(Count / sum(Count) * 100, 1))

## `summarise()` has grouped output by 'Set'. You can override using the `.groups`
## argument.

# Bar chart
ggplot(churn_percent, aes(x = Set, y = Percentage, fill = factor(Exited))) +
  geom_bar(stat = "identity", position = "dodge") +
  scale_fill_manual(values = c("blue", "red"),
                    labels = c("Non-Churner", "Churner"),
                    name = "Churn Status") +
  labs(
    title = "Churn Rate per Dataset (Train vs Test)",
    x = "Dataset",
    y = "Percentage (%)"
  ) +
  theme_minimal()

5.2 Εκπαίδευση και πειράματα μοντέλου

Πριν δημιουργήσουμε το μοντέλο λογιστικής παλινδρόμησης, πραγματοποιήσαμε καθαρισμό του train set. Αφαιρέθηκαν οι μεταβλητές που: - Είχαν προκύψει από προηγούμενα μοντέλα (όπως το PredictedSalary) - Είχαν μόνο μία μοναδική τιμή και άρα δεν παρέχουν διακριτική πληροφορία στο μοντέλο (π.χ. dummy variables χωρίς μεταβλητότητα)

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

# Βήμα 1: Καθαρισμός δεδομένων
dataTrain_clean <- dataTrain %>%
  select(-CustomerId, -Surname, -RowNumber, -Set)

# Βήμα 2: Μετατροπή κατηγορικών μεταβλητών σε factors
dataTrain_clean$Geography <- factor(dataTrain_clean$Geography, levels = c("France", "Germany", "Spain"))  # France as baseline
dataTrain_clean$Gender <- factor(dataTrain_clean$Gender)

# Βήμα 3: Αφαίρεση μεταβλητών χωρίς μεταβλητότητα (αν υπάρχουν)
valid_vars <- sapply(dataTrain_clean, function(x) length(unique(x)) > 1)
dataTrain_clean <- dataTrain_clean[, valid_vars]

# Βήμα 4: Εκπαίδευση λογιστικού μοντέλου
log_model <- glm(Exited ~ ., data = dataTrain_clean, family = "binomial")

# Προβολή αποτελεσμάτων
summary(log_model)

## 
## Call:
## glm(formula = Exited ~ ., family = "binomial", data = dataTrain_clean)
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -3.450e+00  3.037e-01 -11.362  < 2e-16 ***
## CreditScore      -7.371e-04  3.464e-04  -2.128   0.0334 *  
## GeographyGermany  7.312e-01  8.416e-02   8.689  < 2e-16 ***
## GeographySpain   -6.878e-03  8.696e-02  -0.079   0.9370    
## GenderMale       -5.090e-01  6.755e-02  -7.535  4.9e-14 ***
## Age               7.542e-02  3.233e-03  23.327  < 2e-16 ***
## Tenure           -1.816e-02  1.159e-02  -1.567   0.1171    
## Balance           2.724e-06  6.352e-07   4.288  1.8e-05 ***
## NumOfProducts    -7.789e-02  5.855e-02  -1.330   0.1834    
## HasCrCard        -8.723e-02  7.309e-02  -1.193   0.2327    
## IsActiveMember   -1.020e+00  7.142e-02 -14.287  < 2e-16 ***
## EstimatedSalary   3.857e-07  5.885e-07   0.655   0.5122    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 6570.3  on 6497  degrees of freedom
## Residual deviance: 5565.8  on 6486  degrees of freedom
##   (2 observations deleted due to missingness)
## AIC: 5589.8
## 
## Number of Fisher Scoring iterations: 5

Το μοντέλο λογιστικής παλινδρόμησης κατασκευάστηκε με όλες τις ανεξάρτητες μεταβλητές που θεωρούνται σχετικές. Με βάση τα αποτελέσματα:

Οι μεταβλητές με ισχυρή συσχέτιση (p-value < 0.05) με την πιθανότητα αποχώρησης (Exited) είναι:

GeographyGermany (p < 0.001) → Πελάτες στη Γερμανία έχουν αυξημένη πιθανότητα αποχώρησης.
GenderMale (p < 0.001) → Οι άντρες έχουν μικρότερη πιθανότητα αποχώρησης σε σχέση με τις γυναίκες.
Age (p < 0.001) → Όσο αυξάνεται η ηλικία, αυξάνεται και η πιθανότητα αποχώρησης.
Balance (p < 0.001) → Θετικό υπόλοιπο σχετίζεται με αποχώρηση.
IsActiveMember (p < 0.001) → Οι ενεργοί πελάτες έχουν χαμηλότερη πιθανότητα αποχώρησης.

Άλλες μεταβλητές όπως το EstimatedSalary, HasCrCard, NumOfProducts δεν εμφανίζουν στατιστικά σημαντική επίδραση στο μοντέλο.

library(dplyr)
library(pROC)

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

# Προετοιμασία του test set: αφαίρεση άχρηστων μεταβλητών
dataTest_clean <- dataTest %>%
  select(-CustomerId, -Surname, -RowNumber, -Set)

# Μετατροπή κατηγορικών σε factors (όπως στο train)
dataTest_clean$Geography <- factor(dataTest_clean$Geography, levels = c("France", "Germany", "Spain"))
dataTest_clean$Gender <- factor(dataTest_clean$Gender)

# Πείραμα 1: Threshold 0.50 (default)
# Δημιουργία προβλέψεων (πιθανότητες churn)
predictTest <- predict(log_model, newdata = dataTest_clean, type = "response")

# Αφαίρεση προβλέψεων με NA (σε περίπτωση που υπάρχουν missing values)
valid_indices <- !is.na(predictTest)
predictTest_clean <- predictTest[valid_indices]
actual_clean <- dataTest_clean$Exited[valid_indices]

# Μετατροπή πιθανοτήτων σε κατηγορίες (0/1) με κατώφλι 0.5
predicted_class <- ifelse(predictTest_clean >= 0.5, 1, 0)

# Confusion matrix
conf_matrix <- table(Predicted = predicted_class, Actual = actual_clean)
print(conf_matrix)

##          Actual
## Predicted    0    1
##         0 2669  555
##         1  116  158

# Υπολογισμός accuracy
accuracy <- mean(predicted_class == actual_clean)
cat("Ακρίβεια του μοντέλου στο test set:", round(accuracy * 100, 2), "%\n")

## Ακρίβεια του μοντέλου στο test set: 80.82 %

# Πείραμα 2: Βέλτιστο Threshold 
# Δημιουργία προβλέψεων (πιθανότητες churn)
predictTest <- predict(log_model, newdata = dataTest_clean, type = "response")

# Αφαίρεση NA τιμών
valid_indices <- !is.na(predictTest)
predictTest_clean <- predictTest[valid_indices]
actual_clean <- dataTest_clean$Exited[valid_indices]

# ROC curve
roc_obj <- roc(actual_clean, predictTest_clean)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

plot(roc_obj, col = "blue", main = "ROC Curve for Logistic Regression")

auc_value <- auc(roc_obj)
cat("AUC:", round(auc_value, 4), "\n")

## AUC: 0.7695

# Βέλτιστο κατώφλι (threshold) από την ROC curve
opt_coords <- coords(roc_obj, "best", ret = c("threshold", "sensitivity", "specificity"), transpose = FALSE)
optimal_threshold <- as.numeric(opt_coords["threshold"])
cat("Βέλτιστο threshold:", round(optimal_threshold, 3), "\n")

## Βέλτιστο threshold: 0.186

# Προβλέψεις με βάση το νέο κατώφλι
predicted_class_opt <- ifelse(predictTest_clean >= optimal_threshold, 1, 0)

# Πίνακας σύγχυσης και ακρίβεια
conf_matrix_opt <- table(Predicted = predicted_class_opt, Actual = actual_clean)
print(conf_matrix_opt)

##          Actual
## Predicted    0    1
##         0 1852  183
##         1  933  530

accuracy_opt <- mean(predicted_class_opt == actual_clean)
cat("Accuracy με το βέλτιστο threshold:", round(accuracy_opt * 100, 2), "%\n")

## Accuracy με το βέλτιστο threshold: 68.1 %

# --- Threshold = 0.5 ---
predicted_class_05 <- ifelse(predictTest_clean >= 0.5, 1, 0)
conf_matrix_05 <- table(Predicted = predicted_class_05, Actual = actual_clean)

# Recall = TP / (TP + FN)
TP_05 <- conf_matrix_05["1", "1"]
FN_05 <- conf_matrix_05["0", "1"]
recall_05 <- TP_05 / (TP_05 + FN_05)

# --- Best threshold from ROC ---
optimal_threshold <- as.numeric(opt_coords["threshold"])
predicted_class_opt <- ifelse(predictTest_clean >= optimal_threshold, 1, 0)
conf_matrix_opt <- table(Predicted = predicted_class_opt, Actual = actual_clean)

TP_opt <- conf_matrix_opt["1", "1"]
FN_opt <- conf_matrix_opt["0", "1"]
recall_opt <- TP_opt / (TP_opt + FN_opt)

# --- Display results ---
cat("Recall με threshold 0.5:", round(recall_05 * 100, 2), "%\n")

## Recall με threshold 0.5: 22.16 %

cat("Recall με το βέλτιστο threshold (", round(optimal_threshold, 3), "):", round(recall_opt * 100, 2), "%\n")

## Recall με το βέλτιστο threshold ( 0.186 ): 74.33 %

#Πειράμα 3: Βέλτιστο threshold με σημαντικότερα features
# Επιλογή των σημαντικότερων μεταβλητών (με βάση τα p-values από το πλήρες μοντέλο)
# Χρησιμοποιούμε: Age, IsActiveMember, Gender, GeographyGermany, Balance

# Δημιουργία νέου train set με επιλεγμένες μεταβλητές
final_train <- dataTrain %>%
  select(Exited, Age, IsActiveMember, Gender, Geography, Balance)

# Μετατροπή κατηγορικών
final_train$Geography <- factor(final_train$Geography, levels = c("France", "Germany", "Spain"))
final_train$Gender <- factor(final_train$Gender)

# Νέο μοντέλο
final_model <- glm(Exited ~ Age + IsActiveMember + Gender + Geography + Balance, 
                   data = final_train, family = "binomial")

# Δημιουργία νέου test set
final_test <- dataTest %>%
  select(Exited, Age, IsActiveMember, Gender, Geography, Balance)

final_test$Geography <- factor(final_test$Geography, levels = c("France", "Germany", "Spain"))
final_test$Gender <- factor(final_test$Gender)

# Προβλέψεις στο test set
final_predict <- predict(final_model, newdata = final_test, type = "response")

# Αφαίρεση NA
valid_idx <- !is.na(final_predict)
final_predict_clean <- final_predict[valid_idx]
final_actual_clean <- final_test$Exited[valid_idx]

# Χρήση του βέλτιστου threshold για ταξινόμηση
final_class <- ifelse(final_predict_clean >= optimal_threshold, 1, 0)

# Υπολογισμός ακρίβειας και recall
final_conf_matrix <- table(Predicted = final_class, Actual = final_actual_clean)

TP_final <- final_conf_matrix["1", "1"]
FN_final <- final_conf_matrix["0", "1"]
recall_final <- TP_final / (TP_final + FN_final)

accuracy_final <- mean(final_class == final_actual_clean)

# Εκτύπωση αποτελεσμάτων
cat("Accuracy με το τελικό μοντέλο:", round(accuracy_final * 100, 2), "%\n")

## Accuracy με το τελικό μοντέλο: 67.55 %

cat("Recall με το τελικό μοντέλο:", round(recall_final * 100, 2), "%\n")

## Recall με το τελικό μοντέλο: 74.47 %

5.3 Συμπεράσματα πειραμάτων

Για την πρόβλεψη της μεταβλητής Exited στο test set, εφαρμόστηκε το μοντέλο λογιστικής παλινδρόμησης και υπολογίστηκαν οι πιθανότητες αποχώρησης (predictTest).

Αρχικά, εφαρμόστηκε η τυπική προσέγγιση ταξινόμησης με κατώφλι 0.5. Αν και η ακρίβεια του μοντέλου ήταν 80.82%, η ανάκληση (recall) για την τάξη των πελατών που αποχωρούν ήταν πολύ χαμηλή (~22%), δηλαδή το μοντέλο απέτυχε να αναγνωρίσει την πλειοψηφία των πελατών που πραγματικά αποχωρούν.

Δεδομένου ότι η πρόβλεψη αποχώρησης (churn) είναι ένα πρόβλημα ανισορροπημένων τάξεων — όπου το 20% περίπου των πελατών είναι churners — η χρήση της ακρίβειας ως μοναδικό μέτρο αξιολόγησης είναι ανεπαρκής.

Για καλύτερη αξιολόγηση: - Δημιουργήθηκε ROC καμπύλη, η οποία απεικονίζει τη συμπεριφορά του μοντέλου για όλα τα πιθανά thresholds. - Υπολογίστηκε το AUC (Area Under Curve), που μετρά τη διακριτική ικανότητα του μοντέλου. Το AUC ήταν περίπου 0.7695, που δείχνει ικανοποιητική απόδοση. - Από την ROC καμπύλη προέκυψε ένα βέλτιστο κατώφλι (0.186), το οποίο βελτιστοποιεί την ισορροπία μεταξύ ευαισθησίας και ειδικότητας.

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

Στη συνέχεια, πραγματοποιήθηκε ένα τελικό πείραμα με λιγότερες μεταβλητές, επιλέγοντας μόνο τις 4–5 πιο σημαντικές μεταβλητές (βάσει p-value): Age, IsActiveMember, Gender, GeographyGermany, και Balance. Το μοντέλο επανεκπαιδεύτηκε με αυτό το υποσύνολο και εφαρμόστηκε στο test set χρησιμοποιώντας το ίδιο βέλτιστο threshold.

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

Συμπέρασμα: Για προβλήματα όπως το churn, σε datasets με σημαντική ανισορροπία, η χρήση χαμηλότερου κατωφλίου (π.χ. ~0.18) ενισχύει σημαντικά την ικανότητα του μοντέλου να εντοπίζει churners. Ακόμα και με λιγότερα χαρακτηριστικά, το μοντέλο μπορεί να διατηρήσει υψηλή ανάκληση, αν και με κάποια απώλεια στην ακρίβεια.

5.4 Backward elimination

“Ακολουθήθηκε διαδικασία backward elimination για την απομάκρυνση ασήμαντων μεταβλητών (βάσει p-value). Ξεκινώντας από το πλήρες μοντέλο, απομακρύνθηκαν σταδιακά οι μεταβλητές που δεν παρουσίαζαν στατιστική σημαντικότητα. Το τελικό μοντέλο διατήρησε μόνο τις πιο ισχυρές μεταβλητές (Age, Balance, Geography, Gender, IsActiveMember), διατηρώντας παρόμοια ακρίβεια και βελτιώνοντας την απλότητα και τη σταθερότητα του μοντέλου.”

# Επιλογή σημαντικών μεταβλητών από το train set
significant_train <- dataTrain %>%
  select(Exited, Geography, Gender, Age, Balance, IsActiveMember)

# Μετατροπή κατηγορικών μεταβλητών σε factors
significant_train$Geography <- factor(significant_train$Geography, levels = c("France", "Germany", "Spain"))
significant_train$Gender <- factor(significant_train$Gender)

# Εκπαίδευση του τελικού μοντέλου
final_sig_model <- glm(Exited ~ ., data = significant_train, family = "binomial")

# Προβολή αποτελεσμάτων
summary(final_sig_model)

## 
## Call:
## glm(formula = Exited ~ ., family = "binomial", data = significant_train)
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)      -4.176e+00  1.516e-01 -27.541  < 2e-16 ***
## GeographyGermany  7.180e-01  8.352e-02   8.596  < 2e-16 ***
## GeographySpain   -8.664e-03  8.688e-02  -0.100    0.921    
## GenderMale       -5.072e-01  6.744e-02  -7.521 5.44e-14 ***
## Age               7.555e-02  3.228e-03  23.402  < 2e-16 ***
## Balance           2.951e-06  6.099e-07   4.838 1.31e-06 ***
## IsActiveMember   -1.023e+00  7.128e-02 -14.358  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 6570.8  on 6498  degrees of freedom
## Residual deviance: 5576.8  on 6492  degrees of freedom
##   (1 observation deleted due to missingness)
## AIC: 5590.8
## 
## Number of Fisher Scoring iterations: 5

# Προετοιμασία test set
significant_test <- dataTest %>%
  select(Exited, Geography, Gender, Age, Balance, IsActiveMember)

significant_test$Geography <- factor(significant_test$Geography, levels = c("France", "Germany", "Spain"))
significant_test$Gender <- factor(significant_test$Gender)

# Δημιουργία προβλέψεων (πιθανότητες)
predict_final_sig <- predict(final_sig_model, newdata = significant_test, type = "response")

# Αφαίρεση NAs
valid_final_idx <- !is.na(predict_final_sig)
pred_final_clean <- predict_final_sig[valid_final_idx]
actual_final_clean <- significant_test$Exited[valid_final_idx]

# Χρήση του προηγούμενου βέλτιστου threshold
final_class_sig <- ifelse(pred_final_clean >= optimal_threshold, 1, 0)

# Confusion matrix και μετρικές
conf_matrix_sig <- table(Predicted = final_class_sig, Actual = actual_final_clean)

TP_sig <- conf_matrix_sig["1", "1"]
FN_sig <- conf_matrix_sig["0", "1"]
recall_sig <- TP_sig / (TP_sig + FN_sig)

accuracy_sig <- mean(final_class_sig == actual_final_clean)
conf_matrix_sig

##          Actual
## Predicted    0    1
##         0 1832  182
##         1  953  531

# Εκτύπωση αποτελεσμάτων
cat("✅ Accuracy (μόνο σημαντικές μεταβλητές):", round(accuracy_sig * 100, 2), "%\n")

## ✅ Accuracy (μόνο σημαντικές μεταβλητές): 67.55 %

cat("🔍 Recall (μόνο σημαντικές μεταβλητές):", round(recall_sig * 100, 2), "%\n")

## 🔍 Recall (μόνο σημαντικές μεταβλητές): 74.47 %

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

Η σταθερότητα των τιμών ακρίβειας (accuracy) και ανάκλησης (recall) μετά την αφαίρεση των στατιστικά μη σημαντικών μεταβλητών από το μοντέλο αποτελεί ένδειξη ότι η απόδοσή του παραμένει αμετάβλητη, επιβεβαιώνοντας την ορθότητα της διαδικασίας. Η επιλογή χαρακτηριστικών βασίστηκε στην ανάλυση των p-values από το πλήρες μοντέλο λογιστικής παλινδρόμησης, διατηρώντας μόνο εκείνα που παρουσιάζουν σημαντική επίδραση στην πρόβλεψη της αποχώρησης πελατών (Exited). Οι προβλέψεις συνεχίζουν να βασίζονται σε κρίσιμες μεταβλητές όπως η ηλικία (Age), το υπόλοιπο (Balance), η ενεργή συμμετοχή (IsActiveMember), το φύλο και η χώρα, οι οποίες παρέχουν επαρκή πληροφορία. Συνεπώς, η ακρίβεια και η ικανότητα αναγνώρισης των πελατών που αποχωρούν (recall) δεν επηρεάζονται, ενώ το μοντέλο γίνεται απλούστερο, πιο ερμηνεύσιμο και πιο αποδοτικό.

6 Δένδρο Απόφασης

Θα χρησιμοποιηθεί επιπρόσθετα ένα ακόμα μοντέλο classification με σκοπό την σύγκριση μοντέλων μεταξύ λογιστικής παλινδρόμησης και decision trees. Στο πείραμα αξιοποιείται η μέθοδος CART για να παράγει ένα σύνολο κανόνων ταξινόμησης με σκοπό να διαχωριστούν οι πελάτες με το κριτήριο churn (αποχώρησης).

# Προσθήκη κατάλληλων βιβλιοθήκων
library(rpart)
library(rpart.plot)

6.1 Δημιουργία μοντέλου

Για την δημιουργία μοντέλου χρησιμοποιήθηκαν τα σημαντικότερα features που εφαρμόστηκαν και στην λογιστική παλινδρόμηση (Age,isActiveMember,Gender, GeographyGermany, Balance)

churnTree<-  rpart(Exited ~ Age + Gender + IsActiveMember + Geography + Balance, data = final_train,  method="class", minbucket=25)
prp(churnTree)

Το συγκεκριμένο decision tree χρησιμοποιεί μόνο 2 features για να προβλέψει την εξαρτημένη μεταβλητή churn. Ο βασικότερος παράγοντας αποχώρησης με βάση το GINI είναι η ηλικία. Συγκεκρίμενα στην η ρίζα του δένδρου χωρίζει τους πελάτες που είναι >=45 και τους προβλέπει όλους 0 ( θα αποχωρήσουν) χωρίς καμία άλλη διάσπαση.

Επιπλέον, για τους πελάτες <45 ετών γίνεται μια ακόμα διάσπαση που τους χωρίζει με βάση το feature isActive. Τέλος, αυτοί που βρίσκονται στο συγκεκριμένο κλαδί και είναι ενεργοι κατηγοριοποιούνται ως 1 (δεν θα αποχωρήσουν) ενώ οι υπόλοιποι ως 0 (θα αποχωρήσουν).

churnTree$variable.importance

##            Age IsActiveMember      Geography 
##    267.0620369    107.5367172      0.9941761

PredictCART <- predict (churnTree, newdata=final_test, type="class")
table(final_test$Exited, PredictCART)

##    PredictCART
##        0    1
##   0 2668  119
##   1  479  234

# Confusion matrix
cm <- table(final_test$Exited, PredictCART)

# Extract values
TN <- cm[1, 1]
FP <- cm[1, 2]
FN <- cm[2, 1]
TP <- cm[2, 2]

# Metrics
accuracy <- (TP + TN) / sum(cm)
recall <- TP / (TP + FN)

# Print
cat("Accuracy:", round(accuracy, 4), "\n")

## Accuracy: 0.8291

cat("Recall:", round(recall, 4), "\n")

## Recall: 0.3282

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

Για την σύγκριση μεταξύ του μοντέλου λογιστικής παλινδρόμησης και δένδρου απόφασης δημιουργήθηκε το confusion matrix για να αναδείξει τα TP,TN,FP,FN και έπειτα υπολογίστηκε το accuracy και το recall του decision tree. Σύμφωνα με το πείραμα το accuracy που επιτέυχθηκε με τα decision trees είναι 82.91% που σημαίνει οτι είναι μεγαλύτερο από το μοντέλο λογιστικής παλινδρόμησης (σε όλα τα πειράματα). Ωστόσο, το ζήτημα που μας απασχολεί είναι η αποτελεσματική πρόβλεψη των πελατών που αποχωρούν και ένα υψηλότερο accuracy πιθάνως μπορεί να οδηγήσει σε bias στην μεγάλυτερη κλάση (στα άτομα που δεν αποχωρούν) γιαυτό το λόγο γίνεται και η σύγκριση μεταξύ recall.

Με βάση το classifier decision tree, επιτεύχθηκε recall=32.82% το οποίο είναι μεγαλύτερο από το logistic regression (22.16% recall) με default threshold (0.5) όχι όμως από το recall (74.33%) με βέλτιστο threshold. Δεδομένου αυτού, κρίνεται απαραίτητο να υπολογιστούν εκ νέου οι μετρικές accuracy,recall στο decision tree με βέλτιστο threshold αυτή τη φορά για να μπορούν να συγκριθούν τα μοντέλα ύπο τις ίδιες προυποθέσεις.

6.3 Πείραμα 2ο

library(pROC)
# 1. Predict probabilities for class 1 (churn)
prob_pred <- predict(churnTree, newdata = final_test, type = "prob")[, 2]

# 2. Create ROC object
roc_obj <- roc(final_test$Exited, prob_pred)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

# 3. Plot ROC Curve
plot(roc_obj, col = "blue", main = "ROC Curve for Decision Tree", lwd = 2)
abline(a = 0, b = 1, lty = 2, col = "gray")

# 4. AUC value
auc_value <- auc(roc_obj)
cat("AUC:", round(auc_value, 4), "\n")

## AUC: 0.6745

Η παραπάνω ROC καμπύλη απεικονίζει την απόδοση του μοντέλου λήψης απόφασης (Decision Tree) όσον αφορά την ταξινόμηση των πελατών σε churners (Exited = 1) και non-churners.

Παρατηρούμε ότι:

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

Η ευαισθησία (sensitivity) δεν αυξάνεται δραματικά για υψηλές τιμές ειδικότητας, γεγονός που υποδεικνύει ότι το μοντέλο δυσκολεύεται να εντοπίσει με ακρίβεια τους churners.

Το AUC (Area Under Curve) που υπολογίστηκε ήταν σχετικά χαμηλό (0.67), το οποίο υποδεικνύει ότι το μοντέλο έχει χαμηλή διακριτική ικανότητα μεταξύ των πελατών που αποχωρούν και αυτών που παραμένουν.

# 5. Optimal threshold using Youden’s J
opt_coords <- coords(roc_obj, "best", ret = c("threshold", "sensitivity", "specificity"), transpose = FALSE)
optimal_threshold <- as.numeric(opt_coords["threshold"])  # convert from list to numeric
cat("Optimal Threshold:", round(optimal_threshold, 4), "\n")

## Optimal Threshold: 0.2112

# 1. Predict probabilities for class 1 (churn)
prob_pred <- predict(churnTree, newdata = final_test, type = "prob")[, 2]

# 2. Apply the optimal threshold
predicted_class_opt <- ifelse(prob_pred >= 0.2112, 1, 0)

# 3. Confusion matrix
cm_opt <- table(Predicted = predicted_class_opt, Actual = final_test$Exited)

# 4. Extract TP, FN, etc.
TP <- cm_opt["1", "1"]
FN <- cm_opt["0", "1"]
TN <- cm_opt["0", "0"]
FP <- cm_opt["1", "0"]

# 5. Calculate metrics
accuracy <- (TP + TN) / sum(cm_opt)
recall <- TP / (TP + FN)

# 6. Display results
cat("Accuracy using optimal threshold (0.2112):", round(accuracy * 100, 2), "%\n")

## Accuracy using optimal threshold (0.2112): 76.09 %

cat("Recall using optimal threshold (0.2112):", round(recall * 100, 2), "%\n")

## Recall using optimal threshold (0.2112): 48.25 %

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

Με τη χρήση του βέλτιστου κατωφλίου (threshold) που προέκυψε από την καμπύλη ROC, η ακρίβεια (accuracy) του μοντέλου decision tree μειώθηκε ελαφρώς στο 76.09%, ωστόσο παρατηρήθηκε σημαντική αύξηση στην ανάκληση (recall), η οποία έφτασε το 48.25%.

Αν και η συνολική απόδοση του decision tree βελτιώθηκε σε σχέση με τη χρήση του default threshold (0.5), το μοντέλο λογιστικής παλινδρόμησης εξακολουθεί να παρουσιάζει ανώτερα αποτελέσματα σε όρους recall (74.47%), έστω κι αν η ακρίβεια του είναι χαμηλότερη (67.55%).

Το υψηλότερο recall καθιστά το μοντέλο γραμμικής παλινδρόμησης πιο ικανό στην ανίχνευση του minority class, δηλαδή των πελατών που αποχωρούν — γεγονός ιδιαίτερα σημαντικό για επιχειρησιακές αποφάσεις που στοχεύουν στην πρόληψη αποχώρησης.

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

minbucket (ελάχιστο πλήθος παρατηρήσεων ανά φύλλο)
cp (complexity parameter)

το μοντέλο ενδέχεται να επιτύχει καλύτερη ισορροπία μεταξύ accuracy και recall, και να καταστεί πιο ανταγωνιστικό.