Confusion.Matrix.HW.

remove(list=ls())

library(visdat)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(tidyr)
library(stargazer)

Please cite as: 

 Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.

 R package version 5.2.3. https://CRAN.R-project.org/package=stargazer 

library(caret)

Loading required package: ggplot2

Loading required package: lattice

df_train <-  read.csv("C:/Users/Dell/Downloads/insurance-training-data2.csv")
df_test <- read.csv("C:/Users/Dell/Downloads/insurance-testing-data2.csv")

vis_dat(df_test)

str(df_test)

'data.frame':   1633 obs. of  26 variables:
 $ INDEX      : int  5 8 26 40 45 55 61 66 67 71 ...
 $ TARGET_FLAG: int  0 0 1 0 0 0 1 0 1 1 ...
 $ TARGET_AMT : num  0 0 3627 0 0 ...
 $ KIDSDRIV   : int  0 0 0 0 0 0 0 0 1 0 ...
 $ AGE        : int  51 54 43 52 38 47 40 56 45 33 ...
 $ HOMEKIDS   : int  0 0 0 0 0 0 0 0 1 4 ...
 $ YOJ        : int  14 NA 13 8 11 8 11 16 14 12 ...
 $ INCOME     : chr  "" "$18,755" "$37,214" "$51,278" ...
 $ PARENT1    : chr  "No" "No" "No" "No" ...
 $ HOME_VAL   : chr  "$306,251" "" "" "$230,340" ...
 $ MSTATUS    : chr  "Yes" "Yes" "Yes" "Yes" ...
 $ SEX        : chr  "M" "z_F" "M" "z_F" ...
 $ EDUCATION  : chr  "<High School" "<High School" "<High School" "Bachelors" ...
 $ JOB        : chr  "z_Blue Collar" "z_Blue Collar" "z_Blue Collar" "Professional" ...
 $ TRAVTIME   : int  32 33 52 37 47 35 20 30 50 46 ...
 $ CAR_USE    : chr  "Private" "Private" "Commercial" "Private" ...
 $ BLUEBOOK   : chr  "$15,440" "$8,780" "$26,560" "$1,500" ...
 $ TIF        : int  7 1 1 4 1 6 4 13 6 13 ...
 $ CAR_TYPE   : chr  "Minivan" "z_SUV" "Panel Truck" "z_SUV" ...
 $ RED_CAR    : chr  "yes" "no" "yes" "no" ...
 $ OLDCLAIM   : chr  "$0" "$0" "$0" "$0" ...
 $ CLM_FREQ   : int  0 0 0 0 0 2 1 0 2 3 ...
 $ REVOKED    : chr  "No" "No" "No" "No" ...
 $ MVR_PTS    : int  0 0 3 1 2 5 13 0 0 0 ...
 $ CAR_AGE    : int  6 1 1 10 9 NA 6 6 13 1 ...
 $ URBANICITY : chr  "Highly Urban/ Urban" "Highly Urban/ Urban" "Highly Urban/ Urban" "Highly Urban/ Urban" ...

Data Cleaning

psych::describe(df_test)

            vars    n    mean      sd median trimmed     mad min      max
INDEX          1 1633 5131.84 2948.66   5047 5124.00 3765.80   5 10301.00
TARGET_FLAG    2 1633    0.26    0.44      0    0.21    0.00   0     1.00
TARGET_AMT     3 1633 1655.07 5288.83      0  597.33    0.00   0 73783.47
KIDSDRIV       4 1633    0.17    0.52      0    0.03    0.00   0     4.00
AGE            5 1630   44.54    8.53     45   44.50    8.90  16    72.00
HOMEKIDS       6 1633    0.73    1.16      0    0.50    0.00   0     5.00
YOJ            7 1554   10.45    4.05     11   11.01    2.97   0    19.00
INCOME*        8 1633  612.81  444.68    600  600.48  596.01   1  1404.00
PARENT1*       9 1633    1.14    0.34      1    1.04    0.00   1     2.00
HOME_VAL*     10 1633  355.27  356.23    264  320.19  388.44   1  1071.00
MSTATUS*      11 1633    1.40    0.49      1    1.38    0.00   1     2.00
SEX*          12 1633    1.54    0.50      2    1.55    0.00   1     2.00
EDUCATION*    13 1633    3.10    1.44      3    3.13    1.48   1     5.00
JOB*          14 1633    5.79    2.64      6    5.95    2.97   1     9.00
TRAVTIME      15 1633   33.66   15.68     33   33.25   16.31   5   113.00
CAR_USE*      16 1633    1.62    0.49      2    1.65    0.00   1     2.00
BLUEBOOK*     17 1633  584.78  355.65    572  584.64  475.91   1  1191.00
TIF           18 1633    5.29    4.13      4    4.76    4.45   1    22.00
CAR_TYPE*     19 1633    3.58    1.94      3    3.60    2.97   1     6.00
RED_CAR*      20 1633    1.29    0.45      1    1.23    0.00   1     2.00
OLDCLAIM*     21 1633  118.76  185.22      1   81.54    0.00   1   615.00
CLM_FREQ      22 1633    0.80    1.16      0    0.59    0.00   0     5.00
REVOKED*      23 1633    1.10    0.31      1    1.01    0.00   1     2.00
MVR_PTS       24 1633    1.68    2.16      1    1.29    1.48   0    13.00
CAR_AGE       25 1522    8.38    5.61      8    8.04    5.93   0    28.00
URBANICITY*   26 1633    1.20    0.40      1    1.12    0.00   1     2.00
               range  skew kurtosis     se
INDEX       10296.00  0.02    -1.18  72.97
TARGET_FLAG     1.00  1.07    -0.86   0.01
TARGET_AMT  73783.47  7.44    71.57 130.88
KIDSDRIV        4.00  3.54    13.68   0.01
AGE            56.00  0.02    -0.12   0.21
HOMEKIDS        5.00  1.42     0.91   0.03
YOJ            19.00 -1.22     1.25   0.10
INCOME*      1403.00  0.11    -1.29  11.00
PARENT1*        1.00  2.13     2.54   0.01
HOME_VAL*    1070.00  0.51    -1.19   8.82
MSTATUS*        1.00  0.39    -1.85   0.01
SEX*            1.00 -0.16    -1.98   0.01
EDUCATION*      4.00  0.12    -1.39   0.04
JOB*            8.00 -0.38    -1.13   0.07
TRAVTIME      108.00  0.37     0.32   0.39
CAR_USE*        1.00 -0.49    -1.76   0.01
BLUEBOOK*    1190.00  0.03    -1.27   8.80
TIF            21.00  0.92     0.44   0.10
CAR_TYPE*       5.00 -0.03    -1.49   0.05
RED_CAR*        1.00  0.94    -1.12   0.01
OLDCLAIM*     614.00  1.32     0.29   4.58
CLM_FREQ        5.00  1.19     0.18   0.03
REVOKED*        1.00  2.59     4.71   0.01
MVR_PTS        13.00  1.41     1.69   0.05
CAR_AGE        28.00  0.28    -0.71   0.14
URBANICITY*     1.00  1.52     0.30   0.01

table(df_test$TARGET_FLAG)

   0    1 
1202  431 

df_clean <- df_test %>%
  mutate(
    SEX = sub("^z_", "", SEX),
    JOB = sub("^z_", "", JOB)
  ) %>%
  drop_na(AGE, SEX, JOB,)

set.seed(123)  

train_index <- createDataPartition(
  df_clean$TARGET_FLAG,
  p = 0.7,
  list = FALSE
)

train <- df_clean[train_index, ]
test <- df_clean[-train_index, ]

Regression

reg1 <- glm(
  TARGET_FLAG ~ AGE + SEX + JOB,
  data = train,
  family = binomial(link = "logit")
)

summary(reg1)

Call:
glm(formula = TARGET_FLAG ~ AGE + SEX + JOB, family = binomial(link = "logit"), 
    data = train)

Coefficients:
                 Estimate Std. Error z value Pr(>|z|)  
(Intercept)     -0.859436   0.504266  -1.704   0.0883 .
AGE             -0.011286   0.008819  -1.280   0.2006  
SEXM            -0.024765   0.147805  -0.168   0.8669  
JOBBlue Collar   0.575240   0.322385   1.784   0.0744 .
JOBClerical      0.668716   0.343335   1.948   0.0515 .
JOBDoctor        0.203389   0.480339   0.423   0.6720  
JOBHome Maker    0.525190   0.379185   1.385   0.1660  
JOBLawyer       -0.507112   0.418398  -1.212   0.2255  
JOBManager      -0.789900   0.388110  -2.035   0.0418 *
JOBProfessional  0.151793   0.345814   0.439   0.6607  
JOBStudent       0.814623   0.364499   2.235   0.0254 *
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 1282.7  on 1140  degrees of freedom
Residual deviance: 1226.8  on 1130  degrees of freedom
AIC: 1248.8

Number of Fisher Scoring iterations: 4

test$predicted_prob <- predict(
  reg1,
  newdata = test,
  type = "response"
)

test$predicted <- ifelse(
  test$predicted_prob > 0.5,
  1,
  0
)

Confusion Matrix

nrow(test)

[1] 489

length(test$TARGET_FLAG)

[1] 489

length(test$predicted)

[1] 489

confusionMatrix(
  data = factor(test$predicted, levels = c(0,1)),
  reference = factor(test$TARGET_FLAG, levels = c(0,1)),
  positive = "1"
)

Confusion Matrix and Statistics

          Reference
Prediction   0   1
         0 345 144
         1   0   0
                                          
               Accuracy : 0.7055          
                 95% CI : (0.6629, 0.7456)
    No Information Rate : 0.7055          
    P-Value [Acc > NIR] : 0.5225          
                                          
                  Kappa : 0               
                                          
 Mcnemar's Test P-Value : <2e-16          
                                          
            Sensitivity : 0.0000          
            Specificity : 1.0000          
         Pos Pred Value :    NaN          
         Neg Pred Value : 0.7055          
             Prevalence : 0.2945          
         Detection Rate : 0.0000          
   Detection Prevalence : 0.0000          
      Balanced Accuracy : 0.5000          
                                          
       'Positive' Class : 1               
                                          

cm <- table(
  Actual = factor(test$TARGET_FLAG, levels = c(0, 1)),
  Predicted = factor(test$predicted, levels = c(0, 1))
)

cm

      Predicted
Actual   0   1
     0 345   0
     1 144   0

TP <- cm["1","1"]
TN <- cm["0","0"]
FP <- cm["0","1"]
FN <- cm["1","0"]

accuracy <- (TP + TN) / (TP + TN + FP + FN)
accuracy

[1] 0.7055215

sensitivity <- TP / (TP + FN)
sensitivity

[1] 0