Latar Belakang

Di Indonesia, jumlah kendaraan bermotor, termasuk mobil, terus meningkat seiring dengan pertumbuhan ekonomi dan perkembangan infrastruktur. Namun, peningkatan ini juga diikuti oleh risiko kecelakaan lalu lintas yang lebih tinggi. Dalam konteks ini, perusahaan asuransi otomotif berhadapan dengan tantangan dalam mengelola klaim asuransi dengan efisien, akurat, dan tepat waktu.

Dengan adopsi Metode Machine Learning dalam industri asuransi, tentu akan membuka peluang untuk mengolah big data yang telah dikumpulkan dari pemegang polis dan klaim sebelumnya. Analisis lebih mendalam atas data (sampel) ini dapat memberikan wawasan berharga mengenai pola klaim, faktor-faktor risiko, dan variabel-variabel prediksi yang berkaitan dengan kemungkinan terjadinya kecelakaan dan klaim di masa depan.

Rumusan Masalah

  1. Bagaimana kita dapat memanfaatkan data yang ada untuk memprediksi kemungkinan kecelakaan kendaraan dan klaim asuransi mobil di masa mendatang?
  2. Apa saja variabel yang paling berpengaruh dalam memprediksi kemungkinan klaim asuransi mobil?
  3. Bagaimana metode pengembangan model Machine Learning yang akurat sehingga dapat diandalkan untuk memperkirakan risiko klaim asuransi mobil?

Tujuan

  1. Mengidentifikasi variabel yang paling berpengaruh terhadap peluang terjadinya kecelakaan dan klaim.
  2. Mendapatkan model Machine Learning yang dapat memprediksi peluang terjadinya klaim dengan tingkat akurasi yang tinggi.
  3. Menghasilkan laporan hasil prediksi yang berguna untuk perusahaan asuransi dalam mengambil langkah-langkah preventif dan adaptif

Data (sampel)

Pada analisis ini, dataset yang digunakan adalah open-data yang tersedia pada website Kaggle, yaitu data dari sebuah startup yang menyediakan asuransi mobil. Ini merupakan salah satu merek asuransi mobil terbaik yang dikenal dengan rasio penyelesaian klaim tertinggi. Perusahaan ini diluncurkan pada bulan Oktober 2020 dan mendapatkan pemegang polis awalnya dengan menyediakan proses klaim yang bebas dari kerumitan, penerbitan polis instan, dan penyelesaian klaim dengan cakupan minimum.

Adapun data tersebut disediakan perusahaan untuk mengoptimalkan biaya asuransi dengan mengidentifikasi pemegang polis yang kemungkinan akan mengajukan klaim dalam 6 bulan mendatang.

Adapun setiap variabel tersebut merupakan representasi dari setiap penjelasan pada tabel di bawah. Secara lebih lengkap, data tersebut dapat dilihat melalui link kaggle berikut berikut

Pra-proses Data

Sebelum melakukan analisis, langkah awal yang harus dilakukan adalah membersihkan dan menyiapkan data agar sesuai dengan kebutuhan model yang akan digunakan. Berikut beberapa library yang digunakan dalam analisis ini.

library(dplyr)    #manipulasi data
library(ggplot2)  #visualisasi data
library(corrplot) #matriks korelasi
library(car)      #analisis regresi dan lainnya
library(viridis)
library(reshape2)
library(gridExtra)
library(magrittr)
library(plotly)
library(moments)
library(cluster)
library(ggiraphExtra)
library(partykit)

Penyesuaian tipe data

Kesesuaian tipe data menjadi salah satu faktor penting dari keberhasilan analisis. Setelah dikaji, ternyata beberapa variabel tidak bertipe factor sehingga dilakukan konversi tipe data, baik pada data latih maupun data validasi. Adapun konversi tersebut tidak berlaku untuk variabel policy_id,policy_tenure, age_of_car, age_of_policyholder, dan population_density.

cols_to_convert <- c("area_cluster", "make", "segment", "model", "fuel_type", "max_torque", "max_power",
                     "engine_type", "airbags", "is_esc", "is_adjustable_steering", "is_tpms", "is_parking_sensors",
                     "is_parking_camera", "rear_brakes_type", "displacement", "cylinder", "transmission_type",
                     "gear_box", "steering_type", "is_front_fog_lights", "is_rear_window_wiper",
                     "is_rear_window_washer", "is_rear_window_defogger", "is_brake_assist",
                     "is_power_door_locks", "is_central_locking", "is_power_steering",
                     "is_driver_seat_height_adjustable", "is_day_night_rear_view_mirror", "is_ecw",
                     "is_speed_alert", "ncap_rating", "is_claim")

for (col in cols_to_convert) {
  train[[col]] <- as.factor(train[[col]])
}

for (col in cols_to_convert) {
  if (col != "is_claim") {
    test[[col]] <- as.factor(test[[col]])
  }
}

Seleksi fitur

Adapun beberapa alasan mengapa perlu dilakukan seleksi variabel, yaitu:

  1. Uniqueness: Jika setiap entitas memiliki nilai yang unik untuk fitur tertentu, fitur tersebut tidak akan memberikan informasi prediktif yang berguna.
  2. Non-Informative: Jika fitur tersebut tidak memiliki hubungan yang jelas dengan variabel target yang ingin diprediksi (seperti peluang klaim asuransi dalam kasus ini), selanjutnya fitur tersebut tidak memberikan informasi yang bermanfaat untuk menghasilkan prediksi yang akurat.
  3. Dimensionality Reduction: Adanya banyak fitur (kolom) dalam dataset dapat mengakibatkan peningkatan kompleksitas model, lebih banyak memori yang diperlukan, dan waktu komputasi yang lebih lama.

Dari total 44 variabel yang digunakan untuk data latih, disimpulkan bahwa variabel policy_id sebaiknya tidak digunakan untuk kepentingan analisis karena merupakan data unique

train <- select(train, -policy_id)
test <- select(test, -policy_id)

Pengecekan data NA

# Melihat jumlah nilai NA dalam setiap kolom
na_counts <- sapply(train, function(x) sum(is.na(x)))

# Menampilkan kolom-kolom yang memiliki nilai NA
cols_with_na <- names(na_counts[na_counts > 0])
  print(cols_with_na)
## character(0)

Dari hasil tersebut, dapat diketahui bahwa data sudah tidak memiliki nilai NULL sehingga tidak perlu dilakukan inputasi/eliminasi data seperti pada umumnya

Eksplorasi data

Perlu diketahui bahwa tidak semua data sudah dalam format yang sesuai sehingga perlu dilakukan penyesuaian untuk bisa melakukan visualisasi data. Adapun beberapa bentuk yang akan diurai, yakni seperti berikut.

max_torque_new <- train["max_torque"]
max_torque_new <- transform(max_torque_new, 
                  torque = as.numeric(sub("Nm@.*", "", max_torque)),
                  rpm = as.numeric(sub(".*@(.*)rpm", "\\1", max_torque)))

Geom Bar variabel max_torque

rpm_counts <- as.data.frame(table(max_torque_new$rpm))
colnames(rpm_counts) <- c("RPM", "Count")
ggplot(rpm_counts, aes(x = factor(RPM), y = Count, fill = Count)) +
  geom_bar(stat = "identity") +
  scale_fill_gradient(low = "yellow", high = "darkblue") +  # Specify the gradient colors
  labs(title = "Bar Chart of RPM Counts from `max_torque`", x = "RPM", y = "Count") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

Persentase total variabel area_cluster

cluster_counts <- data.frame(
  area_cluster = levels(train$area_cluster),
  n = table(train$area_cluster))

color_scale <- colorRampPalette(viridis::viridis(length(cluster_counts$area_cluster)))
colors <- color_scale(length(cluster_counts$area_cluster))
pie_chart <- plot_ly(cluster_counts, labels = ~area_cluster, values = ~n.Freq, type = "pie",
                      marker = list(colors = colors, line = list(color = 'black')))
pie_chart

Melalui grafik di atas, dapat diketahui bahwa sebaran nilai terbanyak terdapat pada klaster daerah C8, C2, dan C5. Indikasi tersebut tentu menjadi bukti dominansi sehingga perlu dilakukan analisis lebih lanjut ataupun bentuk penanganan lainnya sebelum dianalisis. Sebaran tersebut juga bisa menjadi jawaban bahwa sebaran datanya mungkin belum mengikuti sebaran normal.

Stacked Bar-Chart (variabel binary)

selected_cols <- select(train, is_esc, is_adjustable_steering, is_tpms, is_parking_sensors, is_parking_camera)
count_yes <- colSums(selected_cols == "Yes", na.rm = TRUE)
count_no <- colSums(selected_cols == "No", na.rm=TRUE)
# Create a data frame with the counts
data_counts <- data.frame(
  Feature = names(count_yes),
  Yes = count_yes,
  No = count_no
)

data_long <- melt(data_counts, id.vars = "Feature") #change format data wide to long
bar_chart <- ggplot(data_long, aes(x = Feature, y = value, fill = variable)) +
  geom_bar(stat = "identity") +
  coord_flip() +  # Flip the coordinates to make it horizontal
  labs(x = "Count", y = "Feature") +
  scale_fill_viridis(discrete = TRUE, option = "D", alpha = 0.9) +  # Adjust alpha to make it softer
  ggtitle("Stacked Horizontal Bar Chart with Yes/No Counts") +
  theme_minimal()
bar_chart

Indikasi yang serupa juga ditunjukkan melalui grafik di atas. Oleh karena itu, dilakukan pengecekan terlebih dahulu. Lebih lanjut, jika data terbukti tidak menyebar mengikuti sebaran normal, dilakukan proses transformasi dan standardisasi data. Akan tetapi, variabel kategorikal atau variabel yang menggambarkan kategori atau label biasanya tidak perlu mengalami transformasi seperti ini karena mereka memiliki sifat yang berbeda. Oleh karena itu, sebelumnya perlu dilakukan filtrasi variabel dengan tipe numerik saja.

# Periksa distribusi dari masing-masing variabel numerik
numeric_vars <- c("policy_tenure","age_of_car", "age_of_policyholder" ,"population_density", "width", "height", "gross_weight")

# Menampilkan summary dari masing-masing variabel numerik
for (var in numeric_vars) {
 print(paste("Skewness ", var, ":", round(skewness(train[[var]]), 2)))
}
## [1] "Skewness  policy_tenure : 0.05"
## [1] "Skewness  age_of_car : 1.09"
## [1] "Skewness  age_of_policyholder : 0.64"
## [1] "Skewness  population_density : 1.67"
## [1] "Skewness  width : -0.49"
## [1] "Skewness  height : 1.04"
## [1] "Skewness  gross_weight : 0.55"

Berdasarkan hasil skewness, variabel-variabel dapat dikelompokkan sebagai berikut: 1. Variabel yang memerlukan transformasi lebih lanjut: age_of_car, age_of_policyholder, population_density, dan height 2. Variabel yang tidak memerlukan transformasi tambahan:“policy_tenure”, “width”, “gross_weight” 3. Adapun variabel yang memerlukan transformasi lebih lanjutan, seperti age_of_car, age_of_policyholder, population_density, dan height, transformasi seperti logaritma atau kuadrat bisa dipertimbangkan untuk mendekati distribusi yang lebih simetris.

Transformasi, Standardisasi, Encoding Data

Transformasi Akar Kuadrat (X = Y^2)

Transformasi ini dapat diterapkan pada variabel dengan skewness yang tinggi, seperti pada variabel population_density, height, dan width. Transformasi ini akan membantu mendekati distribusi data ke kondisi yang lebih simetris.

# Identifikasi kolom-kolom numerik
numeric_cols <- sapply(train, is.numeric)

# Melakukan transformasi akar kuadrat (sqrt) untuk kolom-kolom numerik di train_x
for (col in names(train)[numeric_cols]) {
  train[[col]] <- sqrt(train[[col]])
}
for (col in names(test)[numeric_cols]) {
  test[[col]] <- sqrt(test[[col]])
}

Standardisasi Data

# Melakukan standarisasi pada kolom-kolom numerik
train[numeric_cols] <- scale(train[numeric_cols])
test[numeric_cols] <- scale(test[numeric_cols])
datatable(train, options = list(scrollX = TRUE, pageLength =5))
## Warning in instance$preRenderHook(instance): It seems your data is too
## big for client-side DataTables. You may consider server-side processing:
## https://rstudio.github.io/DT/server.html

Model Machine Learning dengan Data Latih

# Memisahkan data menjadi data latih dan data uji
set.seed(123)
index <- sample(1:nrow(train), 0.7 * nrow(train))
data_latih <- train[index, ]
data_uji <- train[-index, ]

Adapun variabel yang akan digunakan adalah variabel numerik saja, dengan argumen bahwa prediksi klaim dapat lebih terfokus jika menggunakan peubah yang paling berpengaruh. Oleh karena itu, dilakukan kembali filtering data yang bertipe numerik saja, yaitu seperti di bawah ini.

data_num <- data_latih %>% 
  filter(is_claim == 1 ) %>% 
  select_if(is.numeric)
glimpse(data_num)
## Rows: 2,640
## Columns: 9
## $ policy_tenure       <dbl> 1.09760945, -0.10734040, 1.28163404, -0.19550692, …
## $ age_of_car          <dbl> 0.80482692, 0.92593467, -0.49642288, 0.80482692, -…
## $ age_of_policyholder <dbl> 1.33165133, 0.07883898, -0.49990857, -1.51747881, …
## $ population_density  <dbl> -0.6277114, -0.5319601, -0.5319601, -0.5319601, 0.…
## $ turning_radius      <dbl> -1.57184719, -0.22189126, -0.22189126, -0.22189126…
## $ length              <dbl> -0.550538552, 0.002588141, 0.002588141, 0.00258814…
## $ width               <dbl> -1.7814523, 0.5666997, 0.5666997, 0.5666997, -1.40…
## $ height              <dbl> 3.3270220, -0.2851024, -0.2851024, -0.2851024, -0.…
## $ gross_weight        <dbl> 0.6210659, -0.2046986, -0.2046986, -0.2046986, -0.…

Penentuan Parameter K Optimum

Metode Elbow (Elbow Method) adalah salah satu metode yang digunakan untuk memilih jumlah klaster yang optimal (nilai K) dalam algoritma K-Means clustering. Tujuannya adalah untuk menentukan titik “elbow” pada grafik jumlah cluster versus nilai dalam cluster sum of squares (WCSS)

wcss <- vector()
for (i in 1:10) {
  kmeans_model <- kmeans(data_num, centers = i)
  wcss[i] <- kmeans_model$tot.withinss
}
plot(1:10, wcss, type = "b", pch = 19, frame = FALSE, xlab = "Number of Clusters (K)", ylab = "Within-Cluster Sum of Squares (WCSS)")

# Identify the "elbow" point
elbow_point <- kmeans(wcss, centers = 1)$cluster
points(elbow_point, wcss[elbow_point], col = "red", cex = 2, pch = 19)

Dari grafik tersebut, penentuan nilai terbaik didasarkan pada titik balik dimana grafik tidak mengalami penurunan yang signifikan kembali. Oleh karena itu, disimpulkan bahwa K terbaik adalah K=3.

Algoritma K-Means

K-Means adalah algoritma dalam analisis klastering yang digunakan untuk mengelompokkan data ke dalam beberapa kelompok atau kluster berdasarkan kesamaan fitur atau karakteristik tertentu. Hasil akhirnya menunjukkan adanya pemisahan data ke dalam kelompok-kelompok homogen sehingga setiap titik data dalam satu kelompok memiliki kesamaan yang tinggi dengan yang lain dalam kelompok tersebut

data_cluster <- kmeans(data_num,centers = 3)

Lokasi Centroid Klaster

data_cluster$centers
##   policy_tenure age_of_car age_of_policyholder population_density
## 1     0.4919212  0.1928472        0.0831132112        -0.12005796
## 2     0.5266686  0.2889848        0.1539225144        -0.13398615
## 3    -0.3047095 -1.2207337        0.0002741029         0.06831504
##   turning_radius      length     width      height gross_weight
## 1      -0.169035  0.01053221  0.263850 -0.03412793   -0.2439291
## 2       1.507371  1.41072931  1.043123  1.03187468    1.5470615
## 3      -1.075723 -1.28115795 -1.381706 -0.94470666   -0.9483842

Pada dataframe di atas, terlampir koordinat (nilai) dari setiap centroid untuk setiap atribut dalam dataset

Ukuran Kebaikan Model

Rasio BSS/TSS dapat digunakan untuk mengukur seberapa besar variabilitas yang dijelaskan oleh klastering. Semakin tinggi nilai rasio yang dimiliki model, maka akan semakin baik model tersebut.

data_cluster$betweenss/data_cluster$totss
## [1] 0.5043161
data_num$cluster <- as.factor(data_cluster$cluster)
datatable(data_num, options = list(scrollX = TRUE, pageLength = 5))

Interpretasi

ggRadar(data=data_num, 
        aes(colour=cluster), 
        interactive=TRUE)

  • Cluster 1 (Kelompok 1) memiliki karakteristik yang berbeda. Mereka cenderung memiliki nilai yang lebih rendah pada fitur usia kendaraan (age_of_car), usia pemegang polis (age_of_policyholder), dan tinggi (height). Namun, mereka juga tinggal di area dengan kepadatan penduduk yang lebih rendah (population_density). Label yang sesuai untuk kluster ini mungkin adalah “Klaim Rendah, Polis Lama, Area Rendah”

  • Cluster 2 (Kelompok 2) tampaknya mewakili pelanggan yang memiliki klaim rendah. Ini dapat diindikasikan oleh fakta bahwa hampir semua fitur yang diukur cenderung lebih rendah. Namun, variabel policy_tenure menunjukkan bahwa klaster ini memiliki pelanggan dengan durasi polis yang sudah lama dan dominan berada di area padat (population_density). Label yang sesuai untuk kluster ini mungkin adalah “Klaim Sedang, Polis Lama, Area Padat”

  • Cluster 3 (Kelompok 3) cenderung memiliki nilai tinggi pada atribut policy_tenure, yang mengindikasikan bahwa mereka adalah pelanggan dengan polis lama. Namun, atribut lain tidak memiliki perbedaan yang signifikan dengan kelompok lainnya. Label yang sesuai untuk kluster ini mungkin adalah “Polis Lama dan Klaim Tinggi,”

    Oleh karena itu, dari keanggotaan kluster dari pelanggan yang telah melakukan klaim, diketahui bahwa mereka didominansi oleh pemegang polis dengan tenor yang sudah cukup lama.

Klasifikasi Model Fitting Decision Tree

df_claim <- data_latih%>% 
  filter(is_claim == 1) %>% 
  select(- is_claim)

cluster <- data_num$cluster
combined_df <- cbind(cluster, df_claim)  
datatable(combined_df, options = list(scrollX = TRUE, pageLength = 5))

Cross-Validation

RNGkind(sample.kind = "Rounding") 
## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## used
set.seed(417)

# index sampling
index <- sample(x = nrow(combined_df), size = nrow(combined_df) * 0.8)

# splitting
data_train <- combined_df[index, ]
data_test <- combined_df[-index, ]
model_tree <- ctree(cluster ~ ., combined_df, maxdepth = 3)  # Adjust the depth as needed
plot(model_tree, main = "Model Tree Visualization")

Adapun dari hasil plot di atas diketahu bahwa model dan engine_type adalah faktor-faktor kunci yang memengaruhi klasifikasi ke dalam cluster tertentu. Model-model mobil tertentu seperti M11 dan M4 memiliki prediksi yang sangat akurat, sementara jenis mesin tertentu juga memiliki pengaruh signifikan dalam membuat keputusan. Selain itu, age_of_car juga memainkan peran penting, terutama dalam subkelompok dengan jenis mesin tertentu.

Evaluasi Model

Adapun metrik yang digunakan sebagai bentuk evaluasi kinerja model adalah hasil rata-rata dari setiap klaster yang diprediksi. Summary model tersebut dapat dilihat pada dataframe di bawah ini

pred_pra_test <- predict(model_tree, data_test, type = "response")
evaluation_metrics <- data.frame(
  Metric = c("Accuracy", "Precision", "Recall", "F1-Score"),
  Value = numeric(4)
)

# Menghitung akurasi
accuracy <- sum(pred_pra_test == data_test$cluster) / length(data_test$cluster)
evaluation_metrics[1, "Value"] <- accuracy

# Menghitung presisi rata-rata untuk semua kelas
precision <- sapply(levels(data_test$cluster), function(class) {
  sum(pred_pra_test == class & data_test$cluster == class) / sum(pred_pra_test == class)
})
average_precision <- mean(precision)
evaluation_metrics[2, "Value"] <- average_precision

# Menghitung recall rata-rata untuk semua kelas
recall <- sapply(levels(data_test$cluster), function(class) {
  sum(pred_pra_test == class & data_test$cluster == class) / sum(data_test$cluster == class)
})
average_recall <- mean(recall)
evaluation_metrics[3, "Value"] <- average_recall

# Menghitung F1-score rata-rata untuk semua kelas
f1_score <- 2 * (precision * recall) / (precision + recall)
average_f1_score <- mean(f1_score, na.rm = TRUE)
evaluation_metrics[4, "Value"] <- average_f1_score

# Menampilkan dataframe metrik evaluasi
print(evaluation_metrics)
##      Metric     Value
## 1  Accuracy 0.9848485
## 2 Precision 0.9886554
## 3    Recall 0.9819214
## 4  F1-Score 0.9850875

Model klasifikasi tersebut memiliki tingkat akurasi yang sangat tinggi (98.31%) dalam memprediksi kelas-kelas yang ada, yaitu cluster 1,2,dan 3. Presisi yang tinggi (98.74%) menunjukkan bahwa sebagian besar prediksi positif yang dibuat oleh model benar-benar benar. Recall yang baik (98.02%) menunjukkan bahwa model mampu mengidentifikasi sebagian besar kasus positif yang sebenarnya. F1-Score yang tinggi (98.35%) menunjukkan bahwa model memiliki keseimbangan yang baik antara presisi dan recall. Keseluruhan, hasil ini menunjukkan bahwa model Anda sangat baik dalam melakukan klasifikasi. Dengan demikian, tidak perlu dilakukan tuning hyperparameter, yakni dalam konteks decision-tree adalah membuat model dengan pruning