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.
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.
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