AS3-3 Group-4 Predicting Loan Repayment

rm(list=ls(all=T))
options(digits=4, scipen=12)
library(magrittr)

---

Introduction

議題：議題：使用貸款人的資料，預測他會不會還款

---

1 資料整理 Preparing the Dataset

【1.1 基礎機率】What proportion of the loans in the dataset were not paid in full?

loans = read.csv("C:/MIT summer 2018/Unit3/data/loans.csv")
table(loans$not.fully.paid)

   0    1 
8045 1533 

1533/(8045+1533)

[1] 0.1601

【1.2 檢查缺項】Which of the following variables has at least one missing observation?

summary(loans)

 credit.policy                 purpose        int.rate      installment    log.annual.inc       dti       
 Min.   :0.000   all_other         :2331   Min.   :0.060   Min.   : 15.7   Min.   : 7.55   Min.   : 0.00  
 1st Qu.:1.000   credit_card       :1262   1st Qu.:0.104   1st Qu.:163.8   1st Qu.:10.56   1st Qu.: 7.21  
 Median :1.000   debt_consolidation:3957   Median :0.122   Median :268.9   Median :10.93   Median :12.66  
 Mean   :0.805   educational       : 343   Mean   :0.123   Mean   :319.1   Mean   :10.93   Mean   :12.61  
 3rd Qu.:1.000   home_improvement  : 629   3rd Qu.:0.141   3rd Qu.:432.8   3rd Qu.:11.29   3rd Qu.:17.95  
 Max.   :1.000   major_purchase    : 437   Max.   :0.216   Max.   :940.1   Max.   :14.53   Max.   :29.96  
                 small_business    : 619                                   NA's   :4                      
      fico     days.with.cr.line   revol.bal         revol.util    inq.last.6mths   delinq.2yrs        pub.rec     
 Min.   :612   Min.   :  179     Min.   :      0   Min.   :  0.0   Min.   : 0.00   Min.   : 0.000   Min.   :0.000  
 1st Qu.:682   1st Qu.: 2820     1st Qu.:   3187   1st Qu.: 22.7   1st Qu.: 0.00   1st Qu.: 0.000   1st Qu.:0.000  
 Median :707   Median : 4140     Median :   8596   Median : 46.4   Median : 1.00   Median : 0.000   Median :0.000  
 Mean   :711   Mean   : 4562     Mean   :  16914   Mean   : 46.9   Mean   : 1.57   Mean   : 0.164   Mean   :0.062  
 3rd Qu.:737   3rd Qu.: 5730     3rd Qu.:  18250   3rd Qu.: 71.0   3rd Qu.: 2.00   3rd Qu.: 0.000   3rd Qu.:0.000  
 Max.   :827   Max.   :17640     Max.   :1207359   Max.   :119.0   Max.   :33.00   Max.   :13.000   Max.   :5.000  
               NA's   :29                          NA's   :62      NA's   :29      NA's   :29       NA's   :29     
 not.fully.paid
 Min.   :0.00  
 1st Qu.:0.00  
 Median :0.00  
 Mean   :0.16  
 3rd Qu.:0.00  
 Max.   :1.00  
               

#log.annual.inc , days.with.cr.line , revol.util , inq.last.6mths,delinq.2yrs , pub.rec

【1.3 決定是否要補缺項】Which of the following is the best reason to fill in the missing values for these variables instead of removing observations with missing data?

missing = subset(loans, is.na(log.annual.inc) | is.na(days.with.cr.line) | is.na(revol.util) | is.na(inq.last.6mths) | is.na(delinq.2yrs) | is.na(pub.rec))
nrow(missing)

[1] 62

table(missing$not.fully.paid)

 0  1 
50 12 

【1.4 補缺項工具】What best describes the process we just used to handle missing values?

##install.packages("mice") 
loans = read.csv("C:/MIT summer 2018/Unit3/data/loans_imputed.csv")
library(mice)
set.seed(144)
vars.for.imputation = setdiff(names(loans), "not.fully.paid")
imputed = complete(mice(loans[vars.for.imputation]))

 iter imp variable
  1   1
  1   2
  1   3
  1   4
  1   5
  2   1
  2   2
  2   3
  2   4
  2   5
  3   1
  3   2
  3   3
  3   4
  3   5
  4   1
  4   2
  4   3
  4   4
  4   5
  5   1
  5   2
  5   3
  5   4
  5   5

loans[vars.for.imputation] = imputed
# We predicted missing variable values using the available independent variables for each observation. 

---

2 建立模型 Prediction Models

【2.1 顯著性】Which independent variables are significant in our model?

library("caTools")
set.seed(144)
split = sample.split(loans$not.fully.paid,SplitRatio = 0.7)
train = subset(loans,split==TRUE)
test = subset(loans,split==FALSE)
model1= glm(not.fully.paid ~ .,data=train,family=binomial)
summary(model1)

Call:
glm(formula = not.fully.paid ~ ., family = binomial, data = train)

Deviance Residuals: 
   Min      1Q  Median      3Q     Max  
-2.205  -0.621  -0.495  -0.361   2.640  

Coefficients:
                             Estimate  Std. Error z value     Pr(>|z|)    
(Intercept)                9.18714453  1.55446335    5.91 0.0000000034 ***
credit.policy             -0.33680457  0.10106680   -3.33      0.00086 ***
purposecredit_card        -0.61405712  0.13443839   -4.57 0.0000049340 ***
purposedebt_consolidation -0.32120484  0.09182890   -3.50      0.00047 ***
purposeeducational         0.13472394  0.17531177    0.77      0.44220    
purposehome_improvement    0.17270095  0.14796329    1.17      0.24313    
purposemajor_purchase     -0.48299241  0.20088623   -2.40      0.01620 *  
purposesmall_business      0.41204779  0.14186303    2.90      0.00368 ** 
int.rate                   0.61098056  2.08454887    0.29      0.76945    
installment                0.00127469  0.00020921    6.09 0.0000000011 ***
log.annual.inc            -0.43367555  0.07148249   -6.07 0.0000000013 ***
dti                        0.00463768  0.00550209    0.84      0.39929    
fico                      -0.00931679  0.00171000   -5.45 0.0000000508 ***
days.with.cr.line          0.00000237  0.00001588    0.15      0.88134    
revol.bal                  0.00000309  0.00000117    2.64      0.00827 ** 
revol.util                 0.00183926  0.00153463    1.20      0.23072    
inq.last.6mths             0.08437328  0.01599605    5.27 0.0000001330 ***
delinq.2yrs               -0.08319927  0.06560940   -1.27      0.20476    
pub.rec                    0.32995658  0.11385916    2.90      0.00376 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 5896.6  on 6704  degrees of freedom
Residual deviance: 5485.2  on 6686  degrees of freedom
AIC: 5523

Number of Fisher Scoring iterations: 5

#credit.policy ,purpose2 (credit card) ,purpose3 (debt consolidation) , purpose6 (major purchase) , purpose7 (small business) , installment ,log.annual.inc,fico,revol.bal,inq.last.6mths,pub.rec

【2.2 從回歸係數估計邊際效用】Consider two loan applications, which are identical other than the fact that the borrower in Application A has FICO credit score 700 while the borrower in Application B has FICO credit score 710. What is the value of Logit(A) - Logit(B)? What is the value of O(A)/O(B)?

coef(model1)

              (Intercept)             credit.policy        purposecredit_card purposedebt_consolidation 
              9.187144531              -0.336804575              -0.614057123              -0.321204840 
       purposeeducational   purposehome_improvement     purposemajor_purchase     purposesmall_business 
              0.134723939               0.172700949              -0.482992409               0.412047791 
                 int.rate               installment            log.annual.inc                       dti 
              0.610980561               0.001274688              -0.433675545               0.004637680 
                     fico         days.with.cr.line                 revol.bal                revol.util 
             -0.009316790               0.000002371               0.000003085               0.001839259 
           inq.last.6mths               delinq.2yrs                   pub.rec 
              0.084373276              -0.083199271               0.329956577 

# the difference of logits
(700-710)*-0.009316790

[1] 0.09317

# the ratio of odds
exp(0.09317)

[1] 1.098

【2.3 混淆矩陣、正確率 vs 底線機率】What is the accuracy of the logistic regression model? What is the accuracy of the baseline model?

# test accuracy
test$predicted.risk = predict(model1,type="response",newdata=test)
table(test$not.fully.paid,test$predicted.risk>0.5)

   
    FALSE TRUE
  0  2400   13
  1   457    3

(2400+3)/(2400+3+13+457)

[1] 0.8364

# baseline accuracy
table(test$not.fully.paid)

   0    1 
2413  460 

2413/(2413+460)

[1] 0.8399

【2.4 ROC & AUC】Use the ROCR package to compute the test set AUC.

library(ROCR)
ROCRpredTest = prediction(test$predicted.risk, test$not.fully.paid)
auc = as.numeric(performance(ROCRpredTest, "auc")@y.values)
auc

[1] 0.6721

---

3 提高底線 Smart Baseline

【3.1 高底線模型】The variable int.rate is highly significant in the bivariate model, but it is not significant at the 0.05 level in the model trained with all the independent variables. What is the most likely explanation for this difference?

SmartBaseline = glm(not.fully.paid ~ int.rate,data=train ,family=binomial)
summary( SmartBaseline)

Call:
glm(formula = not.fully.paid ~ int.rate, family = binomial, data = train)

Deviance Residuals: 
   Min      1Q  Median      3Q     Max  
-1.055  -0.627  -0.544  -0.436   2.291  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept)   -3.673      0.169   -21.8   <2e-16 ***
int.rate      15.921      1.270    12.5   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 5896.6  on 6704  degrees of freedom
Residual deviance: 5734.8  on 6703  degrees of freedom
AIC: 5739

Number of Fisher Scoring iterations: 4

summary(model1)

Call:
glm(formula = not.fully.paid ~ ., family = binomial, data = train)

Deviance Residuals: 
   Min      1Q  Median      3Q     Max  
-2.205  -0.621  -0.495  -0.361   2.640  

Coefficients:
                             Estimate  Std. Error z value     Pr(>|z|)    
(Intercept)                9.18714453  1.55446335    5.91 0.0000000034 ***
credit.policy             -0.33680457  0.10106680   -3.33      0.00086 ***
purposecredit_card        -0.61405712  0.13443839   -4.57 0.0000049340 ***
purposedebt_consolidation -0.32120484  0.09182890   -3.50      0.00047 ***
purposeeducational         0.13472394  0.17531177    0.77      0.44220    
purposehome_improvement    0.17270095  0.14796329    1.17      0.24313    
purposemajor_purchase     -0.48299241  0.20088623   -2.40      0.01620 *  
purposesmall_business      0.41204779  0.14186303    2.90      0.00368 ** 
int.rate                   0.61098056  2.08454887    0.29      0.76945    
installment                0.00127469  0.00020921    6.09 0.0000000011 ***
log.annual.inc            -0.43367555  0.07148249   -6.07 0.0000000013 ***
dti                        0.00463768  0.00550209    0.84      0.39929    
fico                      -0.00931679  0.00171000   -5.45 0.0000000508 ***
days.with.cr.line          0.00000237  0.00001588    0.15      0.88134    
revol.bal                  0.00000309  0.00000117    2.64      0.00827 ** 
revol.util                 0.00183926  0.00153463    1.20      0.23072    
inq.last.6mths             0.08437328  0.01599605    5.27 0.0000001330 ***
delinq.2yrs               -0.08319927  0.06560940   -1.27      0.20476    
pub.rec                    0.32995658  0.11385916    2.90      0.00376 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 5896.6  on 6704  degrees of freedom
Residual deviance: 5485.2  on 6686  degrees of freedom
AIC: 5523

Number of Fisher Scoring iterations: 5

# int.rate is correlated with other risk-related variables, and therefore does not incrementally improve the model when those other variables are included.

【3.2 高底線模型的預測值】What is the highest predicted probability of a loan not being paid in full on the testing set? With a logistic regression cutoff of 0.5, how many loans would be predicted as not being paid in full on the testing set?

Pred2 = predict(SmartBaseline ,type = "response", test)
sort(Pred2,TRUE)

  5869   7314   9477   6433   9249   9338   9460   5275   3714   3992   9064   9197   9289   9146   9569   6423 
0.4266 0.4146 0.4146 0.4000 0.4000 0.4000 0.4000 0.3867 0.3844 0.3844 0.3844 0.3844 0.3736 0.3724 0.3724 0.3606 
  9296   3603   4695   5136   5480   9306   9333   9394   9475   1545   7164   8772   3656   5718   6081   9561 
0.3606 0.3493 0.3482 0.3482 0.3482 0.3482 0.3482 0.3482 0.3482 0.3450 0.3450 0.3385 0.3378 0.3357 0.3357 0.3318 
  8386   8424   8432   8620   8733   4031   9063   9149   2322   3553   5183   5253   5597   6722   9245   9304 
0.3297 0.3297 0.3297 0.3297 0.3272 0.3269 0.3269 0.3269 0.3234 0.3234 0.3234 0.3234 0.3234 0.3234 0.3234 0.3234 
  9348   8194   7425   7609   8284   3719   9020   4669   6099   6903   9250   8227   8406   8531   7403   8756 
0.3234 0.3210 0.3189 0.3189 0.3185 0.3158 0.3158 0.3117 0.3117 0.3117 0.3117 0.3100 0.3076 0.3076 0.3062 0.3055 
  8807   8998   7807   8004   8847   4860   5026   5969   6008   6134   6241   6398   6790   9365   9484   9485 
0.3055 0.3052 0.3039 0.3039 0.3012 0.2998 0.2998 0.2998 0.2998 0.2998 0.2998 0.2998 0.2998 0.2998 0.2998 0.2998 
  8539   8598   8784   2290   3875   8939   9036   7782   7855   7866   7918   6720   7707   9106   9423   8292 
0.2972 0.2972 0.2948 0.2945 0.2945 0.2945 0.2945 0.2932 0.2932 0.2932 0.2932 0.2883 0.2883 0.2883 0.2883 0.2866 
  8534   8543   8593   8801   2731   2825   8894   8996   9013   9018   7795   8026   8097   6786   6796   7119 
0.2866 0.2866 0.2866 0.2847 0.2840 0.2840 0.2840 0.2840 0.2840 0.2840 0.2827 0.2827 0.2827 0.2818 0.2818 0.2818 
  7366   9520   1608   8211   4284   4346   4380   4686   4708   4721   5371   6930   7695   9395   8520   1742 
0.2818 0.2818 0.2805 0.2786 0.2770 0.2770 0.2770 0.2770 0.2770 0.2770 0.2770 0.2770 0.2770 0.2770 0.2766 0.2741 
  2130   2358   2564   3563   3629   8964   9031   7794   7800   7808   8092   2838    600   8349   9571   4641 
0.2741 0.2741 0.2741 0.2741 0.2741 0.2741 0.2741 0.2728 0.2728 0.2728 0.2728 0.2700 0.2666 0.2666 0.2666 0.2663 
  4718   4872   4999   5497   5564   5932   6024   6032   6448   6726   6823   6884   9363   9449   8805   8809 
0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2663 0.2647 0.2647 
  8811   2298   4100   8986   8994   8143   8152   6957   7027   7085   7102   8306   8374   8547   8637   8689 
0.2647 0.2641 0.2641 0.2641 0.2641 0.2589 0.2589 0.2586 0.2586 0.2586 0.2586 0.2570 0.2570 0.2570 0.2570 0.2570 
  2229   2814   4253   4378   4420   4439   4781   4926   5160   5368   5516   5528   6181   6768   6873   7038 
0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 0.2555 
  7057   1287   1873   1997   2112   2294   2375   2518   2789   2801   3759   9016   9026   9045   7840   7929 
0.2555 0.2549 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2546 0.2534 0.2534 
  7964    406   8149   8155   8176   8254   8463   3713   6644   6653   6976   7322   7336   9516   9549   8741 
0.2534 0.2495 0.2495 0.2495 0.2495 0.2474 0.2474 0.2471 0.2471 0.2471 0.2471 0.2471 0.2471 0.2471 0.2471 0.2454 
  8765   8813   8820   1711   1764   2574   2849   2855   2859   2912   2993   3173   3746   4039   4113   4265 
0.2454 0.2454 0.2454 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 
  4288   4511   4715   4878   4930   5151   5409   5580   5658   5684   6057   6205   6419   8907   8956   9058 
0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 0.2451 
  9299   9324   9346   9456   9468   1361   8844   8130    624    943   8270   8391   8423   8502   8690    783 
0.2451 0.2451 0.2451 0.2451 0.2451 0.2415 0.2415 0.2401 0.2381 0.2381 0.2381 0.2381 0.2381 0.2381 0.2381 0.2363 
  7101   7330   7391   7394   7536   8762   9547   1733   2052   2107   2138   2429   2434   2671   2828   2942 
0.2363 0.2363 0.2363 0.2363 0.2363 0.2363 0.2363 0.2358 0.2358 0.2358 0.2358 0.2358 0.2358 0.2358 0.2358 0.2358 
  2972   3321   3779   3973   8945   8983   9006    115   4224   4674   4870   4889   5074   5276   5295   5387 
0.2358 0.2358 0.2358 0.2358 0.2358 0.2358 0.2358 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 
  5426   5486   5722   5736   5737   5770   5936   6246   6457   6734   7017   7696   8061   9223   9357   9402 
0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 0.2349 
  9405   9442   1524   1554   8158   1022   8275   8345   8429   8453   8647   8790   1862   2067   2302   2416 
0.2349 0.2349 0.2326 0.2326 0.2309 0.2292 0.2292 0.2292 0.2292 0.2292 0.2292 0.2273 0.2270 0.2270 0.2270 0.2270 
  2509   2529   2596   2619   2848   2851   2875   2882   3040   3372   3432   3970   4098   8892   8946   9163 
0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 0.2270 
    87   7110   7172   7206   7300   7346   7372   7471   7568   7704   7801   7894   7973   9559   4552   4597 
0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2259 0.2253 0.2253 
  4671   4714   4803   4944   4974   5018   5055   5116   5310   5346   5399   5460   5576   5634   5710   5812 
0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 
  6050   6053   6219   6282   6313   6639   6660   6687   6778   6859   6916   9222   9375   9409   9431   1617 
0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2253 0.2236 
   369   8147   8175   8219    764   8307   8412   8415   8442   8501   8600   8778   8814   1747   2247   2451 
0.2223 0.2223 0.2223 0.2223 0.2203 0.2203 0.2203 0.2203 0.2203 0.2203 0.2203 0.2187 0.2187 0.2182 0.2182 0.2182 
  2488   2531   2640   2676   2890   3180   3351   3567   3658   3697   4035   8991   9005   9022   9044   9069 
0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 0.2182 
  9176     74   7764   7793   7882   2747   3398   4227   4360   4517   4866   4948   5021   5032   5033   5225 
0.2182 0.2171 0.2171 0.2171 0.2171 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 
  5274   5277   5359   5462   5479   5696   5721   5794   5947   6074   6453   6599   6751   6920   7302   7340 
0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 
  7633   9191   9355   9471   9474   9476   9479   9536   1454   1537    360   8154   8191    548   7718   8408 
0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2157 0.2149 0.2149 0.2136 0.2136 0.2136 0.2120 0.2120 0.2120 
  8422   8458   8479   8492   8514   8589   8639   1285   8731   8776   8812   2351   2455   2466   2482   2506 
0.2120 0.2120 0.2120 0.2120 0.2120 0.2120 0.2120 0.2101 0.2101 0.2101 0.2101 0.2099 0.2099 0.2099 0.2099 0.2099 
  2610   2684   2688   2727   2857   2949   2971   3018   3445   3621   3635   3839   3910   3977   8888   8962 
0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 0.2099 
  9011   9035   9068   7758   1427   8867   3617   4268   4416   4510   4529   4619   4622   4633   4757   5127 
0.2099 0.2099 0.2099 0.2088 0.2067 0.2067 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 
  5246   5466   5723   5756   5757   6311   6329   6350   6472   6619   6769   6818   6832   7065   8961   9211 
0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 0.2065 
  9234   9263   9328   9429   5990   6888   7082   7174   7390   7562   7581   9551   8167   8222    884    966 
0.2065 0.2065 0.2065 0.2065 0.2059 0.2059 0.2059 0.2059 0.2059 0.2059 0.2059 0.2059 0.2054 0.2054 0.2036 0.2036 
  1062   8277   8278   8461   8493   8542   8617   8622   8669   8721   8818   1443   1485   1729   1933   2102 
0.2036 0.2036 0.2036 0.2036 0.2036 0.2036 0.2036 0.2036 0.2036 0.2036 0.2018 0.2015 0.2015 0.2015 0.2015 0.2015 
  2131   2173   2191   2410   2465   2493   2776   2823   2845   2862   3401   3443   3696   3763   8931   8974 
0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 0.2015 
  9000   9085   9100   9141   9171    238   7778   7863   7906   7926   7980   7987   7990   8060   8063   8072 
0.2015 0.2015 0.2015 0.2015 0.2015 0.2005 0.2005 0.2005 0.2005 0.2005 0.2005 0.2005 0.2005 0.2005 0.2005 0.2005 
  1484   1487   1488   3315   4137   4450   4498   4507   4508   4643   4673   4727   4739   4791   4848   4924 
0.1985 0.1985 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 
  4951   5014   5019   5102   5149   5220   5266   5485   5515   5522   5754   5779   5795   5813   5845   5854 
0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 
  5942   5998   6007   6038   6066   6177   6355   6400   6568   6771   7006   7012   9256   9406   8101   8131 
0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1975 0.1972 0.1972 
  8171   8207   7143   7156   7317   7433   7674   7675    543    626    981   8344   8402   8468   8506   8529 
0.1972 0.1972 0.1965 0.1965 0.1965 0.1965 0.1965 0.1965 0.1955 0.1955 0.1955 0.1955 0.1955 0.1955 0.1955 0.1955 
  8552   8631   8715   8722   1350   8769   1703   1882   1983   2011   2024   2111   2179   2192   2332   2450 
0.1955 0.1955 0.1955 0.1955 0.1940 0.1940 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 
  2622   2771   2777   2868   2870   2873   3034   3137   3251   3422   3494   3657   3864   4015   4029   4053 
0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 0.1937 
  8781   8942   9161   7790   7825   7865   7874   7895   7945   7948   1470   1510    461   8225   8226   2166 
0.1937 0.1937 0.1937 0.1927 0.1927 0.1927 0.1927 0.1927 0.1927 0.1927 0.1907 0.1907 0.1893 0.1893 0.1893 0.1890 
  3143   3414   4216   4228   4274   4328   4491   4527   4689   4707   4759   4941   5083   5107   5413   5416 
0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 
  5448   5452   5491   5512   5570   5610   5666   5672   5827   5832   6116   6155   6198   6458   6757   6963 
0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 
  6974   7037   9243   9252   9259   9358    477    565    580    597    710    891    974   1019   1184   8255 
0.1890 0.1890 0.1890 0.1890 0.1890 0.1890 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 
  8257   8395   8400   8427   8503   8601   8602   8618   8650   8652   8672   8728   7078   7190   7218   7271 
0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1878 0.1873 0.1873 0.1873 0.1873 
  7375   7543   7550   7676   7697   9557   9565   7717   1072   1814   1968   2141   2145   2325   2349   2374 
0.1873 0.1873 0.1873 0.1873 0.1873 0.1873 0.1873 0.1861 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 
  2392   2415   2589   2600   2613   2765   2844   2904   2953   3036   3154   3198   3227   3289   3305   3482 
0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 
  3508   3512   3584   3595   3755   3824   3860   3993   8896   8935   8982   9103   9105   9180     28   7833 
0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1859 0.1849 0.1849 
  7878   7887   7955   7959   7999   1481   1648   1686   1811   8826   8186      3   3389   3881   4144   4214 
0.1849 0.1849 0.1849 0.1849 0.1849 0.1830 0.1830 0.1830 0.1830 0.1830 0.1818 0.1806 0.1806 0.1806 0.1806 0.1806 
  4219   4286   4347   4408   4571   4687   4694   4704   4830   4970   5205   5243   5344   5345   5483   5508 
0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 
  5529   5571   5640   5729   5759   5826   5872   6044   6158   6251   6272   6331   6377   6405   6441   6552 
0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 
  6723   6871   6907   6932   6994   9228   9288   9336   9403   9413    496    504    735    737    756    889 
0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1806 0.1802 0.1802 0.1802 0.1802 0.1802 0.1802 
   904   1020   1167   8246   8563   8574   8599   8668   8693   8714   2147   6281   7202   7235   7334   7484 
0.1802 0.1802 0.1802 0.1802 0.1802 0.1802 0.1802 0.1802 0.1802 0.1802 0.1785 0.1785 0.1785 0.1785 0.1785 0.1785 
  7537   7613   9398   1860   1930   1972   1996   2013   2033   2061   2066   2070   2236   2250   2379   2423 
0.1785 0.1785 0.1785 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 
  2511   2520   2647   2701   2760   2763   2772   2819   2937   3006   3151   3268   3337   3408   3523   3613 
0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 
  3633   3752   3776   8936   8984   9008   9065   9080   9082   9117   9189   7867   7961   8042   8076   1547 
0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1783 0.1774 0.1774 0.1774 0.1774 0.1757 
  1556   1633   8858    309    310    389    393    415    453   8134     12    542    728    754    832    879 
0.1757 0.1757 0.1757 0.1744 0.1744 0.1744 0.1744 0.1744 0.1744 0.1744 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 
   921   1023   1107   1176   8279   8310   8459   8474   8489   8491   8606   8607   8627   4135   4146   4395 
0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1730 0.1725 0.1725 0.1725 
  4422   4458   4459   4493   4501   4555   4971   5057 
0.1725 0.1725 0.1725 0.1725 0.1725 0.1725 0.1725 0.1725 
 [ reached getOption("max.print") -- omitted 1873 entries ]

sum(Pred2 > 0.5)

[1] 0

【3.3 高底線模型的辨識率】What is the test set AUC of the bivariate model?

library(ROCR)
ROCRpredTest = prediction(Pred2, test$not.fully.paid)
auc = as.numeric(performance(ROCRpredTest, "auc")@y.values)
auc

[1] 0.6239

---

4 預估投資獲利 Computing the Profitability of an Investment

【4.1 投資價值的算法】How much does a $10 investment with an annual interest rate of 6% pay back after 3 years, using continuous compounding of interest?

10*exp(0.06*3)

[1] 11.97

【4.2 投資獲利的算法，合約完成】While the investment has value c * exp(rt) dollars after collecting interest, the investor had to pay $c for the investment. What is the profit to the investor if the investment is paid back in full?

# c * exp(rt) - c 

【4.3 投資獲利的算法，違約】Now, consider the case where the investor made a $c investment, but it was not paid back in full. Assume, conservatively, that no money was received from the borrower (often a lender will receive some but not all of the value of the loan, making this a pessimistic assumption of how much is received). What is the profit to the investor in this scenario?

# c * exp(rt) - c correct
# -c 

---

5 簡單投資策略 A Simple Investment Strategy

【5.1 計算測試資料的實際投報率】What is the maximum profit of a $10 investment in any loan in the testing set?

test$profit = exp(test$int.rate*3) - 1
test$profit[test$not.fully.paid == 1] = -1
10*max(test$profit)

[1] 8.895

---

6 面對不確定性的投資策略 An Investment Strategy Based on Risk

A simple investment strategy of equally investing in all the loans would yield profit $20.94 for a $100 investment. But this simple investment strategy does not leverage the prediction model we built earlier in this problem.

【6.1 高利率、高風險】What is the average profit of a $1 investment in one of these high-interest loans (do not include the $ sign in your answer)? What proportion of the high-interest loans were not paid back in full?

highInterest = subset(test,int.rate>0.15)
mean(highInterest$profit)

[1] 0.2251

table(highInterest$not.fully.paid)

  0   1 
327 110 

110/(110+327)

[1] 0.2517

【6.2 高利率之中的低風險】What is the profit of the investor, who invested $1 in each of these 100 loans? How many of 100 selected loans were not paid back in full?

cutoff = sort(highInterest$predicted.risk, decreasing=FALSE)[100]
selectedLoans = subset(highInterest,predicted.risk<=0.1764)
sum(selectedLoans$profit)

[1] 31.28

sum(selectedLoans$not.fully.paid==1)

[1] 19

---

【Q】利用我們建好的模型，你可以設計出比上述的方法獲利更高的投資方法嗎？請詳述你的作法？

rate = seq(0.060,0.216,0.001)
profit = data.frame(interest=c(), profit=c())
for(x in rate){
  mediumInterest<-subset(test,int.rate>=x )
  if(nrow(mediumInterest)>=100){
    cutoff1 = sort(mediumInterest$predicted.risk, decreasing=FALSE)[100]
    selectedLoans1<-subset(mediumInterest,predicted.risk<=cutoff1)
  }
  else{
    selectedLoans1 = mediumInterest
  }
  p = sum(selectedLoans1$profit)
  
  x1 = data.frame(interest=x, profit=p)
  profit = rbind(profit,x1)
}
# View(profit)
# profit = profit[!is.nan(profit$profit),]
which.max(profit$profit)

[1] 98

profit[98,]

summary(train$int.rate)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.060   0.104   0.123   0.123   0.141   0.216 

mediumInterest<-subset(test,int.rate>=0.157 )
cutoff1 = sort(mediumInterest$predicted.risk, decreasing=FALSE)[100]
selectedLoans1<-subset(mediumInterest,predicted.risk<=cutoff1)
100*mean(selectedLoans1$profit)

[1] 38.93

100*mean(selectedLoans1$not.fully.paid)

[1] 16

# 我們以「高報酬、低風險」為決策目標，檢視test的資料裡的int.rate範圍，以for迴圈來取得前100的最佳解來獲得最高的獲利組合。(實際以將確定倒帳的結果考慮進去而確定選擇利率0.157為門檻能獲得的利益為38.93)

---