day7

remove(list=ls())

library(visdat)
library(psych)
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(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ forcats   1.0.1     ✔ readr     2.2.0
✔ ggplot2   4.0.3     ✔ stringr   1.6.0
✔ lubridate 1.9.5     ✔ tibble    3.3.1
✔ purrr     1.2.2     ✔ tidyr     1.3.2

── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ ggplot2::%+%()   masks psych::%+%()
✖ ggplot2::alpha() masks psych::alpha()
✖ dplyr::filter()  masks stats::filter()
✖ dplyr::lag()     masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggplot2)
library(caret)

Loading required package: lattice

Attaching package: 'caret'

The following object is masked from 'package:purrr':

    lift

df_test <- read.csv("~/Downloads/Day 7/car_crashes/insurance-testing-data2.csv", row.names=1)


df_train <- read.csv("~/Downloads/Day 7/car_crashes/insurance-training-data2.csv", row.names=1)

vis_dat(df_train)

str(df_train)

'data.frame':   6528 obs. of  25 variables:
 $ TARGET_FLAG: int  0 0 0 0 0 0 0 1 0 0 ...
 $ TARGET_AMT : num  0 0 0 0 0 ...
 $ KIDSDRIV   : int  0 0 0 0 0 2 0 0 0 0 ...
 $ AGE        : int  40 48 51 56 51 45 65 56 53 49 ...
 $ HOMEKIDS   : int  0 0 0 0 0 2 0 0 1 0 ...
 $ YOJ        : int  9 0 14 10 9 11 15 13 10 12 ...
 $ INCOME     : chr  "$78,658" "$0" "$89,606" "$199,336" ...
 $ PARENT1    : chr  "No" "No" "No" "No" ...
 $ HOME_VAL   : chr  "$236,005" "$75,688" "$288,266" "$501,076" ...
 $ MSTATUS    : chr  "z_No" "Yes" "z_No" "Yes" ...
 $ SEX        : chr  "z_F" "z_F" "z_F" "z_F" ...
 $ EDUCATION  : chr  "Masters" "Masters" "Bachelors" "PhD" ...
 $ JOB        : chr  "Lawyer" "Home Maker" "Clerical" "" ...
 $ TRAVTIME   : int  69 39 32 23 46 14 39 48 51 26 ...
 $ CAR_USE    : chr  "Private" "Private" "Private" "Commercial" ...
 $ BLUEBOOK   : chr  "$17,040" "$1,500" "$10,460" "$41,280" ...
 $ TIF        : int  4 6 1 1 6 3 4 1 10 1 ...
 $ CAR_TYPE   : chr  "Pickup" "Sports Car" "z_SUV" "Van" ...
 $ RED_CAR    : chr  "no" "no" "no" "no" ...
 $ OLDCLAIM   : chr  "$0" "$3,867" "$21,581" "$0" ...
 $ CLM_FREQ   : int  0 3 2 0 0 2 0 1 0 0 ...
 $ REVOKED    : chr  "No" "No" "Yes" "No" ...
 $ MVR_PTS    : int  1 5 0 1 0 3 1 7 0 0 ...
 $ CAR_AGE    : int  15 NA 8 16 14 7 11 15 NA 10 ...
 $ URBANICITY : chr  "z_Highly Rural/ Rural" "Highly Urban/ Urban" "Highly Urban/ Urban" "Highly Urban/ Urban" ...

psych::describe(df_train)

            vars    n    mean      sd median trimmed     mad min      max
TARGET_FLAG    1 6528    0.26    0.44    0.0    0.20    0.00   0      1.0
TARGET_AMT     2 6528 1466.62 4545.65    0.0  593.53    0.00   0 107586.1
KIDSDRIV       3 6528    0.17    0.51    0.0    0.03    0.00   0      4.0
AGE            4 6525   44.85    8.65   45.0   44.91    8.90  16     81.0
HOMEKIDS       5 6528    0.72    1.11    0.0    0.50    0.00   0      5.0
YOJ            6 6153   10.51    4.10   11.0   11.09    2.97   0     23.0
INCOME*        7 6528 2332.64 1698.03 2280.5 2283.98 2271.34   1   5371.0
PARENT1*       8 6528    1.13    0.34    1.0    1.04    0.00   1      2.0
HOME_VAL*      9 6528 1369.88 1378.22 1013.5 1234.30 1499.65   1   4139.0
MSTATUS*      10 6528    1.40    0.49    1.0    1.37    0.00   1      2.0
SEX*          11 6528    1.54    0.50    2.0    1.54    0.00   1      2.0
EDUCATION*    12 6528    3.09    1.45    3.0    3.11    1.48   1      5.0
JOB*          13 6528    5.66    2.69    6.0    5.78    2.97   1      9.0
TRAVTIME      14 6528   33.44   15.97   33.0   32.93   16.31   5    142.0
CAR_USE*      15 6528    1.63    0.48    2.0    1.66    0.00   1      2.0
BLUEBOOK*     16 6528 1207.82  825.97 1076.5 1189.39 1071.18   1   2589.0
TIF           17 6528    5.37    4.15    4.0    4.86    4.45   1     25.0
CAR_TYPE*     18 6528    3.52    1.97    3.0    3.52    2.97   1      6.0
RED_CAR*      19 6528    1.29    0.45    1.0    1.24    0.00   1      2.0
OLDCLAIM*     20 6528  452.44  705.87    1.0  311.88    0.00   1   2338.0
CLM_FREQ      21 6528    0.80    1.16    0.0    0.59    0.00   0      5.0
REVOKED*      22 6528    1.13    0.33    1.0    1.03    0.00   1      2.0
MVR_PTS       23 6528    1.70    2.14    1.0    1.32    1.48   0     13.0
CAR_AGE       24 6129    8.32    5.72    8.0    7.94    7.41  -3     27.0
URBANICITY*   25 6528    1.21    0.40    1.0    1.13    0.00   1      2.0
               range  skew kurtosis    se
TARGET_FLAG      1.0  1.07    -0.85  0.01
TARGET_AMT  107586.1  9.12   128.02 56.26
KIDSDRIV         4.0  3.30    11.23  0.01
AGE             65.0 -0.04    -0.05  0.11
HOMEKIDS         5.0  1.32     0.56  0.01
YOJ             23.0 -1.20     1.16  0.05
INCOME*       5370.0  0.11    -1.28 21.02
PARENT1*         1.0  2.19     2.78  0.00
HOME_VAL*     4138.0  0.51    -1.19 17.06
MSTATUS*         1.0  0.41    -1.83  0.01
SEX*             1.0 -0.14    -1.98  0.01
EDUCATION*       4.0  0.12    -1.38  0.02
JOB*             8.0 -0.29    -1.24  0.03
TRAVTIME       137.0  0.46     0.74  0.20
CAR_USE*         1.0 -0.54    -1.70  0.01
BLUEBOOK*     2588.0  0.21    -1.38 10.22
TIF             24.0  0.88     0.42  0.05
CAR_TYPE*        5.0  0.00    -1.52  0.02
RED_CAR*         1.0  0.91    -1.17  0.01
OLDCLAIM*     2337.0  1.31     0.24  8.74
CLM_FREQ         5.0  1.21     0.31  0.01
REVOKED*         1.0  2.24     3.01  0.00
MVR_PTS         13.0  1.33     1.30  0.03
CAR_AGE         30.0  0.28    -0.76  0.07
URBANICITY*      1.0  1.45     0.11  0.01

table(df_train$TARGET_FLAG)

   0    1 
4806 1722 

# Fit logistic regression model
reg1 <- glm(
  formula = TARGET_FLAG ~ AGE + HOMEKIDS + KIDSDRIV + YOJ,
  data    = df_train,
  family  = binomial(link = "logit")
)

summary(reg1)

Call:
glm(formula = TARGET_FLAG ~ AGE + HOMEKIDS + KIDSDRIV + YOJ, 
    family = binomial(link = "logit"), data = df_train)

Coefficients:
             Estimate Std. Error z value Pr(>|z|)    
(Intercept)  0.008601   0.189318   0.045  0.96376    
AGE         -0.018041   0.003974  -4.540 5.62e-06 ***
HOMEKIDS     0.103315   0.033124   3.119  0.00181 ** 
KIDSDRIV     0.356971   0.060474   5.903 3.57e-09 ***
YOJ         -0.037824   0.007028  -5.382 7.37e-08 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 7077.7  on 6149  degrees of freedom
Residual deviance: 6910.2  on 6145  degrees of freedom
  (378 observations deleted due to missingness)
AIC: 6920.2

Number of Fisher Scoring iterations: 4

summary(reg1$fitted.values)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.1075  0.2093  0.2443  0.2623  0.2966  0.6992 

df_test_clean <- df_test %>%
  drop_na(AGE, HOMEKIDS, KIDSDRIV, YOJ)

# 1. Clean test set (drop NAs in predictor and target variables)
df_test_clean <- df_test %>%
  drop_na(AGE, HOMEKIDS, KIDSDRIV, YOJ, TARGET_FLAG)

# 2. Generate predicted probabilities on the cleaned test data
probabilities <- predict(
  reg1,
  newdata = df_test_clean,
  type    = "response"
)

# 3. Add binary classification column
df_test_clean <- df_test_clean %>%
  mutate(predicted = ifelse(probabilities > 0.5, 1, 0))

# 4. Generate Confusion Matrix
confusionMatrix(
  data      = as.factor(df_test_clean$predicted),
  reference = as.factor(df_test_clean$TARGET_FLAG),
  positive  = "1"
)

Confusion Matrix and Statistics

          Reference
Prediction    0    1
         0 1124  405
         1   15    7
                                          
               Accuracy : 0.7292          
                 95% CI : (0.7063, 0.7512)
    No Information Rate : 0.7344          
    P-Value [Acc > NIR] : 0.6887          
                                          
                  Kappa : 0.0055          
                                          
 Mcnemar's Test P-Value : <2e-16          
                                          
            Sensitivity : 0.016990        
            Specificity : 0.986831        
         Pos Pred Value : 0.318182        
         Neg Pred Value : 0.735121        
             Prevalence : 0.265635        
         Detection Rate : 0.004513        
   Detection Prevalence : 0.014184        
      Balanced Accuracy : 0.501910        
                                          
       'Positive' Class : 1               
                                          

df_test_clean <- df_test %>%
  drop_na(AGE, HOMEKIDS, KIDSDRIV, YOJ, TARGET_FLAG)

df_test_clean <- df_test %>%
  drop_na(AGE, HOMEKIDS, KIDSDRIV, YOJ)

TP <- 7
TN <- 1124
FP <- 15
FN <- 405

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

[1] 0.729207

sensitivity <- TP/(TP+FN)
sensitivity

[1] 0.01699029

specificity <- TN/(TN+FP)
specificity

[1] 0.9868306