BankRate Analysis
First, I will run all neccesary Libraries
library(readr)
library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.2library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(tidyr)## Warning: package 'tidyr' was built under R version 4.3.2library(nnet)Next I will load the relevant dataset.
loan_data <- read_csv("PSDCDataset.csv")## Rows: 100000 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): User ID, Reason, Fico_Score_group, Employment_Status, Employment_Se...
## dbl (8): applications, Loan_Amount, FICO_score, Monthly_Gross_Income, Monthl...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.str(loan_data)## spc_tbl_ [100,000 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ User ID : chr [1:100000] "00007820-89cb-4c1d-9940-eb270d605a35" "00012b55-514c-421e-9c76-3300abbc1134" "000157c1-b6a3-4c86-82c7-9ec1bda3799a" "00020400-efab-4b10-8812-2a0aaf774841" ...
## $ applications : num [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ Reason : chr [1:100000] "cover_an_unexpected_cost" "credit_card_refinancing" "home_improvement" "home_improvement" ...
## $ Loan_Amount : num [1:100000] 1e+05 7e+04 1e+04 1e+05 3e+04 3e+04 8e+04 7e+04 4e+04 9e+04 ...
## $ FICO_score : num [1:100000] 669 594 596 642 642 565 691 715 634 661 ...
## $ Fico_Score_group : chr [1:100000] "fair" "fair" "fair" "fair" ...
## $ Employment_Status : chr [1:100000] "full_time" "full_time" "full_time" "part_time" ...
## $ Employment_Sector : chr [1:100000] "consumer_discretionary" "information_technology" "information_technology" "energy" ...
## $ Monthly_Gross_Income : num [1:100000] 5024 5764 4017 3129 4220 ...
## $ Monthly_Housing_Payment : num [1:100000] 927 1177 1487 904 1620 ...
## $ Ever_Bankrupt_or_Foreclose: num [1:100000] 0 0 0 0 0 0 0 0 0 0 ...
## $ Lender : chr [1:100000] "B" "B" "A" "A" ...
## $ Approved : num [1:100000] 0 0 0 0 0 0 1 0 0 0 ...
## $ bounty : num [1:100000] 0 0 0 0 0 0 250 0 0 0 ...
## - attr(*, "spec")=
## .. cols(
## .. `User ID` = col_character(),
## .. applications = col_double(),
## .. Reason = col_character(),
## .. Loan_Amount = col_double(),
## .. FICO_score = col_double(),
## .. Fico_Score_group = col_character(),
## .. Employment_Status = col_character(),
## .. Employment_Sector = col_character(),
## .. Monthly_Gross_Income = col_double(),
## .. Monthly_Housing_Payment = col_double(),
## .. Ever_Bankrupt_or_Foreclose = col_double(),
## .. Lender = col_character(),
## .. Approved = col_double(),
## .. bounty = col_double()
## .. )
## - attr(*, "problems")=<externalptr>head(loan_data)Next I will illustrate the Approval rate amognsts the Lenders
summary(loan_data$Approved)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.1098 0.0000 1.0000approval_rate <- mean(loan_data$Approved) * 100
approval_rate## [1] 10.976This next section will illustrate the Distrubtion of Loan Approval by several important variables
ggplot(loan_data, aes(x = Reason, fill = factor(Approved))) +
geom_bar(position = "stack") +
labs(title = "Distribution of Loan Approval by Reason")
ggplot(loan_data, aes(x = Employment_Status, fill = factor(Approved))) +
geom_bar(position = "stack") +
labs(title = "Distribution of Loan Approval by Employment Status")
ggplot(loan_data, aes(x = Employment_Sector, fill = factor(Approved))) +
geom_bar(position = "stack") +
labs(title = "Distribution of Loan Approval by Employment Sector")
ggplot(loan_data, aes(x = Approved, y = Loan_Amount, fill = factor(Approved))) +
geom_boxplot() +
labs(title = "Loan Amount Distribution by Approval Status")
ggplot(loan_data, aes(x = FICO_score, y = Loan_Amount, color = factor(Approved))) +
geom_point() +
labs(title = "Scatter plot of FICO Score vs. Loan Amount by Approval Status")
These visualizations will help us understand how each independent variable relates to the target variable (“Approved”) and identify potential patterns or trends in the data.
Next, I will assess the significance of categorical variables in predicting loan approval.
loan_data <- loan_data %>%
mutate_if(is.character, as.factor)
logit_model <- glm(Approved ~ Reason + Employment_Status + Employment_Sector + Fico_Score_group,
data = loan_data, family = binomial)
summary(logit_model)##
## Call:
## glm(formula = Approved ~ Reason + Employment_Status + Employment_Sector +
## Fico_Score_group, family = binomial, data = loan_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.135017 0.066312 -2.036 0.0417
## Reasoncredit_card_refinancing 0.048884 0.036182 1.351 0.1767
## Reasondebt_conslidation -0.009362 0.032678 -0.286 0.7745
## Reasonhome_improvement -0.006702 0.040910 -0.164 0.8699
## Reasonmajor_purchase -0.022169 0.037130 -0.597 0.5505
## Reasonother -0.030775 0.044189 -0.696 0.4862
## Employment_Statuspart_time -0.470223 0.031649 -14.857 < 2e-16
## Employment_Sectorconsumer_discretionary -0.060903 0.080065 -0.761 0.4469
## Employment_Sectorconsumer_staples -0.030921 0.057549 -0.537 0.5911
## Employment_Sectorenergy 0.033231 0.064347 0.516 0.6056
## Employment_Sectorfinancials 0.138418 0.054603 2.535 0.0112
## Employment_Sectorhealth_care 0.107893 0.052616 2.051 0.0403
## Employment_Sectorindustrials 0.113985 0.057824 1.971 0.0487
## Employment_Sectorinformation_technology 0.103585 0.049424 2.096 0.0361
## Employment_Sectormaterials 0.060296 0.060131 1.003 0.3160
## Employment_Sectorreal_estate 0.084918 0.055577 1.528 0.1265
## Employment_Sectorutilities 0.029655 0.066886 0.443 0.6575
## Fico_Score_groupfair -2.495252 0.049479 -50.431 < 2e-16
## Fico_Score_groupgood -1.336790 0.047203 -28.320 < 2e-16
## Fico_Score_grouppoor -3.365965 0.057522 -58.516 < 2e-16
## Fico_Score_groupvery_good -0.418465 0.053668 -7.797 6.33e-15
##
## (Intercept) *
## Reasoncredit_card_refinancing
## Reasondebt_conslidation
## Reasonhome_improvement
## Reasonmajor_purchase
## Reasonother
## Employment_Statuspart_time ***
## Employment_Sectorconsumer_discretionary
## Employment_Sectorconsumer_staples
## Employment_Sectorenergy
## Employment_Sectorfinancials *
## Employment_Sectorhealth_care *
## Employment_Sectorindustrials *
## Employment_Sectorinformation_technology *
## Employment_Sectormaterials
## Employment_Sectorreal_estate
## Employment_Sectorutilities
## Fico_Score_groupfair ***
## Fico_Score_groupgood ***
## Fico_Score_grouppoor ***
## Fico_Score_groupvery_good ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 66226 on 93592 degrees of freedom
## Residual deviance: 57705 on 93572 degrees of freedom
## (6407 observations deleted due to missingness)
## AIC: 57747
##
## Number of Fisher Scoring iterations: 6the coefficient for “Reasoncredit_card_refinancing” is 0.048884. This means that compared to the reference category, applicants who request a loan for credit card refinancing have a log odds of loan approval that is 0.048884 higher, holding all other variables constant. All coefficients for FICO score groups are statistically significant (p-value < 0.05), indicating that FICO score group is a significant predictor of loan approval.
Next, I will use correlation analysis and t-tests to assess the impact of continuous variables on loan approval as well compare the means of continous variables
correlation <- cor(loan_data[c("FICO_score", "Loan_Amount")], loan_data$Approved)
correlation## [,1]
## FICO_score 0.26958716
## Loan_Amount -0.04008939t_test_fico <- t.test(FICO_score ~ Approved, data = loan_data)
t_test_fico##
## Welch Two Sample t-test
##
## data: FICO_score by Approved
## t = -98.451, df = 14771, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## -77.98636 -74.94163
## sample estimates:
## mean in group 0 mean in group 1
## 620.9569 697.4209# Independent t-test for "Loan Amount"
t_test_loan_amount <- t.test(Loan_Amount ~ Approved, data = loan_data)
t_test_loan_amount##
## Welch Two Sample t-test
##
## data: Loan_Amount by Approved
## t = 12.945, df = 13980, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
## 3123.979 4238.874
## sample estimates:
## mean in group 0 mean in group 1
## 45638.42 41957.00loan_data$FICO_Loan_Interact <- loan_data$FICO_score * loan_data$Loan_Amount
logit_model_interact <- glm(Approved ~ FICO_score + Loan_Amount + FICO_Loan_Interact, data = loan_data, family = binomial)
summary(logit_model_interact)##
## Call:
## glm(formula = Approved ~ FICO_score + Loan_Amount + FICO_Loan_Interact,
## family = binomial, data = loan_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.693e+00 1.868e-01 -51.882 <2e-16 ***
## FICO_score 1.184e-02 2.713e-04 43.648 <2e-16 ***
## Loan_Amount -1.148e-05 3.699e-06 -3.105 0.0019 **
## FICO_Loan_Interact 9.351e-09 5.347e-09 1.749 0.0803 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 69203 on 99999 degrees of freedom
## Residual deviance: 60694 on 99996 degrees of freedom
## AIC: 60702
##
## Number of Fisher Scoring iterations: 6loan_data$FICO_Score_Squared <- loan_data$FICO_score^2
logit_model_poly <- glm(Approved ~ FICO_score + FICO_Score_Squared, data = loan_data, family = binomial)
summary(logit_model_poly)##
## Call:
## glm(formula = Approved ~ FICO_score + FICO_Score_Squared, family = binomial,
## data = loan_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -7.669e+00 6.002e-01 -12.778 < 2e-16 ***
## FICO_score 4.732e-03 1.782e-03 2.655 0.00793 **
## FICO_Score_Squared 5.532e-06 1.317e-06 4.199 2.68e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 69203 on 99999 degrees of freedom
## Residual deviance: 60861 on 99997 degrees of freedom
## AIC: 60867
##
## Number of Fisher Scoring iterations: 6Overall, the logistic regression model suggests that FICO score and loan amount are significant predictors of loan approval, with higher FICO scores and lower loan amounts associated with higher odds of approval. Additionally, there may be a potential interaction effect between FICO score and loan amount, although its significance is less clear. The model fits the data well, as indicated by the goodness-of-fit statistics (Null and Residual deviance) and the AIC value. Overall, the results in the T-test indicate a statistically significant difference in mean loan amounts between denied and approved loan applications. The mean loan amount for denied applications (Group 0) is higher than that for approved applications (Group 1), with a confidence interval suggesting that the true difference in means lies between approximately 3124 and 4239 units. This suggests that approved loan applications tend to have lower loan amounts compared to denied applications.
Next, I will calculate the approval rates for each lender and visualize the differences
approval_rates <- loan_data %>%
group_by(Lender) %>%
summarize(Approval_Rate = mean(Approved) * 100)
# Print approval rates
print(approval_rates)## # A tibble: 3 × 2
## Lender Approval_Rate
## <fct> <dbl>
## 1 A 11.0
## 2 B 7.13
## 3 C 17.1# Visualize approval rates using a bar plot
ggplot(approval_rates, aes(x = Lender, y = Approval_Rate)) +
geom_bar(stat = "identity", fill = "skyblue", width = 0.5) +
labs(title = "Approval Rates by Lender",
x = "Lender",
y = "Approval Rate (%)") +
theme_minimal()
Next, I will display the plots comparing the distributions of key variables between approved and denied applications for each lender
key_variables <- c("FICO_score", "Loan_Amount", "Monthly_Gross_Income")
# Function to create plots for each lender
create_plots <- function(data, lender) {
plots <- lapply(key_variables, function(variable) {
ggplot(data, aes_string(x = variable, fill = "factor(Approved)")) +
geom_histogram(position = "dodge", bins = 30, alpha = 0.7) +
facet_wrap(~ Approved, scales = "free") +
labs(title = paste("Distribution of", variable, "for", lender),
x = variable, y = "Frequency") +
theme_minimal()
})
return(plots)
}
# Plot distributions for each lender
for (lender in unique(loan_data$Lender)) {
lender_data <- loan_data %>% filter(Lender == lender)
plots <- create_plots(lender_data, lender)
print(paste("Lender:", lender))
for (plot in plots) {
print(plot)
}
}## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## [1] "Lender: B"
## [1] "Lender: A"
## [1] "Lender: C"
In the next phase, I will Analyze the relationship between variables and the bounty received for each lender. Segment customers based on variables like FICO score group, employment status, loan amount, etc. Calculate the average bounty for each segment with each lender. Recommend matching specific customer segments to lenders with higher bounties for those segments to potentially maximize RPA.
relationship_analysis <- loan_data %>%
group_by(Lender) %>%
summarize(Average_Bounty = mean(bounty))
# Print relationship analysis
print(relationship_analysis)## # A tibble: 3 × 2
## Lender Average_Bounty
## <fct> <dbl>
## 1 A 27.4
## 2 B 24.9
## 3 C 25.6segmented_data <- loan_data %>%
group_by(Fico_Score_group, Employment_Status, Lender) %>%
summarize(Average_Bounty = mean(bounty))## `summarise()` has grouped output by 'Fico_Score_group', 'Employment_Status'.
## You can override using the `.groups` argument.segmented_analysis <- segmented_data %>%
group_by(Fico_Score_group, Employment_Status) %>%
summarize(Lender = list(Lender), Average_Bounty = list(Average_Bounty))## `summarise()` has grouped output by 'Fico_Score_group'. You can override using
## the `.groups` argument.print(segmented_analysis)## # A tibble: 15 × 4
## # Groups: Fico_Score_group [5]
## Fico_Score_group Employment_Status Lender Average_Bounty
## <fct> <fct> <list> <list>
## 1 excellent full_time <fct [3]> <dbl [3]>
## 2 excellent part_time <fct [3]> <dbl [3]>
## 3 excellent unemployed <fct [3]> <dbl [3]>
## 4 fair full_time <fct [3]> <dbl [3]>
## 5 fair part_time <fct [3]> <dbl [3]>
## 6 fair unemployed <fct [3]> <dbl [3]>
## 7 good full_time <fct [3]> <dbl [3]>
## 8 good part_time <fct [3]> <dbl [3]>
## 9 good unemployed <fct [3]> <dbl [3]>
## 10 poor full_time <fct [3]> <dbl [3]>
## 11 poor part_time <fct [3]> <dbl [3]>
## 12 poor unemployed <fct [3]> <dbl [3]>
## 13 very_good full_time <fct [3]> <dbl [3]>
## 14 very_good part_time <fct [3]> <dbl [3]>
## 15 very_good unemployed <fct [3]> <dbl [3]> segmented_analysis <- segmented_analysis %>%
unnest(cols = c(Lender, Average_Bounty))
print(segmented_analysis)## # A tibble: 45 × 4
## # Groups: Fico_Score_group [5]
## Fico_Score_group Employment_Status Lender Average_Bounty
## <fct> <fct> <fct> <dbl>
## 1 excellent full_time A 111.
## 2 excellent full_time B 169.
## 3 excellent full_time C 92.6
## 4 excellent part_time A 103.
## 5 excellent part_time B 73.3
## 6 excellent part_time C 85.7
## 7 excellent unemployed A 163.
## 8 excellent unemployed B 94.6
## 9 excellent unemployed C 43.5
## 10 fair full_time A 18.1
## # ℹ 35 more rowsThis table gives each Lender a guide to maximize revenue per application when considering the key indicators FICO score group and employment status.
Conclusion: Maximizing Revenue Per Application through Strategic Lender Matching
In conclusion, this analysis focused on optimizing Revenue Per Application (RPA) by strategically matching specific customer segments to lenders. Through a comprehensive exploration of loan application variables, lenders’ approval rates, and customer segmentation, I gained valuable insights into factors influencing approval likelihood and potential strategies for maximizing RPA.
Key Findings:
Variables Influencing Approval Likelihood:
Through analysis I identified several key variables, including FICO score, employment status, and loan amount, as significant predictors of loan approval likelihood. Understanding the distribution and impact of these variables provided essential insights into the factors driving approval decisions. Lenders’ Approval Rates and Customer Segmentation:
Evaluation of lenders’ approval rates and customer segmentation revealed distinct patterns in approval likelihood across different customer segments. Logistic regression analysis and comparison of variable distributions between approved and denied applications helped elucidate the determinants of approval. Recommendations for Maximizing RPA:
Based on our analysis, we recommended matching specific customer segments to lenders with higher bounties to potentially maximize RPA. Segmentation by FICO score group, employment status, and other variables enabled us to identify optimal lender matches for different customer segments. Next Possible Steps:
Further refinement of analysis techniques, including advanced statistical modeling and predictive analytics, can enhance the accuracy of lender matching recommendations.
Validation of the analysis results through robust testing and validation techniques is essential to ensure the reliability and validity of the findings.
Implementation of the recommended lender matching strategies in real-world scenarios requires careful planning and execution.
Continuous monitoring of RPA and lender performance metrics is crucial for identifying areas of improvement and optimizing lender matching strategies over time.
Collaboration with key stakeholders, including lenders, financial advisors, and regulatory bodies, is essential for gaining insights and addressing challenges in implementing lender matching initiatives effectively.
In conclusion, this analysis provides a roadmap for optimizing RPA through strategic lender matching, driving growth and profitability in the personal loan segment. By leveraging the insights gained and following the next possible steps outlined, Bankrate can enhance its competitive edge and maximize returns in the dynamic financial landscape.
Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Cmd+Option+I.
When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Cmd+Shift+K to preview the HTML file).
The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed. tinytex::install_tinytex()