AI in Credit Default

Data Preparation

Data import and overview

german_credit <- read.csv("german_credit.csv")
str(german_credit) #continuous or factors, convert category to factor

'data.frame':   1000 obs. of  21 variables:
 $ Creditability                    : int  1 1 1 1 1 1 1 1 1 1 ...
 $ Account.Balance                  : int  1 1 2 1 1 1 1 1 4 2 ...
 $ Duration.of.Credit..month.       : int  18 9 12 12 12 10 8 6 18 24 ...
 $ Payment.Status.of.Previous.Credit: int  4 4 2 4 4 4 4 4 4 2 ...
 $ Purpose                          : int  2 0 9 0 0 0 0 0 3 3 ...
 $ Credit.Amount                    : int  1049 2799 841 2122 2171 2241 3398 1361 1098 3758 ...
 $ Value.Savings.Stocks             : int  1 1 2 1 1 1 1 1 1 3 ...
 $ Length.of.current.employment     : int  2 3 4 3 3 2 4 2 1 1 ...
 $ Instalment.per.cent              : int  4 2 2 3 4 1 1 2 4 1 ...
 $ Sex...Marital.Status             : int  2 3 2 3 3 3 3 3 2 2 ...
 $ Guarantors                       : int  1 1 1 1 1 1 1 1 1 1 ...
 $ Duration.in.Current.address      : int  4 2 4 2 4 3 4 4 4 4 ...
 $ Most.valuable.available.asset    : int  2 1 1 1 2 1 1 1 3 4 ...
 $ Age..years.                      : int  21 36 23 39 38 48 39 40 65 23 ...
 $ Concurrent.Credits               : int  3 3 3 3 1 3 3 3 3 3 ...
 $ Type.of.apartment                : int  1 1 1 1 2 1 2 2 2 1 ...
 $ No.of.Credits.at.this.Bank       : int  1 2 1 2 2 2 2 1 2 1 ...
 $ Occupation                       : int  3 3 2 2 2 2 2 2 1 1 ...
 $ No.of.dependents                 : int  1 2 1 2 1 2 1 2 1 1 ...
 $ Telephone                        : int  1 1 1 1 1 1 1 1 1 1 ...
 $ Foreign.Worker                   : int  1 1 1 2 2 2 2 2 1 1 ...

id = c(1,2,4,5,7:13,15:21)
german_credit[id]=lapply(german_credit[id],as.factor)

Data split and resamping

library(caret)
library(rsample)

set.seed(999)

idx1<-initial_split(data=german_credit,prop=0.7,strata = "Creditability")
train1<-training(idx1)
test1<-testing(idx1)
control<-trainControl(method = "cv",number=10)

Models for Classification

Logistic Regression

set.seed(999)

logit<-train(Creditability~.,data=train1,method="glm",family="binomial",trControl=control)

Tree-based Method: Single Tree
- 1 with Gini index
- 2 with Entropy

set.seed(999)

single_gini<-train(Creditability~., data=train1,trControl=control,method="rpart",tuneLength=10,parms=list(split="gini"))

single_entropy<-train(Creditability~., data=train1,trControl=control,method="rpart",tuneLength=10,parms=list(split="information"))

Ensemble Method: Bagging

library(doParallel) 
cl<-makePSOCKcluster(detectCores()/2)
registerDoParallel(cl)

set.seed(999)
control2<-trainControl(method="cv",number = 10,allowParallel = T)

tree_bag<-train(Creditability~., data=train1,method="treebag",trControl=control2,nbagg=100,parms=list(split="gini"),importance=T)

stopCluster(cl)
registerDoSEQ()

Ensemble Method: Random Forest

mtry<-sqrt(ncol(test1)-1) # sqrt of p features
tunegrid<-expand.grid(.mtry=seq(mtry,20)) # can be in the train function

library(doParallel) 
cl<-makePSOCKcluster(detectCores()/2)
registerDoParallel(cl)

set.seed(999)
tree_rf<-train(Creditability~., data=train1,method="rf",trControl=control2,tuneGrid=tunegrid)

stopCluster(cl)
registerDoSEQ()

Prediction

pred_logit<-predict(logit,newdata=test1)
pred_tree<-predict(single_gini,newdata=test1)
pred_bagging<-predict(tree_bag,newdata=test1)
pred_rf<-predict(tree_rf,newdata=test1)

Comparison

In-sample comparison

resamp<-resamples(list("Logistic"=logit,"Single Tree"=single_gini,"Bagging"=tree_bag,"Random Forest"=tree_rf))
summary(resamp)


Call:
summary.resamples(object = resamp)

Models: Logistic, Single Tree, Bagging, Random Forest 
Number of resamples: 10 

Accuracy 
                   Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
Logistic      0.6571429 0.6954451 0.7357143 0.7324638 0.7571429 0.8142857    0
Single Tree   0.6428571 0.6892857 0.7285714 0.7296687 0.7582298 0.8428571    0
Bagging       0.6571429 0.7285714 0.7428571 0.7439959 0.7821429 0.7971014    0
Random Forest 0.7000000 0.7142857 0.7357143 0.7411180 0.7678571 0.7857143    0

Kappa 
                    Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
Logistic      0.11111111 0.2436845 0.3199513 0.3188794 0.3880979 0.5255474    0
Single Tree   0.03100775 0.2148760 0.2430442 0.2750166 0.3715603 0.6099291    0
Bagging       0.08396947 0.2528346 0.3484353 0.3384645 0.4521512 0.5098039    0
Random Forest 0.16000000 0.2374809 0.3150845 0.3027506 0.3773289 0.4000000    0

bwplot(resamp,metric="Accuracy")

Out-of-sample comparison

cm_logit <- confusionMatrix(pred_logit, test1$Creditability)
cm_tree <- confusionMatrix(pred_tree, test1$Creditability)
cm_bag  <- confusionMatrix(pred_bagging, test1$Creditability)
cm_rf   <- confusionMatrix(pred_rf, test1$Creditability)

# combine test-set performance

com_results <- data.frame(
  Model = c("Logistic","Single Tree", "Bagging", "Random Forest"),
  Accuracy = c(
    cm_logit$overall["Accuracy"],
    cm_tree$overall["Accuracy"],
    cm_bag$overall["Accuracy"],
    cm_rf$overall["Accuracy"]
  ),
  Kappa = c(
    cm_logit$overall["Kappa"],
    cm_tree$overall["Kappa"],
    cm_bag$overall["Kappa"],
    cm_rf$overall["Kappa"]
  ),
  Sensitivity = c(
    cm_logit$byClass["Sensitivity"],
    cm_tree$byClass["Sensitivity"],
    cm_bag$byClass["Sensitivity"],
    cm_rf$byClass["Sensitivity"]
  ),
  Specificity = c(
    cm_logit$byClass["Specificity"],
    cm_tree$byClass["Specificity"],
    cm_bag$byClass["Specificity"],
    cm_rf$byClass["Specificity"]
  ),
  Mcnemar = c(
    cm_logit$overall["McnemarPValue"],
    cm_tree$overall["McnemarPValue"],
    cm_bag$overall["McnemarPValue"],
    cm_rf$overall["McnemarPValue"]
  )
)

com_results

Output Results

library(knitr)

kable(
  com_results,
  digits = 4,
  col.names = c(
    "Model", "Accuracy", "Kappa",
    "Sensitivity", "Specificity", "McNemar's p-value"
  ),
  caption = "Comparison of Classification Models",
  format = "html"
)

Comparison of Classification Models
Model	Accuracy	Kappa	Sensitivity	Specificity	McNemar’s p-value
Logistic	0.7774	0.4190	0.4778	0.9052	0.0015
Single Tree	0.7409	0.3067	0.3778	0.8957	0.0002
Bagging	0.7641	0.4051	0.5111	0.8720	0.0576
Random Forest	0.7940	0.4410	0.4444	0.9431	0.0000

AUC - ROC Curve

library(pROC)
library(ggplot2)


actual <- test1$Creditability

# Predicted probability of Bad Credit (class 1)

p_logit <- predict(logit, test1, type = "prob")[, "1"]
p_tree  <- predict(single_gini, test1, type = "prob")[, "1"]
p_bag   <- predict(tree_bag, test1, type = "prob")[, "1"]
p_rf    <- predict(tree_rf, test1, type = "prob")[, "1"]

# Calculate ROC curves
roc_list <- list(
  "Logistic" = roc(actual, p_logit,
                   levels = c("0", "1"), direction = "<"),
  "Single Tree" = roc(actual, p_tree,
                      levels = c("0", "1"), direction = "<"),
  "Bagging" = roc(actual, p_bag,
                  levels = c("0", "1"), direction = "<"),
  "Random Forest" = roc(actual, p_rf,
                        levels = c("0", "1"), direction = "<")
)

auc_labels <- paste0(
  names(roc_list),
  " (AUC = ",
  sprintf("%.3f", sapply(roc_list, \(x) as.numeric(auc(x)))),
  ")"
)

names(roc_list) <- auc_labels

ggroc(roc_list, legacy.axes = TRUE) +
  geom_abline(
    intercept = 0, slope = 1,
    linetype = "dashed", colour = "grey60"
  ) +
  labs(
    title = "ROC Curves: Credit Default Prediction",
    x = "False Positive Rate (1 - Specificity)",
    y = "True Positive Rate (Sensitivity)",
    colour = "Model"
  ) +
  theme_minimal(base_size = 13)

AI in Credit Default

Dr Chloe Chen

Data Preparation

Models for Classification

Prediction

Comparison

In-sample comparison

Out-of-sample comparison

AUC - ROC Curve