Inspect the data

I will inspect the data to understand what different variables mean.

summary(lc_raw)

##     int_rate      loan_amnt      term_months    installment        dti      
##  Min.   :0      Min.   :  500   Min.   :36     Min.   :  16   Min.   : 0    
##  1st Qu.:0      1st Qu.: 5500   1st Qu.:36     1st Qu.: 169   1st Qu.: 8    
##  Median :0      Median :10000   Median :36     Median : 288   Median :13    
##  Mean   :0      Mean   :11253   Mean   :42     Mean   : 333   Mean   :13    
##  3rd Qu.:0      3rd Qu.:15000   3rd Qu.:60     3rd Qu.: 449   3rd Qu.:19    
##  Max.   :0      Max.   :35000   Max.   :60     Max.   :1305   Max.   :30    
##  NA's   :4669   NA's   :4669    NA's   :4669   NA's   :4669   NA's   :4669  
##   delinq_2yrs     annual_inc         grade            emp_title        
##  Min.   : 0     Min.   :   4000   Length:42538       Length:42538      
##  1st Qu.: 0     1st Qu.:  40800   Class :character   Class :character  
##  Median : 0     Median :  59534   Mode  :character   Mode  :character  
##  Mean   : 0     Mean   :  69148                                        
##  3rd Qu.: 0     3rd Qu.:  82800                                        
##  Max.   :11     Max.   :6000000                                        
##  NA's   :4669   NA's   :4669                                           
##   emp_length        home_ownership     verification_status   issue_d         
##  Length:42538       Length:42538       Length:42538        Length:42538      
##  Class :character   Class :character   Class :character    Class :character  
##  Mode  :character   Mode  :character   Mode  :character    Mode  :character  
##                                                                              
##                                                                              
##                                                                              
##                                                                              
##    zip_code          addr_state        loan_status            desc          
##  Length:42538       Length:42538       Length:42538       Length:42538      
##  Class :character   Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character   Mode  :character  
##                                                                             
##                                                                             
##                                                                             
##                                                                             
##    purpose             title             x20            x21         
##  Length:42538       Length:42538       Mode:logical   Mode:logical  
##  Class :character   Class :character   NA's:42538     NA's:42538    
##  Mode  :character   Mode  :character                                
##                                                                     
##                                                                     
##                                                                     
##                                                                     
##    x22            x23            x24            x25            x26         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x27            x28            x29            x30            x31         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x32            x33            x34            x35            x36         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x37            x38            x39            x40            x41         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x42            x43            x44            x45            x46         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x47            x48            x49            x50            x51         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x52            x53            x54            x55            x56         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x57            x58            x59            x60            x61         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x62            x63            x64            x65            x66         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x67            x68            x69            x70            x71         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x72            x73            x74            x75            x76         
##  Mode:logical   Mode:logical   Mode:logical   Mode:logical   Mode:logical  
##  NA's:42538     NA's:42538     NA's:42538     NA's:42538     NA's:42538    
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##                                                                            
##    x77            x78             x79             x80         
##  Mode:logical   Mode:logical   Mode :logical   Mode :logical  
##  NA's:42538     NA's:42538     FALSE:2660      FALSE:2718     
##                                NA's :39878     NA's :39820    
##                                                               
##                                                               
##                                                               
## 

Clean the data

Are there any redundant columns and rows? Are all the variables in the correct format (e.g., numeric, factor, date)? Lets fix it.

The variable “loan_status” contains information as to whether the loan has been repaid or charged off (i.e., defaulted). I will create a binary factor variable for this and focus on it in my further analysis.

lc_clean<- lc_raw %>%
  dplyr::select(-x20:-x80) %>% #delete empty columns
  filter(!is.na(int_rate)) %>%   #delete empty rows
  mutate(
    issue_d = lubridate::mdy(issue_d),  # lubridate::mdy() to fix date format
    term = factor(term_months),     # turn 'term' into a categorical variable
    delinq_2yrs = factor(delinq_2yrs) # turn 'delinq_2yrs' into a categorical variable
  ) %>% 
  mutate(default = dplyr::recode(loan_status, 
                      "Charged Off" = "1", 
                      "Fully Paid" = "0"))%>%
    mutate(default = as.factor(default)) %>%
  dplyr::select(-emp_title,-installment, -term_months, everything()) #move some not-so-important variables to the end. 

Explore the data

I will explore loan defaults by creating different visualizations. I will start with examining how prevalent defaults are, whether the default rate changes by loan grade or number of delinquencies, and a couple of scatter plots of defaults against loan amount and income.

#bar chart of defaults
def_vis1<-ggplot(data=lc_clean, aes(x=default)) +
  geom_bar(aes(y = (..count..)/sum(..count..))) + 
  labs(x="Default, 1=Yes, 0=No", y="relative frequencies") +
  scale_y_continuous(labels=scales::percent) +
  geom_text(aes( label = scales::percent((..count..)/sum(..count..) ),y=(..count..)/sum(..count..) ), stat= "count",vjust=-0.5) 

def_vis1

#bar chart of defaults per loan grade
def_vis2<-ggplot(data=lc_clean, aes(x=default), group=grade) +
  geom_bar(aes(y = (..count..)/sum(..count..), fill = factor(..x..)), stat="count")  +
  labs(title="Defaults by Grade", x="Default, 1=Yes, 0=No", y="relative frequencies") +
  scale_y_continuous(labels=scales::percent) +facet_grid(~grade) +
  theme(legend.position = "none") +
  geom_text(aes( label = scales::percent((..count..)/sum(..count..) ),y=(..count..)/sum(..count..) ), stat= "count",vjust=-0.5) 

def_vis2

#bar chart of defaults per number of Delinquencies
def_vis3<-lc_clean %>%
  filter(as.numeric(delinq_2yrs)<4) %>%
  ggplot(aes(x=default), group=delinq_2yrs) +
  geom_bar(aes(y = (..count..)/sum(..count..), fill = factor(..x..)), stat="count")  +
  labs(title="Defaults by Number of Delinquencies", x="Default, 1=Yes, 0=No", y="relative frequencies") +
  scale_y_continuous(labels=scales::percent) +
  facet_grid(~delinq_2yrs) +
  theme(legend.position = "none") +
  geom_text(aes( label = scales::percent((..count..)/sum(..count..) ),y=(..count..)/sum(..count..) ), stat= "count",vjust=-0.5)

def_vis3

#scatter plots 

#We select 2000 random loans to display only to make the display less busy. 
set.seed(1234)
reduced<-lc_clean[sample(0:nrow(lc_clean), 2000, replace = FALSE),]%>%
  mutate(default=as.numeric(default)-1) # also convert default to a numeric {0,1} to make it easier to plot.

          
# scatter plot of defaults against loan amount                         
def_vis4<-ggplot(data=reduced, aes(y=default,x=I(loan_amnt/1000)))  +
  labs(y="Default, 1=Yes, 0=No", x="Loan Amnt (1000 $)") +
  geom_jitter(width=0, height=0.05, alpha=0.7)

def_vis4

#scatter plot of defaults against loan amount.
def_vis5<-ggplot(data=reduced, aes(y=default,x=I(annual_inc/1000))) +
  labs(y="Default, 1=Yes, 0=No", x="Annual Income(1000 $)") +
  geom_jitter(width=0, height=0.05, alpha=0.7) +
  xlim(0,400)

def_vis5

I will also estimate a correlation table between defaults and other continuous variables.

# correlation table using GGally::ggcor()
# this takes a while to plot
lc_clean %>% 
    mutate(default=as.numeric(default)-1)%>%
  select(loan_amnt, dti, annual_inc, default) %>% #keep Y variable last
 ggcorr(method = c("pairwise", "pearson"), label_round=2, label = TRUE)

ggplot(lc_clean, aes(x= loan_amnt,y= default, colour=term)) +
  geom_boxplot() +
  facet_wrap(~grade) +
  labs(title= "Average annual income across all the grades for term 36 and 60", y="Default", x="Annual Income(1000 $)")

lc_clean %>% 
  select(grade, int_rate, default) %>% 
           ggpairs(aes(colour=default), alpha=1)+
  theme_bw()

From the graph it is interesting to observe that across particular loan grades from A to G the loan amount tends to increase in both terms for 36 months and 60 months. However, the loan amount for 36 months always stays slower disregard grade or default.

From the ggpairs plot, we can draw a few conclusions. First of all, the amount of data on default=1 is much smaller than the smount of data on default=0. Second of all, the biggest group by grade is group B, and groups that mostly tend to default are B, C or D. Interestingly, the interest rate tends to be bigger for people who fail to pay the loan back. Also the interest rate is the lowest for grade A and increases across the grades.

Conclusion

Logistic model in the case when real y (default) takes values equal to 0 or 1 is much better than OLS. It is because it avoids the negative values for probability, which are impossible to achieve empirically and not explainable.

Explanation of the notions:

1. Estimated Coefficient The Estimated Coeffiecient explains how a change in a particular varaible influence directly the risk factor decrease/increase. Risk factor is connected to the outcome y (probability) though the logistic function in the model. Sign of the coefficient has a general interpretation - if negative, the change in variable by 1 will cause decrease in the probability. If coeffiecient is positive, the change in variable by 1 will cause increase in probability.

2. Standard error of coefficient The magnitude of the standard error estimates how estimated coefficient would be affected if different data are fed in the model. It is also useful when constructing the 95% Confidence Interval for the true coefficients.

3. p-value of coefficient The p-value of the coefficient is connected to the Z-score in the Z-test. If the p-value is smaller than 0.05, the coeffieint is signifficant. The p-value describes the probability of the coeffiecient’s value falling inside the 95% confidence interval.

4. Deviance Deviance (or -2 log-likelihood (-2LL) statistic) is a goodness-of-fit statistic for a statistical model. We often use it for statistical hypothesis testing. Deviance is a generalization of the idea of using the sum of squares of residuals in ordinary least squares to cases where model-fitting is achieved by maximum likelihood. It tells us how much unexplained variation there is in our logistic regression model - the higher the value the less accurate the model.

5. AIC The Akaike Information Critetion rectifies deviance by penalizing number of coefficients. In other words AIC is an estimator of out-of-sample prediction error. The furmula is as follows: =-2log(L)+2k, where k is the number of coefficients. Again, the lower the score, the more accurate our model. AIC is used most frequently in situations when one is not able to easilty test model’s performance with use of machine learning (when having a small dataset or time series).

6. Null Deviance It is the outcome of Deviance, when model depends only on intercept.

Conclusion

FOr our predicitons, logistic 2 model is better than logistic 1 model as both deviance and AIC are lower.

From probability to classification

The logistic regression model gives us a sense of how likely defaults are; it gives us a probability estimate. To convert this into a prediction, we need to choose a cutoff probability and classify every loan with a predicted probability of default above the cutoff as a prediction of default (and vice versa for loans with a predicted probability below this cutoff).

Let’s choose a threshold of 20%. Of course some of our predictions will turn out to be right but some will turn out to be wrong – you can see this in the density figures of the previous section. Let’s call “default” the “positive” class since this is the class we are trying to predict. We could be making two types of mistakes. False positives (i.e., predict that a loan will default when it will not) and false negatives (I.e., predict that a loan will not default when it does). These errors are summarized in the confusion matrix.

Confusion matrix

I will now produce the confusion matrix for the model logistic 2 for a cutoff of 18%.

#using the logistic 2 model predict default probabilities
prob_default2<- predict(logistic2, lc_clean, type="response")
  
#Call any loan with probability more than 18% as default and any loan with lower probability as non-default.
p_class<-factor(ifelse(prob_default2>0.18,"1","0"),levels=levels(lc_clean$default))
  
#produce the confusion matrix and set default as the positive outcome
con2<-confusionMatrix(p_class,lc_clean$default,positive="1") 

#print the confusion matrix
con2

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction     0     1
##          0 24674  2818
##          1  7766  2611
##                                         
##                Accuracy : 0.721         
##                  95% CI : (0.716, 0.725)
##     No Information Rate : 0.857         
##     P-Value [Acc > NIR] : 1             
##                                         
##                   Kappa : 0.175         
##                                         
##  Mcnemar's Test P-Value : <2e-16        
##                                         
##             Sensitivity : 0.4809        
##             Specificity : 0.7606        
##          Pos Pred Value : 0.2516        
##          Neg Pred Value : 0.8975        
##              Prevalence : 0.1434        
##          Detection Rate : 0.0689        
##    Detection Prevalence : 0.2740        
##       Balanced Accuracy : 0.6208        
##                                         
##        'Positive' Class : 1             
## 

Using the confusion matrix, I can calculate the following:

a. Accuracy Percentage of status correctly predicted, regardless of default status. (2611+24674)/(2611+2818+24674+7766)=0.7205

b. Sensitivity Proportion of good loans correctly identified as non-default. 2611/(2611+2818)=0.48094

c. Specificity Proportion of bad loans correctly identified as default. 24674/(24674+7766)=0.76060

ROC curve and AUS

Using the model logistic 2 I will produce the ROC curve and calculate the AUC measure.

#estimate the ROC curve for Logistic 2
ROC_logistic2 <- roc(lc_clean$default,prob_default2)

#estimate the AUC for Logistic 2 and round it to two decimal places
AUC2<-round(auc(lc_clean$default,prob_default2)*100, digits=2)
#Plot the ROC curve and display the AUC in the title
ROC2<-ggroc(ROC_logistic2,  alpha = 0.5)+ ggtitle(paste("Model Logistic 2: AUC=",round(auc(lc_clean$default,prob_default2)*100, digits=2),"%"))  + geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1), color="grey", linetype="dashed")+geom_segment(aes(x = 1, xend = 1, y = 0, yend = 1), color="black", linetype="dashed")+geom_segment(aes(x = 1, xend = 0, y = 1, yend = 1), color="black", linetype="dashed")

ROC2

The ROC curve shows for any given level of True Positives, what level of True Negatives we can expect.The stright line shows the situation in which instead of a model we were using the probability of 0.5. Anything about the line is better than the random prediction. We aim for the ROC to be as close to the (1.00,1.00) point as possible. The AUC measure measures the area under the curve. Again for random prediciton (stright line) the AUC=0.5. The better the AUC the better the model. We expect the AUC of any predictive model to be between 0.5 and 1 as we expect is to be better than the random prediciton based on 0.5 chance. In case of a bad model, the AUC could be equal to the number below 0.5. However, in that case, we should immediately drop the model, as it means, that our model predictions are worse that the random chance of being correct. The AUC cannot be equal to the number above 1, as in case AUC=1, the model predictions are already 100% correct.

Out of sample ROC curve estimation

So far we have only worked in-sample. I will now split the data into training and testing and estimate the models ROC curve and AUC measure out of sample.

# splitting the data into training and testing
set.seed(1234)
train_test_split <- initial_split(lc_clean, prop = 0.8)
testing <- testing(train_test_split) #20% of the data is set aside for testing
training <- training(train_test_split) #80% of the data is set aside for training

# run logistic 2 on the training set 
logistic2_in<-glm(default~I(annual_inc/1000)+term+grade+loan_amnt, family="binomial", training)

#calculate probability of default in the training sample 
p_in<-predict(logistic2_in, training, type = "response")
  
#ROC curve using in-sample predictions
ROC_logistic2_in <- roc(training$default,p_in)
#AUC using in-sample predictions
AUC_logistic2_in<-round(auc(training$default,p_in)*100, digits=2)
  
#calculate probability of default out of sample 
p_out<-predict(logistic2_in, testing, type = "response")

#ROC curve using out-of-sample predictions
ROC_logistic2_out <- roc(testing$default,p_out)
#AUC using out-of-sample predictions
AUC_logistic2_out <- round(auc(testing$default,p_out)*100, digits=2)
#plot in the same figure both ROC curves and print the AUC of both curves in the title
ggroc(list("Logistic 2 in-sample"=ROC_logistic2_in, "Logistic 2 out-of-sample"=ROC_logistic2_out))+ggtitle(paste("Model Logistic 2 in-sample AUC=",round(auc(training$default,p_in)*100, digits=2),"%\nModel Logistic 2 out-of-sample AUC=",round(auc(testing$default,p_out)*100, digits=2),"%"))    +
geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1), color="grey", linetype="dashed")

There is a very weak evidence in overfitting, because the ROC curve and AUC statistic has remained roughly the same in both in-sample and out-of-sample cases. Therefore we can assume that overfitting does not occur in our model.

Finding cut-off threshold

I will now use the trained model to determine the optimal cut-off threshold based on the validation test.

logistic2_in<-glm(default~I(annual_inc/1000)+term+grade+loan_amnt, family="binomial", training)
summary(logistic2_in)

## 
## Call:
## glm(formula = default ~ I(annual_inc/1000) + term + grade + loan_amnt, 
##     family = "binomial", data = training)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.053  -0.607  -0.487  -0.338   3.237  
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -2.49e+00   6.64e-02  -37.54   <2e-16 ***
## I(annual_inc/1000) -5.70e-03   6.08e-04   -9.38   <2e-16 ***
## term60              5.02e-01   4.59e-02   10.94   <2e-16 ***
## gradeB              7.34e-01   6.89e-02   10.65   <2e-16 ***
## gradeC              1.07e+00   7.08e-02   15.09   <2e-16 ***
## gradeD              1.32e+00   7.48e-02   17.59   <2e-16 ***
## gradeE              1.42e+00   8.74e-02   16.27   <2e-16 ***
## gradeF              1.70e+00   1.11e-01   15.32   <2e-16 ***
## gradeG              1.78e+00   1.72e-01   10.35   <2e-16 ***
## loan_amnt           1.45e-06   3.03e-06    0.48     0.63    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 18591  on 22721  degrees of freedom
## Residual deviance: 17493  on 22712  degrees of freedom
## AIC: 17513
## 
## Number of Fisher Scoring iterations: 5

p_val<-predict(logistic2_in, validation, type = "response") #predict probability of default on the validation set

#we select the cutoff threshold using the estimated model and the validation set
profit=0
threshold=0
for(i in 1:100) {
  threshold[i]=i/400
  one_or_zero_search<-ifelse(p_val>threshold[i],"1","0")
  p_class_search<-factor(one_or_zero_search,levels=levels(validation$default))

  con_search<-confusionMatrix(p_class_search,validation$default,positive="1")
  profit[i]=con_search$table[1,1]*20-con_search$table[1,2]*100
}

ggplot(as.data.frame(threshold), aes(x=threshold,y=profit)) + geom_smooth(method = 'loess', se=0) +labs(title="Profit curve with logistic 2 based on validation set, ")

paste0("Based on the validation set: Maximum profit per loan is $", round(max(profit)/nrow(validation),2), " achieved at a threshold of ", threshold[which.is.max(profit)]*100,"%.")

## [1] "Based on the validation set: Maximum profit per loan is $5.55 achieved at a threshold of 17%."

#calculate probability of default out of sample 
p_out<-predict(logistic2_in, testing, type = "response")

#we select the cutoff threshold using the estimated model and the testing set
profitt=0
thresholdt=0
for(i in 1:100) {
  thresholdt[i]=i/400
  one_or_zero_search_t<-ifelse(p_out>thresholdt[i],"1","0")
  p_class_search_t<-factor(one_or_zero_search_t,levels=levels(testing$default))

  con_search_t<-confusionMatrix(p_class_search_t,testing$default,positive="1")
  profitt[i]=con_search_t$table[1,1]*20-con_search_t$table[1,2]*100
}

ggplot(as.data.frame(thresholdt), aes(x=thresholdt,y=profitt)) + geom_smooth(method = 'loess', se=0) +labs(title="Profit curve with logistic 2 based on testing set, ")

paste0("Based on the testing set: Maximum profit per loan is $", round(max(profitt)/nrow(testing),2), " achieved at a threshold of ", thresholdt[which.is.max(profitt)]*100,"%.")

## [1] "Based on the testing set: Maximum profit per loan is $5.62 achieved at a threshold of 17.75%."

Based on the validation set, we can observe that the maximum profit per loan is >’$’5.55
achieved at a threshold of 17% optimal cutoff. In case of using the testing set, I obtain also the cutoff point of 17.5%, however the maximum profit per loan amount to $5.62.

Expected return of the loans

In the nest step, I will calculate the expected return of the loans in the validation set using the logistic 2 model trained in the training set. I will check how the realized return varies as I change \(n\).

expected_return <- p_val*(-0.6)+(1-p_val)*(validation2$term_months*validation2$installment/validation2$loan_amnt-1)

expected_return <-as.data.frame(expected_return) %>% 
  arrange(-expected_return) 
  
expected_return_800<-expected_return %>% head(800)

expected_return_800%>% 
  summarize(expected_return_in_percent = sum(expected_return)/800*100)

expected_return_1500<-expected_return %>% head(1500)

expected_return_1500%>% 
  summarize(expected_return_in_percent =sum(expected_return)/1500*100)

expected_return_8000<-expected_return %>% head(8000)

expected_return_8000%>% 
  summarize(expected_return_in_percent =sum(expected_return)/8000*100)

expected_return_80<-expected_return %>% head(80)

expected_return_80%>% 
  summarize(expected_return_in_percent =sum(expected_return)/80*100)

In case n=800, our expected return amount to 23.64%. In case of increasing n, the perctange value of expected return decreases. If we decrease \(n\), then the expected return in percent increases. We can use the expected return metric as one of the means to select a portfolio, however we should not rely only on this measure. The less loans we choose, the less nominal profit we will obtain. Therefore, it would be smart to use other measures to complement this approach.

For \(n=800\), I will check how sensitive is my answer to the assumption that if a loan defaults I lose 60% of the value.

To answer this question I will assess how the realized return of the 800 loans chosen in my portfolio change if the loss proportion varies from 20%-80%.

expected_return20 <- p_val*(-0.2)+(1-p_val)*(validation2$term_months*validation2$installment/validation2$loan_amnt-1)

expected_return20 <-as.data.frame(expected_return20) %>% 
  arrange(-expected_return20) 
  
expected_return_800_20<-expected_return20 %>% head(800)

expected_return_800_20%>% 
  summarize(sum(expected_return20)/800*100)

expected_return80 <- p_val*(-0.8)+(1-p_val)*(validation2$term_months*validation2$installment/validation2$loan_amnt-1)

expected_return80 <-as.data.frame(expected_return80) %>% 
  arrange(-expected_return80) 
  
expected_return_800_80<-expected_return80 %>% head(800)

expected_return_800_80%>% 
  summarize(sum(expected_return80)/800*100)

expected_return40 <- p_val*(-0.4)+(1-p_val)*(validation2$term_months*validation2$installment/validation2$loan_amnt-1)

expected_return40 <-as.data.frame(expected_return40) %>% 
  arrange(-expected_return40) 
  
expected_return_800_40<-expected_return40 %>% head(800)

expected_return_800_40%>% 
  summarize(sum(expected_return40)/800*100)

If we lose 20% on default loans, we have expected return on the 800 loans as 33.36%. If we lose 80% on default loans, we have expected return on the 800 loans as 19.44%. The return changes but we still gain profit from it. The expected return increases more if the loss is small. It means that our answer is not this much sensitive to the assupmtion that if the loan defaults, we lose 60% of the value.

Predicting outcomes for the testing data

The file “Assessment Data_2020.csv” contains information on almost 1800 new loans. I will use my best model form the previous point to choose 200 loans to invest. For this I will assume that the loss proportion is 60%.

lc_assessment<- read_csv("~/Documents/LBS/Data Science/Session 05/Assessment Data_2020.csv") 
 lc_assessment<-  lc_assessment %>% 
   janitor::clean_names() %>% # use janitor::clean_names() 
  mutate(
    issue_d = lubridate::mdy(issue_d),  # lubridate::mdy() to fix date format
    term = factor(term_months),     # turn 'term' into a categorical variable
    delinq_2yrs = factor(delinq_2yrs)) # turn 'delinq_2yrs' into a categorical variable
 
#  lc_assessment %>% head(10)
  
 p_assessment<-predict(logistic_wild, lc_assessment, type = "response")

  p_assessment %>% head(10)

##      1      2      3      4      5      6      7      8      9     10 
## 0.0873 0.1225 0.0498 0.1685 0.2225 0.1730 0.1021 0.0771 0.1113 0.1775

   expected_return_assessment <- p_assessment*(-0.6)+(1-p_assessment)*(lc_assessment$term_months*lc_assessment$installment/lc_assessment$loan_amnt-1)

lc_assessment_total<- lc_assessment %>% 
  mutate(expected_return=expected_return_assessment ) %>% 
arrange(-expected_return ) 

lc_assessment_total_200 <- lc_assessment_total %>%  
  head(200) %>% 
  mutate( agnieszka_prawda= 1)



merged_assessment<- merge(x = lc_assessment_total, y = lc_assessment_total_200, by = "loan_number", all.x = TRUE) %>% 
  select(loan_number, agnieszka_prawda) 
  
merged_assessment<- replace_na(merged_assessment,list(agnieszka_prawda=0))


merged_assessment %>% head(20) #glimpse for 10 rows

Data on gender or race

We do not include data on race or gender as our model could become bias and disciminate poeple of particular sex or skin color. Even if such variables may be good predictors, they may sometimes be not the best choice for machine learning if not carefully trained and considered. It is an aesthetic approach to data and modelling. We need to remember that when using machine learning methods, the models may sometimes take spourious values as significant ones and become sexist or racist.