Data used in this analysis is collected from FED reserve Microeconomic Data.

Input data layout 

library(DT)
library(dplyr)
library(tidyverse)
library(plotly)
library(sqldf)

dfAutoLoanOriginationData <- read.csv(file= "C:\\R\\RData\\AutoLoanOriginationData.txt" , header=TRUE, quote = "\"", sep="\t")
str(dfAutoLoanOriginationData)
## 'data.frame':    65 obs. of  10 variables:
##  $ Year_Quarter       : Factor w/ 65 levels "04:Q1","04:Q2",..: 1 2 3 4 5 6 7 8 9 10 ...
##  $ Year               : int  2004 2004 2004 2004 2005 2005 2005 2005 2006 2006 ...
##  $ Quarter            : Factor w/ 4 levels "Q1","Q2","Q3",..: 1 2 3 4 1 2 3 4 1 2 ...
##  $ AutoLoan_620_LS    : num  31.9 26.8 30.3 30 27.5 41.2 35.5 31.4 30.7 36.4 ...
##  $ AutoLoan_620_659   : num  14.5 15.6 15.6 13.3 12 19.7 22.6 18.1 13.9 16.8 ...
##  $ AutoLoan_660_719   : num  27 32.3 27.1 26.4 23 34.2 35.3 25 21.2 23.4 ...
##  $ AutoLoan_720_759   : num  17.3 18 18.9 16.6 15.6 21.7 24.6 13.7 14.4 15.8 ...
##  $ AutoLoan_760_GT    : num  21.2 24.8 24 23.4 22.4 33.8 41.7 20.4 21 21.9 ...
##  $ AutoLoan_Total     : num  112 118 116 110 100 ...
##  $ AutoLoanOutstanding: num  0.72 0.74 0.75 0.73 0.73 0.77 0.83 0.79 0.79 0.8 ...
# Summarize data by Year
dfAutoLoanOriginationSummaryByYear <-  
  sqldf("SELECT Year,'AutoLoan' LoanType,SUM(AutoLoan_Total) AllOrigination 
        ,SUM(AutoLoan_620_LS) AutoLoan_620_LS
        ,SUM(AutoLoan_620_659) AutoLoan_620_659
        ,SUM(AutoLoan_620_LS)+SUM(AutoLoan_620_659)  AutoLoan_660_LS
        ,SUM(AutoLoan_660_719) AutoLoan_660_719
        ,SUM(AutoLoan_720_759) AutoLoan_720_759
        ,SUM(AutoLoan_760_GT) AutoLoan_760_GT
        ,SUM(AutoLoanOutstanding*1000) AutoLoanOutstanding
        from dfAutoLoanOriginationData WHERE  Year < 2020 GROUP BY Year") 
Origination2019 <- with(filter(dfAutoLoanOriginationSummaryByYear, dfAutoLoanOriginationSummaryByYear$Year  == 2019),mean(AllOrigination))

# Calculate the Percent change in AutoLoanOrigination   
dfAutoLoanOriginationByYear <-(dfAutoLoanOriginationSummaryByYear %>% 
         arrange(desc(Year)) %>% 
         mutate(pct_change = (AllOrigination/lead(AllOrigination) - 1) )   %>% 
           mutate(pct_changeAutoLoanOutstanding = (AutoLoanOutstanding/lead(AutoLoanOutstanding) - 1)) 
           )


# Calculate the Percent change in autoloan origination
df2 <-(dfAutoLoanOriginationSummaryByYear %>% 
  arrange(desc(Year)) %>% 
  mutate(pct_change = (AutoLoanOutstanding/lead(AutoLoanOutstanding) - 1) * 100))
z<-with(filter(df2, df2$Year  > 2008 & df2$Year < 2020)  ,mean(pct_change))
During the prior 10 years, automobile loan origination has had consistent growth. Auto originations in year 2019 reached to 612.4 billion . New loan growth rate for the past 10 years is 4.68%

The new loan growth rate has been steady over the last 10 years. 

#### Plot the AutoLoan origination 
dfAutoLoanOriginationDataPlot <-   
  sqldf("SELECT *
        from dfAutoLoanOriginationData WHERE  Year < 2020 AND Year > 2008") 

p1 <- plot_ly(x = dfAutoLoanOriginationDataPlot$Year  ,
              y =  dfAutoLoanOriginationDataPlot$AutoLoan_Total ,
                type = "bar") 

p1 <- p1 %>% layout(title = "Auto Loan Origination (in Billion)",
                    xaxis = list(title = ""),
                    yaxis = list(title = "")) 
p1 <- p1 %>% 
  layout(yaxis = list(tickformat = "$"))

p1
dfAutoLoanPercent <- data.frame (Year = dfAutoLoanOriginationByYear$Year)
dfAutoLoanPercent$AutoLoan_660_LSPercent = dfAutoLoanOriginationByYear$AutoLoan_660_LS/dfAutoLoanOriginationByYear$AllOrigination   
dfAutoLoanPercent$AutoLoan_660_719Percent = dfAutoLoanOriginationByYear$AutoLoan_660_719  /dfAutoLoanOriginationByYear$AllOrigination  
dfAutoLoanPercent$AutoLoan_720_759Percent = dfAutoLoanOriginationByYear$AutoLoan_720_759  /dfAutoLoanOriginationByYear$AllOrigination  
dfAutoLoanPercent$AutoLoan_760_GTPercent  = dfAutoLoanOriginationByYear$AutoLoan_760_GT   /dfAutoLoanOriginationByYear$AllOrigination
AvgAutoLoan_660_LSPercent<-with(dfAutoLoanPercent  ,mean(AutoLoan_660_LSPercent))*100
AvgAutoLoan_660_719Percent<-with(dfAutoLoanPercent ,mean(AutoLoan_660_719Percent))*100
AvgAutoLoan_720_759Percent<-with(dfAutoLoanPercent  ,mean(AutoLoan_720_759Percent))*100
AvgAutoLoan_760_GTPercent<-with( dfAutoLoanPercent ,mean(AutoLoan_760_GTPercent))*100 

  

AvgAutoLoan_660_LSPercentPrior2008<-with(filter (dfAutoLoanPercent,dfAutoLoanPercent$Year < 2008)  ,mean(AutoLoan_660_LSPercent))*100

AvgAutoLoan_660_LSPercentAfter2008<-with(filter (dfAutoLoanPercent,dfAutoLoanPercent$Year > 2008)   ,mean(AutoLoan_660_LSPercent))*100

Loan origination growth across different credit band has also stayed similar over the period. Percentage of originations across different credit band history shows consistent pattern with
average origination percent by credit score range

  • Less than 660 : 35.361%
  • 660 - 719 :21.413%
  • 720 - 759 : 14.628%
  • Greater than 760 : 28.585% 

    • datatable(
  dfAutoLoanPercent
  ,filter = "none"
  ,rownames = FALSE
  ,caption = htmltools::tags$caption(style = 'caption-side: top; text-align: center; font-size: 20px;font-weight: 900',
                                     "New Autoloans by Credit Score")
  
  ,options = list(    searching = FALSE,    ordering = FALSE,    paging = FALSE ,width="80%",
                      initComplete = JS(
                        "function(settings, json) {",
                        "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
                        "}")
  )
  ,colnames = c('Year','< 660 %','660 - 719 %','720-759%', '>= 760 %' )
) %>%
  formatPercentage(    c(  'AutoLoan_660_LSPercent',  'AutoLoan_660_719Percent', 'AutoLoan_720_759Percent', 'AutoLoan_760_GTPercent'  ),
                       digits = 2,
                       interval = 3,
                       mark = ",",
                       dec.mark = getOption("OutDec")
  )

    Prior to financial crisis of 2008 originations in the lower credit scores were hovering around 41.16% total new loans. But recent 5 years history shows consistent 33.05% of the new auto loans are underwritten in lower than 660 scores. 

    fig <- plot_ly(type = 'box')
fig <- fig %>% add_trace( y = ~dfAutoLoanPercent$AutoLoan_660_LSPercent, type = "box",name="< 660")
fig <- fig %>% add_trace(y = ~dfAutoLoanPercent$AutoLoan_660_719Percent,name="660 to 719")
fig <- fig %>% add_trace(y = ~dfAutoLoanPercent$AutoLoan_720_759Percent,name="720 to 759")
fig <- fig %>% add_trace(y = ~dfAutoLoanPercent$AutoLoan_760_GTPercent,name="> 760+") 
fig <- fig %>% layout(title = "Box Plot Loan origination % by credit score over the historical period",
                      yaxis = list(title = "% Origination") )


fig

    As origination rates stayed same, total outstanding auto loan balances are on rise.This leads to conclude that duration of these loans are on rise. Principal pay down is on decline. FED data does not breakout outstanding balance by credit scores. But if outstanding balances are rising in lower tier credit score, there will be big concerns in coming year heading to higher auto delinquency and significant losses (charge off) after COVID-19. 

    p1 <- plot_ly(x = dfAutoLoanOriginationSummaryByYear$Year  ,
              y =  dfAutoLoanOriginationSummaryByYear$AllOrigination ,name = "Origination(million)",
              type = "bar") 
p1 <- p1 %>%  add_trace(x = dfAutoLoanOriginationSummaryByYear$Year, y=dfAutoLoanOriginationSummaryByYear$AutoLoanOutstanding,
                        type = "bar",name = "Outstanding (Billion)" )

p1 <- p1 %>% layout(title = "AutoLoan View (in Billion)",
                    xaxis = list(title = ""),
                    yaxis = list(title = "Loan Outstanding/New Loans",tickformat = "$") )
 
p1