Machine learning algorithms are reshaping financial decision-making, changing how the industry manages financial risk. These advanced algorithms can analyze vast amounts of data to deliver predictive insights, which creates new opportunities to drive informed decisions or to expedite client service.
And now, machine learning is more streamlined than it has ever been. Financial analysts can use Posit to harness the performance and data governance capabilities of Databricks. Analysts can use:
Moreover, they can work in managed environments with their preferred IDE in Posit Workbench and deploy and share their models on Posit Connect. This workflow combines the power of R’s tidymodels framework for machine learning with the storage and computation capabilities of Databricks.
In this article, we will use both Posit and Databricks to apply machine learning methods to the consumer credit market, where accurately predicting lending rates is critical for customer acquisition. Credit lenders must use a comprehensive process, transparent to regulators, to choose lending rates for loan applicants—but this takes time. Customers shopping between lenders want personalized lending rates, quickly. To avoid losing customers to faster alternatives, while still minimizing loan associated risks, we will build a user friendly Shiny app, based on a machine learning model, that customers can use to predict the interest rates on their loans before they submit their applications.
Specifically, we will:
Let’s start by loading the packages that will be integral to our workflow.
# Importing data
library(DBI)
library(odbc)
# Wrangling packages
library(tidyverse)
library(dbplyr)
# Visualization packages
library(dbplot)
library(ggplot2)
# Modeling packages
library(rsample)
library(recipes)
library(parsnip)
library(workflows)
library(yardstick)
library(glmnet)
library(dials)
library(tune)
library(broom)For those with access to Databricks, add the historical lending rate data to your catalog by running the below:
CREATE TABLE lending_club USING com.databricks.spark.csv OPTIONS(path 'dbfs:/databricks-datasets/lending-club-loan-stats/LoanStats_2018Q2.csv', header "true");As previously mentioned, analysts have several options for accessing Databricks data. In this walk-through, we’ll demonstrate connectivity using the odbc package. The Posit Solutions site provides detailed guidance on using the new odbc databricks() function. Essentially, we need to store a Databricks token and host URL in our R environment. The function itself requires only the HTTP path to the SQL warehouse.
# Sys.setenv("DATABRICKS_HOST" = "your-databricks-host.com")
# Sys.setenv("DATABRICKS_TOKEN" = "your-databricks-token")
con <-
dbConnect(odbc::databricks(), httpPath = Sys.getenv("HTTP_PATH"))This code snippet establishes a connection whose details are stored in the con object. With this connection, we can create an object named lendingclub_dat that refers to our table in Databricks.
lendingclub_dat <-
tbl(con, dbplyr::in_catalog("hive_metastore", "default", "lendingclub"))tbl() creates the R equivalent of an SQL view: an SQL query that represents a table. For example, lendingclub_dat is the virtual table represented by this SQL query. We can view the query with show_query().
lendingclub_dat |>
show_query()<SQL>
SELECT *
FROM `hive_metastore`.`default`.`lendingclub`As a result, lendingclub_dat is very lightweight—it has no data. The data still lives in Databricks, and therefore can be far larger than what we would normally import into R.
But we can still work with lendingclub_dat as if it were an R data frame. When we manipulate a tbl with dplyr or base R code, dbplyr translates our code to SQL and adds it to the query. The comparison below shows some code we might write with R, alongside the SQL translation provided by dbplyr. As you can see, dplyr often provides a more efficient way to write SQL than SQL itself due to its expressive syntax.
lendingclub_dat |>
mutate(across(c(starts_with("annual")), ~ as.numeric(.))) |>
select(int_rate, starts_with("annual")) |>
head()lendingclub_dat |>
mutate(across(c(starts_with("annual")), ~ as.numeric(.))) |>
select(int_rate, starts_with("annual")) |>
head() |>
show_query()<SQL>
SELECT
`int_rate`,
CAST(`annual_inc` AS DOUBLE) AS `annual_inc`,
CAST(`annual_inc_joint` AS DOUBLE) AS `annual_inc_joint`
FROM `hive_metastore`.`default`.`lendingclub`
LIMIT 6When we wish to run the accumulated query and access the result, we can call collect(). R will send the SQL query to Databricks to be evaluated in Databricks’ compute. It will then import the result as a real table into R, where we can continue to manipulate it in R; for example, to run advanced operations on the data that have no equivalent in SQL.
lendingclub_subset <-
lendingclub_dat |>
mutate(across(c(starts_with("annual")), ~ as.numeric(.))) |>
select(int_rate, starts_with("annual")) |>
head() |>
collect()
lendingclub_subset# A tibble: 6 × 3
int_rate annual_inc annual_inc_joint
<chr> <dbl> <dbl>
1 20.39% 26000 53000
2 13.06% 94000 NA
3 10.56% 98000 NA
4 6.83% 144000 NA
5 17.47% 60000 NA
6 16.46% 20388 NAR will also lazily call collect() when it needs to to show us a result that we ask for.
lendingclub_dat |>
head() |>
select(int_rate, bc_util)# Source: SQL [6 x 2]
# Database: Spark SQL 3.1.1[token@Spark SQL/hive_metastore]
int_rate bc_util
<chr> <chr>
1 20.39% 94
2 13.06% 82
3 10.56% 34.5
4 6.83% 7.9
5 17.47% 62.1
6 16.46% 92.2 This arrangement has two advantages:
collect() leads to significantly faster performance.And while this arrangement may seem exotic, it is very true to R’s design philosophy. R’s precursor, S, was originally created to provide a human friendly syntax layer that would call more formal routines, written in FORTRAN, C, and so on, under the hood.
Now, we can proceed with using dplyr to clean up the rest of the variables and create supplementary variables that could potentially influence lending rates.
lendingclub_dat <-
dplyr::tbl(con, dbplyr::in_catalog("hive_metastore", "default", "lendingclub")) |>
select(-c("acc_now_delinq", "chargeoff_within_12_mths",
"debt_settlement_flag", "debt_settlement_flag_date",
"deferral_term",
"delinq_amnt","desc","disbursement_method","emp_title",
"funded_amnt","funded_amnt_inv","grade","hardship_amount",
"hardship_dpd", "hardship_end_date", "hardship_flag",
"hardship_last_payment_amount", "hardship_length",
"hardship_loan_status", "hardship_payoff_balance_amount",
"hardship_reason", "hardship_start_date", "hardship_status",
"last_credit_pull_d",
"hardship_type","id","initial_list_status","installment","issue_d",
"last_pymnt_d", "last_pymnt_amnt", "loan_status",
"member_id", "next_pymnt_d", "num_tl_30dpd", "num_tl_120dpd_2m",
"orig_projected_additional_accrued_interest",
"out_prncp", "out_prncp_inv","payment_plan_start_date",
"policy_code","purpose", "pymnt_plan", "revol_bal_joint",
"revol_util", "sec_app_earliest_cr_line",
"sec_app_inq_last_6mths", "sec_app_mort_acc", "sec_app_open_acc",
"sec_app_revol_util", "sec_app_open_act_il",
"sec_app_num_rev_accts", "sec_app_chargeoff_within_12_mths",
"sec_app_collections_12_mths_ex_med",
"sec_app_mths_since_last_major_derog","settlement_amount",
"settlement_date", "settlement_percentage", "settlement_status",
"settlement_term","sub_grade","title", "total_pymnt", "total_pymnt_inv",
"total_rec_int", "total_rec_late_fee", "total_rec_prncp", # "total_rev_hi_lim",
"url","verification_status",
"verification_status_joint")) |>
mutate(
# Convert these columns into numeric
across(c(starts_with("annual"), starts_with("dti"), starts_with("inq"),
starts_with("mo"), starts_with("mths"), starts_with("num"),
starts_with("open"), starts_with("percent"), starts_with("pct"),
starts_with("revol"), starts_with("tot"), "acc_open_past_24mths",
"all_util", "avg_cur_bal","bc_open_to_buy", "bc_util",
"collections_12_mths_ex_med", "collection_recovery_fee", "delinq_2yrs",
"il_util", "loan_amnt", "max_bal_bc", "pub_rec",
"pub_rec_bankruptcies", "recoveries", "tax_liens"),
~ as.numeric(.)),
# Calculate a loan to income statistic
loan_to_income = case_when(
application_type == "Individual" ~ loan_amnt / annual_inc,
.default = loan_amnt / annual_inc_joint
),
# Calculate the percentage of the borrower's total income that current debt
# obligations, including this loan, will represent
adjusted_dti = case_when(
application_type == "Individual" ~ (loan_amnt + tot_cur_bal) / (annual_inc),
.default = (loan_amnt + tot_cur_bal) / (annual_inc_joint)
),
# Calculate utilization on installment accounts excluding mortgage balance
il_util_ex_mort = case_when(
total_il_high_credit_limit > 0 ~ total_bal_ex_mort / total_il_high_credit_limit,
.default = 0
),
# Fill debt to income joint with individual debt to income where missing
dti_joint = coalesce(dti_joint, dti),
# Fill annual income joint with individual annual income where missing
annual_inc_joint = coalesce(annual_inc_joint, annual_inc)) |>
collect()After running collect(), when we have our data frame in R, we gain access to additional advanced R functions that are not available in SQL. This enables us to further refine and clean our data as needed.
lendingclub_dat_clean <-
lendingclub_dat |>
mutate(
# Missing values for these columns seem most appropriate to fill with zero
across(c("inq_fi", "dti", "all_util", "percent_bc_gt_75", "il_util",
"avg_cur_bal","all_util", "il_util", "inq_last_6mths", "inq_last_12m",
"open_il_12m", "open_il_24m", "open_rv_12m", "open_rv_24m"),
~ replace_na(., 0)),
# Missing values for these columns seem most appropriate to fill with the column max
across(c("mo_sin_old_il_acct", "mths_since_last_major_derog", "mths_since_last_delinq",
"mths_since_recent_bc", "mths_since_last_record", "mths_since_rcnt_il",
"mths_since_recent_bc", "mths_since_recent_bc_dlq", "mths_since_recent_inq",
"mths_since_recent_revol_delinq", "mths_since_recent_revol_delinq"),
~ replace_na(., max(., na.rm = TRUE))),
# Remove percent sign
int_rate = as.numeric(stringr::str_remove(int_rate, "%")),
# Create variable for earliest line of credit
earliest_cr_line = lubridate::parse_date_time2(paste("01", earliest_cr_line, sep = "-"),
"dmy", cutoff_2000 = 50L),
# Calculate time since earliest line of credit
age_earliest_cr = lubridate::interval(as.Date(earliest_cr_line),
as.Date(lubridate::today())) %/% lubridate::days(1),
# Convert characters to factors
across(where(is.character), .fns = as.factor),
# Encode ordered factors
term = as.numeric(stringr::str_trim(stringr::str_remove(term, "months"))),
emp_length = as.ordered(factor(emp_length,
levels = c("< 1 year", "1 year", "2 years",
"3 years", "4 years", "5 years",
"6 years", "7 years", "8 years",
"9 years", "10+ years")))) |>
# drop date column
select(!earliest_cr_line) |>
filter(!is.na(int_rate))Finally, we create vectors for conveniently referencing variable categories later if necessary.
mean_impute_vals <-
c("bc_util", "num_rev_accts", "bc_open_to_buy", "emp_length", "percent_bc_gt_75",
"total_bal_il", "total_il_high_credit_limit", "total_cu_tl")
categorical_vars <-
c("addr_state", "application_type", "home_ownership", "emp_length", "term",
"zip_code")With our data cleaned up, it’s time to examine the variables we intend to include in the model. Let’s start with the variable we want to predict.
We can use the dbplot package to generate a ggplot without transferring the data into R. db_compute_bins() bins and counts interest rates in Databricks and then returns a small dataset of counts for ggplot() to plot. This visualization displays the distribution of the variable we aim to predict, lending rate. Loan amounts are plotted on the x-axis, while the frequency of loans at each amount is depicted on the y-axis. It shows that the majority of loans have an lending rate of less than 20%. It also shows that our response variable may not be normally distributed, an insight that we will ignore for this demo.
lendingclub_dat |>
mutate(int_rate = as.numeric(stringr::str_remove(int_rate, "%"))) |>
db_compute_bins(int_rate, binwidth = 0.5) |>
ggplot() +
geom_col(
aes(x = int_rate, y = count),
fill = "#4682b4",
color = "#4682b4",
alpha = 0.4
) +
labs(
title = "Distribution of lending rate",
x = "Lending rate",
y = "Count"
) +
theme_minimal()
To check whether any of our columns have missing values, we can run the below:
sum(colSums(is.na(lendingclub_dat_clean)) > 0)[1] 3colSums(is.na(lendingclub_dat_clean)) loan_amnt term
0 0
int_rate emp_length
0 10468
home_ownership annual_inc
0 0
zip_code addr_state
0 0
dti delinq_2yrs
0 0
inq_last_6mths mths_since_last_delinq
0 0
mths_since_last_record open_acc
0 0
pub_rec revol_bal
0 0
total_acc recoveries
0 0
collection_recovery_fee collections_12_mths_ex_med
0 0
mths_since_last_major_derog application_type
0 0
annual_inc_joint dti_joint
0 0
tot_coll_amt tot_cur_bal
0 0
open_acc_6m open_act_il
0 0
open_il_12m open_il_24m
0 0
mths_since_rcnt_il total_bal_il
0 0
il_util open_rv_12m
0 0
open_rv_24m max_bal_bc
0 0
all_util total_rev_hi_lim
0 0
inq_fi total_cu_tl
0 0
inq_last_12m acc_open_past_24mths
0 0
avg_cur_bal bc_open_to_buy
0 1740
bc_util mo_sin_old_il_acct
1792 0
mo_sin_old_rev_tl_op mo_sin_rcnt_rev_tl_op
0 0
mo_sin_rcnt_tl mort_acc
0 0
mths_since_recent_bc mths_since_recent_bc_dlq
0 0
mths_since_recent_inq mths_since_recent_revol_delinq
0 0
num_accts_ever_120_pd num_actv_bc_tl
0 0
num_actv_rev_tl num_bc_sats
0 0
num_bc_tl num_il_tl
0 0
num_op_rev_tl num_rev_accts
0 0
num_rev_tl_bal_gt_0 num_sats
0 0
num_tl_90g_dpd_24m num_tl_op_past_12m
0 0
pct_tl_nvr_dlq percent_bc_gt_75
0 0
pub_rec_bankruptcies tax_liens
0 0
tot_hi_cred_lim total_bal_ex_mort
0 0
total_bc_limit total_il_high_credit_limit
0 0
loan_to_income adjusted_dti
0 0
il_util_ex_mort age_earliest_cr
0 0 We can ensure that no factor columns have fewer than two factors by running the below:
lendingclub_dat_clean |>
select(where(is.factor)) %>%
select(where( ~ nlevels(.) < 2))# A tibble: 130,772 × 0With our dataset prepared, we can begin the modeling process. This involves creating train and test datasets, which we’ll use to train and evaluate our model.
set.seed(1234)
train_test_split <- initial_split(lendingclub_dat_clean)
lend_train <- training(train_test_split)
lend_test <- testing(train_test_split)Using tidymodels, we can construct a “recipe” detailing the steps we want to take to pre-process our data:
step_normalize(): This recipe step normalizes numeric data to have a standard deviation of one and a mean of zero. Given that our dataset contains numeric values of various units (e.g., dollars, months), normalization ensures that variables with larger value ranges do not disproportionately influence the model.step_ordinal_score(): This recipe step encodes variables as ordered categorical variables (ordered factors in R).step_integer(): This recipe step converts non-numeric data into a set of integers, based on unique values within the data.step_impute_mean(): This recipe step replaces missing values of numeric variables with the mean of those values in the training set. Performing this step now, rather than during the data cleaning phase, prevents information leakage from the testing set into the model. By calculating the mean solely using the training set, we avoid bias when applying it to the testing data during model evaluation.rec_obj <- recipe(int_rate ~ ., data = lend_train) |>
step_normalize(all_numeric_predictors()) |>
step_ordinalscore(emp_length) |>
step_integer(c("addr_state", "application_type", "home_ownership", "zip_code")) |>
step_impute_mean(all_of(mean_impute_vals))To verify that the recipe functions as intended, we can run prep(rec_obj, lend_train) |> bake(newdata = NULL). This will display the data that the workflow will provide to the model.
prep(rec_obj, lend_train) |> bake(new_data = NULL)# A tibble: 98,079 × 78
loan_amnt term emp_length home_ownership annual_inc zip_code addr_state
<dbl> <dbl> <int> <int> <dbl> <int> <int>
1 -0.583 -0.656 4 4 -0.434 21 30
2 -0.583 -0.656 11 3 0.993 88 34
3 -0.188 1.52 11 2 -0.239 392 17
4 -0.632 -0.656 7 2 -0.438 221 45
5 -1.22 -0.656 7 4 -0.531 60 31
6 0.00996 -0.656 11 2 0.749 359 25
7 0.405 -0.656 8 2 -0.165 312 10
8 0.800 -0.656 10 2 0.566 4 19
9 -0.978 -0.656 2 2 -0.434 118 34
10 -1.08 -0.656 6 3 0.261 614 29
# ℹ 98,069 more rows
# ℹ 71 more variables: dti <dbl>, delinq_2yrs <dbl>, inq_last_6mths <dbl>,
# mths_since_last_delinq <dbl>, mths_since_last_record <dbl>, open_acc <dbl>,
# pub_rec <dbl>, revol_bal <dbl>, total_acc <dbl>, recoveries <dbl>,
# collection_recovery_fee <dbl>, collections_12_mths_ex_med <dbl>,
# mths_since_last_major_derog <dbl>, application_type <int>,
# annual_inc_joint <dbl>, dti_joint <dbl>, tot_coll_amt <dbl>, …Now, we proceed with tuning and fitting a model.
The LASSO regression is a form of penalized linear regression that performs both variable selection and regularization to create a model that has high predictive accuracy, but remains explainable (say, to a bank regulator).
To perform a LASSO regression, we must choose the value of a hyperparameter, \(\lambda\), known as the penalty parameter or the regularization parameter. We cannot know ahead of time what the optimum value of \(\lambda\) will be, but we can use R’s tidymodels framework to perform hyper-parameter tuning.
To do this, we use R’s glmnet package as an engine to fit a linear regression. The glmnet package requires two parameters. We set mixture = 1 to perform a LASSO regression (mixture = 0 would perform a ridge regression). We set the penalty parameter to the desired value of \(\lambda\). Here, we set penalty to tune() to indicate that we want to find the optimum value with hyper-parameter tuning.
lend_lasso <-
linear_reg(penalty = tune(), mixture = 1) |>
set_engine("glmnet")Finally, we add our model and the recipe above to a tidymodels workflow object. This creates a single workflow that we will apply to our data each time we fit a model.
lend_lasso_wflow <-
workflow() |>
add_model(lend_lasso) |>
add_recipe(rec_obj)We can find the optimal value of \(\lambda\) with the tune_grid() function from tidymodel’s tune package. We ask tune_grid() to use 10-fold cross-validation on our training data to compare the performance of 50 values of \(\lambda\).
lambda_grid <-
grid_regular(penalty(), levels = 50)
lasso_grid <-
lend_lasso_wflow |>
tune_grid(grid = lambda_grid, resamples = vfold_cv(lend_train))We can explore our results as a table.
lasso_grid |>
collect_metrics()# A tibble: 100 × 7
penalty .metric .estimator mean n std_err .config
<dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
1 1 e-10 rmse standard 3.71 10 0.0114 Preprocessor1_Model01
2 1 e-10 rsq standard 0.472 10 0.00319 Preprocessor1_Model01
3 1.60e-10 rmse standard 3.71 10 0.0114 Preprocessor1_Model02
4 1.60e-10 rsq standard 0.472 10 0.00319 Preprocessor1_Model02
5 2.56e-10 rmse standard 3.71 10 0.0114 Preprocessor1_Model03
6 2.56e-10 rsq standard 0.472 10 0.00319 Preprocessor1_Model03
7 4.09e-10 rmse standard 3.71 10 0.0114 Preprocessor1_Model04
8 4.09e-10 rsq standard 0.472 10 0.00319 Preprocessor1_Model04
9 6.55e-10 rmse standard 3.71 10 0.0114 Preprocessor1_Model05
10 6.55e-10 rsq standard 0.472 10 0.00319 Preprocessor1_Model05
# ℹ 90 more rowsOr more commonly, as a plot.
lasso_grid |>
autoplot()
Every parameter value below 0.01 seems similar, but 0.01 will give us a parsimonious model. We add the parameter value that we choose to our workflow.
final_lasso_wflow <-
lend_lasso_wflow |>
finalize_workflow(list(penalty = 0.1))Now, we can fit our tuned model using fit() along with the training dataset.
lend_lasso_fit <-
final_lasso_wflow |>
fit(data = lend_train)Below are our predicted lending rates:
predict(lend_lasso_fit, new_data = lend_train) # A tibble: 98,079 × 1
.pred
<dbl>
1 14.1
2 11.3
3 16.3
4 12.1
5 9.49
6 12.3
7 11.2
8 12.9
9 11.7
10 14.7
# ℹ 98,069 more rowsHow well does the model do? We can analyze our results by calculating the coefficient of determination, which is 0.46 in this case. While this indicates some level of explanatory power, it suggests that our model’s estimate may not be very robust.
lend_lasso_results <-
bind_cols(predict(lend_lasso_fit, lend_train)) |>
bind_cols(lend_train |> select(int_rate))
rsq(lend_lasso_results, truth = int_rate, estimate = .pred)# A tibble: 1 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 rsq standard 0.458rmse(lend_lasso_results, truth = int_rate, estimate = .pred)# A tibble: 1 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 rmse standard 3.77Now that we have a model, we can ask whether it is useful for our use case. We want to provide a model that loan applicants can use to get a quick estimate. This means that applicants will need to provide a value for every variable used by the model.
We mentioned above that LASSO regression does variable selection, so let’s check how many variables this model selected. The model selects, or uses, a variable if its coefficient is non-zero.
When we extract the underlying parsnip model from our results and run it through the tidy() function of the broom package, we see that our model uses 20 variables.
# library(broom)
lend_lasso_fit |>
extract_fit_parsnip() |>
tidy() |>
filter(estimate > 0) |>
nrow()[1] 20This is not realistic for our use case. Unfortunately, we think that clients who use our app will only have patience to input four or five variables. Hence, we need to find the subset of five variables that yield the best predictions.
We use the properties of our LASSO model to do this. As we increase the \(\lambda\) parameter, more and more variable coefficients go to zero, leaving behind progressively smaller subsets of the most powerful predictors.
lend_lasso_fit |>
extract_fit_parsnip() |>
autoplot()
We inspect the highest values of \(\lambda\) to identify the five best variables to retain.
lend_lasso_fit |>
extract_fit_parsnip() |>
autoplot(min_penalty = 1, top_n = 5)
We choose to use the final subset of four variables, term, all_util, bc_util, and bc_open_to_buy, because:
We can compute these from fields that are easy for the user to provide:
The fifth term would be difficult for users to calculate, i.e. percent_bc_gt_75, the percent of the applicants bank cards that are currently withdrawn by more than 75%, so we choose not to include it.
We now repeat our modeling steps to build a final model with the four variables.
set.seed(1234)
lendingclub_dat_reduced <-
lendingclub_dat_clean |>
select(int_rate, term, bc_open_to_buy, bc_util, all_util)
reduced_split <- initial_split(lendingclub_dat_reduced)
reduced_train <- training(reduced_split)
reduced_test <- testing(reduced_split)
red_rec_obj <- recipe(int_rate ~ ., data = reduced_train) |>
step_normalize(all_numeric_predictors()) |>
step_impute_mean(all_of(c("bc_open_to_buy", "bc_util")))
lend_linear <-
linear_reg()
lend_linear_wflow <-
workflow() |>
add_model(lend_linear) |>
add_recipe(red_rec_obj)
lend_linear_fit <-
lend_linear_wflow |>
fit(data = reduced_train)How much performance do we sacrifice by using only four variables? Quite a bit, as you might suspect. We have much less information with which to make predictions, but we think the trade-off is worth it.
lend_linear_results <-
bind_cols(predict(lend_linear_fit, reduced_train)) |>
bind_cols(reduced_train |> select(int_rate))
rsq(lend_linear_results, truth = int_rate, estimate = .pred)# A tibble: 1 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 rsq standard 0.298rmse(lend_linear_results, truth = int_rate, estimate = .pred)# A tibble: 1 × 3
.metric .estimator .estimate
<chr> <chr> <dbl>
1 rmse standard 4.28If we aim to log our model for use in other contexts, like a Shiny app, we can utilize the vetiver package. This tool facilitates deploying and maintaining machine learning models in production, allowing us to store models in a pin for convenient access and reference.
We can create a vetiver object v to store the trained model.
v <- vetiver_model(lend_linear_fit, "lending_club_model")We can deploy the model by creating a special Plumber router in R with the plumber package. We add a POST endpoint for making predictions. Following that, we connect to the destination where we intend to store our model artifact. In our case, this would be Posit Connect. Then, we save the vetiver model to a pin for future access.
board <-
board_connect(
auth = "manual",
server = Sys.getenv("CONNECT_SERVER"),
key = Sys.getenv("CONNECT_API_KEY")
)
board |> vetiver_pin_write(v)Now, we can deploy the model to Posit Connect to generate predictions as needed.
rsconnect::addServer(Sys.getenv("CONNECT_SERVER"))
rsconnect::connectApiUser(
server = Sys.getenv("CONNECT_SERVER_WITHOUT_HTTP"),
account = Sys.getenv("CONNECT_USER"),
apiKey = Sys.getenv("CONNECT_API_KEY")
)
vetiver_deploy_rsconnect(
board = board,
name = "garrett@posit.co/lending_club_model",
predict_args = list(debug = TRUE)
)
# To generate predictions
# endpoint <-
# vetiver_endpoint(
# "https://pub.demo.posit.team/public/lending-club-model-vetiver-api/predict"
# )
#
# predict(endpoint, <new_data>)Now that our model is available through an API, we can use it in other places – such as a Shiny app! Since our current model is so lightweight, we will skip this step and instead rely on a version of the model bundled with our app. This will make our app slightly faster. Every millisecond counts!
We will use a Shiny app to provide a UI for applicants to send input to our model, and to see the results. Because our predictions are not very robust, we will include a histogram that visualizes the distribution of rates received by applicants with similar characteristics. Since this data lives in Databricks, our Shiny app will need to connect to Databricks to draw the histogram.
We can use the same code as before to connect to Databricks, visible in authenticate.R below. In this case, we will provide the environmental variables DATABRICKS_HOST, DATABRICKS_TOKEN, and HTTP_PATH when we deploy the app. Our app will use these environmental variables on behalf of its users.
Below is our Shiny app for predicting lending rates. Each time you select an input, it calculates the rate based on our model. The design and layout of the Shiny app is developed with bslib.
# install.packages("remotes")
# remotes::install_github("rstudio/shiny") # for version 1.8.1.9001
library(shiny)
library(tibble)
library(readr)
library(workflows)
library(recipes)
source("authenticate.R")
source("cards.R")
source("helpers.R")
rates <- connect_to_lending_club_data_on_databricks()
endpoint <- read_rds("model.RDS")
ui <- bslib::page_navbar(
title = "Predicted Interest Rate Calculator",
theme = bs_theme(bootswatch = "flatly", success = "#4682b4"),
bg = "#082D46",
underline = FALSE,
nav_panel(
title = " ",
layout_columns(
# Row 1
card(
helpText("Please fill out the fields below. Then click Predict Rate."),
layout_columns(
cards[[1]],
cards[[2]],
cards[[3]],
cards[[4]],
cards[[5]],
width = 1/5,
height = 170
),
actionButton(
"predict", "Predict Rate", width = 200,
style="color: #fff; background-color: #4682b4;"
)
),
# Row 2
layout_columns(
conditionalPanel(condition = "input.predict > 0", vbs),
conditionalPanel(condition = "input.predict > 0", plot),
height = 500, col_widths = c(3, 9)
),
col_widths = c(12, 12)
),
card_footer(foot)
)
)
server <- function(input, output, session) {
all_util <-
reactive(input$all_balance / input$all_limit)
bc_util <-
reactive(input$bc_balance / input$bc_limit)
bc_open_to_buy <-
reactive(input$bc_limit - input$bc_balance)
predictions_df <-
reactive({
pred_tibble <-
tibble(term = as.numeric(input$term),
all_util = all_util(),
bc_util = bc_util(),
bc_open_to_buy = bc_open_to_buy())
predict(endpoint, new_data = pred_tibble)
}) |>
bindCache(input$term,
input$all_balance,
input$all_limit,
input$bc_balance,
input$bc_limit) |>
bindEvent(input$predict)
output$pred_int <-
renderText({
predictions_df()$.pred |> round(2)
})
rate_distribution <-
reactive({
rates |>
find_rates_for_similar_applicants(input$term,
all_util(),
bc_util(),
bc_open_to_buy())
}) |>
bindCache(input$term,
input$all_balance,
input$all_limit,
input$bc_balance,
input$bc_limit) |>
bindEvent(input$predict)
output$plot <-
renderPlot({
plot_rate_distribution(rate_distribution())
})
}
shinyApp(ui, server)# authenticate.R
library(dplyr)
library(dbplyr)
library(odbc)
# Sys.setenv("DATABRICKS_HOST" = "your-databricks-host.com")
# Sys.setenv("DATABRICKS_TOKEN" = "your-databricks-token")
con <-
dbConnect(odbc::databricks(), httpPath = Sys.getenv("HTTP_PATH"))
# Return connection to lending club table
connect_to_lending_club_data_on_databricks <- function(){
tbl(con, dbplyr::in_catalog("hive_metastore", "default", "lendingclub")) |>
select(int_rate, term, all_util, bc_util, bc_open_to_buy) |>
filter(!is.na(int_rate)) |>
mutate(int_rate = REPLACE(int_rate, "%", ""),
term = SUBSTRING(term, 2,2),
across(everything(), ~ as.numeric(.)))
}# cards.R
# install.packages("remotes")
# remotes::install_github("rstudio/bslib") # for version 0.7.1
library(bslib)
library(bsicons)
cards <- list(
card(
card_body(
selectInput(
inputId = "term",
choices = list("36 months" = 36, "60 months" = 60),
selected = 36,
label = tooltip(
trigger = list("Term of loan", bs_icon("info-circle")),
"How soon would you like to pay off the loan?"
)
)
)
),
card(
card_body(
numericInput(
inputId = "all_balance",
value = 5000,
min = 0,
max = 500000,
step = 1000,
label = tooltip(
trigger = list("Credit Balance", bs_icon("info-circle")),
"How much credit, in dollars, do you currently have withdrawn from all sources of credit, including bank cards?"
)
)
)
),
card(
card_body(
numericInput(
inputId = "all_limit",
value = 10000,
min = 0,
max = 500000,
step = 1000,
label = tooltip(
trigger = list("Credit Limit", bs_icon("info-circle")),
"What is your total credit limit, in dollars, for all sources of credit, including bank cards?"
)
)
)
),
card(
card_body(
numericInput(
inputId = "bc_balance",
value = 5000,
min = 0,
max = 500000,
step = 1000,
label = tooltip(
trigger = list("Bank Card Balance", bs_icon("info-circle")),
"How much credit, in dollars, do you currently have withdrawn from only bank cards?"
)
)
)
),
card(
card_body(
numericInput(
inputId = "bc_limit",
value = 10000,
min = 0,
max = 500000,
step = 1000,
label = tooltip(
trigger = list("Bank Card Limit", bs_icon("info-circle")),
"What is your total credit limit, in dollars, for only bank cards?"
)
)
)
)
)
vbs <-
value_box(
title = "Predicted interest rate",
value = textOutput("pred_int"),
style = "background-color: #082D46!important; color: #FFFFFF!important",
showcase = bsicons::bs_icon("bank", fill = '#4682b4 !important;'),
showcase_layout = "top right",
height = 500
)
foot <-
tags$div(
style = "background-color: #FFFFFF; padding: 0px; text-align: center; bottom: 0; width: 100%;",
HTML(
"Powered by <a href='https://posit.co'><img src='https://www.rstudio.com/assets/img/posit-logo-fullcolor-TM.svg' alt='Posit Logo' style='width:55px;'></a> | Integrated with <a href='https://www.databricks.com'><img src='https://cdn.cookielaw.org/logos/29b588c5-ce77-40e2-8f89-41c4fa03c155/bc546ffe-d1b7-43af-9c0b-9fcf4b9f6e58/1e538bec-8640-4ae9-a0ca-44240b0c1a20/databricks-logo.png' alt='Databricks Logo' style='width:85px;'></a>. For more details, see our <a href='https://posit.co/blog/databricks-and-posit-announce-new-integrations/' target='_blank'>blog post</a> announcing the partnership."
)
)
plot <-
card(full_screen = TRUE,
card_header(HTML("Applicants like you have received these interest rates")),
card_body(
plotOutput("plot")
))# helpers.R
library(dplyr)
library(ggplot2)
library(dbplyr)
library(dbplot)
# Returns binned interest rates for 50 most similar applicants
find_rates_for_similar_applicants <- function(data,
.term,
.all_util,
.bc_util,
.bc_open_to_buy) {
data |>
mutate(distance = (term - as.numeric(.term))^2 +
(all_util - .all_util)^2 +
(bc_util - .bc_util)^2 +
(bc_open_to_buy - .bc_open_to_buy)^2,
rank = min_rank(distance)) |>
filter(rank <= 50 & !is.na(rank)) |>
db_compute_bins(int_rate, binwidth = 0.5)
}
# Plots binned interest rates
plot_rate_distribution <- function(distribution) {
distribution |>
ggplot() +
geom_col(aes(x = int_rate, y = count),
fill = "#4682b4", color = "#4682b4", alpha = 0.4) +
labs(x = "Interest Rate (%)", y = "Number of applicants") +
scale_x_continuous(limits = c(0, 35),
breaks = seq(from = 0, to = 35, by = 5)) +
theme_minimal()
}Posit Connect provides a production ready environment to host our app, and Posit Workbench provides push button publishing to Connect.
To deploy, we click the Publish icon at the top of our app.
This launches a wizard that we can use to connect and publish to a Connect account.
Once our app is deployed, we visit on Connect to:
We also visit the Vars tab to provide values for the environmental variables that the app will use to access Databricks.
Our app is now ready for use.
In summary, we’ve gone on a comprehensive journey to predict lending rates using machine learning techniques within the context of financial analysis. We began by accessing our data from Databricks, cleaning our data, and using tidymodels for modeling and evaluation. We developed two predictive models, evaluated their performance, and identified key variables driving interest rate predictions.
Leveraging the power of vetiver, we deployed our model for seamless integration into production environments, such as Shiny apps.
We then deployed our model as a Shiny app that uses Posit Connect’s secure environmental variables feature to access Databricks.
This holistic approach can help enhance decision-making processes within the financial domain.
We believe our products are better together. Learn more about our partnership.