Το σύνολο δεδομένων “Default of Credit Card Clients” περιέχει πληροφορίες για 30.000 κατόχους πιστωτικών καρτών στην Ταϊβάν, που συλλέχθηκαν από μια τράπεζα το 2005. Χρησιμοποιείται κυρίως για την πρόβλεψη της πιθανότητας αθέτησης πληρωμής τον επόμενο μήνα.
kable(df, format = "html", align = "c", escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped"
, "hover"
, "condensed"
, "responsive")
, full_width = FALSE, position = "center") %>%
column_spec(3
, bold = TRUE)| Χαρακτηριστικό | Περιγραφή | Type |
|---|---|---|
| ID | Μοναδικός αναγνωριστικός αριθμός πελάτη. | Integer |
| LIMIT_BAL | Ποσό πιστωτικού ορίου σε δολάρια Ταϊβάν. | Numeric |
| SEX | Φύλο πελάτη (1 = Άνδρας, 2 = Γυναίκα). | Categorical |
| EDUCATION | Εκπαιδευτικό επίπεδο (1 = Μεταπτυχιακό, 2 = Πανεπιστήμιο, 3 = Λύκειο, 4 = Άλλο). | Categorical |
| MARRIAGE | Οικογενειακή κατάσταση (1 = Παντρεμένος, 2 = Άγαμος, 3 = Άλλο). | Categorical |
| AGE | Ηλικία πελάτη σε έτη. | Integer |
| PAY_0 | Κατάσταση αποπληρωμής Σεπτεμβρίου 2005 (-1 = έγκαιρη πληρωμή, 1 = 1 μήνας καθυστέρηση, κ.λπ.). | Ordinal |
| PAY_2 | Κατάσταση αποπληρωμής Αυγούστου 2005. | Ordinal |
| PAY_3 | Κατάσταση αποπληρωμής Ιουλίου 2005. | Ordinal |
| PAY_4 | Κατάσταση αποπληρωμής Ιουνίου 2005. | Ordinal |
| PAY_5 | Κατάσταση αποπληρωμής Μαΐου 2005. | Ordinal |
| PAY_6 | Κατάσταση αποπληρωμής Απριλίου 2005. | Ordinal |
| BILL_AMT1 | Ποσό λογαριασμού Σεπτεμβρίου 2005. | Numeric |
| BILL_AMT2 | Ποσό λογαριασμού Αυγούστου 2005. | Numeric |
| BILL_AMT3 | Ποσό λογαριασμού Ιουλίου 2005. | Numeric |
| BILL_AMT4 | Ποσό λογαριασμού Ιουνίου 2005. | Numeric |
| BILL_AMT5 | Ποσό λογαριασμού Μαΐου 2005. | Numeric |
| BILL_AMT6 | Ποσό λογαριασμού Απριλίου 2005. | Numeric |
| PAY_AMT1 | Πληρωμή Σεπτεμβρίου 2005. | Numeric |
| PAY_AMT2 | Πληρωμή Αυγούστου 2005. | Numeric |
| PAY_AMT3 | Πληρωμή Ιουλίου 2005. | Numeric |
| PAY_AMT4 | Πληρωμή Ιουνίου 2005. | Numeric |
| PAY_AMT5 | Πληρωμή Μαΐου 2005. | Numeric |
| PAY_AMT6 | Πληρωμή Απριλίου 2005. | Numeric |
| DefaultPaymentNextMonth | Εάν ο πελάτης καθυστέρησε την πληρωμή τον επόμενο μήνα (1 = Ναι, 0 = Όχι). | Binary |
Αρχικά θα χωρίσω το σύνολο δεδομένων σε Train και Test με SplitRatio = 0.7 χρησιμοποιώντας την κατηγορική μεταβλητή DefaultPaymentNextMonth με seed = 953.
CreditClientsData <- na.omit(CreditClientsData)
set.seed(953)
spl <- sample.split(CreditClientsData$DefaultPaymentNextMonth
, SplitRatio = 0.7)
creditTrain <- subset(CreditClientsData
, spl==TRUE)
creditTest <- subset(CreditClientsData
, spl==FALSE)
nrow(creditTest)## [1] 9000
## [1] 21000
Tο δέντρο απόφασης αφορά την πρόβλεψη της μεταβλητής DefaultPaymentNextMonth (Εάν ο πελάτης καθυστέρησε την πληρωμή τον επόμενο μήνα (1 = Ναι, 0 = Όχι). Για την δημιουργία του δέντρου απόφασης χρησιμοποιήθηκαν όλες οι ανεξάρτητες μεταβλητές, και το minbucket τέθηκε στο 25 ώστε να μην είναι πολύ χαμηλό και κάνει δυσνόητο το δέντρο, αλλά ούτε πολύ υψηλό και περικόψει σημαντικά κλαδιά.
creditTree <- rpart(DefaultPaymentNextMonth ~ .
, data = creditTrain
, method="class"
, control = rpart.control(minbucket = 25
, cp = 0.001
, minsplit = 5))
prp(creditTree)creditTrainPredictCART <- predict(creditTree, newdata=creditTrain, type="class")
table(creditTrain$DefaultPaymentNextMonth, creditTrainPredictCART)## creditTrainPredictCART
## 0 1
## 0 15576 779
## 1 2855 1790
Για τα δεδομένα με τα οποία εκπαιδεύτηκε το μοντέλο, η πρόβλεψη ήταν σωστή στο 86,83% των 21.000 εγγραφών του train-set. Αυτό είναι ένα καλό αποτέλεσμα, καθώς δείχνει ότι το μοντέλο προβλέπει πολύ καλά τα υπάρχοντα δεδομένα, ενώ ταυτόχρονα δεν κάνει overfit, δηλαδή μπορεί να γενικεύσει καλά και σε νέες, άγνωστες εγγραφές. Παρακάτω θα γίνει πρόβλεψη με το ίδιο μοντέλο για τα δεδομένα του test-set.
creditTestPredictCART <- predict(creditTree
, newdata=creditTest
, type="class")
table(creditTest$DefaultPaymentNextMonth
, creditTestPredictCART)## creditTestPredictCART
## 0 1
## 0 6635 374
## 1 1252 739
Παραπάνω φαίνονται οι προβλέψεις του που έκανε το δέντρο απόφασης για το Test-set. Παρατηρώ ότι το μοντέλο μου προέβλεψε σωστά το 81.94% των 9000 εγγραφών.
PredictROC_CART <- predict(creditTree
, newdata = creditTest)
pred <- prediction(PredictROC_CART[,2]
, creditTest$DefaultPaymentNextMonth)
perf <- performance(pred
, "tpr"
, "fpr")
plot(perf)## [1] 0.6932815
Τέλος, η ROC καμπύλη δείχνει ότι το λογιστικό μοντέλο έχει μέτρια ικανότητα διάκρισης μεταξύ ακριβών και μη ακριβών laptops, καθώς η καμπύλη απέχει το επάνω αριστερό άκρο, τη διαγώνιο της τυχαίας πρόβλεψης. Η τιμή του AUC είναι 0.6932, γεγονός που υποδηλώνει ότι το μοντέλο έχει ικανοποιητική προβλεπτική ακρίβεια, με περίπου 70% πιθανότητα να κατατάξει σωστά ένα τυχαίο ζεύγος παρατηρήσεων. Συνεπώς, το μοντέλο θεωρείται οριακά αποδοτικό στη συγκεκριμένη ταξινόμηση.