Algorithm

As this problem is regression problem we will use Multiple Linear Regression Algorithm to make Medical insurance Predictive Model.

Simple Linear Regression

simple linear regression is a simple method for predicting the quantitative value and study relationships between two continuous variables suppose X and Y. Mathematically, simple linear regression can be written as:

\[Y=a+b∗X+e\]

Where \(Y\) is dependent variable, \(X\) is independent variable, \(a\) is the intercept , \(b\) is the slope of \(X\) and \(e\) is the error term in equation.

Linear regression method’s main task is to find the best-fitting straight line through the Y and X points

Spliting the data

Machine Learning we require training data to train the model and testing data to test the model performance. We will use 75% of data as training data and remaining as a testing data.

set.seed(101) # Set Seed so that same sample can be reproduced in future also
 
sample <- sample.int(n = nrow(insurance), size = floor(.75*nrow(insurance)), replace = F)
train_df <- insurance[sample, ] # 75% data for the training
test_df  <- insurance[-sample, ] # remaining data  for testing

dim(train_df)

## [1] 1003    7

dim(test_df)

## [1] 335   7

We have 1003 rows in training sets and 335 rows for the testing data.

Train the Model

We will use linear regression model from caret package for our insurance problem.

knitr::kable(head(test_df))

real_charges <- select(test_df,charges)
test_df <- select(test_df,-charges)

ins_model <- train(charges ~ .
                        ,train_df
                        ,method = "lm"
                        )

ins_model

## Linear Regression 
## 
## 1003 samples
##    6 predictor
## 
## No pre-processing
## Resampling: Bootstrapped (25 reps) 
## Summary of sample sizes: 1003, 1003, 1003, 1003, 1003, 1003, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   6364.451  0.7248959  4416.144
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

summary(ins_model)

## 
## Call:
## lm(formula = .outcome ~ ., data = dat)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -28647  -3039  -1072   1814  29678 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -10886.35    1183.76  -9.196   <2e-16 ***
## age                227.74      14.42  15.798   <2e-16 ***
## sexmale            274.18     396.51   0.691   0.4894    
## bmi                347.64      34.23  10.155   <2e-16 ***
## children           425.81     169.09   2.518   0.0119 *  
## smokeryes        23553.52     492.65  47.810   <2e-16 ***
## regionnorthwest   -930.97     574.91  -1.619   0.1057    
## regionsoutheast  -1312.03     562.47  -2.333   0.0199 *  
## regionsouthwest  -1258.10     575.88  -2.185   0.0291 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6249 on 994 degrees of freedom
## Multiple R-squared:  0.7337, Adjusted R-squared:  0.7315 
## F-statistic: 342.3 on 8 and 994 DF,  p-value: < 2.2e-16

The output of summary() shows there are eight coefficients while we passed only 6 features. This happened because the caret packages applied a technique called dummy coding to each of the factor - type variables .

• residuals section provides the summary statistics for the errors in our Predictions. The residuals is equals to the true value minus the predicted value.

• p-value denoted Pr(>|t|), shows the relationship between the dependent variable and independent variable . The level of significance is 0.05(threshold value). The independent variable with p-value less than significance level are considered statistically significant.

• Multiple R-squared value provides a measure of how well our model as a whole explains the values of the dependent variable. The closer the value is to 1.0 the better the model perfectly explains the data.

cor(predict(ins_model,test_df), real_charges)

##        charges
## [1,] 0.8055643

real_charges$prediction <- predict(ins_model,test_df)

knitr::kable(head(real_charges))

Improve Model

BMI may have zero impact on medical expenditure for individuals in the normal weight range but , it may be strongly related to higher costs for the obese people i.e BMI >= 30.

We can model this relationship by creating a binary obesity indicator variable i.e 1 if BMI >= 30 and 0 if BMI < 30.

train_df$bmi30 <- ifelse(train_df$bmi >= 30, 1, 0)
test_df$bmi30 <- ifelse(test_df $bmi >= 30 ,1 ,0)

In linear Regression , the relationship between an independent variable and the dependent variable is assumed to be linear, but this may not be always true.

• The effect of age on medical expenditure may not be constant through out the age group. The treatment may become disproportionately expensive for oldest population.

• to show non linear age to the model we will use square of age.

• When two features have a combined effect , this is known as interaction.

In my opinion obesity indicator (bmi30) and smoker indicator has relationship between eachother. We will bmi30*smoker to the model and test our hypothesis.

new_model <- train(charges ~ age+ age^2+ children + bmi+ bmi30*smoker + region 
                        ,train_df
                        ,method = "lm"
                        )

Compare two model

summary(new_model)

## 
## Call:
## lm(formula = .outcome ~ ., data = dat)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -37254  -1952  -1143    -38  30576 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       -4451.53    1172.52  -3.797 0.000156 ***
## age                 239.93      11.17  21.488  < 2e-16 ***
## children            531.72     130.97   4.060  5.3e-05 ***
## bmi                 140.07      42.84   3.269 0.001115 ** 
## bmi30             -1022.20     529.17  -1.932 0.053683 .  
## smokeryes         12727.41     573.17  22.205  < 2e-16 ***
## regionnorthwest    -658.96     445.12  -1.480 0.139082    
## regionsoutheast   -1065.91     435.82  -2.446 0.014628 *  
## regionsouthwest   -1501.03     445.86  -3.367 0.000790 ***
## `bmi30:smokeryes` 19357.92     764.94  25.307  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4837 on 993 degrees of freedom
## Multiple R-squared:  0.8406, Adjusted R-squared:  0.8391 
## F-statistic: 581.8 on 9 and 993 DF,  p-value: < 2.2e-16

summary(ins_model)

## 
## Call:
## lm(formula = .outcome ~ ., data = dat)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -28647  -3039  -1072   1814  29678 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -10886.35    1183.76  -9.196   <2e-16 ***
## age                227.74      14.42  15.798   <2e-16 ***
## sexmale            274.18     396.51   0.691   0.4894    
## bmi                347.64      34.23  10.155   <2e-16 ***
## children           425.81     169.09   2.518   0.0119 *  
## smokeryes        23553.52     492.65  47.810   <2e-16 ***
## regionnorthwest   -930.97     574.91  -1.619   0.1057    
## regionsoutheast  -1312.03     562.47  -2.333   0.0199 *  
## regionsouthwest  -1258.10     575.88  -2.185   0.0291 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6249 on 994 degrees of freedom
## Multiple R-squared:  0.7337, Adjusted R-squared:  0.7315 
## F-statistic: 342.3 on 8 and 994 DF,  p-value: < 2.2e-16

Our Multiple Linear Regression equation is:

\[charges = -4451.53 + 227.74 age + 274.18 sexmale + 347.64 bmi + 425.81children + 23553.52smokeryes + -930.97regionnorthwest + -1312.03 regionsoutheast + -1258.10 regionsouthwest\]

cor(predict(new_model,test_df), real_charges)

##        charges prediction
## [1,] 0.8729587   0.923047

real_charges$prediction_new <- predict(new_model,test_df)

knitr::kable(head(real_charges,10))

Save Model

saveRDS(new_model,"Final_model.rds")

Model Deployment

We can deploy the model as webservices in R using Shiny framework made by Rstudio .