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)
Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
R package version 5.2.3. https://CRAN.R-project.org/package=stargazer
Loading required package: ggplot2
Loading required package: lattice
df <- read.csv("~/Downloads/insurance-training-data2.csv")
test_df <- read.csv("~/Downloads/insurance-testing-data2.csv")
vis_dat(df)
'data.frame': 6528 obs. of 26 variables:
$ INDEX : int 8023 4658 2005 4396 3706 3871 8670 833 5896 7432 ...
$ 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" ...
Data Cleaning
df_clean <- df %>%
# Remove ID and leakage variables
select(-INDEX, -TARGET_AMT) %>%
# Convert money columns to numeric
mutate(
INCOME = as.numeric(gsub("[$,]", "", INCOME)),
HOME_VAL = as.numeric(gsub("[$,]", "", HOME_VAL)),
BLUEBOOK = as.numeric(gsub("[$,]", "", BLUEBOOK)),
OLDCLAIM = as.numeric(gsub("[$,]", "", OLDCLAIM))
) %>%
# Replace blank strings with NA
mutate(
across(where(is.character), ~na_if(.x, ""))
) %>%
# Fill missing numeric values with median
mutate(
across(
where(is.numeric),
~ifelse(is.na(.x), median(.x, na.rm = TRUE), .x)
)
) %>%
# Fill missing categorical values with most common category
mutate(
across(
where(is.character),
~replace_na(.x, "Unknown")
)
) %>%
# Convert categorical variables to factors
mutate(
across(where(is.character), as.factor),
TARGET_FLAG = as.factor(TARGET_FLAG)
)
str(df_clean)
'data.frame': 6528 obs. of 24 variables:
$ TARGET_FLAG: Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 2 1 1 ...
$ 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 : num 78658 0 89606 199336 161325 ...
$ PARENT1 : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 2 1 1 1 1 ...
$ HOME_VAL : num 236005 75688 288266 501076 429578 ...
$ MSTATUS : Factor w/ 2 levels "Yes","z_No": 2 1 2 1 1 2 1 1 1 2 ...
$ SEX : Factor w/ 2 levels "M","z_F": 2 2 2 2 1 2 1 2 1 1 ...
$ EDUCATION : Factor w/ 5 levels "<High School",..: 3 3 2 4 4 2 4 2 5 2 ...
$ JOB : Factor w/ 9 levels "Clerical","Doctor",..: 4 3 1 8 5 6 2 1 9 6 ...
$ TRAVTIME : int 69 39 32 23 46 14 39 48 51 26 ...
$ CAR_USE : Factor w/ 2 levels "Commercial","Private": 2 2 2 1 1 2 2 1 1 1 ...
$ BLUEBOOK : num 17040 1500 10460 41280 24650 ...
$ TIF : int 4 6 1 1 6 3 4 1 10 1 ...
$ CAR_TYPE : Factor w/ 6 levels "Minivan","Panel Truck",..: 3 4 6 5 2 1 4 3 1 2 ...
$ RED_CAR : Factor w/ 2 levels "no","yes": 1 1 1 1 2 1 2 1 1 2 ...
$ OLDCLAIM : num 0 3867 21581 0 0 ...
$ CLM_FREQ : int 0 3 2 0 0 2 0 1 0 0 ...
$ REVOKED : Factor w/ 2 levels "No","Yes": 1 1 2 1 1 1 1 1 1 2 ...
$ MVR_PTS : int 1 5 0 1 0 3 1 7 0 0 ...
$ CAR_AGE : int 15 8 8 16 14 7 11 15 8 10 ...
$ URBANICITY : Factor w/ 2 levels "Highly Urban/ Urban",..: 2 1 1 1 1 1 1 1 2 1 ...
test_clean <- test_df %>%
# Remove ID and leakage variables
select(-INDEX, -TARGET_AMT) %>%
# Convert money columns to numeric
mutate(
INCOME = as.numeric(gsub("[$,]", "", INCOME)),
HOME_VAL = as.numeric(gsub("[$,]", "", HOME_VAL)),
BLUEBOOK = as.numeric(gsub("[$,]", "", BLUEBOOK)),
OLDCLAIM = as.numeric(gsub("[$,]", "", OLDCLAIM))
) %>%
# Replace blank strings with NA
mutate(
across(where(is.character), ~na_if(.x, ""))
) %>%
# Fill missing numeric values with median
mutate(
across(
where(is.numeric),
~ifelse(is.na(.x), median(.x, na.rm = TRUE), .x)
)
) %>%
# Fill missing categorical values with most common category
mutate(
across(
where(is.character),
~replace_na(.x, "Unknown")
)
) %>%
# Convert categorical variables to factors
mutate(
across(where(is.character), as.factor),
TARGET_FLAG = as.factor(TARGET_FLAG)
)
str(test_clean)
'data.frame': 1633 obs. of 24 variables:
$ TARGET_FLAG: Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 1 2 2 ...
$ KIDSDRIV : int 0 0 0 0 0 0 0 0 1 0 ...
$ AGE : num 51 54 43 52 38 47 40 56 45 33 ...
$ HOMEKIDS : int 0 0 0 0 0 0 0 0 1 4 ...
$ YOJ : num 14 11 13 8 11 8 11 16 14 12 ...
$ INCOME : num 56532 18755 37214 51278 37754 ...
$ PARENT1 : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 1 1 1 1 ...
$ HOME_VAL : num 306251 163671 163671 230340 138823 ...
$ MSTATUS : Factor w/ 2 levels "Yes","z_No": 1 1 1 1 1 1 2 1 1 1 ...
$ SEX : Factor w/ 2 levels "M","z_F": 1 2 1 2 2 2 1 1 2 2 ...
$ EDUCATION : Factor w/ 5 levels "<High School",..: 1 1 1 2 5 5 1 2 3 5 ...
$ JOB : Factor w/ 9 levels "Clerical","Doctor",..: 9 9 9 6 1 7 9 5 4 3 ...
$ TRAVTIME : int 32 33 52 37 47 35 20 30 50 46 ...
$ CAR_USE : Factor w/ 2 levels "Commercial","Private": 2 2 1 2 2 1 1 2 2 2 ...
$ BLUEBOOK : num 15440 8780 26560 1500 12080 ...
$ TIF : int 7 1 1 4 1 6 4 13 6 13 ...
$ CAR_TYPE : Factor w/ 6 levels "Minivan","Panel Truck",..: 1 6 2 6 6 6 3 1 5 6 ...
$ RED_CAR : Factor w/ 2 levels "no","yes": 2 1 2 1 1 1 2 2 1 1 ...
$ OLDCLAIM : num 0 0 0 0 0 ...
$ CLM_FREQ : int 0 0 0 0 0 2 1 0 2 3 ...
$ REVOKED : Factor w/ 2 levels "No","Yes": 1 1 1 1 1 1 2 1 2 1 ...
$ MVR_PTS : int 0 0 3 1 2 5 13 0 0 0 ...
$ CAR_AGE : num 6 1 1 10 9 8 6 6 13 1 ...
$ URBANICITY : Factor w/ 2 levels "Highly Urban/ Urban",..: 1 1 1 1 2 1 1 1 1 1 ...
Regression
full_glm <- glm(
TARGET_FLAG ~ .,
data = df_clean,
family = binomial(link = "logit")
)
# Stepwise optimized logistic regression
best_glm <- step(
full_glm,
direction = "both",
trace = 0
)
# View final model
summary(best_glm)
Call:
glm(formula = TARGET_FLAG ~ KIDSDRIV + INCOME + PARENT1 + HOME_VAL +
MSTATUS + EDUCATION + JOB + TRAVTIME + CAR_USE + BLUEBOOK +
TIF + CAR_TYPE + OLDCLAIM + CLM_FREQ + REVOKED + MVR_PTS +
URBANICITY, family = binomial(link = "logit"), data = df_clean)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -6.683e-01 2.128e-01 -3.140 0.001687 **
KIDSDRIV 4.699e-01 6.218e-02 7.556 4.16e-14 ***
INCOME -3.257e-06 1.199e-06 -2.716 0.006607 **
PARENT1Yes 4.679e-01 1.060e-01 4.415 1.01e-05 ***
HOME_VAL -1.133e-06 3.808e-07 -2.976 0.002924 **
MSTATUSz_No 4.813e-01 8.926e-02 5.393 6.94e-08 ***
EDUCATIONBachelors -4.367e-01 1.213e-01 -3.602 0.000316 ***
EDUCATIONMasters -2.629e-01 1.793e-01 -1.466 0.142611
EDUCATIONPhD -1.356e-01 2.207e-01 -0.614 0.538901
EDUCATIONz_High School -7.829e-03 1.057e-01 -0.074 0.940938
JOBDoctor -1.218e+00 3.415e-01 -3.566 0.000362 ***
JOBHome Maker -1.124e-01 1.519e-01 -0.740 0.459155
JOBLawyer -3.403e-01 2.037e-01 -1.671 0.094792 .
JOBManager -9.333e-01 1.613e-01 -5.784 7.27e-09 ***
JOBProfessional -2.353e-01 1.381e-01 -1.704 0.088388 .
JOBStudent -8.795e-02 1.404e-01 -0.626 0.531126
JOBUnknown -3.922e-01 2.198e-01 -1.785 0.074295 .
JOBz_Blue Collar -3.041e-02 1.193e-01 -0.255 0.798795
TRAVTIME 1.334e-02 2.099e-03 6.358 2.05e-10 ***
CAR_USEPrivate -7.504e-01 1.032e-01 -7.275 3.48e-13 ***
BLUEBOOK -2.398e-05 5.317e-06 -4.510 6.48e-06 ***
TIF -5.662e-02 8.224e-03 -6.884 5.82e-12 ***
CAR_TYPEPanel Truck 5.389e-01 1.706e-01 3.158 0.001589 **
CAR_TYPEPickup 5.494e-01 1.117e-01 4.918 8.76e-07 ***
CAR_TYPESports Car 9.220e-01 1.206e-01 7.643 2.12e-14 ***
CAR_TYPEVan 6.032e-01 1.371e-01 4.399 1.09e-05 ***
CAR_TYPEz_SUV 7.289e-01 9.559e-02 7.625 2.44e-14 ***
OLDCLAIM -1.552e-05 4.283e-06 -3.625 0.000289 ***
CLM_FREQ 2.053e-01 3.176e-02 6.463 1.03e-10 ***
REVOKEDYes 9.446e-01 1.001e-01 9.439 < 2e-16 ***
MVR_PTS 1.169e-01 1.520e-02 7.688 1.49e-14 ***
URBANICITYz_Highly Rural/ Rural -2.351e+00 1.251e-01 -18.794 < 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: 7533.1 on 6527 degrees of freedom
Residual deviance: 5828.7 on 6496 degrees of freedom
AIC: 5892.7
Number of Fisher Scoring iterations: 5
# Predict probabilities on test data
test_prob <- predict(
best_glm,
newdata = test_clean,
type = "response"
)
# Apply your optimized threshold
test_pred <- ifelse(test_prob > 0.23, 1, 0)
# Convert to factor
test_pred <- factor(
test_pred,
levels = c(0,1)
)
# View predictions
head(test_pred)
1 2 3 4 5 6
0 1 1 0 0 1
Levels: 0 1
confusionMatrix(
test_pred,
test_clean$TARGET_FLAG,
positive = "1"
)
Confusion Matrix and Statistics
Reference
Prediction 0 1
0 810 96
1 392 335
Accuracy : 0.7012
95% CI : (0.6783, 0.7233)
No Information Rate : 0.7361
P-Value [Acc > NIR] : 0.9993
Kappa : 0.3697
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.7773
Specificity : 0.6739
Pos Pred Value : 0.4608
Neg Pred Value : 0.8940
Prevalence : 0.2639
Detection Rate : 0.2051
Detection Prevalence : 0.4452
Balanced Accuracy : 0.7256
'Positive' Class : 1
\[F1 = \frac{2(335)}{2(335)+392+96}=0.5786\]
