Bank Customer Churn Prediction

1 Περιγραφή dataset

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

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

2 Επιχειρηματική Αναλυτική

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

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

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

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

3 Eπιχειρηματικά ερωτήματα

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

• Key Factors: Ποιες είναι οι βασικές παράμετροι που επηρεάζουν την αποχώρηση των πελατών;

• Geographical Analysis: Πώς επηρεάζει η γεωγραφική τοποθεσία την πιθανότητα αποχώρησης;

• Credit Score: Οι πελάτες με υψηλό πιστωτικό σκορ είναι λιγότερο πιθανό να αποχωρήσουν;

• Product Usage: Ποιος είναι ο ρόλος της χρήσης πιστωτικής κάρτας στην παραμονή των πελατών;

• Churn Prediction: Μπορούμε να προβλέψουμε με ακρίβεια ποιοι πελάτες θα αποχωρήσουν στο μέλλον;

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

Παρακάτω περιγράφονται οι μεταβλητές του 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 = όχι)

---

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

#Εισαγωγή 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

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

Σε αυτό το στάδιο πραγματοποιήθηκε έλεγχος για ελλιπείς τιμές και διπλότυπες εγγραφές στο 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

7 Υπολογισμοί στατιστικών + Box Plots

Παρακάτω παρουσιάζονται βασικά περιγραφικά στατιστικά για τις μεταβλητές CreditScore, Balance και EstimatedSalary, καθώς και διαγράμματα box plot για την ανίχνευση των outliers.

# Περιγραφικά στατιστικά
summary(Churn_Modeling[, c("CreditScore", "Balance", "EstimatedSalary")])

##   CreditScore       Balance       EstimatedSalary    
##  Min.   :350.0   Min.   :     0   Min.   :    11.58  
##  1st Qu.:584.0   1st Qu.:     0   1st Qu.: 51002.11  
##  Median :652.0   Median : 97199   Median :100193.91  
##  Mean   :650.5   Mean   : 76486   Mean   :100090.24  
##  3rd Qu.:718.0   3rd Qu.:127644   3rd Qu.:149388.25  
##  Max.   :850.0   Max.   :250898   Max.   :199992.48

#Δημιουργία boxplot για την μεταβλητή Credit Score
boxplot(Churn_Modeling$CreditScore,
        main = "Outliers in Credit Score",
        col = "lightblue")

#Δημιουργία boxplot για την μεταβλητή Balance
boxplot(Churn_Modeling$Balance,
        main = "Outliers in Balance",
        col = "lightgreen")

#Δημιουργία boxplot για την μεταβλητή Estimated Salary
boxplot(Churn_Modeling$EstimatedSalary,
        main = "Outliers in Estimated Salary",
        col = "orange")

8 Scatter Plots

8.1 Ηλικία και Πιστωτικό Σκορ

Οι παρακάτω παρατηρήσεις προκύπτουν από τη συσχέτιση μεταξύ ηλικίας και πιστωτικού σκορ σε σχέση με την αποχώρηση πελατών:

• Οι ηλικίες ανάμεσα σε 40–65 έχουν το μεγαλύτερο ποσοστό σε αποχωρήσεις.
• Άτομα με πιστωτικό score μικρότερο του 400 τείνουν να διακόπτουν τη συνεργασία τους με την τράπεζα.
• Οι ηλικίες από 70 και άνω έχουν το χαμηλότερο ποσοστό αποχώρησης.

#Scatter plot πελατών βάσει ηλίκιας και πιστωτικού score 
library(ggplot2)
ggplot(Churn_Modeling, aes(x = Age, y = CreditScore, color = factor(Exited))) +
  geom_point() +
  scale_color_manual(values = c("blue", "red"),
                     labels = c("Non-Churner", "Churner"),
                     name = "Churn Status") +
  labs(title = "Age vs. Credit Score (Churners vs Non-Churners)",
       x = "Age",
       y = "Credit Score") +
  theme_minimal()

Figure 2: Ανάλυση Αποχωρήσεων βάσει Ηλικίας και Πιστωτικού Σκορ

8.2 Υπόλοιπο λογαριασμού και αριθμός προϊόντων

Οι παρακάτω παρατηρήσεις προκύπτουν από την οπτικοποίηση του αριθμού προϊόντων και του υπολοίπου λογαριασμού ανά πελάτη:

-Όσα περισσότερα προϊόντα κατέχει ο πελάτης τόσο πιο πιθανό είναι να αποχωρήσει.

-Το υπόλοιπο του λογαριασμού δεν φαίνεται να σχετίζεται σημαντικά με την αποχώρηση

#Scatter plot πελατών βάσει το υπόλοιπο λογαριασμού και 
#τον αριθμό προϊόντων
ggplot(Churn_Modeling, aes(x = NumOfProducts, y = Balance,
                           color = factor(Exited))) +
  geom_jitter(width = 0.2, height = 0, size = 1.5) +
  scale_color_manual(
    values = c("blue", "red"),
    labels = c("Non-Churner", "Churner"),
    name = "Churn Status"
  ) +
  labs(
    title = "Number of Products vs. Balance (Churners vs Non-Churners)",
    x = "Number of Products",
    y = "Balance"
  ) +
  theme_minimal()

Figure 3: Συσχέτιση αποχωρήσεων με βάσει το υπόλοιπο λογαριασμού και τον αριθμό προϊόντων

9 Στατιστική Απεικόνιση Ανά Χώρα: Stacked Bar Chart

Η παρακάτω γραφική απεικόνιση δείχνει τον αριθμό των πελατών που αποχωρούν (churners) και εκείνων που παραμένουν (non-churners) ανά χώρα:

• Η Γαλλία έχει το χαμηλότερο ποσοστό αποχωρήσεων.
• Η Γερμανία αποτελεί την λιγότερο ικανοποιημένη χώρα με τον μεγαλύτερο αριθμό churners.
• Στην Ισπανία βρίσκεται ο χαμηλότερος αριθμός πελατών.

#Bar chart πελατών ανα χώρα
ggplot(Churn_Modeling, aes(x = Geography, fill = factor(Exited))) +
  geom_bar(position = "dodge") + 
  scale_fill_manual(
    values = c("blue", "red"),
    labels = c("Non-Churner", "Churner"),
    name = "Churn Status"
  ) +
  labs(
    title = "Churn Rate by Geography",
    x = "Country",
    y = "Count"
  ) +
  theme_minimal()

Figure 4: Ποσοστά Αποχωρήσεων Πελατών ανά Χώρα

10 Κατανομή Ηλικίας Πελατών: Histogram

Η ανάλυση της ηλικιακής κατανομής των πελατών παρέχει κρίσιμες πληροφορίες για τη στόχευση στρατηγικών marketing:

• Η τράπεζα προσελκύει κυρίως πελάτες ηλικίας 30–40 ετών, γεγονός που υποδεικνύει το βασικό target group της.
• Οι νεότεροι πελάτες (<30 ετών) και οι μεγαλύτερης ηλικίας (>60 ετών) είναι σημαντικά λιγότεροι, άρα απαιτούνται στοχευμένες ενέργειες προσέγγισης.

#Ιστόγραμμα ηλικίας πελατών
ggplot(Churn_Modeling, aes(x = Age)) +
  geom_histogram(binwidth = 5, fill = "skyblue", color = "black") +
  labs(
    title = "Customer Age Distribution",
    x = "Age",
    y = "Count"
  ) +
  theme_minimal()

Figure 5: Κατανομή Ηλικίας Πελατών

11 Στρατηγικές Μείωσης Αποχωρήσεων

Η παρακάτω στρατηγική ανάλυση βασίζεται στα ευρήματα της μελέτης αποχώρησης πελατών και στοχεύει στην ενίσχυση της διατήρησης πελατών:

---

11.1 🎯 Personalized Retention

Εξατομικευμένες προσφορές, διαφημίσεις και προϊόντα ειδικά προσαρμοσμένα για άτομα ηλικίας 40–65 ετών, όπου παρατηρείται αυξημένη πιθανότητα αποχώρησης.

---

11.2 💰 Financial Support

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

---

11.3 🔽 Reduce Upselling

Μείωση περιττών υπεραγορών και διατήρηση μόνο των απαραίτητων τραπεζικών προϊόντων ώστε να βελτιωθεί η εμπειρία του πελάτη και να μειωθεί η δυσαρέσκεια.

---

11.4 📊 Competitive Analysis

Διεξαγωγή στοχευμένων ερευνών και εφαρμογή ανταγωνιστικής τιμολόγησης στη Γερμανία, όπου παρατηρείται το υψηλότερο ποσοστό churn.

---

Αυτές οι στρατηγικές μπορούν να ενσωματωθούν σε πολιτικές εξυπηρέτησης και marketing, ενισχύοντας τη μακροχρόνια σχέση με τους πελάτες και μειώνοντας την απώλεια εσόδων.

12 Μοντέλα Γραμμικής Παλινδρόμησης

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

12.1 Correlation Heatmap

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

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

# Load necessary libraries

library(dplyr)
library(reshape2)

# Select only continuous variables
cor_data <- Churn_Modeling %>%
  select(CreditScore, Age, Tenure, Balance, EstimatedSalary)

# Calculate correlation matrix
cor_matrix <- round(cor(cor_data, use = "complete.obs"), 2)

# Melt the correlation matrix for ggplot2
cor_melted <- melt(cor_matrix)

# Plot the heatmap with correlation values
ggplot(cor_melted, aes(Var1, Var2, fill = value)) +
  geom_tile(color = "white") +
  geom_text(aes(label = value), size = 4) +  # Add correlation values
  scale_fill_gradient2(low = "blue", high = "red", mid = "white",
                       midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Correlation") +
  theme_minimal() +
  labs(title = "Correlation Heatmap of Key Numerical Variables",
       x = "", y = "") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Figure 6: Correlation Heatmap of Key Numerical Variables

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

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

Ωστόσο, διαπιστώθηκε πως το Balance εμφανίζει ασθενή θετική συσχέτιση με το EstimatedSalary, η οποία παρότι όχι ιδιαίτερα ισχυρή, αποτελεί μία από τις πιο σχετικές σχέσεις εντός του συνόλου δεδομένων.

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

12.2 Simple Linear Regression: EstimatedSalary ~ Balance

# Δημιουργία του μοντέλου
simple_model <- lm(EstimatedSalary ~ Balance, data = Churn_Modeling)

# Αποτελέσματα του μοντέλου
summary(simple_model) 

## 
## Call:
## lm(formula = EstimatedSalary ~ Balance, data = Churn_Modeling)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -100861  -49253      59   49048  100804 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 9.919e+04  9.098e+02  109.02   <2e-16 ***
## Balance     1.179e-02  9.217e-03    1.28    0.201    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 57510 on 9998 degrees of freedom
## Multiple R-squared:  0.0001638,  Adjusted R-squared:  6.377e-05 
## F-statistic: 1.638 on 1 and 9998 DF,  p-value: 0.2007

ggplot(Churn_Modeling, aes(x = Balance, y = EstimatedSalary)) +
  geom_point(alpha = 0.5, color = "steelblue") +
  geom_smooth(method = "lm", se = TRUE, color = "darkred") +
  labs(
    title = "Linear Regression: Balance vs. Estimated Salary",
    x = "Account Balance",
    y = "Estimated Salary"
  ) +
  theme_minimal()

12.3 Σχολιασμός Αποτελεσμάτων

Το μοντέλο γραμμικής παλινδρόμησης μεταξύ του υπολοίπου λογαριασμού (Balance) και του εκτιμώμενου μισθού (EstimatedSalary) δείχνει ότι δεν υπάρχει στατιστικά σημαντική γραμμική συσχέτιση μεταξύ των δύο μεταβλητών. Παρότι ο συντελεστής της μεταβλητής Balance είναι θετικός (1.179e-02), η τιμή p-value = 0.201 υποδεικνύει ότι η μεταβλητή δεν είναι στατιστικά σημαντική (με επίπεδο σημαντικότητας 0.05). Επιπλέον, η τιμή του R² είναι εξαιρετικά χαμηλή (0.00016), γεγονός που σημαίνει πως το υπόλοιπο λογαριασμού εξηγεί λιγότερο από 0.02% της διακύμανσης στο εισόδημα.

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

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

12.5 Πολλαπλή Γραμμική Παλινδρόμηση: EstimatedSalary ~ Balance + Age

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

# Μοντέλο γραμμικής παλινδρόμησης με Balance και Age
model_multi <- lm(EstimatedSalary ~ Balance + Age, data = Churn_Modeling, na.action = na.exclude)

# Προβλέψεις
Churn_Modeling$PredictedSalary <- predict(model_multi)

# Εμφάνιση αποτελεσμάτων μοντέλου
summary(model_multi)

## 
## Call:
## lm(formula = EstimatedSalary ~ Balance + Age, data = Churn_Modeling, 
##     na.action = na.exclude)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -100975  -49104      -7   49004  101536 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.008e+05  2.303e+03  43.771   <2e-16 ***
## Balance      1.204e-02  9.222e-03   1.305    0.192    
## Age         -4.178e+01  5.487e+01  -0.762    0.446    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 57510 on 9996 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.000223,   Adjusted R-squared:  2.294e-05 
## F-statistic: 1.115 on 2 and 9996 DF,  p-value: 0.3281

# Οπτικοποίηση: Πραγματικές vs Προβλεπόμενες Τιμές
ggplot(Churn_Modeling, aes(x = PredictedSalary, y = EstimatedSalary)) +
  geom_point(alpha = 0.4, color = "skyblue") +
  geom_abline(slope = 1, intercept = 0, color = "darkred", linetype = "dashed", size = 1) +
  labs(
    title = "Actual vs Predicted Estimated Salary",
    x = "Predicted Estimated Salary",
    y = "Actual Estimated Salary"
  ) +
  theme_minimal()

Figure: Actual vs Predicted Estimated Salary (Balance + Age)

12.6 Σχολιασμός Αποτελεσμάτων

Το πολλαπλό μοντέλο γραμμικής παλινδρόμησης με τις μεταβλητές Balance και Age ως προβλεπτικούς παράγοντες για το EstimatedSalary, δεν παρουσιάζει στατιστικά σημαντικά αποτελέσματα.
Ο συντελεστής του Balance (0.012) έχει p-value = 0.192, ενώ ο συντελεστής του Age είναι αρνητικός (-41.78) με p-value = 0.446.
Κανένας από τους δύο δεν είναι στατιστικά σημαντικός σε επίπεδο σημαντικότητας 5% (α = 0.05), γεγονός που υποδηλώνει ότι καμία από τις δύο μεταβλητές δεν συμβάλλει ουσιαστικά στην πρόβλεψη του εισοδήματος.

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

Η τιμή του R² παραμένει πολύ χαμηλή (0.00022), ακόμα και μετά την προσθήκη δεύτερης μεταβλητής, κάτι που επιβεβαιώνει ότι το μοντέλο δεν εξηγεί τη διακύμανση του EstimatedSalary. Επιπλέον, η τιμή F-test είναι επίσης μη σημαντική (p-value = 0.328), ενισχύοντας το συμπέρασμα ότι το μοντέλο δεν είναι καλύτερο από ένα μοντέλο χωρίς καθόλου μεταβλητές.
Συνολικά, το μοντέλο δεν προσφέρει πρακτική προβλεπτική αξία και υποδεικνύει πως το EstimatedSalary εξαρτάται πιθανώς από άλλους μη παρατηρούμενους παράγοντες ή από μεταβλητές που δεν περιλαμβάνονται στο παρόν dataset. ### Εναλλακτικές Προσεγγίσεις

Λαμβάνοντας υπόψη τα παραπάνω ευρήματα, καθίσταται σαφές ότι η γραμμική παλινδρόμηση δεν αποτελεί κατάλληλο εργαλείο για την πρόβλεψη των βασικών επιχειρηματικών μεταβλητών του παρόντος dataset. Εναλλακτικά, προτείνεται η χρήση λογιστικής παλινδρόμησης (logistic regression), η οποία είναι ιδανική για την πρόβλεψη δυαδικών μεταβλητών όπως το Exited (Churn).
Η προσέγγιση αυτή θα μπορούσε να βοηθήσει την τράπεζα να αναγνωρίσει πιθανά χαρακτηριστικά πελατών που σχετίζονται με αυξημένη πιθανότητα αποχώρησης και να σχεδιάσει στοχευμένες παρεμβάσεις.

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

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

table(Churn_Modeling$Exited)

## 
##    0    1 
## 7963 2037

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

# Υπολογισμός ποσοστών
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()

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

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

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

# Βήμα 1: Φόρτωση απαραίτητων πακέτων
library(dplyr)

# Βήμα 1: Καθαρισμός δεδομένων
dataTrain_clean <- dataTrain %>%
  select(-CustomerId, -Surname, -PredictedSalary, -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, -PredictedSalary, -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 %

13.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. Ακόμα και με λιγότερα χαρακτηριστικά, το μοντέλο μπορεί να διατηρήσει υψηλή ανάκληση, αν και με κάποια απώλεια στην ακρίβεια.