1 資料整理 Preparing the Datase
【1.1 基礎機率】What proportion of the loans in the dataset were not paid in full?
loans=read.csv('./data/loans.csv')
str(loans)'data.frame': 9578 obs. of 14 variables:
$ credit.policy : int 1 1 1 1 1 1 1 1 1 1 ...
$ purpose : Factor w/ 7 levels "all_other","credit_card",..: 3 2 3 3 2 2 3 1 5 3 ...
$ int.rate : num 0.119 0.107 0.136 0.101 0.143 ...
$ installment : num 829 228 367 162 103 ...
$ log.annual.inc : num 11.4 11.1 10.4 11.4 11.3 ...
$ dti : num 19.5 14.3 11.6 8.1 15 ...
$ fico : int 737 707 682 712 667 727 667 722 682 707 ...
$ days.with.cr.line: num 5640 2760 4710 2700 4066 ...
$ revol.bal : int 28854 33623 3511 33667 4740 50807 3839 24220 69909 5630 ...
$ revol.util : num 52.1 76.7 25.6 73.2 39.5 51 76.8 68.6 51.1 23 ...
$ inq.last.6mths : int 0 0 1 1 0 0 0 0 1 1 ...
$ delinq.2yrs : int 0 0 0 0 1 0 0 0 0 0 ...
$ pub.rec : int 0 0 0 0 0 0 1 0 0 0 ...
$ not.fully.paid : int 0 0 0 0 0 0 1 1 0 0 ...table(loans$not.fully.paid)
0 1
8045 1533 【1.2 檢查缺項】Which of the following variables has at least one missing observation?
summary(loans) credit.policy purpose
Min. :0.000 all_other :2331
1st Qu.:1.000 credit_card :1262
Median :1.000 debt_consolidation:3957
Mean :0.805 educational : 343
3rd Qu.:1.000 home_improvement : 629
Max. :1.000 major_purchase : 437
small_business : 619
int.rate installment log.annual.inc
Min. :0.0600 Min. : 15.67 Min. : 7.548
1st Qu.:0.1039 1st Qu.:163.77 1st Qu.:10.558
Median :0.1221 Median :268.95 Median :10.928
Mean :0.1226 Mean :319.09 Mean :10.932
3rd Qu.:0.1407 3rd Qu.:432.76 3rd Qu.:11.290
Max. :0.2164 Max. :940.14 Max. :14.528
NA's :4
dti fico days.with.cr.line
Min. : 0.000 Min. :612.0 Min. : 179
1st Qu.: 7.213 1st Qu.:682.0 1st Qu.: 2820
Median :12.665 Median :707.0 Median : 4140
Mean :12.607 Mean :710.8 Mean : 4562
3rd Qu.:17.950 3rd Qu.:737.0 3rd Qu.: 5730
Max. :29.960 Max. :827.0 Max. :17640
NA's :29
revol.bal revol.util inq.last.6mths
Min. : 0 Min. : 0.00 Min. : 0.000
1st Qu.: 3187 1st Qu.: 22.70 1st Qu.: 0.000
Median : 8596 Median : 46.40 Median : 1.000
Mean : 16914 Mean : 46.87 Mean : 1.572
3rd Qu.: 18250 3rd Qu.: 71.00 3rd Qu.: 2.000
Max. :1207359 Max. :119.00 Max. :33.000
NA's :62 NA's :29
delinq.2yrs pub.rec not.fully.paid
Min. : 0.0000 Min. :0.0000 Min. :0.0000
1st Qu.: 0.0000 1st Qu.:0.0000 1st Qu.:0.0000
Median : 0.0000 Median :0.0000 Median :0.0000
Mean : 0.1638 Mean :0.0621 Mean :0.1601
3rd Qu.: 0.0000 3rd Qu.:0.0000 3rd Qu.:0.0000
Max. :13.0000 Max. :5.0000 Max. :1.0000
NA's :29 NA's :29 【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))
table(missing$not.fully.paid)
0 1
50 12 12/62[1] 0.1935484##We want to be able to predict risk for all borrowers, instead of just the ones with all data reported.【1.4 補缺項工具】What best describes the process we just used to handle missing values?
library(mice)package 愼㸱愼㸵mice愼㸱愼㸶 was built under R version 3.4.4Loading required package: lattice
Attaching package: 愼㸱愼㸵mice愼㸱愼㸶
The following objects are masked from 愼㸱愼㸵package:base愼㸱愼㸶:
cbind, rbindset.seed(144)
vars.for.imputation = setdiff(names(loans), "not.fully.paid")
imputed = complete(mice(loans[vars.for.imputation]))
iter imp variable
1 1 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
1 2 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
1 3 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
1 4 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
1 5 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
2 1 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
2 2 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
2 3 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
2 4 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
2 5 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
3 1 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
3 2 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
3 3 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
3 4 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
3 5 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
4 1 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
4 2 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
4 3 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
4 4 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
4 5 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
5 1 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
5 2 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
5 3 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
5 4 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.rec
5 5 log.annual.inc days.with.cr.line revol.util inq.last.6mths delinq.2yrs pub.recloans[vars.for.imputation] = imputed2 建立模型 Prediction Models
【2.1 顯著性】Which independent variables are significant in our model?
library(caTools)package 愼㸱愼㸵caTools愼㸱愼㸶 was built under R version 3.4.4set.seed(144)
spl = sample.split(loans$not.fully.paid, 0.7)
train = subset(loans, spl == TRUE)
test = subset(loans, spl == FALSE)
mod = glm(not.fully.paid~., data=train, family="binomial")
summary(mod)
Call:
glm(formula = not.fully.paid ~ ., family = "binomial", data = train)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.1867 -0.6206 -0.4949 -0.3610 2.6395
Coefficients:
Estimate Std. Error z value
(Intercept) 9.158e+00 1.555e+00 5.889
credit.policy -3.492e-01 1.008e-01 -3.464
purposecredit_card -6.144e-01 1.344e-01 -4.571
purposedebt_consolidation -3.217e-01 9.183e-02 -3.503
purposeeducational 1.358e-01 1.753e-01 0.775
purposehome_improvement 1.744e-01 1.479e-01 1.179
purposemajor_purchase -4.814e-01 2.008e-01 -2.398
purposesmall_business 4.134e-01 1.418e-01 2.915
int.rate 6.221e-01 2.085e+00 0.298
installment 1.273e-03 2.092e-04 6.085
log.annual.inc -4.313e-01 7.145e-02 -6.036
dti 4.627e-03 5.500e-03 0.841
fico -9.294e-03 1.708e-03 -5.440
days.with.cr.line 2.187e-06 1.588e-05 0.138
revol.bal 3.035e-06 1.166e-06 2.602
revol.util 1.916e-03 1.533e-03 1.250
inq.last.6mths 8.074e-02 1.587e-02 5.088
delinq.2yrs -8.338e-02 6.554e-02 -1.272
pub.rec 3.310e-01 1.138e-01 2.910
Pr(>|z|)
(Intercept) 3.89e-09 ***
credit.policy 0.000532 ***
purposecredit_card 4.85e-06 ***
purposedebt_consolidation 0.000460 ***
purposeeducational 0.438530
purposehome_improvement 0.238512
purposemajor_purchase 0.016504 *
purposesmall_business 0.003558 **
int.rate 0.765406
installment 1.16e-09 ***
log.annual.inc 1.58e-09 ***
dti 0.400131
fico 5.32e-08 ***
days.with.cr.line 0.890435
revol.bal 0.009279 **
revol.util 0.211336
inq.last.6mths 3.62e-07 ***
delinq.2yrs 0.203296
pub.rec 0.003614 **
---
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: 5487.4 on 6686 degrees of freedom
AIC: 5525.4
Number of Fisher Scoring iterations: 5【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)?
-0.009317 * (-10) [1] 0.09317##ln(oddA)-ln(oddB) = 10 * FICO
exp(0.09317)[1] 1.097648【2.3 混淆矩陣、正確率 vs 底線機率】What is the accuracy of the logistic regression model? What is the accuracy of the baseline model?
test$predicted.risk = predict(mod, newdata=test, type="response")
table(test$not.fully.paid, test$predicted.risk > 0.5)
FALSE TRUE
0 2400 13
1 457 3【2.4 ROC & AUC】Use the ROCR package to compute the test set AUC.
library(ROCR)package 愼㸱愼㸵ROCR愼㸱愼㸶 was built under R version 3.4.4Loading required package: gplots
package 愼㸱愼㸵gplots愼㸱愼㸶 was built under R version 3.4.4
Attaching package: 愼㸱愼㸵gplots愼㸱愼㸶
The following object is masked from 愼㸱愼㸵package:stats愼㸱愼㸶:
lowesspred = prediction(test$predicted.risk, test$not.fully.paid)
as.numeric(performance(pred, "auc")@y.values)[1] 0.6718878【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?
bivariate = glm(not.fully.paid~int.rate, data=train, family="binomial")
summary(bivariate)
Call:
glm(formula = not.fully.paid ~ int.rate, family = "binomial",
data = train)
Deviance Residuals:
Min 1Q Median 3Q Max
-1.0547 -0.6271 -0.5442 -0.4361 2.2914
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -3.6726 0.1688 -21.76 <2e-16 ***
int.rate 15.9214 1.2702 12.54 <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: 5738.8
Number of Fisher Scoring iterations: 4cor(train$int.rate, train$fico)[1] -0.711659【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?
pred.bivariate = predict(bivariate, newdata=test, type="response")
summary(pred.bivariate) Min. 1st Qu. Median Mean 3rd Qu. Max.
0.06196 0.11549 0.15077 0.15963 0.18928 0.42662 【3.3 高底線模型的辨識率】What is the test set AUC of the bivariate model?
prediction.bivariate = prediction(pred.bivariate, test$not.fully.paid)
as.numeric(performance(prediction.bivariate, "auc")@y.values)[1] 0.6239081【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.97217【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?
##the investor gets no money but paid c dollars, yielding a profit of -c dollars【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
summary(test$profit) Min. 1st Qu. Median Mean 3rd Qu. Max.
-1.0000 0.2858 0.4111 0.2094 0.4980 0.8895 【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)
summary(highInterest$profit) Min. 1st Qu. Median Mean 3rd Qu. Max.
-1.0000 -1.0000 0.5992 0.2251 0.6380 0.8895 table(highInterest$not.fully.paid)
0 1
327 110 【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 <= cutoff)
sum(selectedLoans$profit)[1] 31.27825table(selectedLoans$not.fully.paid)
0 1
81 19 sort(selectedLoans$profit, decreasing=FALSE) [1] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[5] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[9] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[13] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[17] -1.0000000 -1.0000000 -1.0000000 0.5706664
[21] 0.5706664 0.5706664 0.5706664 0.5744405
[25] 0.5801187 0.5829655 0.5829655 0.5829655
[29] 0.5829655 0.5829655 0.5829655 0.5829655
[33] 0.5829655 0.5829655 0.5829655 0.5829655
[37] 0.5839156 0.5839156 0.5839156 0.5858174
[41] 0.5858174 0.5858174 0.5858174 0.5858174
[45] 0.5858174 0.5858174 0.5896280 0.5991944
[49] 0.5991944 0.5991944 0.5991944 0.6006343
[53] 0.6006343 0.6006343 0.6006343 0.6006343
[57] 0.6006343 0.6015950 0.6015950 0.6015950
[61] 0.6044805 0.6102670 0.6160744 0.6160744
[65] 0.6160744 0.6160744 0.6160744 0.6165593
[69] 0.6194717 0.6194717 0.6194717 0.6194717
[73] 0.6316634 0.6316634 0.6316634 0.6316634
[77] 0.6331326 0.6331326 0.6331326 0.6331326
[81] 0.6380393 0.6380393 0.6469087 0.6503708
[85] 0.6503708 0.6503708 0.6503708 0.6627951
[89] 0.6627951 0.6748105 0.6748105 0.6748105
[93] 0.6783313 0.7026741 0.7026741 0.7088147
[97] 0.7124070 0.7268518 0.7751768 0.8507667【Q】利用我們建好的模型，你可以設計出比上述的方法獲利更高的投資方法嗎？請詳述你的作法？
highInterest = subset(test, int.rate >= 0.16)
summary(highInterest$profit) Min. 1st Qu. Median Mean 3rd Qu. Max.
-1.0000 -1.0000 0.6331 0.1994 0.6824 0.8895 table(highInterest$not.fully.paid)
0 1
187 74 cutoff = sort(highInterest$predicted.risk, decreasing=FALSE)[100]
selectedLoans = subset(highInterest, predicted.risk <= cutoff)
sum(selectedLoans$profit)[1] 34.18946table(selectedLoans$not.fully.paid)
0 1
81 19 sort(selectedLoans$profit, decreasing=FALSE) [1] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[5] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[9] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[13] -1.0000000 -1.0000000 -1.0000000 -1.0000000
[17] -1.0000000 -1.0000000 -1.0000000 0.6160744
[21] 0.6160744 0.6160744 0.6160744 0.6160744
[25] 0.6160744 0.6160744 0.6160744 0.6160744
[29] 0.6160744 0.6160744 0.6160744 0.6160744
[33] 0.6160744 0.6160744 0.6160744 0.6165593
[37] 0.6165593 0.6165593 0.6194717 0.6194717
[41] 0.6194717 0.6194717 0.6194717 0.6233631
[45] 0.6316634 0.6316634 0.6316634 0.6316634
[49] 0.6331326 0.6331326 0.6331326 0.6331326
[53] 0.6331326 0.6331326 0.6331326 0.6331326
[57] 0.6331326 0.6331326 0.6331326 0.6331326
[61] 0.6331326 0.6355841 0.6380393 0.6380393
[65] 0.6380393 0.6385308 0.6469087 0.6469087
[69] 0.6478971 0.6503708 0.6503708 0.6503708
[73] 0.6503708 0.6503708 0.6627951 0.6627951
[77] 0.6627951 0.6672907 0.6672907 0.6748105
[81] 0.6748105 0.6748105 0.6783313 0.6945208
[85] 0.7026741 0.7026741 0.7088147 0.7108666
[89] 0.7113799 0.7124070 0.7206463 0.7268518
[93] 0.7315206 0.7382867 0.7476989 0.7608559
[97] 0.7703902 0.7751768 0.8314353 0.8507667