Το dataset περιλαμβάνει πληροφορίες για 45.000 πελάτες που έχουν αιτηθεί για προσωπικά δάνεια. Περιλαμβάνει χαρακτηριστικά όπως ηλικία, εισόδημα, σκοπός δανείου, εμπειρία, ιστορικό πίστωσης, και αν ο πελάτης αποπλήρωσε ή όχι το δάνειό του.
Πηγή: Το dataset διατίθεται από το Kaggle.
Η πρόβλεψη πιθανής καθυστέρησης πληρωμής ενός δανείου είναι κρίσιμη για τα χρηματοπιστωτικά ιδρύματα. Μέσω αυτής της ανάλυσης, μπορούμε να εντοπίσουμε προφίλ πελατών με αυξημένο ρίσκο, να διαμορφώσουμε καλύτερες πολιτικές αξιολόγησης και να βελτιώσουμε τις διαδικασίες έγκρισης δανείων.
Πιθανά Επιχειρηματικά Ερωτήματα
| Μεταβλητή | Τύπος |
|---|---|
| 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 | Δυαδικό |
## 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
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. Σχέση Ηλικίας και Εμπειρίας ανά Κατάσταση Δανείου.
Σχόλιο: Οι περισσότερες καθυστερήσεις συμβαίνουν σε άτομα με χαμηλή εμπειρία και ηλικία.
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. Ποσό Δανείου ανά Κατοχή Κατοικίας.
Σχόλιο: Οι ιδιοκτήτες κατοικίας φαίνεται να λαμβάνουν μικρότερα δάνεια με λιγότερες καθυστερήσεις, ενώ οι ενοικιαστές εμφανίζουν μεγαλύτερη διακύμανση και υψηλότερο ρίσκο καθυστέρησης.
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. Κατανομή Εισοδήματος με βάση την Κατάσταση Δανείου.
Σχόλιο: Οι χαμηλότεροι μισθοί σχετίζονται με υψηλότερο ποσοστό καθυστέρησης.
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. Κατάσταση Δανείου ως προς την Εκπαίδευση.
Σχόλιο: Οι δανειολήπτες με υψηλότερη εκπαίδευση φαίνεται να έχουν μικρότερα ποσοστά καθυστέρησης.
Αφού βρούμε την ακρίβεια του μοντέλου βάσης, για την εκπαίδευση και αξιολόγηση του μοντέλου λογιστικής παλινδρόμησης, το αρχικό σύνολο δεδομένων διαχωρίζεται τυχαία σε δύο υποσύνολα: training set (65% των παρατηρήσεων) και testing set (35% των παρατηρήσεων). Ο διαχωρισμός πραγματοποιείται με χρήση της εντολής sample() και ορίζεται τιμή seed ίση με 930, ώστε τα αποτελέσματα να είναι αναπαραγώγιμα. Η επιλογή της συγκεκριμένης τιμής προκύπτει από τα δύο τελευταία ψηφία του ιδρυματικού email.
##
## 0 1
## 34992 10000
## 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 καταχωρήσεις
## Test set: 15747 καταχωρήσεις
Ας εντοπίσουμε τις σημαντικότερες μεταβλητές
##
## 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
##
## 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:
## 0 1
## 0.2081557 0.2716153
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
##
## 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:
## 0 1
## 0.1705776 0.4031097
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:
## 0 1
## 0.1528924 0.4649943
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% του
εισοδήματος). Πρόκειται για μία από τις ισχυρότερες μεταβλητές
πρόβλεψης, όπως φαίνεται από τη γραφική απεικόνιση.
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.
Η εντολή predict() με type = “response” επιστρέφει τις προβλεπόμενες πιθανότητες το δάνειο να αθετηθεί (loan_status = 1). Οι τιμές κυμαίνονται από 0 έως 1 και εκφράζουν το πόσο σίγουρο είναι το μοντέλο για την κάθε πρόβλεψη. Οι πιθανότητες αυτές μπορούν στη συνέχεια να μετατραπούν σε κατηγορίες (0 ή 1) με χρήση ενός κατωφλίου (π.χ. 0.5) για την εξαγωγή της τελικής απόφασης.