Exam 3

Part 1: Problem to be Completed in R Use R to complete the following question. Provide the instructor with the output from your code as either screenshots pasted in Word, or as output generated in an HTML document. Submit both your code and output in Brightspace. Make sure all textual explanations match the output that you provide the instructor.

  1. Load the credit_default dataset into R.
credit <- read.csv("C:/Users/raze1/OneDrive/Desktop/UIndy/MSDA 622/Exams/Exam 3/credit_default.csv")
summary(credit)
##    LIMIT_BAL            SEX          EDUCATION        MARRIAGE    
##  Min.   :  10000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:  50000   1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.000  
##  Median : 140000   Median :2.000   Median :2.000   Median :2.000  
##  Mean   : 167501   Mean   :1.603   Mean   :1.844   Mean   :1.552  
##  3rd Qu.: 240000   3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:2.000  
##  Max.   :1000000   Max.   :2.000   Max.   :4.000   Max.   :3.000  
##       AGE           PAY_0              PAY_2            PAY_3        
##  Min.   :21.0   Min.   :-2.00000   Min.   :-2.000   Min.   :-2.0000  
##  1st Qu.:28.0   1st Qu.:-1.00000   1st Qu.:-1.000   1st Qu.:-1.0000  
##  Median :34.0   Median : 0.00000   Median : 0.000   Median : 0.0000  
##  Mean   :35.5   Mean   :-0.01575   Mean   :-0.128   Mean   :-0.1667  
##  3rd Qu.:41.0   3rd Qu.: 0.00000   3rd Qu.: 0.000   3rd Qu.: 0.0000  
##  Max.   :79.0   Max.   : 8.00000   Max.   : 7.000   Max.   : 7.0000  
##      PAY_4             PAY_5             PAY_6           BILL_AMT1     
##  Min.   :-2.0000   Min.   :-2.0000   Min.   :-2.0000   Min.   :-15308  
##  1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:  3690  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 22658  
##  Mean   :-0.2256   Mean   :-0.2678   Mean   :-0.2931   Mean   : 51392  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 67207  
##  Max.   : 7.0000   Max.   : 7.0000   Max.   : 8.0000   Max.   :964511  
##    BILL_AMT2        BILL_AMT3         BILL_AMT4        BILL_AMT5     
##  Min.   :-33350   Min.   :-157264   Min.   :-81334   Min.   :-81334  
##  1st Qu.:  3156   1st Qu.:   2980   1st Qu.:  2411   1st Qu.:  1863  
##  Median : 21652   Median :  20330   Median : 19078   Median : 18244  
##  Mean   : 49246   Mean   :  47080   Mean   : 43102   Mean   : 40314  
##  3rd Qu.: 63787   3rd Qu.:  59662   3rd Qu.: 53117   3rd Qu.: 49927  
##  Max.   :983931   Max.   : 855086   Max.   :891586   Max.   :927171  
##    BILL_AMT6          PAY_AMT1         PAY_AMT2            PAY_AMT3     
##  Min.   :-339603   Min.   :     0   Min.   :      0.0   Min.   :     0  
##  1st Qu.:   1309   1st Qu.:  1000   1st Qu.:    944.8   1st Qu.:   400  
##  Median :  17130   Median :  2128   Median :   2013.0   Median :  1827  
##  Mean   :  38821   Mean   :  5766   Mean   :   6250.1   Mean   :  5195  
##  3rd Qu.:  48938   3rd Qu.:  5006   3rd Qu.:   5000.0   3rd Qu.:  4505  
##  Max.   : 961664   Max.   :493358   Max.   :1227082.0   Max.   :896040  
##     PAY_AMT4         PAY_AMT5         PAY_AMT6       
##  Min.   :     0   Min.   :     0   Min.   :     0.0  
##  1st Qu.:   300   1st Qu.:   300   1st Qu.:   142.8  
##  Median :  1500   Median :  1518   Median :  1500.0  
##  Mean   :  4878   Mean   :  4868   Mean   :  5432.7  
##  3rd Qu.:  4078   3rd Qu.:  4121   3rd Qu.:  4061.8  
##  Max.   :432130   Max.   :426529   Max.   :528666.0  
##  default.payment.next.month
##  Min.   :0.0000            
##  1st Qu.:0.0000            
##  Median :0.0000            
##  Mean   :0.2193            
##  3rd Qu.:0.0000            
##  Max.   :1.0000
head(credit)
##   LIMIT_BAL SEX EDUCATION MARRIAGE AGE PAY_0 PAY_2 PAY_3 PAY_4 PAY_5 PAY_6
## 1    290000   2         2        2  26     0     0     0     0    -1    -1
## 2     20000   1         2        2  51    -1    -1    -2    -1    -1    -2
## 3    280000   1         1        2  29    -2    -2    -2    -2    -2    -2
## 4    280000   2         1        2  47     0     0     0     0     0     0
## 5     20000   1         2        2  24     0     0     0     0     0     0
## 6     50000   1         1        2  26    -2    -2    -2    -2    -2    -2
##   BILL_AMT1 BILL_AMT2 BILL_AMT3 BILL_AMT4 BILL_AMT5 BILL_AMT6 PAY_AMT1 PAY_AMT2
## 1     18125     20807     99860    100000      3015     23473     3000    80000
## 2       780         0     -1500       780         0         0        0        0
## 3     10660      5123      8467      2510       591     14994     5123     8467
## 4    269124    266163    215177    184270    130954     92215    11268     8196
## 5     17924     18475     19539     19396     11643     11578     1400     1380
## 6      2411      3059      2333      1800      1620         0     3068     2440
##   PAY_AMT3 PAY_AMT4 PAY_AMT5 PAY_AMT6 default.payment.next.month
## 1     3000     3015    23473     1148                          0
## 2     2280        0        0        0                          0
## 3     2510      591    14994     5000                          0
## 4     6281     4403     3532     3510                          0
## 5     1181     1000      500      500                          0
## 6     1807     2204        0        0                          0
  1. Develop a neural network model with one hidden layer having 2 neurons. In developing this model, use 50% of the rows as your training set and the remaining 50% as your testing set. Use the binary variable default.payment.next.month as your target variable, and use all other columns of data as your covariates. Be sure to develop the neural network in such a way that your target is treated as binary.
maxs <- apply(credit, 2, max)
mins <- apply(credit, 2, min)
credit_scaled <- as.data.frame(scale(credit, center = mins, scale = maxs - mins))

sample_index <- sample(nrow(credit_scaled), nrow(credit_scaled)*0.5)
credit_train <- credit_scaled[sample_index,]
credit_test <- credit_scaled[-sample_index,]
head(credit_scaled)
##    LIMIT_BAL SEX EDUCATION MARRIAGE        AGE PAY_0     PAY_2     PAY_3
## 1 0.28282828   1 0.3333333      0.5 0.08620690   0.2 0.2222222 0.2222222
## 2 0.01010101   0 0.3333333      0.5 0.51724138   0.1 0.1111111 0.0000000
## 3 0.27272727   0 0.0000000      0.5 0.13793103   0.0 0.0000000 0.0000000
## 4 0.27272727   1 0.0000000      0.5 0.44827586   0.2 0.2222222 0.2222222
## 5 0.01010101   0 0.3333333      0.5 0.05172414   0.2 0.2222222 0.2222222
## 6 0.04040404   0 0.0000000      0.5 0.08620690   0.0 0.0000000 0.0000000
##       PAY_4     PAY_5 PAY_6  BILL_AMT1  BILL_AMT2 BILL_AMT3  BILL_AMT4
## 1 0.2222222 0.1111111   0.1 0.03412161 0.05323701 0.2539873 0.18638120
## 2 0.1111111 0.1111111   0.0 0.01641936 0.03278347 0.1538638 0.08439954
## 3 0.0000000 0.0000000   0.0 0.02650285 0.03781944 0.1637092 0.08617769
## 4 0.2222222 0.2222222   0.2 0.29029035 0.29442504 0.3678975 0.27299675
## 5 0.2222222 0.2222222   0.2 0.03391647 0.05094463 0.1746461 0.10353369
## 6 0.0000000 0.0000000   0.0 0.01808395 0.03579050 0.1576500 0.08544793
##    BILL_AMT5 BILL_AMT6    PAY_AMT1    PAY_AMT2    PAY_AMT3    PAY_AMT4
## 1 0.08363766 0.2790173 0.006080777 0.065195317 0.003348065 0.006977067
## 2 0.08064809 0.2609787 0.000000000 0.000000000 0.002544529 0.000000000
## 3 0.08123410 0.2725013 0.010383940 0.006900109 0.002801214 0.001367644
## 4 0.21049772 0.3318443 0.022839399 0.006679260 0.007009732 0.010189063
## 5 0.09219290 0.2698762 0.002837696 0.001124619 0.001318022 0.002314118
## 6 0.08225443 0.2609787 0.006218608 0.001988457 0.002016651 0.005100317
##      PAY_AMT5     PAY_AMT6 default.payment.next.month
## 1 0.055032600 0.0021715034                          0
## 2 0.000000000 0.0000000000                          0
## 3 0.035153530 0.0094577673                          0
## 4 0.008280797 0.0066393526                          0
## 5 0.001172253 0.0009457767                          0
## 6 0.000000000 0.0000000000                          0
head(credit)
##   LIMIT_BAL SEX EDUCATION MARRIAGE AGE PAY_0 PAY_2 PAY_3 PAY_4 PAY_5 PAY_6
## 1    290000   2         2        2  26     0     0     0     0    -1    -1
## 2     20000   1         2        2  51    -1    -1    -2    -1    -1    -2
## 3    280000   1         1        2  29    -2    -2    -2    -2    -2    -2
## 4    280000   2         1        2  47     0     0     0     0     0     0
## 5     20000   1         2        2  24     0     0     0     0     0     0
## 6     50000   1         1        2  26    -2    -2    -2    -2    -2    -2
##   BILL_AMT1 BILL_AMT2 BILL_AMT3 BILL_AMT4 BILL_AMT5 BILL_AMT6 PAY_AMT1 PAY_AMT2
## 1     18125     20807     99860    100000      3015     23473     3000    80000
## 2       780         0     -1500       780         0         0        0        0
## 3     10660      5123      8467      2510       591     14994     5123     8467
## 4    269124    266163    215177    184270    130954     92215    11268     8196
## 5     17924     18475     19539     19396     11643     11578     1400     1380
## 6      2411      3059      2333      1800      1620         0     3068     2440
##   PAY_AMT3 PAY_AMT4 PAY_AMT5 PAY_AMT6 default.payment.next.month
## 1     3000     3015    23473     1148                          0
## 2     2280        0        0        0                          0
## 3     2510      591    14994     5000                          0
## 4     6281     4403     3532     3510                          0
## 5     1181     1000      500      500                          0
## 6     1807     2204        0        0                          0
library(neuralnet)
## Warning: package 'neuralnet' was built under R version 4.2.3
f <- as.formula("default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE + AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT1 + BILL_AMT2 + BILL_AMT3 + BILL_AMT4 + BILL_AMT5 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 + PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6")
credit_nn <- neuralnet(f, data=credit_train, hidden=c(2), algorithm = 'rprop+', linear.output = F)
  1. Create a plot of your neural network displaying all weights.
plot(credit_nn)
  1. Use your neural network model to develop predictions for the data in your testing set. When making your predictions, use the cut-off probability of 0.5, and display a confusion matrix for your predictions. How many rows of testing data were misclassified by the model? (Note: Be sure to upload a screenshot of the confusion matrix that you produce.)
pcut_nn <- 1/2
prob_nn_in <- predict(credit_nn, credit_train, type = "response")
pred_nn_in <- (prob_nn_in >= pcut_nn)*1
table(credit_train$default.payment.next.month, pred_nn_in, dnn = c("Observed", "Predicted"))  
##         Predicted
## Observed    0    1
##        0 4432  245
##        1  756  567
prob_nn_out <- predict(credit_nn, credit_test, type = "response")
pred_nn_out <- (prob_nn_out >= pcut_nn)*1
table(credit_test$default.payment.next.month, pred_nn_out, dnn = c("Observed", "Predicted"))
##         Predicted
## Observed    0    1
##        0 4400  291
##        1  802  507

1,083 Rows were misclassified.