Travel Insurance Prediction

Introduction

Pada analisis kali ini saya akan menggunakan metode Supervised Learning (Classfication Machine Learning) untuk mengkaji data prediksi asuransi perjalanan, mencari indikator yang dapat digunakan untuk memprediksi pelanggan yang ingin memakai asuransi perjalanan. Metode pendekatan Supervised Learning yang akan dilakukan terdiri dari Klasifikasi Naive Bayes, Decision Tree dan Random Forest.

Library

library(dplyr)
library(caret)
library(e1071)
library(ROCR)
library(partykit)
library(randomForest)

Data Preparation

Import Data

travel <- read.csv("datainput/travel_insurance.csv", stringsAsFactors = T)
head(travel)

#>   X Age              Employment.Type GraduateOrNot AnnualIncome FamilyMembers
#> 1 0  31            Government Sector           Yes       400000             6
#> 2 1  31 Private Sector/Self Employed           Yes      1250000             7
#> 3 2  34 Private Sector/Self Employed           Yes       500000             4
#> 4 3  28 Private Sector/Self Employed           Yes       700000             3
#> 5 4  28 Private Sector/Self Employed           Yes       700000             8
#> 6 5  25 Private Sector/Self Employed            No      1150000             4
#>   ChronicDiseases FrequentFlyer EverTravelledAbroad TravelInsurance
#> 1               1            No                  No               0
#> 2               0            No                  No               0
#> 3               1            No                  No               1
#> 4               1            No                  No               0
#> 5               1           Yes                  No               0
#> 6               0            No                  No               0

Data Cleansing

🧮 Mengecek tipe data

glimpse(travel)

#> Rows: 1,987
#> Columns: 10
#> $ X                   <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, …
#> $ Age                 <int> 31, 31, 34, 28, 28, 25, 31, 31, 28, 33, 31, 26, 32…
#> $ Employment.Type     <fct> Government Sector, Private Sector/Self Employed, P…
#> $ GraduateOrNot       <fct> Yes, Yes, Yes, Yes, Yes, No, Yes, Yes, Yes, Yes, Y…
#> $ AnnualIncome        <int> 400000, 1250000, 500000, 700000, 700000, 1150000, …
#> $ FamilyMembers       <int> 6, 7, 4, 3, 8, 4, 4, 3, 6, 3, 9, 5, 6, 6, 3, 7, 4,…
#> $ ChronicDiseases     <int> 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1,…
#> $ FrequentFlyer       <fct> No, No, No, No, Yes, No, No, Yes, Yes, Yes, No, Ye…
#> $ EverTravelledAbroad <fct> No, No, No, No, No, No, No, Yes, Yes, No, No, Yes,…
#> $ TravelInsurance     <int> 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0,…

⚙️ Mengubah isi nama kolom Travel Insurance untuk kelas target

travel$TravelInsurance <- factor(travel$TravelInsurance,levels = c(0,1) , labels = c("Yes","No"))

⚙️ Mengubah tipe data dan menghapus kolom yang tidak digunakan

travel_clean <- travel %>% 
  select(-X) %>% 
  mutate(ChronicDiseases = as.factor(ChronicDiseases))
travel_clean %>% head()

#>   Age              Employment.Type GraduateOrNot AnnualIncome FamilyMembers
#> 1  31            Government Sector           Yes       400000             6
#> 2  31 Private Sector/Self Employed           Yes      1250000             7
#> 3  34 Private Sector/Self Employed           Yes       500000             4
#> 4  28 Private Sector/Self Employed           Yes       700000             3
#> 5  28 Private Sector/Self Employed           Yes       700000             8
#> 6  25 Private Sector/Self Employed            No      1150000             4
#>   ChronicDiseases FrequentFlyer EverTravelledAbroad TravelInsurance
#> 1               1            No                  No             Yes
#> 2               0            No                  No             Yes
#> 3               1            No                  No              No
#> 4               1            No                  No             Yes
#> 5               1           Yes                  No             Yes
#> 6               0            No                  No             Yes

glimpse(travel_clean)

#> Rows: 1,987
#> Columns: 9
#> $ Age                 <int> 31, 31, 34, 28, 28, 25, 31, 31, 28, 33, 31, 26, 32…
#> $ Employment.Type     <fct> Government Sector, Private Sector/Self Employed, P…
#> $ GraduateOrNot       <fct> Yes, Yes, Yes, Yes, Yes, No, Yes, Yes, Yes, Yes, Y…
#> $ AnnualIncome        <int> 400000, 1250000, 500000, 700000, 700000, 1150000, …
#> $ FamilyMembers       <int> 6, 7, 4, 3, 8, 4, 4, 3, 6, 3, 9, 5, 6, 6, 3, 7, 4,…
#> $ ChronicDiseases     <fct> 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 1,…
#> $ FrequentFlyer       <fct> No, No, No, No, Yes, No, No, Yes, Yes, Yes, No, Ye…
#> $ EverTravelledAbroad <fct> No, No, No, No, No, No, No, Yes, Yes, No, No, Yes,…
#> $ TravelInsurance     <fct> Yes, Yes, No, Yes, Yes, Yes, Yes, No, No, Yes, Yes…

✏️ Pastikan data tidak ada missing value

colSums(is.na(travel_clean))

#>                 Age     Employment.Type       GraduateOrNot        AnnualIncome 
#>                   0                   0                   0                   0 
#>       FamilyMembers     ChronicDiseases       FrequentFlyer EverTravelledAbroad 
#>                   0                   0                   0                   0 
#>     TravelInsurance 
#>                   0

Exploratory Data Analysis

summary(travel_clean)

#>       Age                            Employment.Type GraduateOrNot
#>  Min.   :25.00   Government Sector           : 570   No : 295     
#>  1st Qu.:28.00   Private Sector/Self Employed:1417   Yes:1692     
#>  Median :29.00                                                    
#>  Mean   :29.65                                                    
#>  3rd Qu.:32.00                                                    
#>  Max.   :35.00                                                    
#>   AnnualIncome     FamilyMembers   ChronicDiseases FrequentFlyer
#>  Min.   : 300000   Min.   :2.000   0:1435          No :1570     
#>  1st Qu.: 600000   1st Qu.:4.000   1: 552          Yes: 417     
#>  Median : 900000   Median :5.000                                
#>  Mean   : 932763   Mean   :4.753                                
#>  3rd Qu.:1250000   3rd Qu.:6.000                                
#>  Max.   :1800000   Max.   :9.000                                
#>  EverTravelledAbroad TravelInsurance
#>  No :1607            Yes:1277       
#>  Yes: 380            No : 710       
#>                                     
#>                                     
#>                                     
#>

Cek proporsi kelas target

travel_clean$TravelInsurance %>% 
   table() %>% 
   prop.table()

#> .
#>       Yes        No 
#> 0.6426774 0.3573226

Naive Bayes

Cross Validation

✏️ Pisahkan data menjadi data test dan data train dengan perbandingan 75% : 25%. Pengambilan data secara acak menggunakan nilai seed 100. Penggunaan seed dilakukan agar hasil pengacakan tetap.

RNGkind(sample.kind = "Rounding")
set.seed(100)


index_travel <- sample(nrow(travel_clean), nrow(travel_clean)*0.75)

travel_train <- travel_clean[index_travel, ]
travel_test <- travel_clean[-index_travel, ]

# re-check class imbalance
travel_train$TravelInsurance %>% 
   table() %>% 
   prop.table()

#> .
#>       Yes        No 
#> 0.6463087 0.3536913

Build Model

Dalam memodelkan Naive Bayes menggunakan data train dengan fungsi naiveBayes(), dan cukup menambahkan parameter laplace = 1

names(travel_train)

#> [1] "Age"                 "Employment.Type"     "GraduateOrNot"      
#> [4] "AnnualIncome"        "FamilyMembers"       "ChronicDiseases"    
#> [7] "FrequentFlyer"       "EverTravelledAbroad" "TravelInsurance"

# train model
model_naive <- naiveBayes(formula = TravelInsurance~., data = travel_train, laplace = 1)
model_naive

#> 
#> Naive Bayes Classifier for Discrete Predictors
#> 
#> Call:
#> naiveBayes.default(x = X, y = Y, laplace = laplace)
#> 
#> A-priori probabilities:
#> Y
#>       Yes        No 
#> 0.6463087 0.3536913 
#> 
#> Conditional probabilities:
#>      Age
#> Y         [,1]     [,2]
#>   Yes 29.47560 2.633184
#>   No  29.85389 3.337125
#> 
#>      Employment.Type
#> Y     Government Sector Private Sector/Self Employed
#>   Yes         0.3274611                    0.6725389
#>   No          0.1795841                    0.8204159
#> 
#>      GraduateOrNot
#> Y            No       Yes
#>   Yes 0.1585492 0.8414508
#>   No  0.1436673 0.8563327
#> 
#>      AnnualIncome
#> Y          [,1]     [,2]
#>   Yes  817808.9 330118.5
#>   No  1137476.3 371507.4
#> 
#>      FamilyMembers
#> Y         [,1]     [,2]
#>   Yes 4.638629 1.575621
#>   No  4.952562 1.657919
#> 
#>      ChronicDiseases
#> Y             0         1
#>   Yes 0.7181347 0.2818653
#>   No  0.7126654 0.2873346
#> 
#>      FrequentFlyer
#> Y            No       Yes
#>   Yes 0.8632124 0.1367876
#>   No  0.6672968 0.3327032
#> 
#>      EverTravelledAbroad
#> Y             No        Yes
#>   Yes 0.93056995 0.06943005
#>   No  0.56899811 0.43100189

Model Prediction

Lakukan predict class pada data test, menggunakan fungsi predict()

travel_predClass <- predict(object = model_naive, newdata = travel_test, type = "class")
head(travel_predClass)

#> [1] Yes Yes No  Yes No  No 
#> Levels: Yes No

Model Evaluation

Evaluasi hasil model dengan confusion matrix

# confusion matrix
library(caret)

confusionMatrix(data = travel_predClass,
                reference = travel_test$TravelInsurance,
                positive = "Yes")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction Yes  No
#>        Yes 283  90
#>        No   31  93
#>                                           
#>                Accuracy : 0.7565          
#>                  95% CI : (0.7163, 0.7937)
#>     No Information Rate : 0.6318          
#>     P-Value [Acc > NIR] : 0.000000001884  
#>                                           
#>                   Kappa : 0.439           
#>                                           
#>  Mcnemar's Test P-Value : 0.000000134411  
#>                                           
#>             Sensitivity : 0.9013          
#>             Specificity : 0.5082          
#>          Pos Pred Value : 0.7587          
#>          Neg Pred Value : 0.7500          
#>              Prevalence : 0.6318          
#>          Detection Rate : 0.5694          
#>    Detection Prevalence : 0.7505          
#>       Balanced Accuracy : 0.7047          
#>                                           
#>        'Positive' Class : Yes             
#>

📝 Berdasarkan hasil Confusion Matrix, dapat disimpulkan bahwa tingkat akurasi model sebesar 75,65%. Lalu karena dalam hal ini, kami menawarkan investasi perjalanan kepada pelanggan, dan ingin memprediksi apakah pelanggan akan tertarik berinvestasi. Jadi, kami akan menggunakan metrik Sensitivitas/Recall, yang memiliki tingkat keberhasilan sebesar 90,13%.

ROC and AUC

Receiver-Operating Curve (ROC)

ROC adalah kurva yang menggambarkan hubungan antara True Positive Rate dengan False Positive Rate pada setiap threshold. Model yang baik idealnya memiliki True Positive Rate yang tinggi dan False Positive Rate yang rendah.

travel_predProb <- predict(object = model_naive, newdata = travel_test, type = "raw")
head(travel_predProb)

#>             Yes         No
#> [1,] 0.87101836 0.12898164
#> [2,] 0.79449348 0.20550652
#> [3,] 0.04714785 0.95285215
#> [4,] 0.90178131 0.09821869
#> [5,] 0.04494304 0.95505696
#> [6,] 0.01639295 0.98360705

# ambil peluang kelas positif 
pred_prob <- travel_predProb[,1]

# membuat prediction object supaya bisa menghitung nilai tpr, fpr, dan auc
bayes_roc <- prediction(predictions = pred_prob, 
                        labels = travel_test$TravelInsurance)

# performance
model_roc_naive <- performance(bayes_roc, 
                             "tpr",
                             "fpr")
                             
# membuat plot
plot(model_roc_naive)
abline(0,1 , lty = 2)

Karena berbentuk visual, kurva ROC sulit untuk dibandingkan antar model. Oleh karena itu diperlukan AUC.

Area Under ROC Curve (AUC)

AUC biasa digunakan untuk membandingkan performa antar model. Semakin tinggi nilai AUC, semakin bagus performa modelnya. Untuk mendapatkan nilai AUC, tulis auc pada parameter measure dari performance() dan ambil nilai y.values.

bayes_auc <- performance(bayes_roc, "auc")

bayes_auc@y.values

#> [[1]]
#> [1] 0.749913

📝 Hasil nilai AUC sebesar 0.74, maka dapat disimpulkan bahwa model kita sudah baik dalam memisahkan kelas positif dan negatif.

Decision Tree

Cross Validation

✏️ Pisahkan data menjadi data test dan data train dengan perbandingan 75% : 25%.

RNGkind(sample.kind = "Rounding")
set.seed(100)


index_travel <- sample(nrow(travel_clean), nrow(travel_clean)*0.75)

travel_train <- travel_clean[index_travel, ]
travel_test <- travel_clean[-index_travel, ]

Gunakan teknik downsample untuk mengurangi observasi kelas mayoritas hingga seimbang dengan kelas minoritas.

# downsampling
RNGkind(sample.kind = "Rounding")
set.seed(100)
library(caret)

travel_train_down <- downSample(x = travel_train %>% select(-TravelInsurance),
                         y = travel_train$TravelInsurance,
                         yname = "TravelInsurance")

Cek proporsi kelas target

travel_train_down$TravelInsurance %>% 
  table %>% 
  prop.table()

#> .
#> Yes  No 
#> 0.5 0.5

Model Fitting

Untuk membuat model Decision Tree, dapat digunakan fungsi ctree() dengan parameter:

formula = y ~ x
data = data

library(partykit)

travel_tree <- ctree(TravelInsurance ~ .,
                       data = travel_train_down)
travel_tree

#> 
#> Model formula:
#> TravelInsurance ~ Age + Employment.Type + GraduateOrNot + AnnualIncome + 
#>     FamilyMembers + ChronicDiseases + FrequentFlyer + EverTravelledAbroad
#> 
#> Fitted party:
#> [1] root
#> |   [2] AnnualIncome <= 1300000
#> |   |   [3] Age <= 32: Yes (n = 607, err = 29.2%)
#> |   |   [4] Age > 32
#> |   |   |   [5] FamilyMembers <= 5: Yes (n = 120, err = 35.0%)
#> |   |   |   [6] FamilyMembers > 5: No (n = 75, err = 10.7%)
#> |   [7] AnnualIncome > 1300000
#> |   |   [8] EverTravelledAbroad in No
#> |   |   |   [9] Age <= 25: No (n = 28, err = 3.6%)
#> |   |   |   [10] Age > 25: No (n = 9, err = 44.4%)
#> |   |   [11] EverTravelledAbroad in Yes: No (n = 215, err = 2.8%)
#> 
#> Number of inner nodes:    5
#> Number of terminal nodes: 6

# visualisasi decision tree
plot(travel_tree, type="simple")

📈 Dari hasil di atas, dapat dilihat ada error sebesar 2.8%, yang artinya ada 215 data atau 2.8% yg kelasnya bukan positif.

Model Evaluation

Mari evaluasi travel_tree menggunakan confusion matrix berdasarkan hasil prediksi di data test

# prediksi label kelas di data test
pred_test_label <- predict(travel_tree, newdata = travel_test, type = "response")

# confusion matrix data test
confusionMatrix(data = pred_test_label,
                reference = travel_test$TravelInsurance,
                positive= "Yes")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction Yes  No
#>        Yes 305  71
#>        No    9 112
#>                                                
#>                Accuracy : 0.839                
#>                  95% CI : (0.8037, 0.8703)     
#>     No Information Rate : 0.6318               
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 0.6277               
#>                                                
#>  Mcnemar's Test P-Value : 0.000000000009104    
#>                                                
#>             Sensitivity : 0.9713               
#>             Specificity : 0.6120               
#>          Pos Pred Value : 0.8112               
#>          Neg Pred Value : 0.9256               
#>              Prevalence : 0.6318               
#>          Detection Rate : 0.6137               
#>    Detection Prevalence : 0.7565               
#>       Balanced Accuracy : 0.7917               
#>                                                
#>        'Positive' Class : Yes                  
#>

📝 Berdasarkan hasil Confusion Matrix, dapat disimpulkan bahwa tingkat akurasi model sebesar 83,9%. Lalu karena dalam hal ini, kami menawarkan investasi perjalanan kepada pelanggan, dan ingin memprediksi apakah pelanggan akan tertarik berinvestasi. Jadi, kami akan menggunakan metrik Sensitivitas/Recall, yang memiliki tingkat keberhasilan sebesar 97,13%.

Random Forest

Cross Validation

✏️ Pisahkan data menjadi data test dan data train dengan perbandingan 75% : 25%.

RNGkind(sample.kind = "Rounding")
set.seed(100)


index_travel <- sample(nrow(travel_clean), nrow(travel_clean)*0.75)

travel_train <- travel_clean[index_travel, ]
travel_test <- travel_clean[-index_travel, ]

Model Fitting

Model Random Forest akan menggunakan data OOB (Out-of-Bag) sebagai data untuk melakukan evaluasi dengan cara menghitung error.

library(randomForest)
model_rf <- randomForest(TravelInsurance ~ ., data = travel_train, importance = TRUE, 
                         ntree = 100)
model_rf

#> 
#> Call:
#>  randomForest(formula = TravelInsurance ~ ., data = travel_train,      importance = TRUE, ntree = 100) 
#>                Type of random forest: classification
#>                      Number of trees: 100
#> No. of variables tried at each split: 2
#> 
#>         OOB estimate of  error rate: 17.18%
#> Confusion matrix:
#>     Yes  No class.error
#> Yes 933  30  0.03115265
#> No  226 301  0.42884250

📈 Nilai OOB error pada model sebesar 17,18%. Dengan kata lain, akurasi model pada data OOB adalah 82,68%.

Prediction and Model Evaluation

pred_rf_test <- predict(model_rf, newdata = travel_test)

confusionMatrix(as.factor(pred_rf_test), travel_test$TravelInsurance, positive="Yes")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction Yes  No
#>        Yes 308  76
#>        No    6 107
#>                                                
#>                Accuracy : 0.835                
#>                  95% CI : (0.7994, 0.8666)     
#>     No Information Rate : 0.6318               
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 0.6146               
#>                                                
#>  Mcnemar's Test P-Value : 0.00000000000002541  
#>                                                
#>             Sensitivity : 0.9809               
#>             Specificity : 0.5847               
#>          Pos Pred Value : 0.8021               
#>          Neg Pred Value : 0.9469               
#>              Prevalence : 0.6318               
#>          Detection Rate : 0.6197               
#>    Detection Prevalence : 0.7726               
#>       Balanced Accuracy : 0.7828               
#>                                                
#>        'Positive' Class : Yes                  
#>

📝 Berdasarkan hasil Confusion Matrix, dapat disimpulkan bahwa tingkat akurasi model sebesar 83,5%. Lalu karena dalam hal ini, kami menawarkan investasi perjalanan kepada pelanggan, dan ingin memprediksi apakah pelanggan akan tertarik berinvestasi. Jadi, kami akan menggunakan metrik Sensitivitas/Recall, yang memiliki tingkat keberhasilan sebesar 98,09%.

Conclusion

Dalam hal ini, kami telah membuat beberapa model yang dapat memprediksi apakah pelanggan akan tertarik untuk membeli asuransi perjalanan berdasarkan parameter tertentu. Dan kami akan menggunakan metrik Post Pred Value/Precision, karena ingin mendekati atau menawarkan pelanggan sebanyak mungkin.

Jika dibandingkan dengan ketiga model lainnya yaitu Naive Bayes, Decision Tree dan Random Forest. Dari model Naive Bayes memiliki nilai tingkat accuracy 75,65% dan recall sebesar 90,13%. Yang kedua model Decision Tree memiliki nilai tingkat accuracy 83,9%% dan recall sebesar 97,13%. Yang ketiga model Random Forest memiliki nilai tingkat accuracy 83,5%% dan recall sebesar 98,09%. Berdasarkan urutan tingkat accuracy dan nilai precision, model klasifikasi Random Forest adalah model terbaik. Perusahaan dapat memprediksi calon pelanggan dengan lebih baik dan mengurangi resiko penyediaan asuransi perjalanan dengan menggunakan model ini.