Ανάλυση dataset και Λογιστική Παλινδρόμηση Loan Data

Περιγραφή του Dataset και Πηγή

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

Πηγή: Το dataset διατίθεται από το Kaggle.

Επιχειρηματική Αναλυτική – Αιτιολόγηση Επιλογής

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

Πιθανά Επιχειρηματικά Ερωτήματα

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

Διερεύνηση Δεδομένων

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

loan_data <- read.csv("C:/Users/User/Downloads/loan_data.csv")

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

Πίνακας Περιγραφής Μεταβλητών
Μεταβλητή	Τύπος
person_age	Αριθμητικό
person_gender	Κατηγορική
person_education	Κατηγορική
person_income	Αριθμητικό
person_emp_exp	Αριθμητικό
person_home_ownership	Κατηγορική
loan_amnt	Αριθμητικό
loan_intent	Κατηγορική
loan_int_rate	Αριθμητικό
loan_percent_income	Αριθμητικό
cb_person_cred_hist_length	Αριθμητικό
credit_score	Αριθμητικό
previous_loan_defaults_on_file	Κατηγορική
loan_status	Δυαδικό

Περιγραφικά Στατιστικά

summary(loan_data)

##    person_age     person_gender      person_education   person_income    
##  Min.   : 20.00   Length:45000       Length:45000       Min.   :   8000  
##  1st Qu.: 24.00   Class :character   Class :character   1st Qu.:  47204  
##  Median : 26.00   Mode  :character   Mode  :character   Median :  67048  
##  Mean   : 27.76                                         Mean   :  80319  
##  3rd Qu.: 30.00                                         3rd Qu.:  95789  
##  Max.   :144.00                                         Max.   :7200766  
##  person_emp_exp   person_home_ownership   loan_amnt     loan_intent       
##  Min.   :  0.00   Length:45000          Min.   :  500   Length:45000      
##  1st Qu.:  1.00   Class :character      1st Qu.: 5000   Class :character  
##  Median :  4.00   Mode  :character      Median : 8000   Mode  :character  
##  Mean   :  5.41                         Mean   : 9583                     
##  3rd Qu.:  8.00                         3rd Qu.:12237                     
##  Max.   :125.00                         Max.   :35000                     
##  loan_int_rate   loan_percent_income cb_person_cred_hist_length  credit_score  
##  Min.   : 5.42   Min.   :0.0000      Min.   : 2.000             Min.   :390.0  
##  1st Qu.: 8.59   1st Qu.:0.0700      1st Qu.: 3.000             1st Qu.:601.0  
##  Median :11.01   Median :0.1200      Median : 4.000             Median :640.0  
##  Mean   :11.01   Mean   :0.1397      Mean   : 5.867             Mean   :632.6  
##  3rd Qu.:12.99   3rd Qu.:0.1900      3rd Qu.: 8.000             3rd Qu.:670.0  
##  Max.   :20.00   Max.   :0.6600      Max.   :30.000             Max.   :850.0  
##  previous_loan_defaults_on_file  loan_status    
##  Length:45000                   Min.   :0.0000  
##  Class :character               1st Qu.:0.0000  
##  Mode  :character               Median :0.0000  
##                                 Mean   :0.2222  
##                                 3rd Qu.:0.0000  
##                                 Max.   :1.0000

Δημιουργία του καθαρισμένου dataset (αφαίρεση outliers)

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

loan_data_clean <- loan_data %>%
  filter(person_age <= 90, person_emp_exp <= 70, person_income <= 5000000)

Διαγράμματα

1. Scatterplot – Ηλικία και Χρόνια Εργασιακής Εμπειρίας

ggplot(loan_data_clean, aes(x = person_age, y = person_emp_exp, color = factor(loan_status))) +
  geom_jitter(alpha = 0.5, width = 0.3, height = 0.3) +
  labs(title = "Years of Experience vs. Age (Colored by Loan Status)",
       x = "Age", y = "Employment Experience",
       color = "Loan Status\n(0 = No Default, 1 = Defaulted)") +
  scale_color_manual(values = c("red", "blue"),
                     labels = c("No Default", "Defaulted")) +
  theme_minimal()

Διάγραμμα 1. Σχέση Ηλικίας και Εμπειρίας ανά Κατάσταση Δανείου.

Σχόλιο: Οι περισσότερες καθυστερήσεις συμβαίνουν σε άτομα με χαμηλή εμπειρία και ηλικία.

2. Boxplot – Ποσό Δανείου ανά Κατοχή Κατοικίας

ggplot(loan_data_clean, aes(x = person_home_ownership, y = loan_amnt, fill = factor(loan_status))) +
  geom_boxplot() +
  labs(title = "Loan Amount by Home Ownership",
       x = "Home Ownership", y = "Loan Amount ($)",
       fill = "Loan Status") +
  theme_minimal()

Διάγραμμα 2. Ποσό Δανείου ανά Κατοχή Κατοικίας.

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

3. Ιστόγραμμα – Εισόδημα και Κατάσταση Δανείου

ggplot(loan_data_clean, aes(x = person_income, fill = factor(loan_status))) +
  geom_histogram(position = "identity", alpha = 0.6, bins = 50) +
  labs(title = "Income Distribution by Loan Status",
       x = "Income", y = "Count", fill = "Loan Status") +
  theme_minimal()

Διάγραμμα 3. Κατανομή Εισοδήματος με βάση την Κατάσταση Δανείου.

Σχόλιο: Οι χαμηλότεροι μισθοί σχετίζονται με υψηλότερο ποσοστό καθυστέρησης.

4. Bar Chart – Εκπαίδευση και Κατάσταση Δανείου

ggplot(loan_data_clean, aes(x = person_education, fill = factor(loan_status))) +
  geom_bar(position = "dodge", color = "black") +
  labs(title = "Loan Status by Person Education",
       x = "Education Level", y = "Count",
       fill = "Loan Status\n(0 = No Default, 1 = Defaulted)") +
  theme_light()

Διάγραμμα 4. Κατάσταση Δανείου ως προς την Εκπαίδευση.

Σχόλιο: Οι δανειολήπτες με υψηλότερη εκπαίδευση φαίνεται να έχουν μικρότερα ποσοστά καθυστέρησης.

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

Βήμα 1: Προετοιμασία Δεδομένων

Αφού βρούμε την ακρίβεια του μοντέλου βάσης, για την εκπαίδευση και αξιολόγηση του μοντέλου λογιστικής παλινδρόμησης, το αρχικό σύνολο δεδομένων διαχωρίζεται τυχαία σε δύο υποσύνολα: training set (65% των παρατηρήσεων) και testing set (35% των παρατηρήσεων). Ο διαχωρισμός πραγματοποιείται με χρήση της εντολής sample() και ορίζεται τιμή seed ίση με 930, ώστε τα αποτελέσματα να είναι αναπαραγώγιμα. Η επιλογή της συγκεκριμένης τιμής προκύπτει από τα δύο τελευταία ψηφία του ιδρυματικού email.

table(loan_data_clean$loan_status)

## 
##     0     1 
## 34992 10000

baseacc <- 34992/44992
propability <- (34992/44992)*100
cat(propability)

## 77.77383

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

set.seed(930)
split <- sample.split(loan_data_clean$loan_status,SplitRatio=0.65)
Train = subset(loan_data_clean,split==TRUE)
Test = subset(loan_data_clean,split==FALSE)

cat("Train set:", nrow(Train), "καταχωρήσεις\n")

## Train set: 29245 καταχωρήσεις

cat("Test set:", nrow(Test), "καταχωρήσεις\n")

## Test set: 15747 καταχωρήσεις

Βήμα 2: Δημιουργία μοντέλων λογιστικής παλινδρόμησης

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

model_full <- glm(loan_status ~ ., data = Train, family = "binomial")
summary(model_full)

## 
## Call:
## glm(formula = loan_status ~ ., family = "binomial", data = Train)
## 
## Coefficients:
##                                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                       -6.612e-01  4.514e-01  -1.465  0.14295    
## person_age                         4.056e-02  1.368e-02   2.965  0.00303 ** 
## person_gendermale                  3.037e-02  4.389e-02   0.692  0.48894    
## person_educationBachelor           2.289e-02  5.843e-02   0.392  0.69527    
## person_educationDoctorate          1.031e-01  1.841e-01   0.560  0.57539    
## person_educationHigh School        8.637e-03  6.100e-02   0.142  0.88741    
## person_educationMaster            -1.359e-02  6.953e-02  -0.196  0.84499    
## person_income                      2.556e-06  6.194e-07   4.127 3.68e-05 ***
## person_emp_exp                    -2.446e-02  1.202e-02  -2.035  0.04186 *  
## person_home_ownershipOTHER         1.087e-01  3.809e-01   0.285  0.77542    
## person_home_ownershipOWN          -1.420e+00  1.244e-01 -11.408  < 2e-16 ***
## person_home_ownershipRENT          7.122e-01  4.983e-02  14.291  < 2e-16 ***
## loan_amnt                         -1.170e-04  6.193e-06 -18.896  < 2e-16 ***
## loan_intentEDUCATION              -9.418e-01  7.231e-02 -13.024  < 2e-16 ***
## loan_intentHOMEIMPROVEMENT        -4.569e-02  8.090e-02  -0.565  0.57221    
## loan_intentMEDICAL                -3.394e-01  7.007e-02  -4.844 1.27e-06 ***
## loan_intentPERSONAL               -7.400e-01  7.434e-02  -9.954  < 2e-16 ***
## loan_intentVENTURE                -1.250e+00  7.849e-02 -15.927  < 2e-16 ***
## loan_int_rate                      3.258e-01  8.086e-03  40.296  < 2e-16 ***
## loan_percent_income                1.690e+01  4.707e-01  35.894  < 2e-16 ***
## cb_person_cred_hist_length        -2.006e-02  1.166e-02  -1.720  0.08536 .  
## credit_score                      -8.965e-03  5.071e-04 -17.680  < 2e-16 ***
## previous_loan_defaults_on_fileYes -2.043e+01  1.275e+02  -0.160  0.87267    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 30985  on 29244  degrees of freedom
## Residual deviance: 12932  on 29222  degrees of freedom
## AIC: 12978
## 
## Number of Fisher Scoring iterations: 19

Οι μεταβλητές person_income, loan_amnt, loan_intent, loan_int_rate, loan_percent_income, credit_score, και οι κατηγορίες ιδιοκτησίας person_home_ownership OWN και RENT έχουν πολύ χαμηλά p-values (p < 0.001) και επομένως θεωρούνται στατιστικά σημαντικές. Αυτές οι μεταβλητές παρουσιάζουν ισχυρή συσχέτιση με την πιθανότητα αθέτησης δανείου. Οι μεταβλητές person_age και person_emp_exp είναι επίσης στατιστικά σημαντικές, αλλά σε μικρότερο βαθμό. Οι υπόλοιπες μεταβλητές όπως person_gender, education, και previous_loan_defaults δεν εμφανίζουν στατιστικά σημαντική συσχέτιση με την εξαρτημένη μεταβλητή, καθώς τα p-values τους είναι σημαντικά μεγαλύτερα από 0.05.

Το πρόσημο των Estimate δείχνει την κατεύθυνση της επίδρασης:

Θετικό Estimate (π.χ. loan_percent_income, loan_int_rate) σημαίνει ότι αυξάνεται η πιθανότητα αθέτησης.

Αρνητικό Estimate (π.χ. credit_score, loan_amnt) σημαίνει ότι μειώνεται η πιθανότητα αθέτησης.

# Model 1
model1 <- glm(loan_status ~ person_income + credit_score, data = Train, family = "binomial")

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(model1)

## 
## Call:
## glm(formula = loan_status ~ person_income + credit_score, family = "binomial", 
##     data = Train)
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    1.335e-01  1.832e-01   0.729    0.466    
## person_income -1.719e-05  4.818e-07 -35.686   <2e-16 ***
## credit_score  -3.030e-04  2.858e-04  -1.060    0.289    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 30985  on 29244  degrees of freedom
## Residual deviance: 29232  on 29242  degrees of freedom
## AIC: 29238
## 
## Number of Fisher Scoring iterations: 5

aic1 <- AIC(model1)

pred1 <- predict(model1, newdata = Test, type = "response")
acc1 <- mean(ifelse(pred1 > 0.5, 1, 0) == Test$loan_status)
predTrain1 <- predict(model1, newdata = Train, type = "response")
cat("Model 1 - Μέση πιθανότητα default ανά loan_status:\n")

## Model 1 - Μέση πιθανότητα default ανά loan_status:

print(tapply(predTrain1, Train$loan_status, mean))

##         0         1 
## 0.2081557 0.2716153

threshold_80 <- 0.8
pred_class_80 <- ifelse(pred1 > threshold_80, 1, 0)

# Εμφάνιση Confusion Matrix
cat("Confusion Matrix με threshold 0.8:\n")

## Confusion Matrix με threshold 0.8:

print(table(Προβλέφθηκε = pred_class_80, Πραγματικό = Test$loan_status))

##            Πραγματικό
## Προβλέφθηκε     0     1
##           0 12247  3500

ggplot(Train, aes(x = person_income, y = loan_status)) +
  geom_point(alpha = 0.3, position = position_jitter(height = 0.05)) +
  geom_smooth(method = "glm", method.args = list(family = "binomial")) +
  labs(title = "Logistic Regression: Model 1",
       x = "Εισόδημα (person_income)",
       y = "Πιθανότητα Default") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

Σχόλιο:Η καμπύλη λογιστικής παλινδρόμησης δείχνει ότι όσο αυξάνεται το εισόδημα, η πιθανότητα αθέτησης δανείου μειώνεται δραματικά και τείνει στο 0. Αυτό είναι σύμφωνο με την κοινή λογική: τα άτομα με υψηλό εισόδημα είναι λιγότερο πιθανό να αθετήσουν ένα δάνειο. Ωστόσο, παρατηρείται μεγάλη συσσώρευση παρατηρήσεων σε χαμηλές τιμές εισοδήματος, και αρκετά ακραίες τιμές (outliers) σε υψηλά εισοδήματα που ίσως επηρεάζουν την ομαλότητα της καμπύλης.

# Model 2
model2 <- glm(loan_status ~ person_income + credit_score + loan_int_rate + loan_amnt, data = Train, family = "binomial")

## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

summary(model2)

## 
## Call:
## glm(formula = loan_status ~ person_income + credit_score + loan_int_rate + 
##     loan_amnt, family = "binomial", data = Train)
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -3.406e+00  2.114e-01 -16.113   <2e-16 ***
## person_income -2.982e-05  6.639e-07 -44.920   <2e-16 ***
## credit_score  -4.416e-04  3.141e-04  -1.406     0.16    
## loan_int_rate  2.946e-01  5.933e-03  49.662   <2e-16 ***
## loan_amnt      1.035e-04  2.965e-06  34.911   <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: 30985  on 29244  degrees of freedom
## Residual deviance: 24528  on 29240  degrees of freedom
## AIC: 24538
## 
## Number of Fisher Scoring iterations: 6

aic2 <- AIC(model2)
pred2 <- predict(model2, newdata = Test, type = "response")
acc2 <- mean(ifelse(pred2 > 0.5, 1, 0) == Test$loan_status)
predTrain2 <- predict(model2, newdata = Train, type = "response")
cat("Model 2 - Μέση πιθανότητα default ανά loan_status:\n")

## Model 2 - Μέση πιθανότητα default ανά loan_status:

print(tapply(predTrain2, Train$loan_status, mean))

##         0         1 
## 0.1705776 0.4031097

threshold_80 <- 0.8
pred_class_80 <- ifelse(pred2 > threshold_80, 1, 0)

# Εμφάνιση Confusion Matrix
cat("Confusion Matrix με threshold 0.8:\n")

## Confusion Matrix με threshold 0.8:

print(table(Προβλέφθηκε = pred_class_80, Πραγματικό = Test$loan_status))

##            Πραγματικό
## Προβλέφθηκε     0     1
##           0 12229  3387
##           1    18   113

ggplot(Train, aes(x = loan_int_rate, y = loan_status)) +
  geom_point(alpha = 0.3, position = position_jitter(height = 0.05)) +
  geom_smooth(method = "glm", method.args = list(family = "binomial")) +
  labs(title = "Logistic Regression: Model 2",
       x = "Επιτόκιο Δανείου (loan_int_rate)",
       y = "Πιθανότητα Default") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

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

# Model 3
model3 <- glm(loan_status ~ person_income + credit_score + loan_int_rate + loan_amnt +
                            loan_percent_income + loan_intent, data = Train, family = "binomial")
summary(model3)

## 
## Call:
## glm(formula = loan_status ~ person_income + credit_score + loan_int_rate + 
##     loan_amnt + loan_percent_income + loan_intent, family = "binomial", 
##     data = Train)
## 
## Coefficients:
##                              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                -5.908e+00  2.344e-01 -25.199  < 2e-16 ***
## person_income               1.139e-06  4.902e-07   2.324 0.020135 *  
## credit_score               -2.191e-04  3.344e-04  -0.655 0.512356    
## loan_int_rate               3.340e-01  6.439e-03  51.875  < 2e-16 ***
## loan_amnt                  -1.180e-04  4.695e-06 -25.136  < 2e-16 ***
## loan_percent_income         1.636e+01  3.349e-01  48.860  < 2e-16 ***
## loan_intentEDUCATION       -1.038e+00  5.615e-02 -18.493  < 2e-16 ***
## loan_intentHOMEIMPROVEMENT -2.301e-01  6.197e-02  -3.713 0.000205 ***
## loan_intentMEDICAL         -3.446e-01  5.304e-02  -6.497 8.22e-11 ***
## loan_intentPERSONAL        -7.708e-01  5.735e-02 -13.441  < 2e-16 ***
## loan_intentVENTURE         -1.306e+00  6.122e-02 -21.326  < 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: 30985  on 29244  degrees of freedom
## Residual deviance: 22210  on 29234  degrees of freedom
## AIC: 22232
## 
## Number of Fisher Scoring iterations: 5

aic3 <- AIC(model3)

pred3 <- predict(model3, newdata = Test, type = "response")
acc3 <- mean(ifelse(pred3 > 0.5, 1, 0) == Test$loan_status)
predTrain3 <- predict(model3, newdata = Train, type = "response")
cat("Model 3 - Μέση πιθανότητα default ανά loan_status:\n")

## Model 3 - Μέση πιθανότητα default ανά loan_status:

print(tapply(predTrain3, Train$loan_status, mean))

##         0         1 
## 0.1528924 0.4649943

threshold_80 <- 0.8
pred_class_80 <- ifelse(pred3 > threshold_80, 1, 0)

# Εμφάνιση Confusion Matrix
cat("Confusion Matrix με threshold 0.8:\n")

## Confusion Matrix με threshold 0.8:

print(table(Προβλέφθηκε = pred_class_80, Πραγματικό = Test$loan_status))

##            Πραγματικό
## Προβλέφθηκε     0     1
##           0 12160  3016
##           1    87   484

ggplot(Train, aes(x = loan_percent_income, y = loan_status)) +
  geom_point(alpha = 0.3, position = position_jitter(height = 0.05)) +
  geom_smooth(method = "glm", method.args = list(family = "binomial")) +
  labs(title = "Logistic Regression: Model 3",
       x = "Ποσοστό δανείου ως προς εισόδημα",
       y = "Πιθανότητα Default") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Σχόλιο:Η σχέση εδώ είναι εντυπωσιακά καθαρή: όσο μεγαλύτερο ποσοστό του εισοδήματος απορροφάται από το δάνειο, τόσο αυξάνεται η πιθανότητα default. Η καμπύλη φτάνει πολύ κοντά στο 1 όταν το ποσοστό ξεπερνά ~0.5 (δηλαδή όταν το δάνειο αντιστοιχεί στο 50% του εισοδήματος). Πρόκειται για μία από τις ισχυρότερες μεταβλητές πρόβλεψης, όπως φαίνεται από τη γραφική απεικόνιση.

Βήμα 3. Σύγκριση μοντέλων και συμπεράσματα

comparison <- data.frame(
  Μοντέλο = c("Baseline", "Model 1", "Model 2", "Model 3"),
  AIC = c(NA, aic1, aic2, aic3),
  Accuracy = round(c(baseacc, acc1, acc2, acc3) * 100, 2)
)

print(comparison)

##    Μοντέλο      AIC Accuracy
## 1 Baseline       NA    77.77
## 2  Model 1 29237.81    77.77
## 3  Model 2 24538.37    82.42
## 4  Model 3 22232.23    83.41

Σχόλιο: Model 1: Το πρώτο μοντέλο, το οποίο περιέχει μόνο τις μεταβλητές person_income και credit_score, έχει AIC ίσο με 29237.81 και ακρίβεια 77.77%, δηλαδή δεν βελτιώνει την απόδοση σε σχέση με τη baseline πρόβλεψη.

Model 2: Με την προσθήκη των επιπλέον μεταβλητών loan_int_rate και loan_amnt, το Model 2 μειώνει το AIC σε 24538.37 και αυξάνει την ακρίβεια στο 82.42%. Αυτό υποδηλώνει σημαντική βελτίωση στην προσαρμογή του μοντέλου και την απόδοση πρόβλεψης.

Model 3: Με περαιτέρω προσθήκη των μεταβλητών loan_percent_income και loan_intent, το AIC πέφτει ακόμα περισσότερο, σε 22232.23, ενώ η ακρίβεια ανεβαίνει στο 83.41%. Αυτή η σταδιακή βελτίωση δείχνει ότι οι επιπλέον μεταβλητές συμβάλλουν θετικά στο μοντέλο.

Η μέση προβλεπόμενη πιθανότητα αθέτησης δανείου για κάθε κατηγορία loan_status δείχνει πώς το κάθε μοντέλο διαχωρίζει τις περιπτώσεις default από τις μη-default. Το πρώτο μοντέλο εμφανίζει μικρή διαφορά και περιορισμένη διαχωριστική ικανότητα. Ωστόσο, με την προσθήκη σημαντικών μεταβλητών στα επόμενα μοντέλα, η διαφορά αυξάνεται σημαντικά (μέχρι και 31.2 ποσοστιαίες μονάδες στο μοντέλο 3), γεγονός που υποδηλώνει σαφώς βελτιωμένη απόδοση ταξινόμησης και καλύτερη κατανόηση των υποκείμενων σχέσεων στο dataset.

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

Βήμα 4. Καμπύλη ROC για το καλύτερο μοντέλο

library(ROCR)
ROCRpred <- prediction(pred3, Test$loan_status)
perf <- performance(ROCRpred, "tpr", "fpr")

# Εξαγωγή TPR και FPR για το γράφημα
roc_data <- data.frame(
  fpr = perf@x.values[[1]],
  tpr = perf@y.values[[1]]
)

# Σχεδίαση ROC curve με ggplot2
ggplot(roc_data, aes(x = fpr, y = tpr)) +
  geom_line(color = "blue", size = 1.2) +
  geom_abline(linetype = "dashed", color = "gray") +
  labs(title = "ROC Curve for Model 3",
       x = "False Positive Rate (1 - Specificity)",
       y = "True Positive Rate (Sensitivity)") +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

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