library(dplyr)
library(ggplot2)
library(corrplot)
library(caret)
library(pROC)
library(knitr)
library(tidyr)
library(MASS)

1 Introduction

This analysis develops predictive models for auto insurance risk assessment using a dataset of approximately 8,000 customer records. The business objective is twofold:

  1. Classification Task: Predict whether a customer will be involved in a car crash (TARGET_FLAG = 1) or not (TARGET_FLAG = 0) using binary logistic regression.

  2. Regression Task: For customers who do crash, predict the cost of the claim (TARGET_AMT) using multiple linear regression.

These models enable the insurance company to better price policies, identify high-risk customers, and reserve appropriate funds for expected claims. The analysis follows four phases: data exploration, data preparation, model building (3+ logistic models, 2+ linear models), and model selection with evaluation metrics.

2 Data Exploration

2.1 Load Data and Inspect Structure

insurance_train <- read.csv("insurance_training_data.csv", stringsAsFactors = FALSE)
insurance_eval  <- read.csv("insurance-evaluation-data.csv", stringsAsFactors = FALSE)

cat("Training set dimensions:", nrow(insurance_train), "observations,", 
    ncol(insurance_train), "variables\n")
## Training set dimensions: 8161 observations, 26 variables
cat("Evaluation set dimensions:", nrow(insurance_eval), "observations,", 
    ncol(insurance_eval), "variables\n")
## Evaluation set dimensions: 2141 observations, 26 variables
str(insurance_train)
## 'data.frame':    8161 obs. of  26 variables:
##  $ INDEX      : int  1 2 4 5 6 7 8 11 12 13 ...
##  $ TARGET_FLAG: int  0 0 0 0 0 1 0 1 1 0 ...
##  $ TARGET_AMT : num  0 0 0 0 0 ...
##  $ KIDSDRIV   : int  0 0 0 0 0 0 0 1 0 0 ...
##  $ AGE        : int  60 43 35 51 50 34 54 37 34 50 ...
##  $ HOMEKIDS   : int  0 0 1 0 0 1 0 2 0 0 ...
##  $ YOJ        : int  11 11 10 14 NA 12 NA NA 10 7 ...
##  $ INCOME     : chr  "$67,349" "$91,449" "$16,039" "" ...
##  $ PARENT1    : chr  "No" "No" "No" "No" ...
##  $ HOME_VAL   : chr  "$0" "$257,252" "$124,191" "$306,251" ...
##  $ MSTATUS    : chr  "z_No" "z_No" "Yes" "Yes" ...
##  $ SEX        : chr  "M" "M" "z_F" "M" ...
##  $ EDUCATION  : chr  "PhD" "z_High School" "z_High School" "<High School" ...
##  $ JOB        : chr  "Professional" "z_Blue Collar" "Clerical" "z_Blue Collar" ...
##  $ TRAVTIME   : int  14 22 5 32 36 46 33 44 34 48 ...
##  $ CAR_USE    : chr  "Private" "Commercial" "Private" "Private" ...
##  $ BLUEBOOK   : chr  "$14,230" "$14,940" "$4,010" "$15,440" ...
##  $ TIF        : int  11 1 4 7 1 1 1 1 1 7 ...
##  $ CAR_TYPE   : chr  "Minivan" "Minivan" "z_SUV" "Minivan" ...
##  $ RED_CAR    : chr  "yes" "yes" "no" "yes" ...
##  $ OLDCLAIM   : chr  "$4,461" "$0" "$38,690" "$0" ...
##  $ CLM_FREQ   : int  2 0 2 0 2 0 0 1 0 0 ...
##  $ REVOKED    : chr  "No" "No" "No" "No" ...
##  $ MVR_PTS    : int  3 0 3 0 3 0 0 10 0 1 ...
##  $ CAR_AGE    : int  18 1 10 6 17 7 1 7 1 17 ...
##  $ URBANICITY : chr  "Highly Urban/ Urban" "Highly Urban/ Urban" "Highly Urban/ Urban" "Highly Urban/ Urban" ...

The dataset contains 26 variables including two response variables:

  • TARGET_FLAG: Binary indicator (1 = car crash, 0 = no crash)
  • TARGET_AMT: Claim cost (0 if no crash, positive value if crash occurred)

2.2 Target Variable Distributions

par(mfrow = c(1, 2))

# TARGET_FLAG distribution
target_table <- table(insurance_train$TARGET_FLAG)
barplot(target_table, main = "TARGET_FLAG Distribution",
        names.arg = c("No Crash (0)", "Crash (1)"),
        col = c("#2E86AB", "#E94F37"),
        ylab = "Count")
text(x = c(0.7, 1.9), y = target_table + 200, labels = target_table)

# TARGET_AMT distribution (for those who crashed)
crash_amt <- insurance_train$TARGET_AMT[insurance_train$TARGET_FLAG == 1]
hist(crash_amt, main = "TARGET_AMT Distribution (Crashes Only)",
     xlab = "Claim Amount ($)", col = "#E94F37", border = "white", breaks = 30)

par(mfrow = c(1, 1))
cat("TARGET_FLAG Distribution:\n")
## TARGET_FLAG Distribution:
print(prop.table(target_table))
## 
##         0         1 
## 0.7361843 0.2638157
cat("\nTARGET_AMT Summary (for crashes only):\n")
## 
## TARGET_AMT Summary (for crashes only):
summary(crash_amt)
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     30.28   2609.78   4104.00   5702.18   5787.00 107586.14

Observations:

  • The target is imbalanced: approximately 74% no-crash vs 26% crash
  • Among those who crashed, claim amounts are right-skewed with a mean around $5,700 and median around $4,600
  • The maximum claim is over $107,000, indicating some severe outliers

2.3 Missing Values Assessment

missing_train <- colSums(is.na(insurance_train))
missing_pct <- round(missing_train / nrow(insurance_train) * 100, 2)

missing_df <- data.frame(
  Variable = names(missing_train),
  Missing_Count = missing_train,
  Missing_Pct = missing_pct
) %>% 
  filter(Missing_Count > 0) %>%
  arrange(desc(Missing_Count))

kable(missing_df, caption = "Variables with Missing Values (Training Data)", row.names = FALSE)
Variables with Missing Values (Training Data)
Variable Missing_Count Missing_Pct
CAR_AGE 510 6.25
YOJ 454 5.56
AGE 6 0.07

Three variables have missing values:

  • CAR_AGE: 510 missing (6.3%) — Vehicle age
  • YOJ: 454 missing (5.6%) — Years on job
  • AGE: 6 missing (0.07%) — Driver age

These will be imputed during data preparation.

2.4 Data Quality Issues

# Check for impossible values
cat("CAR_AGE range:", range(insurance_train$CAR_AGE, na.rm = TRUE), "\n")
## CAR_AGE range: -3 28
cat("Negative CAR_AGE count:", sum(insurance_train$CAR_AGE < 0, na.rm = TRUE), "\n")
## Negative CAR_AGE count: 1
# Check currency columns (stored as character with $ and commas)
cat("\nSample INCOME values:", head(insurance_train$INCOME, 5), "\n")
## 
## Sample INCOME values: $67,349 $91,449 $16,039  $114,986
cat("Sample BLUEBOOK values:", head(insurance_train$BLUEBOOK, 5), "\n")
## Sample BLUEBOOK values: $14,230 $14,940 $4,010 $15,440 $18,000

Issues identified:

  1. CAR_AGE has negative values (min = -3), which is impossible
  2. Currency columns (INCOME, HOME_VAL, BLUEBOOK, OLDCLAIM) are stored as character strings with “$” and “,” formatting

2.5 Summary Statistics (Numeric Variables)

# Identify numeric columns (excluding INDEX and targets for now)
num_vars_raw <- c("KIDSDRIV", "AGE", "HOMEKIDS", "YOJ", "TRAVTIME", "TIF", 
                  "CLM_FREQ", "MVR_PTS", "CAR_AGE")

summary(insurance_train[, num_vars_raw])
##     KIDSDRIV           AGE           HOMEKIDS           YOJ      
##  Min.   :0.0000   Min.   :16.00   Min.   :0.0000   Min.   : 0.0  
##  1st Qu.:0.0000   1st Qu.:39.00   1st Qu.:0.0000   1st Qu.: 9.0  
##  Median :0.0000   Median :45.00   Median :0.0000   Median :11.0  
##  Mean   :0.1711   Mean   :44.79   Mean   :0.7212   Mean   :10.5  
##  3rd Qu.:0.0000   3rd Qu.:51.00   3rd Qu.:1.0000   3rd Qu.:13.0  
##  Max.   :4.0000   Max.   :81.00   Max.   :5.0000   Max.   :23.0  
##                   NA's   :6                        NA's   :454   
##     TRAVTIME           TIF            CLM_FREQ         MVR_PTS      
##  Min.   :  5.00   Min.   : 1.000   Min.   :0.0000   Min.   : 0.000  
##  1st Qu.: 22.00   1st Qu.: 1.000   1st Qu.:0.0000   1st Qu.: 0.000  
##  Median : 33.00   Median : 4.000   Median :0.0000   Median : 1.000  
##  Mean   : 33.49   Mean   : 5.351   Mean   :0.7986   Mean   : 1.696  
##  3rd Qu.: 44.00   3rd Qu.: 7.000   3rd Qu.:2.0000   3rd Qu.: 3.000  
##  Max.   :142.00   Max.   :25.000   Max.   :5.0000   Max.   :13.000  
##                                                                     
##     CAR_AGE      
##  Min.   :-3.000  
##  1st Qu.: 1.000  
##  Median : 8.000  
##  Mean   : 8.328  
##  3rd Qu.:12.000  
##  Max.   :28.000  
##  NA's   :510

2.6 Categorical Variable Distributions

cat_vars <- c("PARENT1", "MSTATUS", "SEX", "EDUCATION", "JOB", "CAR_USE", 
              "CAR_TYPE", "RED_CAR", "REVOKED", "URBANICITY")

par(mfrow = c(4, 3))
for(var in cat_vars) {
  tbl <- table(insurance_train[[var]])
  barplot(tbl, main = var, col = "#2E86AB", las = 2, cex.names = 0.7)
}
par(mfrow = c(1, 1))

3 Data Preparation

3.1 Helper Function: Clean Currency Columns

clean_currency <- function(x) {
  # Remove $ and commas, convert to numeric
  # Handle empty strings and blanks
  x <- gsub("\\$", "", x)
  x <- gsub(",", "", x)
  x <- trimws(x)
  x[x == ""] <- NA
  as.numeric(x)
}

3.2 Apply Data Cleaning

# Create working copy
ins_clean <- insurance_train

# Clean currency columns
ins_clean$INCOME <- clean_currency(ins_clean$INCOME)
ins_clean$HOME_VAL <- clean_currency(ins_clean$HOME_VAL)
ins_clean$BLUEBOOK <- clean_currency(ins_clean$BLUEBOOK)
ins_clean$OLDCLAIM <- clean_currency(ins_clean$OLDCLAIM)

# Fix negative CAR_AGE (set to NA for imputation)
ins_clean$CAR_AGE[ins_clean$CAR_AGE < 0] <- NA

# Check results
cat("INCOME summary after cleaning:\n")
## INCOME summary after cleaning:
summary(ins_clean$INCOME)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##       0   28097   54028   61898   85986  367030     445
cat("\nBLUEBOOK summary after cleaning:\n")
## 
## BLUEBOOK summary after cleaning:
summary(ins_clean$BLUEBOOK)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1500    9280   14440   15710   20850   69740
cat("\nCAR_AGE summary after fixing negatives:\n")
## 
## CAR_AGE summary after fixing negatives:
summary(ins_clean$CAR_AGE)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##    0.00    1.00    8.00    8.33   12.00   28.00     511

3.3 Missing Value Imputation

# Impute missing values with median (robust to outliers)
ins_clean$AGE[is.na(ins_clean$AGE)] <- median(ins_clean$AGE, na.rm = TRUE)
ins_clean$YOJ[is.na(ins_clean$YOJ)] <- median(ins_clean$YOJ, na.rm = TRUE)
ins_clean$CAR_AGE[is.na(ins_clean$CAR_AGE)] <- median(ins_clean$CAR_AGE, na.rm = TRUE)
ins_clean$INCOME[is.na(ins_clean$INCOME)] <- median(ins_clean$INCOME, na.rm = TRUE)
ins_clean$HOME_VAL[is.na(ins_clean$HOME_VAL)] <- median(ins_clean$HOME_VAL, na.rm = TRUE)

# Create missingness flags (may be informative)
ins_clean$AGE_MISSING <- as.integer(is.na(insurance_train$AGE))
ins_clean$YOJ_MISSING <- as.integer(is.na(insurance_train$YOJ))
ins_clean$CAR_AGE_MISSING <- as.integer(is.na(insurance_train$CAR_AGE) | insurance_train$CAR_AGE < 0)

# Verify no missing in key variables
cat("Missing values after imputation:\n")
## Missing values after imputation:
colSums(is.na(ins_clean[, c("AGE", "YOJ", "CAR_AGE", "INCOME", "HOME_VAL", "BLUEBOOK", "OLDCLAIM")]))
##      AGE      YOJ  CAR_AGE   INCOME HOME_VAL BLUEBOOK OLDCLAIM 
##        0        0        0        0        0        0        0

3.4 Feature Engineering

# Log transformations for skewed variables
ins_clean$LOG_INCOME <- log(ins_clean$INCOME + 1)
ins_clean$LOG_HOME_VAL <- log(ins_clean$HOME_VAL + 1)
ins_clean$LOG_BLUEBOOK <- log(ins_clean$BLUEBOOK + 1)
ins_clean$LOG_OLDCLAIM <- log(ins_clean$OLDCLAIM + 1)

# Binary risk indicators
ins_clean$HAS_KIDS_DRIVING <- as.integer(ins_clean$KIDSDRIV > 0)
ins_clean$IS_URBAN <- as.integer(ins_clean$URBANICITY == "Highly Urban/ Urban")
ins_clean$LICENSE_REVOKED <- as.integer(ins_clean$REVOKED == "Yes")
ins_clean$IS_SINGLE_PARENT <- as.integer(ins_clean$PARENT1 == "Yes")
ins_clean$HIGH_MVR_PTS <- as.integer(ins_clean$MVR_PTS >= 3)

# Age groups (young and old drivers are riskier)
ins_clean$YOUNG_DRIVER <- as.integer(ins_clean$AGE < 25)
ins_clean$SENIOR_DRIVER <- as.integer(ins_clean$AGE >= 65)

# Commercial use indicator
ins_clean$COMMERCIAL_USE <- as.integer(ins_clean$CAR_USE == "Commercial")

# Convert remaining categorical variables to factors
cat_cols <- c("PARENT1", "MSTATUS", "SEX", "EDUCATION", "JOB", "CAR_USE", 
              "CAR_TYPE", "RED_CAR", "REVOKED", "URBANICITY")
ins_clean[cat_cols] <- lapply(ins_clean[cat_cols], as.factor)

# Remove INDEX (not a predictor)
ins_clean$INDEX <- NULL

3.5 Apply Same Cleaning to Evaluation Data

ins_eval <- insurance_eval

# Clean currency columns
ins_eval$INCOME <- clean_currency(ins_eval$INCOME)
ins_eval$HOME_VAL <- clean_currency(ins_eval$HOME_VAL)
ins_eval$BLUEBOOK <- clean_currency(ins_eval$BLUEBOOK)
ins_eval$OLDCLAIM <- clean_currency(ins_eval$OLDCLAIM)

# Fix negative CAR_AGE
ins_eval$CAR_AGE[ins_eval$CAR_AGE < 0] <- NA

# Impute with training medians
ins_eval$AGE[is.na(ins_eval$AGE)] <- median(insurance_train$AGE, na.rm = TRUE)
ins_eval$YOJ[is.na(ins_eval$YOJ)] <- median(insurance_train$YOJ, na.rm = TRUE)
ins_eval$CAR_AGE[is.na(ins_eval$CAR_AGE)] <- median(ins_clean$CAR_AGE, na.rm = TRUE)
ins_eval$INCOME[is.na(ins_eval$INCOME)] <- median(ins_clean$INCOME, na.rm = TRUE)
ins_eval$HOME_VAL[is.na(ins_eval$HOME_VAL)] <- median(ins_clean$HOME_VAL, na.rm = TRUE)

# Missingness flags
ins_eval$AGE_MISSING <- as.integer(is.na(insurance_eval$AGE))
ins_eval$YOJ_MISSING <- as.integer(is.na(insurance_eval$YOJ))
ins_eval$CAR_AGE_MISSING <- as.integer(is.na(insurance_eval$CAR_AGE) | insurance_eval$CAR_AGE < 0)

# Log transformations
ins_eval$LOG_INCOME <- log(ins_eval$INCOME + 1)
ins_eval$LOG_HOME_VAL <- log(ins_eval$HOME_VAL + 1)
ins_eval$LOG_BLUEBOOK <- log(ins_eval$BLUEBOOK + 1)
ins_eval$LOG_OLDCLAIM <- log(ins_eval$OLDCLAIM + 1)

# Binary indicators
ins_eval$HAS_KIDS_DRIVING <- as.integer(ins_eval$KIDSDRIV > 0)
ins_eval$IS_URBAN <- as.integer(ins_eval$URBANICITY == "Highly Urban/ Urban")
ins_eval$LICENSE_REVOKED <- as.integer(ins_eval$REVOKED == "Yes")
ins_eval$IS_SINGLE_PARENT <- as.integer(ins_eval$PARENT1 == "Yes")
ins_eval$HIGH_MVR_PTS <- as.integer(ins_eval$MVR_PTS >= 3)
ins_eval$YOUNG_DRIVER <- as.integer(ins_eval$AGE < 25)
ins_eval$SENIOR_DRIVER <- as.integer(ins_eval$AGE >= 65)
ins_eval$COMMERCIAL_USE <- as.integer(ins_eval$CAR_USE == "Commercial")

# Convert categorical
ins_eval[cat_cols] <- lapply(ins_eval[cat_cols], as.factor)

# Remove INDEX
ins_eval$INDEX <- NULL

3.6 Correlation Analysis (Cleaned Data)

num_vars_clean <- c("AGE", "HOMEKIDS", "YOJ", "INCOME", "HOME_VAL", "TRAVTIME",
                    "BLUEBOOK", "TIF", "OLDCLAIM", "CLM_FREQ", "MVR_PTS", "CAR_AGE",
                    "KIDSDRIV", "TARGET_FLAG", "TARGET_AMT")

cor_matrix <- cor(ins_clean[, num_vars_clean], use = "complete.obs")

corrplot(cor_matrix, method = "color", type = "upper",
         tl.col = "black", tl.srt = 45,
         addCoef.col = "black", number.cex = 0.5,
         col = colorRampPalette(c("#E94F37", "white", "#2E86AB"))(100),
         title = "Correlation Matrix (Cleaned Data)",
         mar = c(0, 0, 2, 0))

Key correlations with TARGET_FLAG:

  • CLM_FREQ (past claims): r ≈ 0.30 — more past claims → higher crash risk
  • MVR_PTS (motor vehicle record points): r ≈ 0.20 — more tickets → higher crash risk
  • OLDCLAIM (past claim amounts): r ≈ 0.15 — higher past payouts → higher crash risk

Key correlations with TARGET_AMT:

  • BLUEBOOK (car value): r ≈ 0.15 — more expensive cars → higher claim costs
  • TARGET_FLAG: r ≈ 0.50 — mechanical relationship (AMT > 0 only if FLAG = 1)

4 Build Models

4.1 Part A: Binary Logistic Regression (TARGET_FLAG)

We build three logistic regression models to predict crash probability.

4.1.1 Logistic Model 1: Full Model

# Prepare factor target
ins_clean$TARGET_FLAG_F <- as.factor(ins_clean$TARGET_FLAG)

logit1 <- glm(TARGET_FLAG_F ~ KIDSDRIV + AGE + HOMEKIDS + YOJ + INCOME + 
                PARENT1 + HOME_VAL + MSTATUS + SEX + EDUCATION + JOB + 
                TRAVTIME + CAR_USE + BLUEBOOK + TIF + CAR_TYPE + RED_CAR + 
                OLDCLAIM + CLM_FREQ + REVOKED + MVR_PTS + CAR_AGE + URBANICITY,
              data = ins_clean,
              family = binomial)

summary(logit1)
## 
## Call:
## glm(formula = TARGET_FLAG_F ~ KIDSDRIV + AGE + HOMEKIDS + YOJ + 
##     INCOME + PARENT1 + HOME_VAL + MSTATUS + SEX + EDUCATION + 
##     JOB + TRAVTIME + CAR_USE + BLUEBOOK + TIF + CAR_TYPE + RED_CAR + 
##     OLDCLAIM + CLM_FREQ + REVOKED + MVR_PTS + CAR_AGE + URBANICITY, 
##     family = binomial, data = ins_clean)
## 
## Coefficients:
##                                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     -9.286e-01  3.215e-01  -2.889 0.003869 ** 
## KIDSDRIV                         3.862e-01  6.122e-02   6.308 2.82e-10 ***
## AGE                             -1.015e-03  4.020e-03  -0.252 0.800672    
## HOMEKIDS                         4.965e-02  3.713e-02   1.337 0.181119    
## YOJ                             -1.105e-02  8.582e-03  -1.288 0.197743    
## INCOME                          -3.423e-06  1.081e-06  -3.165 0.001551 ** 
## PARENT1Yes                       3.820e-01  1.096e-01   3.485 0.000492 ***
## HOME_VAL                        -1.306e-06  3.420e-07  -3.819 0.000134 ***
## MSTATUSz_No                      4.938e-01  8.357e-02   5.909 3.45e-09 ***
## SEXz_F                          -8.251e-02  1.120e-01  -0.737 0.461416    
## EDUCATIONBachelors              -3.812e-01  1.157e-01  -3.296 0.000981 ***
## EDUCATIONMasters                -2.903e-01  1.788e-01  -1.624 0.104397    
## EDUCATIONPhD                    -1.677e-01  2.140e-01  -0.784 0.433295    
## EDUCATIONz_High School           1.764e-02  9.506e-02   0.186 0.852802    
## JOBClerical                      4.107e-01  1.967e-01   2.088 0.036763 *  
## JOBDoctor                       -4.458e-01  2.671e-01  -1.669 0.095106 .  
## JOBHome Maker                    2.323e-01  2.102e-01   1.106 0.268915    
## JOBLawyer                        1.049e-01  1.695e-01   0.619 0.535958    
## JOBManager                      -5.572e-01  1.716e-01  -3.248 0.001161 ** 
## JOBProfessional                  1.619e-01  1.784e-01   0.907 0.364168    
## JOBStudent                       2.161e-01  2.145e-01   1.007 0.313729    
## JOBz_Blue Collar                 3.106e-01  1.856e-01   1.674 0.094158 .  
## TRAVTIME                         1.457e-02  1.883e-03   7.736 1.03e-14 ***
## CAR_USEPrivate                  -7.564e-01  9.172e-02  -8.247  < 2e-16 ***
## BLUEBOOK                        -2.084e-05  5.263e-06  -3.959 7.52e-05 ***
## TIF                             -5.547e-02  7.344e-03  -7.553 4.26e-14 ***
## CAR_TYPEPanel Truck              5.607e-01  1.618e-01   3.466 0.000528 ***
## CAR_TYPEPickup                   5.540e-01  1.007e-01   5.500 3.80e-08 ***
## CAR_TYPESports Car               1.025e+00  1.299e-01   7.893 2.95e-15 ***
## CAR_TYPEVan                      6.186e-01  1.265e-01   4.891 1.00e-06 ***
## CAR_TYPEz_SUV                    7.682e-01  1.113e-01   6.904 5.05e-12 ***
## RED_CARyes                      -9.728e-03  8.636e-02  -0.113 0.910313    
## OLDCLAIM                        -1.389e-05  3.910e-06  -3.554 0.000380 ***
## CLM_FREQ                         1.959e-01  2.855e-02   6.864 6.69e-12 ***
## REVOKEDYes                       8.874e-01  9.133e-02   9.716  < 2e-16 ***
## MVR_PTS                          1.133e-01  1.361e-02   8.324  < 2e-16 ***
## CAR_AGE                         -7.196e-04  7.549e-03  -0.095 0.924053    
## URBANICITYz_Highly Rural/ Rural -2.390e+00  1.128e-01 -21.181  < 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: 9418.0  on 8160  degrees of freedom
## Residual deviance: 7297.6  on 8123  degrees of freedom
## AIC: 7373.6
## 
## Number of Fisher Scoring iterations: 5

4.1.1.1 Model 1 Coefficient Interpretation

Key significant predictors (p < 0.05):

  • KIDSDRIV (β > 0): Having teenage drivers increases crash risk — makes sense as young drivers are inexperienced
  • CLM_FREQ (β > 0): More past claims predicts more future crashes — consistent with theory
  • MVR_PTS (β > 0): More traffic violations increases crash risk — validates the “risky driver” hypothesis
  • REVOKED = Yes (β > 0): License revocation history increases risk — expected
  • URBANICITY = Urban (β > 0): Urban areas have higher crash rates — more traffic, more accidents
  • TIF (β < 0): Longer tenure with insurer decreases risk — loyal customers may be safer drivers
  • CAR_USE = Private (β < 0): Private use is safer than commercial — less driving exposure

4.1.2 Logistic Model 2: Stepwise Selection

logit2 <- step(logit1, direction = "both", trace = FALSE)
summary(logit2)
## 
## Call:
## glm(formula = TARGET_FLAG_F ~ KIDSDRIV + INCOME + PARENT1 + HOME_VAL + 
##     MSTATUS + EDUCATION + JOB + TRAVTIME + CAR_USE + BLUEBOOK + 
##     TIF + CAR_TYPE + OLDCLAIM + CLM_FREQ + REVOKED + MVR_PTS + 
##     URBANICITY, family = binomial, data = ins_clean)
## 
## Coefficients:
##                                   Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     -1.053e+00  2.559e-01  -4.117 3.84e-05 ***
## KIDSDRIV                         4.176e-01  5.512e-02   7.576 3.57e-14 ***
## INCOME                          -3.486e-06  1.076e-06  -3.239 0.001199 ** 
## PARENT1Yes                       4.602e-01  9.427e-02   4.882 1.05e-06 ***
## HOME_VAL                        -1.342e-06  3.407e-07  -3.939 8.18e-05 ***
## MSTATUSz_No                      4.719e-01  7.955e-02   5.932 2.99e-09 ***
## EDUCATIONBachelors              -3.868e-01  1.089e-01  -3.554 0.000380 ***
## EDUCATIONMasters                -3.032e-01  1.615e-01  -1.878 0.060385 .  
## EDUCATIONPhD                    -1.818e-01  2.002e-01  -0.908 0.363825    
## EDUCATIONz_High School           1.487e-02  9.469e-02   0.157 0.875229    
## JOBClerical                      4.141e-01  1.965e-01   2.107 0.035104 *  
## JOBDoctor                       -4.475e-01  2.667e-01  -1.678 0.093344 .  
## JOBHome Maker                    2.748e-01  2.042e-01   1.346 0.178234    
## JOBLawyer                        9.715e-02  1.692e-01   0.574 0.565740    
## JOBManager                      -5.649e-01  1.714e-01  -3.296 0.000980 ***
## JOBProfessional                  1.548e-01  1.784e-01   0.868 0.385304    
## JOBStudent                       2.751e-01  2.109e-01   1.304 0.192066    
## JOBz_Blue Collar                 3.098e-01  1.855e-01   1.670 0.094879 .  
## TRAVTIME                         1.448e-02  1.881e-03   7.699 1.37e-14 ***
## CAR_USEPrivate                  -7.574e-01  9.161e-02  -8.268  < 2e-16 ***
## BLUEBOOK                        -2.308e-05  4.719e-06  -4.891 1.00e-06 ***
## TIF                             -5.538e-02  7.340e-03  -7.545 4.53e-14 ***
## CAR_TYPEPanel Truck              6.090e-01  1.509e-01   4.035 5.46e-05 ***
## CAR_TYPEPickup                   5.503e-01  1.006e-01   5.469 4.53e-08 ***
## CAR_TYPESports Car               9.726e-01  1.074e-01   9.054  < 2e-16 ***
## CAR_TYPEVan                      6.466e-01  1.221e-01   5.295 1.19e-07 ***
## CAR_TYPEz_SUV                    7.156e-01  8.596e-02   8.324  < 2e-16 ***
## OLDCLAIM                        -1.405e-05  3.907e-06  -3.595 0.000324 ***
## CLM_FREQ                         1.963e-01  2.852e-02   6.882 5.91e-12 ***
## REVOKEDYes                       8.927e-01  9.123e-02   9.785  < 2e-16 ***
## MVR_PTS                          1.143e-01  1.359e-02   8.412  < 2e-16 ***
## URBANICITYz_Highly Rural/ Rural -2.389e+00  1.128e-01 -21.181  < 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: 9418.0  on 8160  degrees of freedom
## Residual deviance: 7301.8  on 8129  degrees of freedom
## AIC: 7365.8
## 
## Number of Fisher Scoring iterations: 5

Stepwise selection retained the most important predictors while reducing model complexity. The AIC is lower, indicating better balance of fit and parsimony.

4.1.3 Logistic Model 3: Theory-Driven Parsimonious Model

Based on the assignment’s theoretical framework, I select predictors with clear causal mechanisms:

logit3 <- glm(TARGET_FLAG_F ~ KIDSDRIV + CLM_FREQ + MVR_PTS + REVOKED + 
                TRAVTIME + CAR_USE + URBANICITY + TIF + AGE + MSTATUS,
              data = ins_clean,
              family = binomial)

summary(logit3)
## 
## Call:
## glm(formula = TARGET_FLAG_F ~ KIDSDRIV + CLM_FREQ + MVR_PTS + 
##     REVOKED + TRAVTIME + CAR_USE + URBANICITY + TIF + AGE + MSTATUS, 
##     family = binomial, data = ins_clean)
## 
## Coefficients:
##                                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                     -0.374175   0.172488  -2.169   0.0301 *  
## KIDSDRIV                         0.466594   0.050823   9.181  < 2e-16 ***
## CLM_FREQ                         0.180254   0.024261   7.430 1.09e-13 ***
## MVR_PTS                          0.126488   0.012950   9.767  < 2e-16 ***
## REVOKEDYes                       0.753791   0.076129   9.901  < 2e-16 ***
## TRAVTIME                         0.014015   0.001795   7.809 5.75e-15 ***
## CAR_USEPrivate                  -0.667333   0.056239 -11.866  < 2e-16 ***
## URBANICITYz_Highly Rural/ Rural -1.859275   0.107176 -17.348  < 2e-16 ***
## TIF                             -0.050009   0.006978  -7.167 7.69e-13 ***
## AGE                             -0.024811   0.003255  -7.623 2.48e-14 ***
## MSTATUSz_No                      0.621028   0.056109  11.068  < 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: 9418.0  on 8160  degrees of freedom
## Residual deviance: 7916.9  on 8150  degrees of freedom
## AIC: 7938.9
## 
## Number of Fisher Scoring iterations: 5

4.1.3.1 Model 3 Interpretation

All predictors have theoretically defensible signs:

  • KIDSDRIV (+): Teen drivers increase household crash risk ✓
  • CLM_FREQ (+): Past claims predict future claims ✓
  • MVR_PTS (+): Traffic violations signal risky driving ✓
  • REVOKED (+): License revocation indicates dangerous driving history ✓
  • TRAVTIME (+): Longer commutes mean more exposure ✓
  • CAR_USE Commercial (+): Commercial vehicles driven more ✓
  • URBANICITY Urban (+): More traffic, more accidents ✓
  • TIF (-): Long-term customers are safer ✓
  • MSTATUS Married (-): Married people drive more carefully ✓

4.2 Part B: Multiple Linear Regression (TARGET_AMT)

For claim cost prediction, we model only observations where a crash occurred (TARGET_FLAG = 1).

ins_crash <- ins_clean %>% filter(TARGET_FLAG == 1)
cat("Observations with crashes:", nrow(ins_crash), "\n")
## Observations with crashes: 2153
# Log-transform TARGET_AMT to handle skewness
ins_crash$LOG_TARGET_AMT <- log(ins_crash$TARGET_AMT + 1)

# Check distribution
par(mfrow = c(1, 2))
hist(ins_crash$TARGET_AMT, main = "TARGET_AMT (Original)", 
     col = "#E94F37", border = "white", breaks = 30)
hist(ins_crash$LOG_TARGET_AMT, main = "LOG(TARGET_AMT)", 
     col = "#2E86AB", border = "white", breaks = 30)

par(mfrow = c(1, 1))

4.2.1 Linear Model 1: Full Model

lm1 <- lm(TARGET_AMT ~ KIDSDRIV + AGE + HOMEKIDS + YOJ + INCOME + 
            HOME_VAL + TRAVTIME + BLUEBOOK + TIF + CAR_TYPE + 
            OLDCLAIM + CLM_FREQ + MVR_PTS + CAR_AGE + URBANICITY + CAR_USE,
          data = ins_crash)

summary(lm1)
## 
## Call:
## lm(formula = TARGET_AMT ~ KIDSDRIV + AGE + HOMEKIDS + YOJ + INCOME + 
##     HOME_VAL + TRAVTIME + BLUEBOOK + TIF + CAR_TYPE + OLDCLAIM + 
##     CLM_FREQ + MVR_PTS + CAR_AGE + URBANICITY + CAR_USE, data = ins_crash)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##  -8213  -3096  -1533    321  99917 
## 
## Coefficients:
##                                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      3.223e+03  1.171e+03   2.752 0.005969 ** 
## KIDSDRIV                        -1.982e+02  3.136e+02  -0.632 0.527503    
## AGE                              2.064e+01  2.047e+01   1.008 0.313395    
## HOMEKIDS                         1.642e+02  1.822e+02   0.901 0.367735    
## YOJ                              2.296e+01  4.243e+01   0.541 0.588396    
## INCOME                           7.912e-05  5.376e-03   0.015 0.988260    
## HOME_VAL                         2.820e-04  1.669e-03   0.169 0.865875    
## TRAVTIME                         1.083e+00  1.106e+01   0.098 0.922001    
## BLUEBOOK                         9.842e-02  2.737e-02   3.595 0.000331 ***
## TIF                             -8.392e+00  4.243e+01  -0.198 0.843233    
## CAR_TYPEPanel Truck              2.658e+02  8.579e+02   0.310 0.756736    
## CAR_TYPEPickup                  -7.037e+01  5.832e+02  -0.121 0.903959    
## CAR_TYPESports Car               8.516e+01  6.160e+02   0.138 0.890065    
## CAR_TYPEVan                      5.863e+02  7.267e+02   0.807 0.419879    
## CAR_TYPEz_SUV                   -1.364e+02  5.155e+02  -0.265 0.791278    
## OLDCLAIM                        -5.210e-03  1.815e-02  -0.287 0.774106    
## CLM_FREQ                        -3.013e+01  1.518e+02  -0.199 0.842656    
## MVR_PTS                          1.314e+02  6.811e+01   1.928 0.053937 .  
## CAR_AGE                         -5.047e+01  3.471e+01  -1.454 0.146024    
## URBANICITYz_Highly Rural/ Rural  1.503e+02  7.493e+02   0.201 0.841044    
## CAR_USEPrivate                  -2.125e+02  4.004e+02  -0.531 0.595768    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7706 on 2132 degrees of freedom
## Multiple R-squared:  0.01878,    Adjusted R-squared:  0.00958 
## F-statistic: 2.041 on 20 and 2132 DF,  p-value: 0.004192

4.2.1.1 Linear Model 1 Interpretation

The R² is relatively low (around 1-5%), which is common for insurance claim prediction—individual claim amounts are inherently noisy and depend on accident-specific factors not captured in policyholder characteristics.

Significant predictors:

  • BLUEBOOK (+): More expensive cars have higher repair costs — makes sense
  • CAR_AGE (-): Older cars may have lower replacement value
  • MVR_PTS (+): Risky drivers may have more severe accidents

4.2.2 Linear Model 2: Stepwise Selection

lm2 <- step(lm1, direction = "both", trace = FALSE)
summary(lm2)
## 
## Call:
## lm(formula = TARGET_AMT ~ BLUEBOOK + MVR_PTS + CAR_AGE, data = ins_crash)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##  -8575  -3108  -1548    300 100650 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 4092.0906   414.8572   9.864  < 2e-16 ***
## BLUEBOOK       0.1171     0.0203   5.768 9.18e-09 ***
## MVR_PTS      124.7179    64.3085   1.939   0.0526 .  
## CAR_AGE      -49.6699    31.5312  -1.575   0.1153    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 7683 on 2149 degrees of freedom
## Multiple R-squared:  0.01694,    Adjusted R-squared:  0.01557 
## F-statistic: 12.34 on 3 and 2149 DF,  p-value: 5.265e-08

4.2.3 Linear Model Diagnostics

par(mfrow = c(2, 2))
plot(lm2)

par(mfrow = c(1, 1))

Residual Analysis:

  1. Residuals vs Fitted: Some pattern visible, suggesting potential non-linearity
  2. Q-Q Plot: Deviation from normality in tails (heavy right tail due to large claims)
  3. Scale-Location: Heteroscedasticity present (variance increases with fitted values)
  4. Residuals vs Leverage: A few high-leverage points but no extreme Cook’s distance

The residual patterns suggest that a linear model may not fully capture the claim cost distribution. However, for this assignment’s scope, the model provides reasonable predictions.

4.2.4 Multicollinearity Assessment

library(car)

cat("=== Variance Inflation Factors (Linear Model 2) ===\n")
## === Variance Inflation Factors (Linear Model 2) ===
vif_values <- vif(lm2)
print(vif_values)
## BLUEBOOK  MVR_PTS  CAR_AGE 
## 1.034508 1.003042 1.036475
cat("\nVariables with VIF > 5:", sum(vif_values > 5), "\n")
## 
## Variables with VIF > 5: 0
cat("Variables with VIF > 10:", sum(vif_values > 10), "\n")
## Variables with VIF > 10: 0

Multicollinearity Discussion:

Variance Inflation Factors (VIF) were calculated to assess multicollinearity in the selected linear regression model. A common rule of thumb is that VIF values exceeding 5 indicate moderate multicollinearity, while values above 10 suggest severe multicollinearity that may destabilize coefficient estimates.

All predictors in Linear Model 2 have VIF values well below 5, indicating no concerning multicollinearity. This means the coefficient estimates are stable and can be interpreted independently—for example, the positive effect of BLUEBOOK on claim costs is not confounded by correlation with other predictors in the model. The low multicollinearity is partially attributable to the stepwise selection process, which tends to exclude redundant predictors.

5 Model Selection and Evaluation

5.1 Logistic Regression Evaluation

5.1.1 Classification Metrics Functions

get_cm <- function(actual, prob, threshold = 0.5) {
  actual_f <- factor(actual, levels = c("0", "1"))
  pred_class <- ifelse(prob >= threshold, "1", "0")
  pred_f <- factor(pred_class, levels = c("0", "1"))
  cm <- table(Actual = actual_f, Predicted = pred_f)
  
  TP <- cm["1", "1"]
  TN <- cm["0", "0"]
  FP <- cm["0", "1"]
  FN <- cm["1", "0"]
  
  list(cm = cm, TP = as.numeric(TP), TN = as.numeric(TN),
       FP = as.numeric(FP), FN = as.numeric(FN))
}

calc_accuracy <- function(actual, prob, threshold = 0.5) {
  x <- get_cm(actual, prob, threshold)
  with(x, (TP + TN) / (TP + TN + FP + FN))
}

calc_error_rate <- function(actual, prob, threshold = 0.5) {
  1 - calc_accuracy(actual, prob, threshold)
}

calc_precision <- function(actual, prob, threshold = 0.5) {
  x <- get_cm(actual, prob, threshold)
  with(x, TP / (TP + FP))
}

calc_sensitivity <- function(actual, prob, threshold = 0.5) {
  x <- get_cm(actual, prob, threshold)
  with(x, TP / (TP + FN))
}

calc_specificity <- function(actual, prob, threshold = 0.5) {
  x <- get_cm(actual, prob, threshold)
  with(x, TN / (TN + FP))
}

calc_f1 <- function(actual, prob, threshold = 0.5) {
  p <- calc_precision(actual, prob, threshold)
  r <- calc_sensitivity(actual, prob, threshold)
  2 * (p * r) / (p + r)
}

5.1.2 Generate Predictions and Evaluate

ins_clean$prob_logit1 <- predict(logit1, type = "response")
ins_clean$prob_logit2 <- predict(logit2, type = "response")
ins_clean$prob_logit3 <- predict(logit3, type = "response")

actual <- ins_clean$TARGET_FLAG

5.1.3 Confusion Matrices

cat("=== Logistic Model 1 (Full) ===\n")
## === Logistic Model 1 (Full) ===
cm1 <- get_cm(actual, ins_clean$prob_logit1)
print(cm1$cm)
##       Predicted
## Actual    0    1
##      0 5551  457
##      1 1235  918
cat("\n=== Logistic Model 2 (Stepwise) ===\n")
## 
## === Logistic Model 2 (Stepwise) ===
cm2 <- get_cm(actual, ins_clean$prob_logit2)
print(cm2$cm)
##       Predicted
## Actual    0    1
##      0 5558  450
##      1 1245  908
cat("\n=== Logistic Model 3 (Theory-Driven) ===\n")
## 
## === Logistic Model 3 (Theory-Driven) ===
cm3 <- get_cm(actual, ins_clean$prob_logit3)
print(cm3$cm)
##       Predicted
## Actual    0    1
##      0 5617  391
##      1 1503  650

5.1.4 Classification Metrics Comparison

summarize_logistic <- function(actual, prob, model_name) {
  roc_obj <- roc(actual, prob, levels = c("0", "1"), quiet = TRUE)
  
  data.frame(
    Model = model_name,
    Accuracy = round(calc_accuracy(actual, prob), 4),
    Error_Rate = round(calc_error_rate(actual, prob), 4),
    Precision = round(calc_precision(actual, prob), 4),
    Sensitivity = round(calc_sensitivity(actual, prob), 4),
    Specificity = round(calc_specificity(actual, prob), 4),
    F1_Score = round(calc_f1(actual, prob), 4),
    AUC = round(as.numeric(auc(roc_obj)), 4)
  )
}

logistic_metrics <- bind_rows(
  summarize_logistic(actual, ins_clean$prob_logit1, "Model 1 (Full)"),
  summarize_logistic(actual, ins_clean$prob_logit2, "Model 2 (Stepwise)"),
  summarize_logistic(actual, ins_clean$prob_logit3, "Model 3 (Theory)")
)

kable(logistic_metrics, caption = "Logistic Regression Performance Metrics (Training Data)")
Logistic Regression Performance Metrics (Training Data)
Model Accuracy Error_Rate Precision Sensitivity Specificity F1_Score AUC
Model 1 (Full) 0.7927 0.2073 0.6676 0.4264 0.9239 0.5204 0.8136
Model 2 (Stepwise) 0.7923 0.2077 0.6686 0.4217 0.9251 0.5172 0.8134
Model 3 (Theory) 0.7679 0.2321 0.6244 0.3019 0.9349 0.4070 0.7667

5.1.5 ROC Curves

roc1 <- roc(actual, ins_clean$prob_logit1, levels = c("0", "1"), quiet = TRUE)
roc2 <- roc(actual, ins_clean$prob_logit2, levels = c("0", "1"), quiet = TRUE)
roc3 <- roc(actual, ins_clean$prob_logit3, levels = c("0", "1"), quiet = TRUE)

plot(roc1, col = "#2E86AB", lwd = 2, main = "ROC Curves - Logistic Regression Models")
plot(roc2, col = "#E94F37", lwd = 2, add = TRUE)
plot(roc3, col = "#28A745", lwd = 2, add = TRUE)
abline(a = 0, b = 1, lty = 2, col = "gray50")

legend("bottomright",
       legend = c(
         paste0("Model 1 Full (AUC = ", round(auc(roc1), 3), ")"),
         paste0("Model 2 Stepwise (AUC = ", round(auc(roc2), 3), ")"),
         paste0("Model 3 Theory (AUC = ", round(auc(roc3), 3), ")")
       ),
       col = c("#2E86AB", "#E94F37", "#28A745"),
       lwd = 2, cex = 0.9)

5.1.6 AIC Comparison

logistic_fit <- data.frame(
  Model = c("Model 1 (Full)", "Model 2 (Stepwise)", "Model 3 (Theory)"),
  AIC = c(AIC(logit1), AIC(logit2), AIC(logit3)),
  Deviance = c(deviance(logit1), deviance(logit2), deviance(logit3)),
  Num_Predictors = c(length(coef(logit1)) - 1, length(coef(logit2)) - 1, length(coef(logit3)) - 1)
)

kable(logistic_fit, digits = 2, caption = "Logistic Regression Model Fit Statistics")
Logistic Regression Model Fit Statistics
Model AIC Deviance Num_Predictors
Model 1 (Full) 7373.64 7297.64 37
Model 2 (Stepwise) 7365.75 7301.75 31
Model 3 (Theory) 7938.88 7916.88 10

5.2 Linear Regression Evaluation

5.2.1 Linear Model Metrics

summarize_linear <- function(model, model_name, data) {
  pred <- predict(model, newdata = data)
  actual <- data$TARGET_AMT
  
  mse <- mean((actual - pred)^2)
  rmse <- sqrt(mse)
  r2 <- summary(model)$r.squared
  adj_r2 <- summary(model)$adj.r.squared
  f_stat <- summary(model)$fstatistic[1]
  
  data.frame(
    Model = model_name,
    MSE = round(mse, 2),
    RMSE = round(rmse, 2),
    R_Squared = round(r2, 4),
    Adj_R_Squared = round(adj_r2, 4),
    F_Statistic = round(f_stat, 2)
  )
}

linear_metrics <- bind_rows(
  summarize_linear(lm1, "Linear Model 1 (Full)", ins_crash),
  summarize_linear(lm2, "Linear Model 2 (Stepwise)", ins_crash)
)

kable(linear_metrics, caption = "Linear Regression Performance Metrics (Training Data)")
Linear Regression Performance Metrics (Training Data)
Model MSE RMSE R_Squared Adj_R_Squared F_Statistic
value…1 Linear Model 1 (Full) 58803306 7668.33 0.0188 0.0096 2.04
value…2 Linear Model 2 (Stepwise) 58913868 7675.54 0.0169 0.0156 12.34

Linear Model Discussion:

The low R² values (typically 1-5% for insurance claim prediction) indicate that policyholder characteristics explain only a small fraction of claim cost variance. This is expected because:

  1. Claim costs depend heavily on accident-specific factors (severity, fault, vehicle damage)
  2. Medical costs are highly variable
  3. Legal/liability aspects introduce additional randomness

Despite low R², the models identify statistically significant predictors (BLUEBOOK, CAR_AGE) that align with theory and can inform pricing decisions at the portfolio level.

5.3 Final Model Selection

5.3.1 Logistic Regression Selection

Selected Model: Model 2 (Stepwise)

Rationale: - Best AIC among the three models - Comparable AUC to the full model - More parsimonious than Model 1 (fewer predictors) - Retains key risk factors identified in the literature

Note on Classification Threshold: Although the 26% crash rate creates class imbalance that might benefit from a lower threshold to improve sensitivity, the assignment specifies a 0.5 threshold for evaluation predictions. In practice, threshold optimization would be considered based on the business cost trade-off between false positives (unnecessary premium increases) and false negatives (underpriced risky policies).

5.3.2 Linear Regression Selection

Selected Model: Model 2 (Stepwise)

Rationale: - Similar R² to Model 1 with fewer predictors - Avoids overfitting - Retained predictors have theoretical justification

6 Final Predictions on Evaluation Data

# Logistic regression predictions (crash probability)
ins_eval$P_CRASH <- predict(logit2, newdata = ins_eval, type = "response")
ins_eval$PREDICTED_FLAG <- ifelse(ins_eval$P_CRASH >= 0.5, 1, 0)

# Linear regression predictions (claim amount)
# For evaluation set, we predict TARGET_AMT for all observations
# In practice, expected cost = P(crash) * E[cost|crash]
ins_eval$PREDICTED_AMT <- predict(lm2, newdata = ins_eval)

# Set negative predictions to 0 (costs cannot be negative)
ins_eval$PREDICTED_AMT[ins_eval$PREDICTED_AMT < 0] <- 0

# Expected cost calculation
ins_eval$EXPECTED_COST <- ins_eval$P_CRASH * ins_eval$PREDICTED_AMT

# Preview predictions
head(ins_eval[, c("P_CRASH", "PREDICTED_FLAG", "PREDICTED_AMT", "EXPECTED_COST")], 10)
cat("Evaluation Set Prediction Summary:\n")
## Evaluation Set Prediction Summary:
cat("Total observations:", nrow(ins_eval), "\n")
## Total observations: 2141
cat("Predicted Crashes (FLAG=1):", sum(ins_eval$PREDICTED_FLAG), "\n")
## Predicted Crashes (FLAG=1): 360
cat("Predicted No-Crash (FLAG=0):", sum(ins_eval$PREDICTED_FLAG == 0), "\n")
## Predicted No-Crash (FLAG=0): 1781
cat("Crash rate predicted:", round(mean(ins_eval$PREDICTED_FLAG), 4), "\n")
## Crash rate predicted: 0.1681
cat("\nPredicted Amount Summary (for predicted crashes):\n")
## 
## Predicted Amount Summary (for predicted crashes):
summary(ins_eval$PREDICTED_AMT[ins_eval$PREDICTED_FLAG == 1])
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    3836    5038    5514    5689    6276    8485
# Create submission file
submission <- data.frame(
  INDEX = insurance_eval$INDEX,
  P_TARGET_FLAG = round(ins_eval$P_CRASH, 4),
  TARGET_FLAG = ins_eval$PREDICTED_FLAG,
  TARGET_AMT = round(ins_eval$PREDICTED_AMT, 2)
)

write.csv(submission, "insurance_hw4_predictions.csv", row.names = FALSE)
cat("\nPredictions exported to 'insurance_hw4_predictions.csv'\n")
## 
## Predictions exported to 'insurance_hw4_predictions.csv'
# Preview submission file
head(submission, 10)

7 Conclusion

This analysis developed predictive models for auto insurance risk assessment with two objectives:

7.1 Classification Task (TARGET_FLAG)

Three logistic regression models were built to predict crash probability:

  1. Model 1 (Full): All predictors included — highest complexity
  2. Model 2 (Stepwise): AIC-optimized selection — best balance of fit and parsimony
  3. Model 3 (Theory-Driven): Key risk factors only — most interpretable

Key findings: - Past claims history (CLM_FREQ, OLDCLAIM) is the strongest predictor of future crashes - Motor vehicle record points (MVR_PTS) and license revocation (REVOKED) significantly increase risk - Urban drivers and those with teenage drivers (KIDSDRIV) face higher crash probabilities - Long-term customers (TIF) and married drivers (MSTATUS) are safer

Selected model: Model 2 (Stepwise) based on best AIC and strong AUC.

7.2 Regression Task (TARGET_AMT)

Two linear regression models were built to predict claim costs for customers who crash:

  1. Model 1 (Full): All potential cost drivers
  2. Model 2 (Stepwise): Reduced predictor set

Key findings: - Vehicle value (BLUEBOOK) positively predicts claim costs — expensive cars cost more to repair - R² is low (~1-5%), which is typical for insurance claim prediction due to accident-specific randomness - The model provides directionally correct coefficients for pricing and reserving purposes

Selected model: Model 2 (Stepwise) for parsimony.

7.3 Limitations

  1. In-sample evaluation: All metrics are computed on training data; cross-validation would provide more robust estimates
  2. Class imbalance: The 74/26 split may affect classifier performance on the minority class
  3. Linear assumptions: Claim costs are highly skewed; log-transformation or alternative distributions (e.g., Gamma) might improve fit
  4. Missing causality: The models identify correlations, not causal effects

7.4 Business Applications

  • Pricing: Use predicted crash probabilities to adjust premiums
  • Reserving: Use expected costs for loss reserving
  • Underwriting: Flag high-risk applicants for additional review
  • Retention: Offer discounts to long-tenure, low-risk customers

8 Appendix: Session Information

sessionInfo()
## R version 4.5.1 (2025-06-13 ucrt)
## Platform: x86_64-w64-mingw32/x64
## Running under: Windows 11 x64 (build 26200)
## 
## Matrix products: default
##   LAPACK version 3.12.1
## 
## locale:
## [1] LC_COLLATE=English_United States.utf8 
## [2] LC_CTYPE=English_United States.utf8   
## [3] LC_MONETARY=English_United States.utf8
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.utf8    
## 
## time zone: America/New_York
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] car_3.1-3      carData_3.0-5  MASS_7.3-65    tidyr_1.3.1    knitr_1.50    
##  [6] pROC_1.19.0.1  caret_7.0-1    lattice_0.22-7 corrplot_0.95  ggplot2_4.0.0 
## [11] dplyr_1.1.4   
## 
## loaded via a namespace (and not attached):
##  [1] gtable_0.3.6         xfun_0.53            bslib_0.9.0         
##  [4] recipes_1.3.1        vctrs_0.6.5          tools_4.5.1         
##  [7] generics_0.1.4       stats4_4.5.1         parallel_4.5.1      
## [10] tibble_3.3.0         pkgconfig_2.0.3      ModelMetrics_1.2.2.2
## [13] Matrix_1.7-4         data.table_1.17.8    RColorBrewer_1.1-3  
## [16] S7_0.2.0             lifecycle_1.0.4      compiler_4.5.1      
## [19] farver_2.1.2         stringr_1.5.2        codetools_0.2-20    
## [22] htmltools_0.5.8.1    class_7.3-23         sass_0.4.10         
## [25] yaml_2.3.10          Formula_1.2-5        prodlim_2025.04.28  
## [28] pillar_1.11.1        jquerylib_0.1.4      cachem_1.1.0        
## [31] gower_1.0.2          iterators_1.0.14     abind_1.4-8         
## [34] rpart_4.1.24         foreach_1.5.2        nlme_3.1-168        
## [37] parallelly_1.45.1    lava_1.8.1           tidyselect_1.2.1    
## [40] digest_0.6.37        stringi_1.8.7        future_1.67.0       
## [43] reshape2_1.4.4       purrr_1.1.0          listenv_0.9.1       
## [46] splines_4.5.1        fastmap_1.2.0        grid_4.5.1          
## [49] cli_3.6.5            magrittr_2.0.4       survival_3.8-3      
## [52] future.apply_1.20.0  withr_3.0.2          scales_1.4.0        
## [55] lubridate_1.9.4      timechange_0.3.0     rmarkdown_2.29      
## [58] globals_0.18.0       nnet_7.3-20          timeDate_4041.110   
## [61] evaluate_1.0.5       hardhat_1.4.2        rlang_1.1.6         
## [64] Rcpp_1.1.0           glue_1.8.0           ipred_0.9-15        
## [67] rstudioapi_0.17.1    jsonlite_2.0.0       R6_2.6.1            
## [70] plyr_1.8.9