library(readr)
library(tidyverse)
library(ggplot2)
library(GGally)
library(dplyr)Predicting Loan Approval Odds
Classification Models for Machine Learning:
- Logistic Regression
- Tree Model
- Naive Bayes
- SVMs
- Random Forest
- XGBoost
I will be analyzing a loan approval dataset to predict applicant outcomes. By using data visualization and testing different modeling methods, I will find the most accurate way to predict approvals and denials.
Data source : https://www.kaggle.com/datasets/taweilo/loan-approval-classification-data
| Column | Description | Type |
|---|---|---|
| person_age | Age of the person | Float |
| person_gender | Gender of the person | Categorical |
| person_education | Highest education level | Categorical |
| person_income | Annual income | Float |
| person_emp_exp | Years of employment experience | Integer |
| person_home_ownership | Home ownership status (e.g., rent, own, mortgage) | Categorical |
| loan_amnt | Loan amount requested | Float |
| loan_intent | Purpose of the loan | Categorical |
| loan_int_rate | Loan interest rate | Float |
| loan_percent_income | Loan amount as a percentage of annual income | Float |
| cb_person_cred_hist_length | Length of credit history in years | Float |
| credit_score | Credit score of the person | Integer |
| previous_loan_defaults_on_file | Indicator of previous loan defaults | Categorical |
| loan_status (target) | Loan approval status: 1 = approved; 0 = rejected | Integer |
loan <- read_csv("C:/Users/151495/Desktop/Loan Aproval Modeling/loan_data.csv")
str(loan)spc_tbl_ [45,000 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
$ person_age : num [1:45000] 22 21 25 23 24 21 26 24 24 21 ...
$ person_gender : chr [1:45000] "female" "female" "female" "female" ...
$ person_education : chr [1:45000] "Master" "High School" "High School" "Bachelor" ...
$ person_income : num [1:45000] 71948 12282 12438 79753 66135 ...
$ person_emp_exp : num [1:45000] 0 0 3 0 1 0 1 5 3 0 ...
$ person_home_ownership : chr [1:45000] "RENT" "OWN" "MORTGAGE" "RENT" ...
$ loan_amnt : num [1:45000] 35000 1000 5500 35000 35000 2500 35000 35000 35000 1600 ...
$ loan_intent : chr [1:45000] "PERSONAL" "EDUCATION" "MEDICAL" "MEDICAL" ...
$ loan_int_rate : num [1:45000] 16 11.1 12.9 15.2 14.3 ...
$ loan_percent_income : num [1:45000] 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 [1:45000] 3 2 3 2 4 2 3 4 2 3 ...
$ credit_score : num [1:45000] 561 504 635 675 586 532 701 585 544 640 ...
$ previous_loan_defaults_on_file: chr [1:45000] "No" "Yes" "No" "No" ...
$ loan_status : num [1:45000] 1 0 1 1 1 1 1 1 1 1 ...
- attr(*, "spec")=
.. cols(
.. person_age = col_double(),
.. person_gender = col_character(),
.. person_education = col_character(),
.. person_income = col_double(),
.. person_emp_exp = col_double(),
.. person_home_ownership = col_character(),
.. loan_amnt = col_double(),
.. loan_intent = col_character(),
.. loan_int_rate = col_double(),
.. loan_percent_income = col_double(),
.. cb_person_cred_hist_length = col_double(),
.. credit_score = col_double(),
.. previous_loan_defaults_on_file = col_character(),
.. loan_status = col_double()
.. )
- attr(*, "problems")=<externalptr> Exploratory Data Analysis
Several categorical variables are currently formatted as characters. I will convert character (chr) variables into factors. This formatting change ensures they work correctly in our models and calculations.
loan$person_gender <- as.factor(loan$person_gender)
loan$person_education <- as.factor(loan$person_education)
loan$person_home_ownership <- as.factor(loan$person_home_ownership)
loan$loan_intent <- as.factor(loan$loan_intent)
loan$previous_loan_defaults_on_file <- as.factor(loan$previous_loan_defaults_on_file)
loan$loan_status <- as.factor(loan$loan_status)summary(loan) person_age person_gender person_education person_income
Min. : 20.00 female:20159 Associate :12028 Min. : 8000
1st Qu.: 24.00 male :24841 Bachelor :13399 1st Qu.: 47204
Median : 26.00 Doctorate : 621 Median : 67048
Mean : 27.76 High School:11972 Mean : 80319
3rd Qu.: 30.00 Master : 6980 3rd Qu.: 95789
Max. :144.00 Max. :7200766
person_emp_exp person_home_ownership loan_amnt
Min. : 0.00 MORTGAGE:18489 Min. : 500
1st Qu.: 1.00 OTHER : 117 1st Qu.: 5000
Median : 4.00 OWN : 2951 Median : 8000
Mean : 5.41 RENT :23443 Mean : 9583
3rd Qu.: 8.00 3rd Qu.:12237
Max. :125.00 Max. :35000
loan_intent loan_int_rate loan_percent_income
DEBTCONSOLIDATION:7145 Min. : 5.42 Min. :0.0000
EDUCATION :9153 1st Qu.: 8.59 1st Qu.:0.0700
HOMEIMPROVEMENT :4783 Median :11.01 Median :0.1200
MEDICAL :8548 Mean :11.01 Mean :0.1397
PERSONAL :7552 3rd Qu.:12.99 3rd Qu.:0.1900
VENTURE :7819 Max. :20.00 Max. :0.6600
cb_person_cred_hist_length credit_score previous_loan_defaults_on_file
Min. : 2.000 Min. :390.0 No :22142
1st Qu.: 3.000 1st Qu.:601.0 Yes:22858
Median : 4.000 Median :640.0
Mean : 5.867 Mean :632.6
3rd Qu.: 8.000 3rd Qu.:670.0
Max. :30.000 Max. :850.0
loan_status
0:35000
1:10000
over100 <- loan %>%
filter(person_age > 100)
over100# A tibble: 7 × 14
person_age person_gender person_education person_income person_emp_exp
<dbl> <fct> <fct> <dbl> <dbl>
1 144 male Bachelor 300616 125
2 144 male Associate 241424 121
3 123 female High School 97140 101
4 123 male Bachelor 94723 100
5 144 female Associate 7200766 124
6 116 male Bachelor 5545545 93
7 109 male High School 5556399 85
# ℹ 9 more variables: person_home_ownership <fct>, loan_amnt <dbl>,
# loan_intent <fct>, loan_int_rate <dbl>, loan_percent_income <dbl>,
# cb_person_cred_hist_length <dbl>, credit_score <dbl>,
# previous_loan_defaults_on_file <fct>, loan_status <fct>Our data has some unrealistic values, since this is modeling experiment I will keep the extreme values for now.
ggpairs(loan,
columns = c("person_age",
"person_gender",
"person_education"),
aes(color=loan_status, alpha=0.4))
ggpairs(loan,
columns = c("person_income",
"person_emp_exp",
"person_home_ownership"),
aes(color=loan_status, alpha=0.4))
library(corrplot)
matrix <- cor(loan[sapply(loan, is.numeric)])
corrplot(matrix, method = "color",
order = "hclust",
addCoef.col = "orange",
number.cex = 1,
tl.col = "black",
tl.srt = 45) 
ggplot(loan, aes(x=loan_intent, y=loan_amnt, fill=loan_status)) + geom_col()
Medical loans are showing better approval rates compare to others, this might be important factor on guessing the outcome.
Model Fitting and Data Partitioning
We will split our data into train and test, but first lets fit the logistic regression using all the variables to our entire dataset to get a sense of the variables weight on prediction outcomes.
Logistic Regression
log_model <- glm(loan_status ~ ., data = loan, family = binomial)
summary(log_model)
Call:
glm(formula = loan_status ~ ., family = binomial, data = loan)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.447e-01 3.594e-01 -0.959 0.33752
person_age 2.476e-02 1.093e-02 2.267 0.02342 *
person_gendermale 3.907e-02 3.540e-02 1.104 0.26979
person_educationBachelor -3.915e-04 4.704e-02 -0.008 0.99336
person_educationDoctorate 1.460e-02 1.476e-01 0.099 0.92122
person_educationHigh School 1.332e-02 4.914e-02 0.271 0.78634
person_educationMaster 3.006e-02 5.624e-02 0.534 0.59303
person_income 5.889e-07 1.969e-07 2.991 0.00278 **
person_emp_exp -2.179e-02 9.710e-03 -2.244 0.02485 *
person_home_ownershipOTHER 3.383e-01 3.188e-01 1.061 0.28857
person_home_ownershipOWN -1.457e+00 1.018e-01 -14.311 < 2e-16 ***
person_home_ownershipRENT 7.217e-01 4.007e-02 18.009 < 2e-16 ***
loan_amnt -1.010e-04 3.940e-06 -25.637 < 2e-16 ***
loan_intentEDUCATION -9.074e-01 5.851e-02 -15.508 < 2e-16 ***
loan_intentHOMEIMPROVEMENT -8.255e-03 6.581e-02 -0.125 0.90018
loan_intentMEDICAL -2.910e-01 5.645e-02 -5.155 2.53e-07 ***
loan_intentPERSONAL -7.272e-01 5.994e-02 -12.133 < 2e-16 ***
loan_intentVENTURE -1.211e+00 6.359e-02 -19.044 < 2e-16 ***
loan_int_rate 3.340e-01 6.574e-03 50.803 < 2e-16 ***
loan_percent_income 1.581e+01 3.072e-01 51.442 < 2e-16 ***
cb_person_cred_hist_length -5.179e-03 9.109e-03 -0.569 0.56967
credit_score -8.911e-03 4.100e-04 -21.732 < 2e-16 ***
previous_loan_defaults_on_fileYes -2.037e+01 1.026e+02 -0.198 0.84268
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 47674 on 44999 degrees of freedom
Residual deviance: 19879 on 44977 degrees of freedom
AIC: 19925
Number of Fisher Scoring iterations: 19actual_labels <- ifelse(loan$loan_status == 1, "approved", "denied")log_probs <- predict(log_model, type="response")
pred_labels <- ifelse(log_probs >0.5, "approved","denied")
conf_matrix <- table(pred_labels, actual_labels)
table(pred_labels, actual_labels) actual_labels
pred_labels approved denied
approved 7506 2152
denied 2494 32848logistic_accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(paste("Logistic Model Accuracy:", round(logistic_accuracy, 4)))[1] "Logistic Model Accuracy: 0.8968"log2_model <- glm(loan_status ~ person_age + person_gender + person_education + log(person_income) +
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 = loan,
family = binomial) log2_probs <- predict(log2_model, type="response")
pred2_labels <- ifelse(log2_probs >0.5, "approved","denied")
conf_matrix2 <- table(pred2_labels, actual_labels)
table(pred2_labels, actual_labels) actual_labels
pred2_labels approved denied
approved 7593 2184
denied 2407 32816logistic2_accuracy <- sum(diag(conf_matrix2)) / sum(conf_matrix2)
print(paste("Logistic Model 2 Accuracy:", round(logistic2_accuracy, 4)))[1] "Logistic Model 2 Accuracy: 0.898"set.seed(210)
train_data <- sample(nrow(loan), nrow(loan) * 0.8)
train_size <- loan[train_data, ]
test_size <- loan[-train_data, ]
dim(train_size)[1] 36000 14dim(test_size)[1] 9000 14Tree Model
library(tree)tree_model <- tree(loan_status ~ ., data = train_size)
summary(tree_model)
Classification tree:
tree(formula = loan_status ~ ., data = train_size)
Variables actually used in tree construction:
[1] "previous_loan_defaults_on_file" "loan_percent_income"
[3] "loan_int_rate" "person_income"
[5] "person_home_ownership"
Number of terminal nodes: 7
Residual mean deviance: 0.4287 = 15430 / 35990
Misclassification error rate: 0.09239 = 3326 / 36000 plot(tree_model)
text(tree_model, pretty = 0, cex = 0.7)
The tree starts with previous loan defaults, which is the most important variable. If a person has a previous loan default, the model predicts
loan_status = 0. If they have no previous default, the tree moves to the next factor, loan percent income, with a cutoff of 24.5%.
For people with no previous default and a loan percent income below 24.5%, the tree looks at the loan interest rate. An interest rate of 13.995% or higher leads to a prediction of
1. If the interest rate is below 13.995%, the model then considers person income, using $24,598.50 as the cutoff.
Overall, the tree shows that previous loan history, loan burden relative to income, interest rate, income, and home ownership are the main factors used to predict loan status. The model gives the most importance to previous loan defaults, while the other variables provide additional decision points for borrowers who have no previous defaults.
pred_tree <- predict(tree_model, newdata = test_size, type = "class")
conf_matrix_tree <- table(Predicted = pred_tree, Actual = test_size$loan_status)
conf_matrix_tree Actual
Predicted 0 1
0 6676 610
1 244 1470accuracy_tree <- mean(pred_tree == test_size$loan_status)
cat("Test Accuracy:", accuracy_tree, "\n")Test Accuracy: 0.9051111 cv_tree <- cv.tree(tree_model)
plot(cv_tree$size, cv_tree$dev, type = "b", xlab = "Tree Size", ylab = "Deviance")
best_size <- cv_tree$size[which.min(cv_tree$dev)]
cat("Optimal Tree Size determined by CV:", best_size, "\n")Optimal Tree Size determined by CV: 7 This results further confirms that our standard tree model utilized best size on its branches.
Naive Bayes
library(e1071)
library(caTools)
library(caret)nb_model <- naiveBayes(loan_status ~., data=train_size)
nb_model
Naive Bayes Classifier for Discrete Predictors
Call:
naiveBayes.default(x = X, y = Y, laplace = laplace)
A-priori probabilities:
Y
0 1
0.78 0.22
Conditional probabilities:
person_age
Y [,1] [,2]
0 27.82810 6.089668
1 27.57184 6.003294
person_gender
Y female male
0 0.4483974 0.5516026
1 0.4513889 0.5486111
person_education
Y Associate Bachelor Doctorate High School Master
0 0.26826923 0.29433761 0.01396011 0.26688034 0.15655271
1 0.26452020 0.30366162 0.01527778 0.26527778 0.15126263
person_income
Y [,1] [,2]
0 86077.00 91356.16
1 59783.62 43945.34
person_emp_exp
Y [,1] [,2]
0 5.467094 6.113810
1 5.232955 5.961267
person_home_ownership
Y MORTGAGE OTHER OWN RENT
0 0.467236467 0.002172365 0.078917379 0.451673789
1 0.214772727 0.003409091 0.021212121 0.760606061
loan_amnt
Y [,1] [,2]
0 9221.926 6012.606
1 10846.944 7143.848
loan_intent
Y DEBTCONSOLIDATION EDUCATION HOMEIMPROVEMENT MEDICAL PERSONAL VENTURE
0 0.1424501 0.2162749 0.1002137 0.1769943 0.1722578 0.1918091
1 0.2178030 0.1565657 0.1246212 0.2366162 0.1517677 0.1126263
loan_int_rate
Y [,1] [,2]
0 10.47401 2.735332
1 12.86800 3.073760
loan_percent_income
Y [,1] [,2]
0 0.1219769 0.07138143
1 0.2020758 0.10675036
cb_person_cred_hist_length
Y [,1] [,2]
0 5.902066 3.873000
1 5.796212 3.930272
credit_score
Y [,1] [,2]
0 632.8164 50.36824
1 632.2072 50.25421
previous_loan_defaults_on_file
Y No Yes
0 0.3469017 0.6530983
1 1.0000000 0.0000000The biggest factors driving denials are financial strain and housing status in our Naive Bayes Model.
Surprisingly, demographics and credit scores barely matter in this model. Age, gender, education, and credit scores (averaging around 632 for both groups) look almost identical across approved and denied applicants. To make accurate predictions, the model relies heavily on income, loan amount, interest rates, and homeownership rather than basic applicant backgrounds.
nb_preds <- predict(nb_model, newdata = test_size)
conf_matrix_nb <- table(Predicted = nb_preds, Actual = test_size$loan_status)
conf_matrix_nb Actual
Predicted 0 1
0 6267 448
1 653 1632accuracy_nb <- sum(diag(conf_matrix_nb)) / sum(conf_matrix_nb)
# Print accuracy as a percentage
print(paste("Accuracy:", round(accuracy_nb * 100, 2), "%"))[1] "Accuracy: 87.77 %"Support Vector Machines (SVMs)
library(caret)
library(kernlab)
control <- trainControl(method = "none") # i didnt want to do cv since dataset is large but I might try on eventually.
# (method = "cv", number = 5)
# tuning_grid <- expand.grid(degree = c(1, 2, 3), scale = c(0.1, 1), C = c(0.1, 1, 10))
# Well I tried running parameters above but the model run time will reach to hours or even days. So this options could be added if there is better computational power is available
svm_model_rad <- train(loan_status ~ .,
data = train_size, method = "svmRadial", trControl = control)
svm_preds_rad <- predict(svm_model_rad, newdata = test_size)
confusionMatrix(svm_preds_rad, test_size$loan_status)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 6626 540
1 294 1540
Accuracy : 0.9073
95% CI : (0.9012, 0.9132)
No Information Rate : 0.7689
P-Value [Acc > NIR] : < 2.2e-16
Kappa : 0.728
Mcnemar's Test P-Value : < 2.2e-16
Sensitivity : 0.9575
Specificity : 0.7404
Pos Pred Value : 0.9246
Neg Pred Value : 0.8397
Prevalence : 0.7689
Detection Rate : 0.7362
Detection Prevalence : 0.7962
Balanced Accuracy : 0.8489
'Positive' Class : 0
svm_rad_results <- confusionMatrix(svm_preds_rad, test_size$loan_status)
svm_rad_accuracy <- svm_rad_results$overall["Accuracy"]
print(paste("Radial SVM Accuracy:", round(svm_rad_accuracy, 4)))[1] "Radial SVM Accuracy: 0.9073"Random Forest
library(randomForest)
set.seed(210)
rforest_model <- randomForest(loan_status ~ .,
data = train_size,
ntree = 600,
mtry = 2,
importance = TRUE)
rf_preds <- predict(rforest_model, newdata = test_size, type = "response")
rf_matrix <- table(Predicted = rf_preds, Actual = test_size$loan_status)
print(rf_matrix) Actual
Predicted 0 1
0 6780 520
1 140 1560rf_accuracy <- sum(diag(rf_matrix)) / sum(rf_matrix)
print(paste("Overall Accuracy:", round(rf_accuracy, 4)))[1] "Overall Accuracy: 0.9267"Extreme Gradient Boosting (XGBoost)
library(xgboost)first I need to prepare the data for XGBoost
X_train <- model.matrix(loan_status ~ ., data = train_size)[, -1]
X_test <- model.matrix(loan_status ~ ., data = test_size)[, -1]
y_train <- as.numeric(as.character(train_size$loan_status))
y_test <- as.numeric(as.character(test_size$loan_status))
dtrain <- xgb.DMatrix(data = X_train, label = y_train)
dtest <- xgb.DMatrix(data = X_test, label = y_test)params <- list(objective = "reg:logistic",
max.depth = 4,
eta = 0.1
)
xgb_model <- xgb.train(params = params,
data = dtrain,
nrounds = 50,
verbose = 0)xgb_probs <- predict(xgb_model, newdata = X_test)
xgb_preds <- ifelse(xgb_probs > 0.5, 1, 0)
xgb_matrix <- table(Predicted = xgb_preds, Actual = y_test)
print(xgb_matrix) Actual
Predicted 0 1
0 6708 519
1 212 1561xgb_accuracy <- sum(diag(xgb_matrix)) / sum(xgb_matrix)
print(xgb_accuracy)[1] 0.9187778Model Comparison
model_comparison <- data.frame(
Model = c(
"Logistic Regression",
" Tree Model",
"Naiive Bayes",
"SVMs Model",
"Random Forest",
"XGBoost"
),
Accuracy = c(
logistic_accuracy,
accuracy_tree,
accuracy_nb,
svm_rad_accuracy,
rf_accuracy,
xgb_accuracy
)
)library(DT)
datatable(
model_comparison,
colnames = c("Model Type", "Prediction Accuracy"),
rownames = FALSE,
options = list(
pageLength = 6,
dom = 't',
columnDefs = list(list(className = 'dt-center', targets = 0:1))
)
) %>%
formatPercentage('Accuracy', digits = 2) library(ggplot2)
library(dplyr)
model_comparison <- model_comparison %>%
mutate(Model = reorder(Model, Accuracy))
ggplot(model_comparison, aes(x = Model, y = Accuracy, fill = Accuracy)) +
geom_col(width = 0.7, show.legend = FALSE) +
geom_text(aes(label = paste0(round(Accuracy * 100, 1), "%")),
hjust = -0.15, size = 4, fontface = "bold", color = "grey20") +
coord_flip() +
scale_fill_gradient(low = "#74a9cf", high = "#0570b0") +
scale_y_continuous(labels = scales::percent_format(accuracy = 1),
expand = expansion(mult = c(0, 0.1))) +
labs(
title = "Model Accuracy Comparison",
subtitle = "Predicting loan approval odds across six different machine learning algorithms",
x = NULL,
y = "Accuracy Score"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(face = "bold", size = 16, color = "#2c3e50"),
plot.subtitle = element_text(size = 11, color = "#C01D0C", margin = ggplot2::margin(b = 15)),
axis.text.y = element_text(face = "bold", color = "#34495e"),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank()
)
Model Selection and Final Take
My winning model is Random Forest with impressive accuracy of 92.7%. This means that my model predict whether person get approve or denied 92.7% of the time.