1 Data Cleaning

1.1 Imports

library(tidyverse)
library(janitor)
library(skimr)
library(gtsummary)
library(summarytools)
library(gridExtra)
library(janitor)
library(readr)
library(gridExtra)
library(summarytools)
library(reshape2)
library(tidymodels)
library(ranger)
library(xgboost)
library(dplyr)
library(janitor)
library(skimr)
library(kableExtra)
library(gridExtra)
library(knitr)
library(ggplot2)
library(randomForest)
library(tidyverse)
library(kableExtra)
library(readr)
library(tidymodels)

1.2 Data Collection

## Rows: 381,109
## Columns: 12
## $ id                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15…
## $ Gender               <chr> "Male", "Male", "Male", "Male", "Female", "Female…
## $ Age                  <dbl> 44, 76, 47, 21, 29, 24, 23, 56, 24, 32, 47, 24, 4…
## $ Driving_License      <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Region_Code          <dbl> 28, 3, 28, 11, 41, 33, 11, 28, 3, 6, 35, 50, 15, …
## $ Previously_Insured   <dbl> 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0…
## $ Vehicle_Age          <chr> "> 2 Years", "1-2 Year", "> 2 Years", "< 1 Year",…
## $ Vehicle_Damage       <chr> "Yes", "No", "Yes", "No", "No", "Yes", "Yes", "Ye…
## $ Annual_Premium       <dbl> 40454, 33536, 38294, 28619, 27496, 2630, 23367, 3…
## $ Policy_Sales_Channel <dbl> 26, 26, 26, 152, 152, 160, 152, 26, 152, 152, 124…
## $ Vintage              <dbl> 217, 183, 27, 203, 39, 176, 249, 72, 28, 80, 46, …
## $ Response             <dbl> 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0…

1.3 Column Description

variables	description
id	Unique ID for the customer
Gender	Gender of the customer
Age	Age of the customer
Driving_License	Customer has DL (yes/no)
Region_Code	Unique code for the region of the customer
Previously_Insured	Customer already has Vehicle Insurance (yes/no)
Vehicle_Age	Age of the Vehicle
Vehicle_Damage	Customer got his/her vehicle damaged in the past (yes/no)
Annual_Premium	The amount customer needs to pay as premium in the year
Policy_Sales_Channel	Anonymized Code for the channel of outreaching to the customer ie. Different Agents, Over Mail, Over Phone, In Person, etc.
Vintage	Number of Days, Customer has been associated with the company
Response	Customer is interested in car insurance (yes/no)

1.4 Data Cleaning

df2 %>% names()

##  [1] "id"                   "Gender"               "Age"                 
##  [4] "Driving_License"      "Region_Code"          "Previously_Insured"  
##  [7] "Vehicle_Age"          "Vehicle_Damage"       "Annual_Premium"      
## [10] "Policy_Sales_Channel" "Vintage"              "Response"

df2 <-  janitor::clean_names(df2, case = "snake") %>% # change the font
        rename(days_associated = vintage, 
               health_annual_paid = annual_premium) %>% # rename columns
        #Use across() with mutate() to apply a transformation  to multiple columns in a tibble
        mutate(
                        #columns          , function
                across(where(is.character), tolower),
                
                driving_license = ifelse(driving_license==1, "yes", "no"),
                
                previously_insured = ifelse(previously_insured==1, "yes", "no"),
                
                response = ifelse(response==1, "yes", "no"),
                
                vehicle_age = case_when(
                                        vehicle_age == "< 1 year" ~ "below_1_year",
                                        vehicle_age == "1-2 year" ~ "between_1_2_years",
                                        vehicle_age == "> 2 years" ~ "over_2_years"
                                        )
              ) %>% 
                              # categorical data
        mutate_if(is.character, as.factor) 
# checking the levels
table(df2$response)

## 
##     no    yes 
## 334399  46710

table(df2$previously_insured)

## 
##     no    yes 
## 206481 174628

        # Make sure yes is the first level of factor response
df2 <- df2 %>%  mutate( response           = factor(response, levels=c("yes", "no")),
                        previously_insured = factor(previously_insured, levels=c("yes", "no")),
                        driving_license    = factor(driving_license, levels=c("yes", "no")),
                        vehicle_damage     = factor(vehicle_damage, levels=c("yes", "no"))
              )
# checking the change of levels
table(df2$response)

## 
##    yes     no 
##  46710 334399

table(df2$previously_insured)

## 
##    yes     no 
## 174628 206481

df2 %>% names()

##  [1] "id"                   "gender"               "age"                 
##  [4] "driving_license"      "region_code"          "previously_insured"  
##  [7] "vehicle_age"          "vehicle_damage"       "health_annual_paid"  
## [10] "policy_sales_channel" "days_associated"      "response"

glimpse(df2)

## Rows: 381,109
## Columns: 12
## $ id                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15…
## $ gender               <fct> male, male, male, male, female, female, male, fem…
## $ age                  <dbl> 44, 76, 47, 21, 29, 24, 23, 56, 24, 32, 47, 24, 4…
## $ driving_license      <fct> yes, yes, yes, yes, yes, yes, yes, yes, yes, yes,…
## $ region_code          <dbl> 28, 3, 28, 11, 41, 33, 11, 28, 3, 6, 35, 50, 15, …
## $ previously_insured   <fct> no, no, no, yes, yes, no, no, no, yes, yes, no, y…
## $ vehicle_age          <fct> over_2_years, between_1_2_years, over_2_years, be…
## $ vehicle_damage       <fct> yes, no, yes, no, no, yes, yes, yes, no, no, yes,…
## $ health_annual_paid   <dbl> 40454, 33536, 38294, 28619, 27496, 2630, 23367, 3…
## $ policy_sales_channel <dbl> 26, 26, 26, 152, 152, 160, 152, 26, 152, 152, 124…
## $ days_associated      <dbl> 217, 183, 27, 203, 39, 176, 249, 72, 28, 80, 46, …
## $ response             <fct> yes, no, yes, no, no, no, no, yes, no, no, yes, n…

saveRDS(df2, "df2.rds")

1.4.1 Data Types

str(df2)

## tibble [381,109 × 12] (S3: tbl_df/tbl/data.frame)
##  $ id                  : num [1:381109] 1 2 3 4 5 6 7 8 9 10 ...
##  $ gender              : Factor w/ 2 levels "female","male": 2 2 2 2 1 1 2 1 1 1 ...
##  $ age                 : num [1:381109] 44 76 47 21 29 24 23 56 24 32 ...
##  $ driving_license     : Factor w/ 2 levels "yes","no": 1 1 1 1 1 1 1 1 1 1 ...
##  $ region_code         : num [1:381109] 28 3 28 11 41 33 11 28 3 6 ...
##  $ previously_insured  : Factor w/ 2 levels "yes","no": 2 2 2 1 1 2 2 2 1 1 ...
##  $ vehicle_age         : Factor w/ 3 levels "below_1_year",..: 3 2 3 1 1 1 1 2 1 1 ...
##  $ vehicle_damage      : Factor w/ 2 levels "yes","no": 1 2 1 2 2 1 1 1 2 2 ...
##  $ health_annual_paid  : num [1:381109] 40454 33536 38294 28619 27496 ...
##  $ policy_sales_channel: num [1:381109] 26 26 26 152 152 160 152 26 152 152 ...
##  $ days_associated     : num [1:381109] 217 183 27 203 39 176 249 72 28 80 ...
##  $ response            : Factor w/ 2 levels "yes","no": 1 2 1 2 2 2 2 1 2 2 ...

lapply(df2, class) # give a list with classes of df1

## $id
## [1] "numeric"
## 
## $gender
## [1] "factor"
## 
## $age
## [1] "numeric"
## 
## $driving_license
## [1] "factor"
## 
## $region_code
## [1] "numeric"
## 
## $previously_insured
## [1] "factor"
## 
## $vehicle_age
## [1] "factor"
## 
## $vehicle_damage
## [1] "factor"
## 
## $health_annual_paid
## [1] "numeric"
## 
## $policy_sales_channel
## [1] "numeric"
## 
## $days_associated
## [1] "numeric"
## 
## $response
## [1] "factor"

unlist(lapply(df2, class))

##                   id               gender                  age 
##            "numeric"             "factor"            "numeric" 
##      driving_license          region_code   previously_insured 
##             "factor"            "numeric"             "factor" 
##          vehicle_age       vehicle_damage   health_annual_paid 
##             "factor"             "factor"            "numeric" 
## policy_sales_channel      days_associated             response 
##            "numeric"            "numeric"             "factor"

      # column     values
tibble(variables = names(df2), 
       type      = unlist(lapply(df2, class)))

1.4.2 Descriptive Statistics

1.4.2.1 Data Structure

skim(df2, -id, -region_code, -policy_sales_channel) # excluding identification columns

Data summary
Name	df2
Number of rows	381109
Number of columns	12
_______________________
Column type frequency:
factor	6
numeric	3
________________________
Group variables	None

Variable type: factor

skim_variable	complete_rate	ordered	n_unique	top_counts
gender	1	FALSE	2	mal: 206089, fem: 175020
driving_license	1	FALSE	2	yes: 380297, no: 812
previously_insured	1	FALSE	2	no: 206481, yes: 174628
vehicle_age	1	FALSE	3	bet: 200316, bel: 164786, ove: 16007
vehicle_damage	1	FALSE	2	yes: 192413, no: 188696
response	1	FALSE	2	no: 334399, yes: 46710

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
age	1	38.82	15.51	20	25	36	49	85	▇▃▃▂▁
health_annual_paid	1	30564.39	17213.16	2630	24405	31669	39400	540165	▇▁▁▁▁
days_associated	1	154.35	83.67	10	82	154	227	299	▇▇▇▇▇

1.4.2.2 General Overview

# checking categorical levels
df2 %>% 
  select(-id) %>% 
  tbl_summary(# saying that a column is categorical forces the rstudio to show all categories
    
    type = list(response           ~ "categorical",
                driving_license    ~ "categorical",
                previously_insured ~ "categorical",
                vehicle_damage     ~ "categorical"),
    
    digits = list(all_categorical() ~ c(0, 2), # decimal places for numbers (0) and percentage (2)
                  all_continuous()  ~ c(1, 2)), 
    
    statistic = list(all_categorical() ~ "{n} ({p}%)", # numbers and percentage
                     all_continuous()  ~ "{median} ({p25}, {p75})"), 
    
    include = everything()
  )

Characteristic	N = 381,109¹
gender
female	175,020 (45.92%)
male	206,089 (54.08%)
age	36.0 (25.00, 49.0)
driving_license
yes	380,297 (99.79%)
no	812 (0.21%)
region_code	28.0 (15.00, 35.0)
previously_insured
yes	174,628 (45.82%)
no	206,481 (54.18%)
vehicle_age
below_1_year	164,786 (43.24%)
between_1_2_years	200,316 (52.56%)
over_2_years	16,007 (4.20%)
vehicle_damage
yes	192,413 (50.49%)
no	188,696 (49.51%)
health_annual_paid	31,669.0 (24,405.00, 39,400.0)
policy_sales_channel	133.0 (29.00, 152.0)
days_associated	154.0 (82.00, 227.0)
response
yes	46,710 (12.26%)
no	334,399 (87.74%)
¹ n (%); Median (IQR)

1.4.2.3 Numerical Statistics

	age	days_associated	health_annual_paid
Mean	38.82	154.35	30564.39
Std.Dev	15.51	83.67	17213.16
Min	20.00	10.00	2630.00
Q1	25.00	82.00	24405.00
Median	36.00	154.00	31669.00
Q3	49.00	227.00	39400.00
Max	85.00	299.00	540165.00
MAD	17.79	108.23	11125.43
IQR	24.00	145.00	14995.00
CV	0.40	0.54	0.56
Skewness	0.67	0.00	1.77
SE.Skewness	0.00	0.00	0.00
Kurtosis	-0.57	-1.20	34.00
N.Valid	381109.00	381109.00	381109.00
Pct.Valid	100.00	100.00	100.00

1.4.3 Visualitzation

1.4.3.1 Numerical Attributes

1.4.4 Categorical Attributes

2 Exploratory Data Analysis

2.1 Data Collection

You can also embed plots, for example:

## Rows: 381,109
## Columns: 12
## $ id                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15…
## $ gender               <fct> male, male, male, male, female, female, male, fem…
## $ age                  <dbl> 44, 76, 47, 21, 29, 24, 23, 56, 24, 32, 47, 24, 4…
## $ driving_license      <fct> yes, yes, yes, yes, yes, yes, yes, yes, yes, yes,…
## $ region_code          <dbl> 28, 3, 28, 11, 41, 33, 11, 28, 3, 6, 35, 50, 15, …
## $ previously_insured   <fct> no, no, no, yes, yes, no, no, no, yes, yes, no, y…
## $ vehicle_age          <fct> over_2_years, between_1_2_years, over_2_years, be…
## $ vehicle_damage       <fct> yes, no, yes, no, no, yes, yes, yes, no, no, yes,…
## $ health_annual_paid   <dbl> 40454, 33536, 38294, 28619, 27496, 2630, 23367, 3…
## $ policy_sales_channel <dbl> 26, 26, 26, 152, 152, 160, 152, 26, 152, 152, 124…
## $ days_associated      <dbl> 217, 183, 27, 203, 39, 176, 249, 72, 28, 80, 46, …
## $ response             <fct> yes, no, yes, no, no, no, no, yes, no, no, yes, n…

2.2 Column Description

variables	description
id	Unique ID for the customer
gender	Gender of the customer
age	Age of the customer
driving_license	Customer has DL (yes/no)
region_code	Unique code for the region of the customer
previously_insured	Customer already has Vehicle Insurance (yes/no)
vehicle_age	Age of the Vehicle
vehicle_damage	Customer got his/her vehicle damaged in the past (yes/no)
health_annual_paid	The amount customer needs to pay as premium in the year
policy_sales_channel	Anonymized Code for the channel of outreaching to the customer ie. Different Agents, Over Mail, Over Phone, In Person, etc.
days_associated	Number of Days, Customer has been associated with the company
response	Customer is interested in car insurance (yes/no)

2.3 Hypothesis Validation

2.3.0.1 H1) Older customers are more likely to be interested in car insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹	p-value²
age	43 (35, 51)	34 (24, 49)	<0.001
¹ Median (IQR)
² Wilcoxon rank sum test

2.3.0.1.1 Young people seem to be less interested in car insurance. The median age of interested customers is 43 years old (AIQ: 35.51), while the median age of uninterested customers is 34 years old (AIQ: 24.49).

2.3.0.2 H2) Women are probably more interested in car insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹
gender
female	18,185 (39%)	156,835 (47%)
male	28,525 (61%)	177,564 (53%)
¹ n (%)

2.3.0.3 H3) Customers having newer cars are more likely to be interested in car insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹	p-value²
vehicle_age			<0.001
below_1_year	7,202 (15%)	157,584 (47%)
between_1_2_years	34,806 (75%)	165,510 (49%)
over_2_years	4,702 (10%)	11,305 (3.4%)
¹ n (%)
² Pearson’s Chi-squared test

2.3.0.3.1 Customers who own a car between 1 and 2 years are more likely to be interested in the car insurance (75%). While only 15% of the interested customers have new car. This hypothesis is FALSE.

2.3.0.4 H4) Customers with previous car damage are more likely to accept auto insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹	p-value²
vehicle_damage	45,728 (98%)	146,685 (44%)	<0.001
¹ n (%)
² Pearson’s Chi-squared test

2.3.0.4.1 Customers with previous car damage are more likely to be interested in car insurance, as 98% said yes.

2.3.0.5 H5) Customers with previous car insurance are more likely to accept car insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹	p-value²
previously_insured	158 (0.3%)	174,470 (52%)	<0.001
¹ n (%)
² Pearson’s Chi-squared test

2.3.0.5.1 Only 0.3% of customers interested in car insurance have car previously insured. FALSE

2.3.0.6 H6) Interest in car insurance is greater among customers who have higher annual health insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹	p-value²
health_annual_paid	33,002 (24,868, 41,297)	31,504 (24,351, 39,120)	<0.001
¹ Median (IQR)
² Wilcoxon rank sum test

2.3.0.6.1 Although the annual healthcare paid has proven to be significant, this hypothesis will be considered FALSE, but its outliers will be investigated, in the next cycle, for example. There are many similarities between the alternatives. There are to much similarities between the alternatives.

2.3.0.7 H7) Customers who have had health insurance for longer are more likely to be interested in car insurance.

Characteristic	yes, N = 46,710¹	no, N = 334,399¹	p-value²
days_associated	154 (82, 226)	154 (82, 227)	0.5
¹ Median (IQR)
² Wilcoxon rank sum test

2.3.0.7.1 This hypothesis is false, basically interested customers and non-interested customers have the same amount of days associated. Yes (median: 154 days, IIQ: 82, 226); No (154 days, AIQ: 82, 227).

2.3.0.8 Hypothesis Conclusion

Hypothesis	Conclusion	Relevance
H1) Older customers are more likely to be interested in car insurance.	True	High
H2) Women are probably more interested in car insurance.	False	Medium
H3) Customers having newer cars are more likely to be interested in car insurance.	False	High
H4) Customers with previous car damage are more likely to accept auto insurance.	True	High
H5) Customers with previous car insurance are more likely to accept car insurance.	False	High
H6) Interest in car insurance is greater among customers who have higher annual health insurance.	False	Low
H7) Customers who have had health insurance for longer are more likely to be interested in car insurance.	False	Low

2.4 Multivariable Analysis

2.4.0.1 Correlation Matrix

2.4.0.2 Visualization

2.4.0.2.1 There is no high correlation between numerical variables

3 Data Preparation And Feature Selection

3.1 Data Collection

## Rows: 381,109
## Columns: 12
## $ id                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15…
## $ gender               <fct> male, male, male, male, female, female, male, fem…
## $ age                  <dbl> 44, 76, 47, 21, 29, 24, 23, 56, 24, 32, 47, 24, 4…
## $ driving_license      <fct> yes, yes, yes, yes, yes, yes, yes, yes, yes, yes,…
## $ region_code          <dbl> 28, 3, 28, 11, 41, 33, 11, 28, 3, 6, 35, 50, 15, …
## $ previously_insured   <fct> no, no, no, yes, yes, no, no, no, yes, yes, no, y…
## $ vehicle_age          <fct> over_2_years, between_1_2_years, over_2_years, be…
## $ vehicle_damage       <fct> yes, no, yes, no, no, yes, yes, yes, no, no, yes,…
## $ health_annual_paid   <dbl> 40454, 33536, 38294, 28619, 27496, 2630, 23367, 3…
## $ policy_sales_channel <dbl> 26, 26, 26, 152, 152, 160, 152, 26, 152, 152, 124…
## $ days_associated      <dbl> 217, 183, 27, 203, 39, 176, 249, 72, 28, 80, 46, …
## $ response             <fct> yes, no, yes, no, no, no, no, yes, no, no, yes, n…

3.2 Column Description

variables	description
id	Unique ID for the customer
gender	Gender of the customer
age	Age of the customer
driving_license	Customer has DL (yes/no)
region_code	Unique code for the region of the customer
previously_insured	Customer already has Vehicle Insurance (yes/no)
vehicle_age	Age of the Vehicle
vehicle_damage	Customer got his/her vehicle damaged in the past (yes/no)
health_annual_paid	The amount customer needs to pay as premium in the year
policy_sales_channel	Anonymized Code for the channel of outreaching to the customer ie. Different Agents, Over Mail, Over Phone, In Person, etc.
days_associated	Number of Days, Customer has been associated with the company
response	Customer is interested in car insurance (yes/no)

3.3 Data Preparation

Frequency encoding for policy_sales_channel

Target encoding for gender e region_code

3.3.1 Target encoding

3.3.2 Frequency encoding

3.3.2.1 Building Encoder Function

3.3.3 Splitting data into train and test

3.3.3.1 Check response proportions

Characteristic	N = 285,831¹
response
yes	35,032 (12%)
no	250,799 (88%)
¹ n (%)

Characteristic	N = 95,278¹
response
yes	11,678 (12%)
no	83,600 (88%)
¹ n (%)

3.3.3.2 Using tidymodels steps to continue the preprocessing

3.3.3.3 Applying the recipe

3.4 Feature Selection

## Time difference of 8.168932 secs

3.4.0.1 Show results

In this first cycle we are going to select the seven most important variables according to the mean decrease gini

4 Machine Learning

4.1 Helper Functions

4.2 Data Collection

## Rows: 381,109
## Columns: 9
## $ id                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15…
## $ age                  <dbl> 44, 76, 47, 21, 29, 24, 23, 56, 24, 32, 47, 24, 4…
## $ vehicle_damage       <fct> yes, no, yes, no, no, yes, yes, yes, no, no, yes,…
## $ days_associated      <dbl> 217, 183, 27, 203, 39, 176, 249, 72, 28, 80, 46, …
## $ previously_insured   <fct> no, no, no, yes, yes, no, no, no, yes, yes, no, y…
## $ health_annual_paid   <dbl> 40454, 33536, 38294, 28619, 27496, 2630, 23367, 3…
## $ policy_sales_channel <dbl> 26, 26, 26, 152, 152, 160, 152, 26, 152, 152, 124…
## $ region_code          <dbl> 28, 3, 28, 11, 41, 33, 11, 28, 3, 6, 35, 50, 15, …
## $ response             <fct> yes, no, yes, no, no, no, no, yes, no, no, yes, n…

4.3 Column Description

variables	description
id	Unique ID for the customer
age	Age of the customer
vehicle_damage	Customer got his/her vehicle damaged in the past (yes/no)
days_associated	Number of Days, Customer has been associated with the company
previously_insured	Customer already has Vehicle Insurance (yes/no)
health_annual_paid	The amount customer needs to pay as premium in the year
policy_sales_channel	Anonymized Code for the channel of outreaching to the customer ie. Different Agents, Over Mail, Over Phone, In Person, etc.
region_code	Unique code for the region of the customer
response	Customer is interested in car insurance (yes/no)

4.4 Pre-processing

4.4.1 Split into train and test datasets

4.4.2 Applying steps

4.5 Logistic Regression

## Time difference of 1.282025 secs

4.5.1 Gain & Lift Curves

Gain: By approaching 25% of the ordered list , ~ 60% of all interested clients are reached.

Lift: By approaching 25% of the ordered list , the model performed ~2.3 times better than a random list.

4.6 Decision Tree 💻

Time to fit the model: 1.065924 secs.

## Time difference of 0.5494246 secs

##    .pred_yes         .pred_no     
##  Min.   :0.1226   Min.   :0.8774  
##  1st Qu.:0.1226   1st Qu.:0.8774  
##  Median :0.1226   Median :0.8774  
##  Mean   :0.1226   Mean   :0.8774  
##  3rd Qu.:0.1226   3rd Qu.:0.8774  
##  Max.   :0.1226   Max.   :0.8774

As the probabilities are constant throughout the rows there is no way to calculate gain and lift. So, this is not a good model to rank our clients as it isn’t better than a random list.

4.7 Random Forest 💻

Time to run the model: 8.450113 mins

## Time difference of 6.781536 mins

Gain: By approaching 25% of the ordered list , ~ 64% of all interested clients are reached.

Lift: By approaching 25% of the ordered list , the model performed ~2.7 times better than a random list.

4.8 XGBosst 💻

Time to train the model: 5.701178 mins.

## Time difference of 3.418764 mins

Gain: By approaching 25% of the ordered list, ~ 62% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performed ~2.4 times better than a random list.

4.9 KNN

Time to train the model: 19.01394 mins

Time for prediction: 9.316501 mins

## Time difference of 19.66517 mins

## Time difference of 10.3549 mins

Gain: By approaching 25% of the ordered list, ~ 62% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performed ~2.2 times better than a random list.

5 Fine Tuning

5.1 Helper Functions

# Encoding
region_encoder <- readRDS("../files/region_encoder.rds")
policy_encoder <- readRDS("../files/policy_encoder.rds")

# Create function
encoder_function <- function(df){
  df %>% 
  left_join(region_encoder) %>% 
  select(-region_code) %>% 
  rename(region_code = region_num) %>% 
  left_join(policy_encoder) %>% 
  select(-policy_sales_channel) %>% 
  rename(policy_sales_channel = policy_num) 
}

# Top @K precision and recall function ---------
metrics_at_k_function <- function(model_results, k){
  df_results <- model_results %>% 
  arrange(desc(.pred_yes)) %>% 
  mutate(
    TP = ifelse(.pred_class == "yes" & response == "yes", 1, 0),
    FP = ifelse(.pred_class == "yes" & response == "no", 1, 0),
    FN = ifelse(.pred_class == "no" & response == "yes", 1, 0),
    TN = ifelse(.pred_class == "no" & response == "no", 1, 0)
  ) 
  
  # Create list for precision and recall
  precision_at_k <- list()
  recall_at_k <- list()

  # Populate the metric list
  for (i in 1:k) {
    subset_k <- df_results %>% 
    dplyr_row_slice(1:i)
    
    precision_at_k[[i]] <- (subset_k$TP %>% sum())/(subset_k$TP %>% sum() + subset_k$FP %>% sum())
  
    recall_at_k[[i]] <- (subset_k$TP %>% sum())/(subset_k$TP %>% sum() + subset_k$FN %>% sum())
  }

    metrics_at_k <- df_results %>% 
          dplyr_row_slice(1:k) %>% 
          mutate(
            precision_at_k = unlist(precision_at_k),
          recall_at_k = unlist(recall_at_k)
  )
    
 return(metrics_at_k)
}

# Final metrics @K Function ----------------------
final_metrics_at_k <- function(model_results, k){
  
  model_metrics_at_k <- metrics_at_k_function(model_results, k)

  model_metrics_at_k %>% 
    dplyr::slice(k) %>% 
    select(precision_at_k, recall_at_k)
}

5.2 Data

5.3 Pre-processing

5.4 Splitting into train and test data sets

5.5 Kfold cross validation

5.6 Logistic Regression 💻

library(glmnet)

doParallel::registerDoParallel()

start_time <- Sys.time()

# Tune the model
lr_tune <- tune_grid(
  lr_model, df_recipe,
  resamples = df_kfolds,
  grid = lr_grid
)


end_time <- Sys.time()

print(end_time - start_time )

saveRDS(lr_tune, "lr_tune.rds")

# Train final model
doParallel::registerDoParallel()

start_time <- Sys.time()

# Train the model
lr_res <- last_fit(lr_wkfl, df_split)

end_time <- Sys.time()

print(end_time - start_time)

saveRDS(lr_res, "lr_res.rds")

##           Truth
## Prediction   yes    no
##        yes     0     0
##        no   9342 66880

Gain:By approaching 25% of the ordered list, ~ 61% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performs ~ 2.3 times better than the random list.

5.7 Decision Tree 💻

# Tune the model ------------
doParallel::registerDoParallel()
start_time <- Sys.time()

tree_tune <- tune_grid(
  tree_model, df_recipe,
  resamples = df_kfolds,
  grid = tree_grid
)

end_time <- Sys.time()

print(end_time - start_time )
saveRDS(tree_tune, "tree_tune.rds")

# Train final model -----------------
doParallel::registerDoParallel()
start_time <- Sys.time()

tree_res <- last_fit(tree_wkfl, df_split)

end_time <- Sys.time()

print(end_time - start_time)

saveRDS(tree_res, "tree_res.rds")

Gain:By approaching 25% of the ordered list, ~ 62% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performs ~ 2.6 times better than the random list.

5.8 Random Forest 💻

# Tune the model ------------
doParallel::registerDoParallel()
start_time <- Sys.time()

rf_tune <- tune_grid(
  rf_model, df_recipe,
  resamples = df_kfolds,
  grid = rf_grid
)

end_time <- Sys.time()

print(end_time - start_time )
saveRDS(rf_tune, "rf_tune.rds")

# Train final model -----------------
doParallel::registerDoParallel()
start_time <- Sys.time()

rf_res <- last_fit(rf_wkfl, df_split)

end_time <- Sys.time()

print(end_time - start_time)

saveRDS(rf_res, "rf_res.rds")

Gain:By approaching 25% of the ordered list, ~ 62% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performs ~ 2.7 times better than the random list.

5.9 XGBoost 💻

# Tune the model ------------
doParallel::registerDoParallel()
start_time <- Sys.time()

xgb_tune <- tune_grid(
  xgb_model, df_recipe,
  resamples = df_kfolds,
  grid = xgb_grid
)

end_time <- Sys.time()

print(end_time - start_time )
saveRDS(xgb_tune, "xgb_tune.rds")

# Train final model -----------------
doParallel::registerDoParallel()
start_time <- Sys.time()

xgb_res <- last_fit(xgb_wkfl, df_split)

end_time <- Sys.time()

print(end_time - start_time)

saveRDS(xgb_res, "xgb_res.rds")

Gain:By approaching 25% of the ordered list, ~ 63% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performs ~ 2.8 times better than the random list.

5.10 KNN 💻

# Tune the model ------------
doParallel::registerDoParallel()
start_time <- Sys.time()

knn_tune <- tune_grid(
  knn_model, df_recipe,
  resamples = df_kfolds,
  grid = knn_grid
)

end_time <- Sys.time()

print(end_time - start_time )
saveRDS(knn_tune, "knn_tune.rds")

# Train final model -----------------
doParallel::registerDoParallel()
start_time <- Sys.time()

knn_res <- last_fit(knn_wkfl, df_split)

end_time <- Sys.time()

print(end_time - start_time)

saveRDS(knn_res, "knn_res.rds")

Gain:By approaching 25% of the ordered list, ~ 62.5% of all interested clients are reached.

Lift: By approaching 25% of the ordered list, the model performs ~ 2.5 times better than the random list.

5.11 Model Comparison

The KNN model was the one that performed better in this cicle. So, it will be selected as our final model to make predictions for new clients.

5.12 Save final model

start_time <- Sys.time()
doParallel::registerDoParallel()

final_model <- fit(knn_wkfl, df6)

end_time <- Sys.time()
print(end_time - start_time)

saveRDS(final_model, "final_model.rds")

5.12.1 Make predictions

## [1] 0.1241431

Health Insurance Cross Sell With R

Cleverson Oliveira

25/06/2024

1 Data Cleaning

1.1 Imports

1.2 Data Collection

1.3 Column Description

1.4 Data Cleaning

1.4.1 Data Types

1.4.2 Descriptive Statistics

1.4.2.1 Data Structure

1.4.2.2 General Overview

1.4.2.3 Numerical Statistics

1.4.3 Visualitzation

1.4.3.1 Numerical Attributes

1.4.4 Categorical Attributes

2 Exploratory Data Analysis

2.1 Data Collection

2.2 Column Description

2.3 Hypothesis Validation

2.3.0.1 H1) Older customers are more likely to be interested in car insurance.

2.3.0.1.1 Young people seem to be less interested in car insurance. The median age of interested customers is 43 years old (AIQ: 35.51), while the median age of uninterested customers is 34 years old (AIQ: 24.49).

2.3.0.2 H2) Women are probably more interested in car insurance.

2.3.0.2.1 Of the customers interested in car insurance, 61% were men and 39% were women. Therefore this hypothesis is FALSE. Although gender and response are statistically significant, i. e., are related.

2.3.0.3 H3) Customers having newer cars are more likely to be interested in car insurance.

2.3.0.3.1 Customers who own a car between 1 and 2 years are more likely to be interested in the car insurance (75%). While only 15% of the interested customers have new car. This hypothesis is FALSE.

2.3.0.4 H4) Customers with previous car damage are more likely to accept auto insurance.

2.3.0.4.1 Customers with previous car damage are more likely to be interested in car insurance, as 98% said yes.

2.3.0.5 H5) Customers with previous car insurance are more likely to accept car insurance.

2.3.0.5.1 Only 0.3% of customers interested in car insurance have car previously insured. FALSE

2.3.0.6 H6) Interest in car insurance is greater among customers who have higher annual health insurance.

2.3.0.6.1 Although the annual healthcare paid has proven to be significant, this hypothesis will be considered FALSE, but its outliers will be investigated, in the next cycle, for example. There are many similarities between the alternatives. There are to much similarities between the alternatives.

2.3.0.7 H7) Customers who have had health insurance for longer are more likely to be interested in car insurance.

2.3.0.7.1 This hypothesis is false, basically interested customers and non-interested customers have the same amount of days associated. Yes (median: 154 days, IIQ: 82, 226); No (154 days, AIQ: 82, 227).

2.3.0.8 Hypothesis Conclusion

2.4 Multivariable Analysis

2.4.0.1 Correlation Matrix

2.4.0.2 Visualization

2.4.0.2.1 There is no high correlation between numerical variables

3 Data Preparation And Feature Selection

3.1 Data Collection

3.2 Column Description

3.3 Data Preparation

3.3.1 Target encoding

3.3.2 Frequency encoding

3.3.2.1 Building Encoder Function

3.3.3 Splitting data into train and test

3.3.3.1 Check response proportions

3.3.3.2 Using tidymodels steps to continue the preprocessing

3.3.3.3 Applying the recipe

3.4 Feature Selection

3.4.0.1 Show results

4 Machine Learning

4.1 Helper Functions

4.2 Data Collection

4.3 Column Description

4.4 Pre-processing

4.4.1 Split into train and test datasets

4.4.2 Applying steps

4.5 Logistic Regression

4.5.1 Gain & Lift Curves

4.6 Decision Tree 💻

4.7 Random Forest 💻

4.8 XGBosst 💻

4.9 KNN

5 Fine Tuning

5.1 Helper Functions

5.2 Data

5.3 Pre-processing

5.4 Splitting into train and test data sets

5.5 Kfold cross validation

5.6 Logistic Regression 💻

5.7 Decision Tree 💻

5.8 Random Forest 💻

5.9 XGBoost 💻

5.10 KNN 💻

5.11 Model Comparison

5.12 Save final model

5.12.1 Make predictions