Executive Summary

Business Problem

Every credit application requires a lender to make an approval decision with limited information about the borrower. This decision forces lenders to balance two costs: the cost of approving future defaulters versus the cost of denying good borrowers. I built a model that allows a lender to score applicants by how likely they are to become seriously delinquent (90 or more days past due) within the first two years of opening a credit line. To do this I used the “Give Me Some Credit” dataset from Kaggle, which contains 150,000 real borrowers.

Data Preparation (SQL)

The raw data was not viable for modeling. Missing values were encoded incorrectly and several fields contained errors. I needed to identify how missing values were stored and found that they were literal text “NA” rather than NULLs. SQLite treats “NA” as a word, which would silently produce incorrect aggregates and filters without raising an error.

I filtered out one row with an age of 0.

The DebtRatio column had many extreme values. This is because to calculate a debt ratio, income is needed as the denominator. I kept only ratios below 50, removing 25,980 rows; 93% of these were missing income data.

In addition, there were 734 remaining rows with unrealistic utilization rates as high as 50,708. These were clear data errors and not genuine outliers. I removed them. I decided to include entries with utilization as high as 1.25 (125%) since these are plausible cases for borrowers in financial distress.

The three past-due columns contained the sentinel codes 96 and 98, which are placeholders. This required me to delete 260 rows carrying them.

Furthermore, monthly income and number of dependents contained genuine missing values. Rather than dropping those rows, I imputed the column median values since borrowers who leave income blank may be systematically different from those who report it; dropping these rows could bias the sample rather than merely shrink it. In total, 5,411 rows were imputed with a monthly income of $5,400, and 1,312 rows were imputed with 0 dependents. The median was used because the mean would be skewed by large outliers in both columns.

After cleaning, the data was reduced to 123,025 borrowers from 150,000. Roughly 18% of the data was removed. About 96% of the 26,975 rows removed came from the debt ratio filter.

## Chunk 1 - Libraries
library(GGally)
library(tidyverse)
library(car)
library(caret)
library(pROC)
## Chunk 2 - Load and Inspect Data
credit_data <- read.csv('credit_clean.csv')
credit_data$SeriousDlqin2yrs <- as.factor(credit_data$SeriousDlqin2yrs)

dim(credit_data)
## [1] 123025     11
summary(credit_data)
##  SeriousDlqin2yrs RevolvingUtilizationOfUnsecuredLines      age        
##  0:114876         Min.   :0.00000                      Min.   : 21.00  
##  1:  8149         1st Qu.:0.03025                      1st Qu.: 41.00  
##                   Median :0.16230                      Median : 51.00  
##                   Mean   :0.32176                      Mean   : 51.91  
##                   3rd Qu.:0.56147                      3rd Qu.: 62.00  
##                   Max.   :1.24941                      Max.   :105.00  
##    DebtRatio       NumberOfOpenCreditLinesAndLoans
##  Min.   : 0.0000   Min.   : 0.000                 
##  1st Qu.: 0.1406   1st Qu.: 5.000                 
##  Median : 0.2982   Median : 8.000                 
##  Mean   : 1.0371   Mean   : 8.577                 
##  3rd Qu.: 0.4940   3rd Qu.:11.000                 
##  Max.   :49.7451   Max.   :58.000                 
##  NumberOfTime30.59DaysPastDueNotWorse NumberOfTime60.89DaysPastDueNotWorse
##  Min.   : 0.0000                      Min.   : 0.00000                    
##  1st Qu.: 0.0000                      1st Qu.: 0.00000                    
##  Median : 0.0000                      Median : 0.00000                    
##  Mean   : 0.2501                      Mean   : 0.06299                    
##  3rd Qu.: 0.0000                      3rd Qu.: 0.00000                    
##  Max.   :13.0000                      Max.   :11.00000                    
##  NumberOfTimes90DaysLate NumberRealEstateLoansOrLines NumberOfDependents
##  Min.   : 0.00000        Min.   : 0.000               Min.   : 0.0000   
##  1st Qu.: 0.00000        1st Qu.: 0.000               1st Qu.: 0.0000   
##  Median : 0.00000        Median : 1.000               Median : 0.0000   
##  Mean   : 0.08616        Mean   : 1.013               Mean   : 0.8158   
##  3rd Qu.: 0.00000        3rd Qu.: 2.000               3rd Qu.: 1.0000   
##  Max.   :17.00000        Max.   :54.000               Max.   :20.0000   
##  MonthlyIncome    
##  Min.   :      0  
##  1st Qu.:   3570  
##  Median :   5400  
##  Mean   :   6720  
##  3rd Qu.:   8100  
##  Max.   :3008750
prop.table(table(credit_data$SeriousDlqin2yrs))
## 
##          0          1 
## 0.93376143 0.06623857
## ---- Chunk 3: EDA — Default rate by age band ----
credit_data %>%
  mutate(age_band = cut(age,
                        breaks = c(20, 30, 40, 50, 60, 70, 110),
                        labels = c("21-30","31-40","41-50","51-60","61-70","70+"))) %>%
  group_by(age_band) %>%
  summarise(default_rate = mean(SeriousDlqin2yrs == 1)) %>%
  ggplot(aes(x = age_band, y = default_rate)) +
  geom_col(fill = "steelblue") +
  geom_text(aes(label = scales::percent(default_rate, accuracy = 0.1)),
            vjust = -0.4, size = 3.5) +
  scale_y_continuous(labels = scales::percent,
                     expand = expansion(mult = c(0, 0.12))) +
  labs(title = "Default Rate Falls Steadily with Age",
       x = "Age Band", y = "Serious Delinquency Rate") +
  theme_minimal()

Default rate falls steadily, from 10.5% in the youngest age group to 2.3% in the oldest. This is a pattern the model later confirms, with age having a negative coefficient even after accounting for other predictors.

## ---- Chunk 4: EDA — Default rate by credit utilization ----
credit_data %>%
  mutate(util_bucket = cut(RevolvingUtilizationOfUnsecuredLines,
                           breaks = c(-0.01, 0.25, 0.5, 0.75, 1.0, 1.25),
                           labels = c("0-25%","25-50%","50-75%","75-100%","100%+"))) %>%
  group_by(util_bucket) %>%
  summarise(default_rate = mean(SeriousDlqin2yrs == 1)) %>%
  ggplot(aes(x = util_bucket, y = default_rate)) +
  geom_col(fill = "firebrick") +
  geom_text(aes(label = scales::percent(default_rate, accuracy = 0.1)),
            vjust = -0.4, size = 3.5) +
  scale_y_continuous(labels = scales::percent,
                     expand = expansion(mult = c(0, 0.12))) +
  labs(title = "Credit Utilization is the Strongest Risk Signal",
       x = "Revolving Utilization of Unsecured Lines", y = "Serious Delinquency Rate") +
  theme_minimal()

Default rates rise sharply as revolving utilization increases, from 2.3% in the lowest bucket to 38.1% among borrowers at or over their limit. The model later confirms this is the strongest predictor of serious delinquency, roughly 7x the odds of default moving from 0% to 100% utilization.

## ---- Chunk 5: EDA — Default rate by 90-day late history ----
credit_data %>%
  mutate(late90 = cut(NumberOfTimes90DaysLate,
                      breaks = c(-1, 0, 1, 2, 20),
                      labels = c("0","1","2","3+"))) %>%
  group_by(late90) %>%
  summarise(default_rate = mean(SeriousDlqin2yrs == 1)) %>%
  ggplot(aes(x = late90, y = default_rate)) +
  geom_col(fill = "darkorange") +
  geom_text(aes(label = scales::percent(default_rate, accuracy = 0.1)),
            vjust = -0.4, size = 3.5) +
  scale_y_continuous(labels = scales::percent,
                     expand = expansion(mult = c(0, 0.12))) +
  labs(title = "Past 90-Day Delinquencies Sharply Predict Future Default",
       x = "Number of Times 90+ Days Late", y = "Serious Delinquency Rate") +
  theme_minimal()

Past 90-day late marks increase the likelihood of future default. The default rate climbs from 4.8% for borrowers with a clean sheet to 60.7% for those with three or more marks. This is a raw comparison from that bundles multiple predictors, such as higher utilization and milder past-due marks. The model isolates the solo effects of the 90 day late marks, roughly double the odds per additional mark, holding the other predictors fixed.

Model Approach

I used logistic regression because it predicts a binary outcome and returns each applicant’s default probability between 0 and 1. Converting that probability into an approve or decline decision requires a threshold, addressed later. Linear regression would produce impossible like negative probabilities or values above 1.

I used 70% of the data to train the model. The leftover 30% was used to test the model on borrowers it has never seen, simulating a real application review. All reported metrics listed below are derived from the test set.

set.seed(430)
n <- nrow(credit_data)
train_idx <- sample(1:n, size = round(0.7 * n))
train <- credit_data[train_idx, ]
test  <- credit_data[-train_idx, ]
model0 <- glm(SeriousDlqin2yrs ~ 1, data = train, family = "binomial")
glm_train <- glm(SeriousDlqin2yrs ~ ., data = train, family = "binomial")

summary(glm_train)
## 
## Call:
## glm(formula = SeriousDlqin2yrs ~ ., family = "binomial", data = train)
## 
## Coefficients:
##                                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                          -3.408e+00  7.317e-02 -46.577  < 2e-16 ***
## RevolvingUtilizationOfUnsecuredLines  2.014e+00  4.551e-02  44.247  < 2e-16 ***
## age                                  -1.723e-02  1.237e-03 -13.931  < 2e-16 ***
## DebtRatio                             6.099e-03  4.356e-03   1.400 0.161479    
## NumberOfOpenCreditLinesAndLoans       3.088e-02  3.391e-03   9.104  < 2e-16 ***
## NumberOfTime30.59DaysPastDueNotWorse  4.260e-01  1.464e-02  29.099  < 2e-16 ***
## NumberOfTime60.89DaysPastDueNotWorse  5.892e-01  3.088e-02  19.076  < 2e-16 ***
## NumberOfTimes90DaysLate               6.606e-01  2.275e-02  29.039  < 2e-16 ***
## NumberRealEstateLoansOrLines          9.788e-02  1.386e-02   7.064 1.62e-12 ***
## NumberOfDependents                    4.910e-02  1.278e-02   3.842 0.000122 ***
## MonthlyIncome                        -2.954e-05  4.013e-06  -7.362 1.82e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 41931  on 86117  degrees of freedom
## Residual deviance: 32530  on 86107  degrees of freedom
## AIC: 32552
## 
## Number of Fisher Scoring iterations: 6

The model is comprised of nine statistically significant predictors with P values far below any normal significance level. There is only one insignificant predictor, debt ratio.

anova(model0, glm_train, test = "Chisq")
## Analysis of Deviance Table
## 
## Model 1: SeriousDlqin2yrs ~ 1
## Model 2: SeriousDlqin2yrs ~ RevolvingUtilizationOfUnsecuredLines + age + 
##     DebtRatio + NumberOfOpenCreditLinesAndLoans + NumberOfTime30.59DaysPastDueNotWorse + 
##     NumberOfTime60.89DaysPastDueNotWorse + NumberOfTimes90DaysLate + 
##     NumberRealEstateLoansOrLines + NumberOfDependents + MonthlyIncome
##   Resid. Df Resid. Dev Df Deviance  Pr(>Chi)    
## 1     86117      41931                          
## 2     86107      32530 10     9401 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
vif(glm_train)
## RevolvingUtilizationOfUnsecuredLines                                  age 
##                             1.218127                             1.145902 
##                            DebtRatio      NumberOfOpenCreditLinesAndLoans 
##                             1.013772                             1.547120 
## NumberOfTime30.59DaysPastDueNotWorse NumberOfTime60.89DaysPastDueNotWorse 
##                             1.140360                             1.116212 
##              NumberOfTimes90DaysLate         NumberRealEstateLoansOrLines 
##                             1.117229                             1.438545 
##                   NumberOfDependents                        MonthlyIncome 
##                             1.055571                             1.263969
exp(coef(glm_train))
##                          (Intercept) RevolvingUtilizationOfUnsecuredLines 
##                           0.03310778                           7.49152691 
##                                  age                            DebtRatio 
##                           0.98291973                           1.00611782 
##      NumberOfOpenCreditLinesAndLoans NumberOfTime30.59DaysPastDueNotWorse 
##                           1.03135882                           1.53117466 
## NumberOfTime60.89DaysPastDueNotWorse              NumberOfTimes90DaysLate 
##                           1.80247484                           1.93589650 
##         NumberRealEstateLoansOrLines                   NumberOfDependents 
##                           1.10282533                           1.05032530 
##                        MonthlyIncome 
##                           0.99997046
# ---- Evaluate on TEST set ----
test_probs <- predict(glm_train, newdata = test, type = "response")
test_pred  <- factor(ifelse(test_probs > 0.5, 1, 0), levels = c(0, 1))
confusionMatrix(test_pred, test$SeriousDlqin2yrs, positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 34213  2085
##          1   238   371
##                                           
##                Accuracy : 0.9371          
##                  95% CI : (0.9345, 0.9395)
##     No Information Rate : 0.9335          
##     P-Value [Acc > NIR] : 0.002653        
##                                           
##                   Kappa : 0.2215          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.15106         
##             Specificity : 0.99309         
##          Pos Pred Value : 0.60920         
##          Neg Pred Value : 0.94256         
##              Prevalence : 0.06655         
##          Detection Rate : 0.01005         
##    Detection Prevalence : 0.01650         
##       Balanced Accuracy : 0.57208         
##                                           
##        'Positive' Class : 1               
## 
## ---- Chunk 13: ROC / AUC ----
roc_obj <- roc(response = test$SeriousDlqin2yrs, predictor = test_probs,
               levels = c("0", "1"), direction = "<")
auc(roc_obj)
## Area under the curve: 0.8392
plot(roc_obj, legacy.axes = TRUE, print.auc = TRUE,
     xlab = "False Positive Rate", ylab = "True Positive Rate",
     main = "ROC Curve — Test Set")

coords(roc_obj, x = c(0.5, 0.3, 0.2, 0.167, 0.1, 0.066),
       input = "threshold",
       ret = c("threshold", "sensitivity", "specificity", "ppv"))
##   threshold sensitivity specificity       ppv
## 1     0.500   0.1510586   0.9930916 0.6091954
## 2     0.300   0.2740228   0.9822937 0.5245518
## 3     0.200   0.3766287   0.9640069 0.4272517
## 4     0.167   0.4393322   0.9503062 0.3865998
## 5     0.100   0.6286645   0.8652869 0.2496362
## 6     0.066   0.7365635   0.7782358 0.1914488
credit_data %>% mutate(util_bucket = cut(RevolvingUtilizationOfUnsecuredLines,
                                         breaks = c(-0.01, 0.25, 0.5, 0.75, 1.0, 1.25),
                                         labels = c("0-25%","25-50%","50-75%","75-100%","100%+"))) %>% count(util_bucket)
##   util_bucket     n
## 1       0-25% 70911
## 2      25-50% 17953
## 3      50-75% 11959
## 4     75-100% 20142
## 5       100%+  2060