1 Περιγραφή dataset

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

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

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

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

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: Εμφάνιση ελλιπών τιμών ανά μεταβλητή**

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 Μοντέλα Γραμμικής Παλινδρόμησης

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

5.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**

Figure 6: Correlation Heatmap of Key Numerical Variables

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

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

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

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

5.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()

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

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

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

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

5.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)**

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

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

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

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

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

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

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

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

table(Churn_Modeling$Exited)
## 
##    0    1 
## 7963 2037

6.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()

6.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 %

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

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

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

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