Lending Club Loan Data - Exploratory Analysis

Introduction

Lending Club is a peer-to-peer lending company that matches borrowers with investors through an online platform. It services people that need personal loans between $1,000 and $40,000. Borrowers receive the full amount of the issued loan minus the origination fee, which is paid to the company. Investors purchase notes backed by the personal loans and pay Lending Club a service fee. The company shares data about all loans issued through its platform during certain time periods.

This analysis will focus on the Lending Club Loan Data from the first quarter of 2017. This document is generated using R Markdown. The code that powers the analysis is hidden by default but you can expand any section by clicking the Code button, like the one in the top right corner of this section. So far I have loaded in the actual data file and the data dictionary. I also performed some minor formatting to prepare for the rest of the analysis.

We’ll start off by running some broad summary statistics and using this information to clean up the data set. Once the data are reasonably formatted we will move on to visualizing the relationships between the variables.

Broad Summary Statistics and Scrubbing

Before we start any analysis or data scrubbing, let’s join in the data dicionary so we can have a quick reference to what the variables actually mean:

# Extracting all data column names and joining to data dictionary
loan_data_cols <- data.frame(Variable = colnames(loan_data),
                             stringsAsFactors = F)
data_dict$var <- trimws(data_dict$var)
mapping <- loan_data_cols %>% left_join(data_dict, by = c("Variable" = "var"))
colnames(mapping)[2] <- "Full Description"
# Formatting into interactive HTML table
lib_load("DT")
mapping <- sapply(mapping, trimws)
datatable(mapping)

We’ll start by taking a broad look at the different variable types in the data set. After dropping some empty and redacted columns we are left with 113 variables in total. There appear to be 94 continuous variables and 22 categorical variables. Let’s run some summary statistics on the continuous variables:

# Grabbing column types to see if they are categorical or contiunous
all_vars <- unlist(lapply(loan_data,class))
# Enters zero NAs for summary when there are none so the summary data structures can be combined
# Borrowed from: https://stackoverflow.com/questions/32011873/force-summary-to-report-the-number-of-nas-even-if-none
custom_summary <- function(var) {
  
  if(!any(is.na(var))) {
    res <- c(summary(var),"NA's"=0)
  } else {
    res <- summary(var)
  }
  return(res)
}
# Extracting continuous variables
cont_info <- lapply(loan_data[,all_vars == "numeric"], custom_summary) 
# Formatting summaries into uniform data structure and combining
cont_names <- names(all_vars[all_vars == "numeric"])
cont_info <- lapply(1:length(cont_info), function(inx) {
  
  new_vect <- c(cont_names[inx],round(cont_info[[inx]],2))
  
  names(new_vect)[1] <- "Var Name"
  
  new_vect
  
}); cont_info <- do.call(rbind,cont_info)
# Formatting into interactive HTML table
datatable(cont_info)

We see several variables that describe the loan such as the amount, payment, interest rate, and term. We also see some descriptive information on the borrower such as annual income, debt-to-income ratio (DTI), number of mortgage accounts, and total credit limit. It looks like dti, recoveries, and collection_recovery_fee have some data issues. The latter two are blank throughout the entire data set. The minimum and maximum values on dti seem completely off. We can plot the histograms of various dti ranges to get more reasonable bounds for the data:

# First cleaning up the blank variables
loan_data[,c("recoveries","collection_recovery_fee")] = NULL
# Plotting the density of dti under various cut-offs
dti_raw <- loan_data$dti
lib_load("ggplot2")
dens1 <- qplot(dti_raw, fill = I("dodgerblue4"), 
               alpha = I(0.4), col = I("grey29")) + xlab("dti full range") + ylab("Count")
dens2 <- qplot(dti_raw[dti_raw > 0 & dti_raw < 15], fill = I("dodgerblue4"), 
               alpha = I(0.4), col = I("grey29")) + xlab("0 < dti < 15") + ylab("Count")
dens3 <- qplot(dti_raw[dti_raw > 0 & dti_raw < 50], fill = I("dodgerblue4"), 
               alpha = I(0.7), col = I("grey29")) + xlab("0 < dti < 50") + ylab("Count")
dens4 <- qplot(dti_raw[dti_raw > 50 & dti_raw < 9999], fill = I("dodgerblue4"), 
               alpha = I(0.4), col = I("grey29")) + xlab("50 < dti < 9999") + ylab("Count")
# Combining density plots
lib_load("gridExtra")
lib_load("grid")
# Subjectively clipping range of dti
grid.arrange(dens1, dens2, dens3, dens4,
             top = textGrob("DTI Histograms (30 bins)"), 
             widths = c(4,4), heights = c(4,4))

# Clipping the range for dti
loan_data$dti[loan_data$dti < 0 | loan_data$dti > 50] = NA

Keeping the full range for dti doesn’t seem to make sense. The lower bound should always be zero since you can’t have less than no debt. The upper bound is a bit debatable. It appears that the majority of the density is captured between 0 and 50, which seems to be reasonable. We can subjectively drop everything outside of this range and convert those entries to missing values, which are represented as NA in the R language. This results in 411 missing entries.

Next, let’s take a look at the categorical variables. We’ll count the frequencies for the top four categories for each variable and lump everything else into a fifth category called Other. If there are less than four categories then we’ll just show all of the counts.

# Extracting categorical variables
cat_info <- lapply(1:sum(all_vars == "character"), function(inx) {
  
  Category <- loan_data[,names(all_vars[all_vars == "character"])[inx]]
  
  # Getting frequency counts and sorting in decreasing order
  counts_df <- data.frame(table(Category)) %>% arrange(desc(Freq))
  counts_df$Category <- as.character(counts_df$Category)
  
  # Summarizing only top 4 counts and lumping everything into a fifth category, Other
  if(nrow(counts_df) > 5) {
    
   counts_df$Freq[5] <- sum(counts_df$Freq[5:nrow(counts_df)])
   counts_df$Category[5] <- "Other"
   
   counts_df <- counts_df[1:5,]
  } 
    
  df <- data.frame(Name = names(all_vars[all_vars == "character"])[inx],
                   counts_df, stringsAsFactors = F)
  df$`Freq %` <- round(100*df$Freq/sum(df$Freq))
  
  df
  
}) %>% bind_rows()
# Saving example of an incorrectly tagged NA
bad_row <- which(loan_data$emp_title == ".")
# Formatting into interactive HTML table
datatable(cat_info)

We see some descriptive information on the loans such as the term, grade, and purpose. There are also some variables that describe the borrower such as employment title, state of residence, and number of accounts currently delinquent. Columns like earliest_cr_line can be converted to an integer that represents the years since that date, which would be more useful for modeling later. There are also entries that are tagged as empty spaces or dots that should really be NA. An example is row 22990 for emp_title, which is tagged as a period. Let’s clean these up.

# Fixing date columns
lib_load("lubridate")
lib_load("zoo")
# Earliest credit line is now the years since the given date
loan_data$earliest_cr_line <- difftime(as.yearmon(loan_data$issue_d, format = "%b-%Y"),
                                       as.yearmon(loan_data$earliest_cr_line, format = "%b-%Y"), 
                                       unit = "weeks")/52.25
loan_data$earliest_cr_line <- as.numeric(loan_data$earliest_cr_line)
loan_data$sec_app_earliest_cr_line <- difftime(as.yearmon(loan_data$issue_d, format = "%b-%Y"),
                                               as.yearmon(loan_data$sec_app_earliest_cr_line, format = "%b-%Y"), 
                                               unit = "weeks")/52.25
loan_data$sec_app_earliest_cr_line <- as.numeric(loan_data$sec_app_earliest_cr_line)
# Dropping columns that don't really add any info
loan_data[,c("pymnt_plan")] = NULL
# Coercing various entries to NA
loan_data[loan_data == "" | loan_data == "."] <- NA

Now that we have cleaned up the variables and correctly tagged missing values as NA, let’s take a look at the sparsity of various columns. Missing data can have strong impacts on predictive and inferential analysis. It’s important to understand any patterns in the sparsity, sometimes dropping incomplete observations can lead to a biased understanding of the data.

# Summarizing variables with lots of NAs
sparse_count <- lapply(1:ncol(loan_data), function(inx) {
  temp <- loan_data[,inx]
  
  Variable = colnames(loan_data)[inx]
  
  `NA %` = round(sum(is.na(temp))/length(temp)*100,2)
  
  `Full Name` = data_dict$desc[which(Variable == data_dict$var)[1]]
  df <- data.frame(Variable,`NA %`,`Full Name`,
                   check.names = F,
                   stringsAsFactors = F)
  
  return(df)
}) %>% bind_rows() %>% arrange(desc(`NA %`))
# Grabbing any variable with at least one NA
sparse_count <- sparse_count[sparse_count$`NA %` > 0,]
datatable(sparse_count)

It looks like a lot of the missing values are related to variables that deal with a second applicant. It doesn’t seem like these are critical to exploratory analysis or inference but we should still keep them in mind. We could explore different ways to impute some of the missing values, especially if we want to use the variables as part of a model for certain types of borrowers.

Visualzing Distributions

# Getting raw counts of continuous and categorical vars, then getting fully complete ones (no NAs)
cont <- sapply(loan_data, class) == "numeric"
cat <- sapply(loan_data, class) == "character"
cont_full <- sum(!(names(cont[cont == TRUE]) %in% sparse_count$Variable))
cat_full <- sum(!(names(cat[cat == TRUE]) %in% sparse_count$Variable))

At this point, we’re left with 65 continuous variables and 14 categorical variables with no NAs. The full data set contains 94 continuous variables and 19 categorical variables. We’ve also got 96779 observations, with each row representing a unique loan. It’s a bit difficult to think about this much data at once. A good first step is to create some plots to better understand the most important variables.

First, let’s try to break out the total loan volume in the first quarter of 2017. Let’s get a feel for who is borrowing the money, what they’re using it for, where they live, and their risk profiles.

# Cleaning up registered nurse double counting across loan_data
loan_data$emp_title[loan_data$emp_title %in% c("RN","Rn","rn","nurse","Nurse")] <- "Registered Nurse"
loan_data$emp_title[is.na(loan_data$emp_title)] <- "Not Available"
# Aggregating up total loans by emp_title
loan_by_emp <- loan_data %>% 
               group_by(emp_title) %>% 
               summarize(`Total Loans ($)` = sum(loan_amnt)) %>%
               arrange(desc(`Total Loans ($)`))
# Getting percentage information since we can only plot a subset
loan_by_emp$emp_title <- paste0(loan_by_emp$emp_title," - ",paste0(round(100*loan_by_emp$`Total Loans ($)`/sum(loan_by_emp$`Total Loans ($)`),1),"%"))
loan_by_emp_plot <- ggplot(loan_by_emp[1:10,], aes(x = reorder(emp_title,-`Total Loans ($)`), 
                                                   y = (`Total Loans ($)`)/1e6, 
                                                   fill = I("dodgerblue4"),
                                                   alpha = I(rep(0.7,10)),
                                                   col = I("grey29"))) + 
                    geom_bar(stat = "identity") +
                    theme(axis.text.x = element_text(angle = 55, hjust = 1)) +
                    xlab("Job Title - % of Total") +
                    ylab("Total Loans - Millions of $")
# Aggregating up by purpose
loan_by_purp <- loan_data %>% 
                group_by(title) %>% 
                summarize(`Total Loans ($)` = sum(loan_amnt)) %>%
                arrange(desc(`Total Loans ($)`))
# Getting percentage information
loan_by_purp$title <- paste0(loan_by_purp$title," - ",paste0(round(100*loan_by_purp$`Total Loans ($)`/sum(loan_by_purp$`Total Loans ($)`),1),"%"))
loan_by_purp_plot <- ggplot(loan_by_purp, aes(x = reorder(title,-`Total Loans ($)`), 
                                              y = (`Total Loans ($)`)/1e6, 
                                              fill = I("dodgerblue4"),
                                              alpha = I(rep(0.7,12)),
                                              col = I("grey29"))) + 
                     geom_bar(stat = "identity") +
                     theme(axis.text.x = element_text(angle = 55, hjust = 1)) +
                     xlab("Purpose") +
                     ylab(NULL)
grid.arrange(loan_by_emp_plot, loan_by_purp_plot,
             top = textGrob("Total Loans by Job Title and Purpose"),
             ncol = 2)

We can see that many of the job titles are actually missing, which could be because Lending Club chooses to hide that information to maintain the borrowers’ anonymity. Registered Nurse, Manager, Teacher, and Business Owner form the next largest categories. However, these only account for about 7.5% of the loan volume. This distribution has a strong right tail that stretches across the 33052 different job titles. The distribution of loan volume by purpose is actually the opposite of this. The vast majority of the loans have been taken out to consolidate debt. There are only 11 other purposes, which are all shown in the plot.

Now let’s take a look at what states the borrowers live in:

# Aggregating up by state
loan_by_state <- loan_data %>% 
                 group_by(addr_state) %>%
                 summarize(`Total Loans ($)` = sum(loan_amnt)/1e6) %>%
                 arrange(desc(`Total Loans ($)`))
colnames(loan_by_state) <- c("region","value")
# Getting summary percentage of top 4 regions
top4_states <- round(100*sum(loan_by_state$value[1:4])/sum(loan_by_state$value),1)
# Replacing out the state codes with their full names for plotting
lib_load("rgdal")
lib_load("choroplethrMaps")
lib_load("choroplethr")
data("state.regions")
loan_by_state$region <- sapply(loan_by_state$region, function(state_code) {
  
  inx <- grep(pattern = state_code, x = state.regions$abb)
  
  state.regions$region[inx]
  
})
# Plotting US map with values
state_choropleth(loan_by_state, title = "           Total Loan Volume by State - Millions $")

Most of the funds borrowed through Lending Club in the first quarter for 2017 went to people in California, Texas, New York, and Florida. These regions accounted for 38.2% of the volume during the period. This ranking actually mimics the ranking of those states’ economic output as measured by GDP. States with larger economies tend to have people who borrow more. It’s also interesting to note that Lending Club loans are currently not available in Iowa or West Virginia.

Finally, we can visualize various measures of the borrowers’ risk profiles. We can start off by taking a look at the distribution of the interest rate charged for each grade rating.

# Grabbing the means
cdat <- data.frame(tapply(loan_data$int_rate, loan_data$grade, mean))
rate_grade_dens <- ggplot(loan_data, aes(x = int_rate, fill = grade)) + 
                    geom_density(alpha = 0.6) +
                      geom_vline(data = cdat, aes(xintercept = cdat, colour =  factor(rownames(cdat))),
                                 linetype = "dashed", size = 1, show.legend = F) +
                      ylab(NULL) +
                      xlab("Interest Rate") + 
                      guides( fill = guide_legend(title = "Loan Grade")) + 
                      theme(axis.ticks.y = element_blank(), plot.title = element_text(hjust = 0.5)) + 
                      ggtitle("Interest Rate Distribution by Grade")
rate_grade_dens

The interest rate generally increases as the loan’s grade decreases, which is expected. However, these distributions appear to be quite lumpy, which points to the fact that there are various risk groups within each grade group. Let’s try to get a deeper look at these grade subgroups.

lib_load("moments")
## Generic function to create four descriptive plots for each loan grade --> Employment, State, Purpose, Amount
grade_plotter <- function(grade) {
  
  # Filtering for grade
  loan_data_tmp <- loan_data[loan_data$grade == grade,]
  ## Aggregating up total loans by job ##
  loan_by_emp <- loan_data_tmp %>% 
                 group_by(emp_title) %>% 
                 summarize(`Total Loans ($)` = sum(loan_amnt)) %>%
                 arrange(desc(`Total Loans ($)`))
  
  # Getting percentage information since we can only plot a subset
  loan_by_emp$emp_title <- paste0(loan_by_emp$emp_title," - ",paste0(round(100*loan_by_emp$`Total Loans ($)`/sum(loan_by_emp$`Total Loans ($)`),1),"%"))
  
  loan_by_emp_plot <- ggplot(loan_by_emp[1:10,], aes(x = reorder(emp_title,-`Total Loans ($)`), 
                                                     y = (`Total Loans ($)`)/1e6, 
                                                     fill = I("dodgerblue4"),
                                                     alpha = I(rep(0.7,10)),
                                                     col = I("grey29"))) + 
                      geom_bar(stat = "identity") +
                      theme(axis.text.x = element_text(angle = 55, hjust = 1)) +
                      xlab("Job Title - % of Total") +
                      ylab("Total Loans - Millions of $")
  
  ## Aggregating up total loans by purpose ##
  loan_by_purp <- loan_data_tmp %>% 
                  group_by(title) %>% 
                  summarize(`Total Loans ($)` = sum(loan_amnt)) %>%
                  arrange(desc(`Total Loans ($)`))
  # Getting percentage information
  loan_by_purp$title <- paste0(loan_by_purp$title," - ",paste0(round(100*loan_by_purp$`Total Loans ($)`/sum(loan_by_purp$`Total Loans ($)`),1),"%"))
  
  loan_by_purp_plot <- ggplot(loan_by_purp, aes(x = reorder(title,-`Total Loans ($)`), 
                                                y = (`Total Loans ($)`)/1e6, 
                                                fill = I("dodgerblue4"),
                                                alpha = I(rep(0.7,12)),
                                                col = I("grey29"))) + 
                     geom_bar(stat = "identity") +
                     theme(axis.text.x = element_text(angle = 55, hjust = 1)) +
                     xlab("Purpose") +
                     ylab(NULL)
  
  ## Aggregating up total loans by state ##
  loan_by_state <- loan_data_tmp %>% 
                   group_by(addr_state) %>% 
                   summarize(`Total Loans ($)` = sum(loan_amnt)) %>%
                   arrange(desc(`Total Loans ($)`))  
  
  # Finding full state names, capitalizing first letter of each one
  loan_by_state$addr_state <- sapply(loan_by_state$addr_state, function(state_code) {
    
    inx <- grep(pattern = state_code, x = state.regions$abb)
    
    state.regions$region[inx]
  
  }, USE.NAMES = F)
  
  # Borrowed from: https://stackoverflow.com/questions/6364783/capitalize-the-first-letter-of-both-words-in-a-two-word-string
  loan_by_state$addr_state <- sapply(loan_by_state$addr_state, function(state_name) {
    
    split <- strsplit(x=state_name, " ")[[1]]
    
      paste(toupper(substring(split, 1,1)), 
            substring(split, 2), sep="", collapse=" ")
  }, USE.NAMES = F)
  
  # Getting percentage information especially since we can only plot a subset
  loan_by_state$addr_state <- paste0(loan_by_state$addr_state," - ",paste0(round(100*loan_by_state$`Total Loans ($)`/sum(loan_by_state$`Total Loans ($)`),1),"%"))
  
  loan_by_state_plot <- ggplot(loan_by_state[1:10,], aes(x = reorder(addr_state,-`Total Loans ($)`), 
                                                         y = (`Total Loans ($)`)/1e6, 
                                                         fill = I("dodgerblue4"),
                                                         alpha = I(rep(0.7,10)),
                                                         col = I("grey29"))) + 
                    geom_bar(stat = "identity") +
                    theme(axis.text.x = element_text(angle = 55, hjust = 1)) +
                    xlab("State - % of Total") +
                    ylab("Total Loans - Millions of $")
  
  ## Aggregating up by loan amount ##
  loan_amnt_tmp <- loan_data_tmp$loan_amnt
  
  loan_amnt_hist <- qplot(loan_amnt_tmp, fill = I("dodgerblue4"), 
                           alpha = I(0.7), col = I("grey29")) + xlab("Loan Amount") + ylab("Count") + 
                            geom_vline(aes(xintercept = mean(loan_amnt_tmp)), 
                                       color = "dodgerblue4", 
                                       linetype = "dashed", 
                                       size = 2) +
                            annotate("text", x = Inf, y = Inf, 
                                     label = sprintf("\n Mean: %s  \n Average Deviation: %s   \n Skewness: %s   \n Kurtosis: %s   ",
                                                     round(mean(loan_amnt_tmp)),
                                                     round(mean(abs(loan_amnt_tmp-mean(loan_amnt_tmp)))),
                                                     round(skewness(loan_amnt_tmp),2),
                                                     round(kurtosis(loan_amnt_tmp),2)), 
                                     vjust = 1, hjust = 1)
  
  # Arranging plots into grid
  grid.arrange(loan_by_emp_plot, loan_by_purp_plot, loan_by_state_plot, loan_amnt_hist,
               widths = c(4,4), heights = c(4,3),   
               top = textGrob(sprintf("Grade %s Loan Volume by Employment, Purpose, State, and Counts",grade)))
  
  return(NULL)
}
# This seems to be a bug, but R errors out due on an obscure dplyr issue that is resolved with:
# 1) Restarting the R session at this point
# 2) Running library(ggplot2); library(dplyr); library(gridExtra); library(moments); library(grid)
# 3) Running the rest of the chunks

Grade A

null <- grid.draw(grade_plotter("A"))

Grade B

null <- grid.draw(grade_plotter("B"))

Grade C

null <- grid.draw(grade_plotter("C"))

Grade D

null <- grid.draw(grade_plotter("D"))

Grade E

null <- grid.draw(grade_plotter("E"))

Grade F

null <- grid.draw(grade_plotter("F"))

The relative orders of the purpose, state, and job title don’t change much between grades. The distribution of the loan size does shift to the right as the grade decreases. That is, people that are riskier tend to borrow more than those that are less risky. As the grade decreases there is a greater tendency to use the loan for debt consolidation. There are likely complex interactions amongst the variables in the full data set that better explain the differences in interest rates within grade groups. We’d likely need to build various models to try to capture what makes a borrower fall under a certain grade and what dictates the interest rate.

Summary

We’ve broken out the data set into continuous and categorical variables. These were scrubbed and analyzed for sparsity. Once we were comfortable with the data set, we moved on to visualizing the relationships between the variables. We broke out loan volume by state, job, and purpose. We also looked at the distribution of interest rate by loan grade and dived deeper into each grade’s statistics. Now that we have a reasonably clean data set and some aggregate information on the variables, we can move on to building models for inference and prediction.