Εργασία 6
Kouimtzidou Danae
2026-04-14
Φόρτωση βιβλιοθηκών
library(caTools)## Warning: package 'caTools' was built under R version 4.5.3library(ROCR)## Warning: package 'ROCR' was built under R version 4.5.3Εισαγωγή του dataset
loan<-read.csv("loan_data.csv")str(loan)## 'data.frame': 45000 obs. of 14 variables:
## $ person_age : num 22 21 25 23 24 21 26 24 24 21 ...
## $ person_gender : chr "female" "female" "female" "female" ...
## $ person_education : chr "Master" "High School" "High School" "Bachelor" ...
## $ person_income : num 71948 12282 12438 79753 66135 ...
## $ person_emp_exp : int 0 0 3 0 1 0 1 5 3 0 ...
## $ person_home_ownership : chr "RENT" "OWN" "MORTGAGE" "RENT" ...
## $ loan_amnt : num 35000 1000 5500 35000 35000 2500 35000 35000 35000 1600 ...
## $ loan_intent : chr "PERSONAL" "EDUCATION" "MEDICAL" "MEDICAL" ...
## $ loan_int_rate : num 16 11.1 12.9 15.2 14.3 ...
## $ loan_percent_income : num 0.49 0.08 0.44 0.44 0.53 0.19 0.37 0.37 0.35 0.13 ...
## $ cb_person_cred_hist_length : num 3 2 3 2 4 2 3 4 2 3 ...
## $ credit_score : int 561 504 635 675 586 532 701 585 544 640 ...
## $ previous_loan_defaults_on_file: chr "No" "Yes" "No" "No" ...
## $ loan_status : int 1 0 1 1 1 1 1 1 1 1 ...summary(loan)## 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Διαχωρισμός δεδομένων σε Training και Testing set
set.seed(949)
split<-sample.split(loan$loan_status , SplitRatio = 0.65)
train <- subset(loan, split == TRUE)
test <- subset(loan, split == FALSE)Σε αυτό το βήμα γίνεται ο διαχωρισμός του dataset σε δύο σύνολα δεδομένων. Το training set χρησιμοποιείται για την εκπαίδευση του μοντέλου, ενώ το testing set χρησιμοποιείται για την αξιολόγηση της απόδοσής του. Με τη χρήση της συνάρτησης sample.split() το 65% των δεδομένων επιλέγεται για το training set και το υπόλοιπο 35% για το testing set. Η εντολή set.seed() χρησιμοποιείται ώστε ο διαχωρισμός να είναι αναπαραγώγιμος.
nrow(train)## [1] 29250nrow(test)## [1] 15750Με τη χρήση της συνάρτησης nrow() υπολογίζεται ο αριθμός των παρατηρήσεων που περιλαμβάνονται στο training και στο testing set. Στην περίπτωση αυτή το training set περιέχει 29.250 παρατηρήσεις, ενώ το testing set περιέχει 15.750 παρατηρήσεις.
Δημιουργία μοντέλου Logistic Regression
LoanLog <- glm(loan_status ~ 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,
data = train,
family = binomial)summary(LoanLog)##
## Call:
## glm(formula = loan_status ~ 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,
## family = binomial, data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -6.675e-01 4.473e-01 -1.492 0.1356
## person_age 2.933e-02 1.356e-02 2.163 0.0306 *
## person_gendermale 5.266e-02 4.407e-02 1.195 0.2321
## person_educationBachelor 3.724e-02 5.851e-02 0.636 0.5245
## person_educationDoctorate 1.846e-01 1.791e-01 1.031 0.3027
## person_educationHigh School 1.145e-01 6.116e-02 1.872 0.0612 .
## person_educationMaster 8.408e-02 6.989e-02 1.203 0.2290
## person_income 8.272e-07 3.264e-07 2.535 0.0113 *
## person_emp_exp -2.511e-02 1.202e-02 -2.088 0.0368 *
## person_home_ownershipOTHER 2.677e-01 3.786e-01 0.707 0.4795
## person_home_ownershipOWN -1.515e+00 1.275e-01 -11.883 < 2e-16 ***
## person_home_ownershipRENT 6.976e-01 4.989e-02 13.984 < 2e-16 ***
## loan_amnt -1.056e-04 5.108e-06 -20.668 < 2e-16 ***
## loan_intentEDUCATION -9.318e-01 7.265e-02 -12.827 < 2e-16 ***
## loan_intentHOMEIMPROVEMENT -3.676e-02 8.159e-02 -0.451 0.6523
## loan_intentMEDICAL -3.403e-01 7.004e-02 -4.859 1.18e-06 ***
## loan_intentPERSONAL -7.347e-01 7.471e-02 -9.835 < 2e-16 ***
## loan_intentVENTURE -1.233e+00 7.933e-02 -15.544 < 2e-16 ***
## loan_int_rate 3.416e-01 8.228e-03 41.510 < 2e-16 ***
## loan_percent_income 1.621e+01 3.972e-01 40.808 < 2e-16 ***
## cb_person_cred_hist_length -7.818e-03 1.124e-02 -0.696 0.4865
## credit_score -8.808e-03 5.083e-04 -17.330 < 2e-16 ***
## previous_loan_defaults_on_fileYes -2.036e+01 1.272e+02 -0.160 0.8729
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 30988 on 29249 degrees of freedom
## Residual deviance: 12839 on 29227 degrees of freedom
## AIC: 12885
##
## Number of Fisher Scoring iterations: 19Το μοντέλο Logistic Regression δημιουργήθηκε χρησιμοποιώντας όλες τις ανεξάρτητες μεταβλητές. Από τα αποτελέσματα του summary() παρατηρούμε ότι αρκετές μεταβλητές είναι στατιστικά σημαντικές.
Οι μεταβλητές με πολύ ισχυρή στατιστική σημαντικότητα (p < 0.001) είναι:
person_home_ownershipOWN person_home_ownershipRENT loan_amnt loan_intentEDUCATION loan_intentMEDICAL loan_intentPERSONAL loan_intentVENTURE loan_int_rate loan_percent_income credit_score
Επίσης σημαντικές στο επίπεδο 5% είναι οι μεταβλητές:
person_age person_income person_emp_exp
Τέλος οριακή στατιστική σημαντικότητα εμφανίζει η μεταβλητή person_educationHigh School (p < 0.1)
Αντίθετα, μεταβλητές όπως person_gender, person_education και cb_person_cred_hist_length δεν εμφανίζουν στατιστικά σημαντική συσχέτιση με την εξαρτημένη μεταβλητή loan_status.
Προβλέψεις στο test set
predictTest <- predict(LoanLog, type = "response", newdata = test)head(predictTest)## 3 4 7 8 14 15
## 0.99397228 0.95872063 0.57364954 0.79811817 0.69018186 0.09769908Με τη χρήση της συνάρτησης predict() δημιουργήθηκαν προβλέψεις για το test set χρησιμοποιώντας το μοντέλο Logistic Regression που εκπαιδεύτηκε στο training set. Η εντολή επιστρέφει πιθανότητες μεταξύ 0 και 1, οι οποίες εκφράζουν την πιθανότητα η εξαρτημένη μεταβλητή loan_status να πάρει την τιμή 1 για κάθε παρατήρηση του test set.
Για παράδειγμα, μια τιμή όπως 0.9939 σημαίνει ότι το μοντέλο εκτιμά περίπου 99,39% πιθανότητα η συγκεκριμένη παρατήρηση να ανήκει στην κατηγορία loan_status = 1. Αντίστοιχα, μια τιμή όπως 0.0977 δείχνει πολύ μικρή πιθανότητα (περίπου 9,77%) για loan_status = 1, άρα η παρατήρηση είναι πιο πιθανό να ανήκει στην κατηγορία loan_status = 0.
Δημιουργία Confusion Matrix
cm <- table(test$loan_status, predictTest > 0.5)
cm##
## FALSE TRUE
## 0 11532 718
## 1 932 2568True Negative (TN) = 11532: Το μοντέλο προέβλεψε ότι η κατηγορία είναι 0 (FALSE) και η πραγματική τιμή ήταν επίσης 0. Πρόκειται για σωστή πρόβλεψη αρνητικής περίπτωσης. False Positive (FP) = 718: Το μοντέλο προέβλεψε την κατηγορία 1 (TRUE), ενώ η πραγματική τιμή ήταν 0. Δηλαδή το μοντέλο θεώρησε ότι υπάρχει θετική περίπτωση ενώ στην πραγματικότητα δεν υπάρχει. False Negative (FN) = 932: Το μοντέλο προέβλεψε την κατηγορία 0 (FALSE), ενώ η πραγματική τιμή ήταν 1. Δηλαδή το μοντέλο δεν εντόπισε μια πραγματικά θετική περίπτωση. True Positive (TP) = 2568: Το μοντέλο προέβλεψε την κατηγορία 1 (TRUE) και η πραγματική τιμή ήταν επίσης 1. Πρόκειται για σωστή πρόβλεψη θετικής περίπτωσης.
Υπολογισμός μετρικών αξιολόγησης
TN <- cm[1,1]
FP <- cm[1,2]
FN <- cm[2,1]
TP <- cm[2,2]
accuracy <- (TP + TN) / sum(cm)
sensitivity <- TP / (TP + FN)
specificity <- TN / (TN + FP)
baseline <- max(table(test$loan_status)) / length(test$loan_status)
accuracy## [1] 0.8952381sensitivity## [1] 0.7337143specificity## [1] 0.9413878baseline## [1] 0.7777778Η accuracy του μοντέλου είναι 89.52%, γεγονός που σημαίνει ότι περίπου το 89.5% των παρατηρήσεων ταξινομούνται σωστά από το μοντέλο.
Η sensitivity είναι 73.37%, πράγμα που δείχνει ότι το μοντέλο αναγνωρίζει σωστά περίπου το 73% των θετικών περιπτώσεων της μεταβλητής loan_status.
Η specificity είναι 94.14%, γεγονός που σημαίνει ότι το μοντέλο έχει πολύ υψηλή ικανότητα να εντοπίζει σωστά τις αρνητικές περιπτώσεις.
Η baseline accuracy είναι 77.78%, η οποία αντιστοιχεί στην ακρίβεια που θα είχαμε αν προβλέπαμε πάντα την πιο συχνή κατηγορία της εξαρτημένης μεταβλητής.
Παρατηρούμε ότι η ακρίβεια του μοντέλου Logistic Regression (89.52%) είναι σημαντικά μεγαλύτερη από την baseline accuracy (77.78%), γεγονός που δείχνει ότι το μοντέλο έχει καλή προγνωστική ικανότητα και αποδίδει καλύτερα από μια απλή πρόβλεψη της πιο συχνής κατηγορίας. Επιπλέον, το μοντέλο παρουσιάζει ιδιαίτερα υψηλή specificity, ενώ η sensitivity είναι χαμηλότερη αλλά παραμένει σε ικανοποιητικό επίπεδο.
Δημιουργία νέου Logistic Regression μοντέλου
train2 <- na.omit(train)
test2 <- na.omit(test)
nrow(train2)## [1] 29250nrow(test2)## [1] 15750Αρχικά δημιουργήθηκαν δύο νέα σύνολα δεδομένων, train2 και test2, χρησιμοποιώντας τη συνάρτηση na.omit(). Η συνάρτηση αυτή αφαιρεί όλες τις παρατηρήσεις που περιέχουν ελλιπείς τιμές (NA), ώστε το μοντέλο να εκπαιδεύεται και να αξιολογείται μόνο με πλήρη δεδομένα.
Στη συνέχεια υπολογίστηκε το πλήθος των παρατηρήσεων σε κάθε νέο σύνολο δεδομένων με τη χρήση της εντολής nrow(). Τα αποτελέσματα έδειξαν ότι το train2 περιέχει 29.250 καταχωρήσεις, ενώ το test2 περιέχει 15.750 καταχωρήσεις.
Τα νέα αυτά σύνολα δεδομένων χρησιμοποιούνται για την εκπαίδευση και την αξιολόγηση του μοντέλου χωρίς την παρουσία ελλιπών τιμών, γεγονός που μπορεί να βελτιώσει την αξιοπιστία των αποτελεσμάτων.
LoanLog2 <- glm(loan_status ~ 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,
data = train2,
family = binomial)
summary(LoanLog2)##
## Call:
## glm(formula = loan_status ~ 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,
## family = binomial, data = train2)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -6.675e-01 4.473e-01 -1.492 0.1356
## person_age 2.933e-02 1.356e-02 2.163 0.0306 *
## person_gendermale 5.266e-02 4.407e-02 1.195 0.2321
## person_educationBachelor 3.724e-02 5.851e-02 0.636 0.5245
## person_educationDoctorate 1.846e-01 1.791e-01 1.031 0.3027
## person_educationHigh School 1.145e-01 6.116e-02 1.872 0.0612 .
## person_educationMaster 8.408e-02 6.989e-02 1.203 0.2290
## person_income 8.272e-07 3.264e-07 2.535 0.0113 *
## person_emp_exp -2.511e-02 1.202e-02 -2.088 0.0368 *
## person_home_ownershipOTHER 2.677e-01 3.786e-01 0.707 0.4795
## person_home_ownershipOWN -1.515e+00 1.275e-01 -11.883 < 2e-16 ***
## person_home_ownershipRENT 6.976e-01 4.989e-02 13.984 < 2e-16 ***
## loan_amnt -1.056e-04 5.108e-06 -20.668 < 2e-16 ***
## loan_intentEDUCATION -9.318e-01 7.265e-02 -12.827 < 2e-16 ***
## loan_intentHOMEIMPROVEMENT -3.676e-02 8.159e-02 -0.451 0.6523
## loan_intentMEDICAL -3.403e-01 7.004e-02 -4.859 1.18e-06 ***
## loan_intentPERSONAL -7.347e-01 7.471e-02 -9.835 < 2e-16 ***
## loan_intentVENTURE -1.233e+00 7.933e-02 -15.544 < 2e-16 ***
## loan_int_rate 3.416e-01 8.228e-03 41.510 < 2e-16 ***
## loan_percent_income 1.621e+01 3.972e-01 40.808 < 2e-16 ***
## cb_person_cred_hist_length -7.818e-03 1.124e-02 -0.696 0.4865
## credit_score -8.808e-03 5.083e-04 -17.330 < 2e-16 ***
## previous_loan_defaults_on_fileYes -2.036e+01 1.272e+02 -0.160 0.8729
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 30988 on 29249 degrees of freedom
## Residual deviance: 12839 on 29227 degrees of freedom
## AIC: 12885
##
## Number of Fisher Scoring iterations: 19Προβλέψεις στο νέο test set
predictTest2 <- predict(LoanLog2, type = "response", newdata = test2)Δημιουργία αντικειμένου ROCR
ROCRpred <- prediction(predictTest2, test2$loan_status)Δημιουργία ROC curve με color-coding
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
plot(ROCRperf, colorize = TRUE)
Υπολογισμός AUC
AUC <- performance(ROCRpred, "auc")
AUC@y.values[[1]]## [1] 0.9530444Η καμπύλη ROC παρουσιάζει τη σχέση μεταξύ του True Positive Rate (Sensitivity) και του False Positive Rate για διαφορετικές τιμές κατωφλίου. Η καμπύλη βρίσκεται κοντά στο πάνω αριστερό μέρος του διαγράμματος, γεγονός που υποδηλώνει καλή απόδοση του μοντέλου.
Η τιμή του AUC είναι 0.953, γεγονός που δείχνει ότι το μοντέλο Logistic Regression έχει πολύ υψηλή ικανότητα να διαχωρίζει σωστά τις δύο κατηγορίες της μεταβλητής loan_status. Όσο πιο κοντά είναι η τιμή του AUC στο 1, τόσο καλύτερη είναι η προγνωστική ικανότητα του μοντέλου.