Klasifikasi Pelanggan Potensial Menggunakan Random Forest dan Extreme Gradient Boosting dengan
Penanganan Imbalanced Data

1. Pendahuluan

1.1 Studi Kasus

Sebuah operator telekomunikasi seluler akan melakukan kerja sama dengan sebuah bank untuk meningkatkan angka recharge pelanggan pra-bayar melalui fasilitas perbankan, seperti ATM, internet banking, dan sebagainya. Dalam usahanya ini, perusahaan tersebut berupaya mengimplementasikan model Machine Learning untuk memprediksi pelanggan yang potensial untuk ditawarkan fasilitas tersebut. Perusahaan tersebut memiliki 45000 data pelanggan dengan indikator rata-rata durasi melakukan panggilan per bulan (menit), rata-rata penghasilan dari transaksi panggilan per bulan (Rp), rata-rata frekuensi melakukan panggilan per bulan, persentase panggilan di jam kerja, persentase panggilan sesama operator, rata-rata penghasilan dari transaksi SMS per bulan (Rp), persentase transaksi SMS sesama operator, rata-rata pemakaian data per bulan (MB), rata-rata penghasilan dari transaksi pemakaian data per bulan (Rp), rata-rata frekuensi melakukan recharge pulsa per bulan, dan rata-rata banyaknya wilayah yang dikunjungi per bulan.

1.2 Tujuan

Adapun tujuan yang akan dicapai pada tugas ini adalah sebagai berikut:

1. Menghasilkan informasi mengenai penggunaan fasilitas perbankan dari 45.000 pelanggan prabayar

2. Menyusun model Machine Learning terbaik berdasarkan data 45.000 pelanggan prabayar

3. Membandingkan performa klasifikasi penanganan imbalance data dengan menggunakan undersampling dan tomek link

2. Metodologi

2.1 Melakukan Input Library

library(tidymodels)

## Warning: package 'tidymodels' was built under R version 4.3.2

## ── Attaching packages ────────────────────────────────────── tidymodels 1.1.1 ──

## ✔ broom        1.0.5     ✔ recipes      1.0.8
## ✔ dials        1.2.0     ✔ rsample      1.2.0
## ✔ dplyr        1.1.3     ✔ tibble       3.2.1
## ✔ ggplot2      3.4.4     ✔ tidyr        1.3.0
## ✔ infer        1.0.5     ✔ tune         1.1.2
## ✔ modeldata    1.2.0     ✔ workflows    1.1.3
## ✔ parsnip      1.1.1     ✔ workflowsets 1.0.1
## ✔ purrr        1.0.2     ✔ yardstick    1.2.0

## Warning: package 'broom' was built under R version 4.3.2

## Warning: package 'dials' was built under R version 4.3.2

## Warning: package 'scales' was built under R version 4.3.2

## Warning: package 'dplyr' was built under R version 4.3.2

## Warning: package 'ggplot2' was built under R version 4.3.2

## Warning: package 'infer' was built under R version 4.3.2

## Warning: package 'modeldata' was built under R version 4.3.2

## Warning: package 'parsnip' was built under R version 4.3.2

## Warning: package 'purrr' was built under R version 4.3.2

## Warning: package 'recipes' was built under R version 4.3.2

## Warning: package 'rsample' was built under R version 4.3.2

## Warning: package 'tibble' was built under R version 4.3.2

## Warning: package 'tidyr' was built under R version 4.3.2

## Warning: package 'tune' was built under R version 4.3.2

## Warning: package 'workflows' was built under R version 4.3.2

## Warning: package 'workflowsets' was built under R version 4.3.2

## Warning: package 'yardstick' was built under R version 4.3.2

## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter()  masks stats::filter()
## ✖ dplyr::lag()     masks stats::lag()
## ✖ recipes::step()  masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/

library(tidyverse)

## Warning: package 'tidyverse' was built under R version 4.3.2

## Warning: package 'stringr' was built under R version 4.3.2

## Warning: package 'lubridate' was built under R version 4.3.2

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats   1.0.0     ✔ readr     2.1.4
## ✔ lubridate 1.9.3     ✔ stringr   1.5.0

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard()    masks scales::discard()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ stringr::fixed()    masks recipes::fixed()
## ✖ dplyr::lag()        masks stats::lag()
## ✖ readr::spec()       masks yardstick::spec()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(mlr3verse)

## Warning: package 'mlr3verse' was built under R version 4.3.2

## Loading required package: mlr3

## Warning: package 'mlr3' was built under R version 4.3.2

## 
## Attaching package: 'mlr3verse'
## 
## The following object is masked from 'package:tune':
## 
##     tune
## 
## The following object is masked from 'package:parsnip':
## 
##     tune

library(rpart) # Random Forest

## 
## Attaching package: 'rpart'
## 
## The following object is masked from 'package:dials':
## 
##     prune

library(rpart.plot) # Random Forest
library(dplyr) # %>%
library(ranger)

## Warning: package 'ranger' was built under R version 4.3.2

library(cowplot)

## 
## Attaching package: 'cowplot'
## 
## The following object is masked from 'package:lubridate':
## 
##     stamp

library(caret)

## Warning: package 'caret' was built under R version 4.3.2

## Loading required package: lattice
## 
## Attaching package: 'caret'
## 
## The following objects are masked from 'package:yardstick':
## 
##     precision, recall, sensitivity, specificity
## 
## The following object is masked from 'package:purrr':
## 
##     lift

library(ROSE)

## Warning: package 'ROSE' was built under R version 4.3.2

## Loaded ROSE 0.0-4

library(caret)
library(themis) # SMOTE

## Warning: package 'themis' was built under R version 4.3.2

library(brulee)

## Warning: package 'brulee' was built under R version 4.3.2

library(DataExplorer)

## Warning: package 'DataExplorer' was built under R version 4.3.2

2.2 Deskripsi Data

Sebuah operator telekomunikasi seluler akan melakukan kerja sama dengan sebuah bank untuk meningkatkan angka recharge pelanggan pra-bayar melalui fasilitas perbankan. Perusahaan tersebut memiliki 45000 data pelanggan sebagai berikut.

data_testing <-read.csv("Tugas2.test.csv",stringsAsFactors = TRUE, sep = ";")
data_training <-read.csv("Tugas2.csv",stringsAsFactors = TRUE, sep = ";")

Data yang digunakan pada tugas ini merupakan informasi dari 45000 pelanggan dengan 1 variabel respon (Y) dan 11 variabel penjelas (X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11).

Keterangan dari masing-masing variabel dapat dilihat pada table berikut :

Variabel	Deskripsi
Y	Pelanggan potensial dan tidak potensial untuk diajak menggunakan fasilitas perbankan
X1	Rata-rata durasi melakukan panggilan per bulan (menit)
X2	Rata-rata penghasilan dari transaksi panggilan per bulan (Rp)
X3	Rata-rata frekuensi melakukan panggilan per bulan
X4	Persentase panggilan di jam kerja
X5	Persentase panggilan sesame operator
X6	Rata-rata penghasilan dari transaksi SMS per bulan (Rp)
X7	Persentase transaksi SMS sesame operator
X8	Rata-rata pemakaian data per bulan (MB)
X9	Rata-rata penghasilan dari transaksi pemakaian data per bulan (Rp)
X10	Rata-rata frekuensi melakukan recharge pulsa per bulan
X11	Rata-rata banyaknya wilayah yang dikunjungi per bulan

2.3 Metode yang digunakan

Metode yang akan digunakan pada tugas ini adalah sebagai berikut.

2.2.1 Exploratory Data Analysis

Exploratory Data Analysis (EDA) adalah proses menganalisis dan menampilkan data bertujuan mendapatkan pemahaman yang lebih baik tentang wawasan dari data. Kebanyakan teknik EDA adalah berbentuk grafis dengan beberapa teknik kuantitatif. Peran utama EDA adalah untuk mengeksplorasi data secara terbuka, dan grafik bertujuan memperkuat analisis yang dilakukan. Terdapat berbagai langkah yang dilakukan saat melakukan EDA, seperti memaksimalkan wawasan ke dalam kumpulan data, mengungkap struktur data, ekstrak variabel yang penting, mendeteksi outlier dan anomali.

2.2.2 Data Duplikat

Data duplikat merupakan kasus dengan adanya data yang sama pada setiap kolom di baris yang berbeda. Data duplikat akan berdampak pada performa model sehingga perlu dihilangkan dari model.

2.2.3 Normalisasi Data

Metode Normalisasi data adalah proses membuat skala data suatu atribut ke dalam rentang yang lebih kecil dengan bobot yang sama seperti berada diantara rentang -1 hingga 1 atau 0 hingga 1. Normalisasi umumnya diperlukan apabila atribut-atribut dari dataset memiliki skala atau rentang yang berbeda. Misalnya terjadi ketimpangan dimana ada data yang terlampau tinggi dan ada yang terlampau rendah. Terdapat banyak metode normalisasi data seperti : Min-max Normalization, Z-score Normalization, Decimal Scaling, dan lainnya.

2.2.4 Resampling

Teknik resampling merupakan cara sederhana yang dapat membantu menangani permasalahan imbalanced dataset pada machine learning. Imbalanced data terjadi ketika jumlah data dalam satu kelas jauh lebih tinggi (majority class) atau lebih rendah (minority class) dibandingkan kelas lainnya. Imbalanced data akan menghasilkan bias jika dilakukan pengolahan dan analisis data seperti pada kasus klasifikasi, prediksi, dan sebagainya. Dalam melakukan resampling data terdapat 3 teknik, yaitu oversampling dengan menambahkan sejumlah data pada minority class, undersampling dengan mengurangi jumlah data pada majority class, dan kombinasi keduanya.

2.2.5 Tomek Link

Metode Tomek Links merupakan salah satu metode undersampling, yang diperkenalkan oleh Ivan Tomek tahun 1976. Metode ini bekerja dengan menghapus data kelas negatif (mayoritas) yang merupakan kasus borderline atau yang memiliki kesamaan karakteristik. Tomek Links dapat digunakan sebagai metode pembersihan data dari noise. Untuk setiap data, jika satu tetangga yang paling dekat memiliki kelas label yang berbeda dengan data tersebut maka data mayor akan dihapus karena dianggap sebagai noise atau misclassification (Khaulsari, 2016).

2.2.6 Random Forest

Random forest (RF) adalah evolusi bagging, yang bertujuan untuk mengurangi varians model statistik dan mensimulasikan variabilitas data dengan mengekstrak secara acak sampel bootsrap dari set pelatihan dan prediksi agregat untuk catatan baru. RF adalah salah satu algoritma klasifikasi ensemble berbasis pohon yang banyak digunakan (Kurniawa et al. 2023). RF dapat meningkatkan hasil akurasi dalam membangkitkan atribut untuk setiap node yang dilakukan secara acak (Amaliah et al. 2022).

2.2.7 Extreme Gradient Boost

Metode XGBoost adalah algoritma pengembangan dari gradient tree boosting yang berbasis algoritma ensemble, secara efektif bisa menanggulangi kasus machine learning yang berskala besar. Metode XGBoost dipilih karena memiliki beberapa fitur tambahan yang berguna untuk mempercepat sistem perhitungan dan mencegah overfitting (Yulianti et al, 2022). Perbedaan antara Gradient Boosting dengan XGBoost, tidak seperti Gradient Boosting, proses penambahan “weak learner” pada XGBoost tidak terjadi secara berurutan, tetapi secara multi-threaded (Abdurrahman et al. 2022).

3. Feature Engineering

3.1 Explanatory Data Analysis (EDA)

Langkah awal dalam tugas ini adalah melakukan Explanatory Data Analysis dengan tujuan untuk menemukan pola, anomali, melihat data ringkasan kemudian representasi grafis (visualisasi). Dari data yang sudah dipanggil, selanjutnya diperiksa struktur data dari data yang kita miliki

str(data_training)

## 'data.frame':    45000 obs. of  13 variables:
##  $ ID : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ X1 : int  1 627 42 209 11 117 144 184 3 3 ...
##  $ X2 : int  760 41160 19002 76895 12650 55057 29560 56162 9835 6603 ...
##  $ X3 : int  1 97 38 262 10 121 66 57 7 4 ...
##  $ X4 : num  0.5 0.707 0.75 0.772 0.604 ...
##  $ X5 : num  1 0.998 0.964 0.978 0.376 ...
##  $ X6 : int  3275 2864 2794 14061 16131 4222 2439 6953 16414 18458 ...
##  $ X7 : num  0.962 0.723 0.748 0.675 0.145 ...
##  $ X8 : int  2542 0 0 0 0 0 74 8 0 666 ...
##  $ X9 : int  43544 0 0 0 0 0 120 13 0 1080 ...
##  $ X10: num  1.3 9.3 4 24.7 10 8.7 4.3 4.3 8.7 5.7 ...
##  $ X11: num  1.3 5 1 9.7 5.3 6 3.7 3 4 4 ...
##  $ Y  : int  0 0 0 0 0 0 0 0 0 0 ...

summary(data_training)

##        ID              X1               X2               X3        
##  Min.   :    1   Min.   :   0.0   Min.   :     0   Min.   :  0.00  
##  1st Qu.:11251   1st Qu.:  14.0   1st Qu.: 10606   1st Qu.: 10.00  
##  Median :22501   Median :  47.0   Median : 22046   Median : 24.00  
##  Mean   :22501   Mean   : 110.7   Mean   : 27882   Mean   : 40.11  
##  3rd Qu.:33750   3rd Qu.: 131.0   3rd Qu.: 36582   3rd Qu.: 50.00  
##  Max.   :45000   Max.   :4130.0   Max.   :612263   Max.   :995.00  
##        X4               X5               X6               X7        
##  Min.   :0.0000   Min.   :0.0000   Min.   :     0   Min.   :0.0000  
##  1st Qu.:0.6977   1st Qu.:0.8551   1st Qu.:  1425   1st Qu.:0.6410  
##  Median :0.7500   Median :0.9706   Median :  3983   Median :0.8630  
##  Mean   :0.7344   Mean   :0.8831   Mean   :  6746   Mean   :0.7723  
##  3rd Qu.:0.8013   3rd Qu.:0.9972   3rd Qu.:  9265   3rd Qu.:0.9817  
##  Max.   :1.0000   Max.   :1.0000   Max.   :244444   Max.   :1.0000  
##        X8                X9              X10              X11        
##  Min.   :    0.0   Min.   :     0   Min.   : 0.000   Min.   : 0.000  
##  1st Qu.:    0.0   1st Qu.:     0   1st Qu.: 3.300   1st Qu.: 2.000  
##  Median :   74.0   Median :  2600   Median : 6.000   Median : 3.000  
##  Mean   :  948.9   Mean   : 16174   Mean   : 7.123   Mean   : 3.679  
##  3rd Qu.:  933.0   3rd Qu.: 24471   3rd Qu.: 9.700   3rd Qu.: 4.700  
##  Max.   :59611.0   Max.   :504086   Max.   :30.700   Max.   :35.700  
##        Y         
##  Min.   :0.0000  
##  1st Qu.:0.0000  
##  Median :0.0000  
##  Mean   :0.1867  
##  3rd Qu.:0.0000  
##  Max.   :1.0000

Data yang digunakan terdiri dari 12 variabel yang bertipe numeric dengan 45000 observasi. Pada data tersebut masih terdapat kolom ID yang tidak digunakan untuk melakukan prediksi klasifikasi variabel respon sehingga langkah selanjutnya adalah menghilangkan kolom ID dan mengubah variabel respon menjadi sebuah faktor.

data_training$Y <- as.factor(data_training$Y)
data_training <- data_training %>% select(-ID)
data_testing <- data_testing %>% select(-ID)

Setelah menghilangkan kolom ID, dibuatlah boxplot untuk melihat sebaran data pada variabel respon terhadap masing-masing variabel prediktornya.

x1_y<- ggplot(data_training, aes(x = X1, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X1 vs Y")
x2_y <- ggplot(data_training, aes(x = X2, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X2 vs Y")

x3_y <- ggplot(data_training, aes(x = X3, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X3 vs Y")

x4_y <- ggplot(data_training, aes(x = X4, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X4 vs Y")

x5_y <- ggplot(data_training, aes(x = X5, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X5 vs Y")

x6_y <- ggplot(data_training, aes(x = X6, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X6 vs Y")

x7_y <- ggplot(data_training, aes(x = X7, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X7 vs Y")

x8_y <- ggplot(data_training, aes(x = X8, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X8 vs Y")

x9_y <- ggplot(data_training, aes(x = X9, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X9 vs Y")

x10_y <- ggplot(data_training, aes(x = X10, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X10 vs Y")

x11_y <- ggplot(data_training, aes(x = X11, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X11 vs Y")

plot_grid(x1_y, x2_y, x3_y, x4_y, x5_y, x6_y, x7_y, x8_y, x9_y, x10_y, x11_y)

plot_correlation(data = data_training,
                 type = "continuous",
                 cor_args = list(method="pearson"),
                 ggtheme = theme_classic(),
                 theme_config = list(legend.position = "none",
                                     axis.text.x=element_text(angle = 90)))

3.2 Pra-Proses Data

3.2.1 Mengecek Data Hilang

colSums(is.na(data_training))

##  X1  X2  X3  X4  X5  X6  X7  X8  X9 X10 X11   Y 
##   0   0   0   0   0   0   0   0   0   0   0   0

Pada data training, tidak terdapat data yang hilang.

3.2.2 Menghapus Data Duplikat

data.frame("jumlah.seluruh.data"=nrow(data_training),
           "jumlah.data.unik" = nrow(distinct(data_training))
           )

Pada data training, terlihat bahwa dari 45000 data pelanggan hanya 49996 data unik saja, artinya terdapat duplikat nilai data yang harus diatasi.

duplicate_rows <- data_training[duplicated(data_training), ]
duplicate_rows

Data di atas merupakan keterangan data yang memiliki duplikat.

data_training <- distinct(data_training)
data.frame("jumlah.seluruh.data"=nrow(data_training),
           "jumlah.data.unik" = nrow(distinct(data_training))
           )

Sudah tidak ada baris yang terduplikat lagi.

3.2.3 Data Balancing

options(scipen=10000) # remove scientific notation when viewing plot

ggplot(data = data_training, aes(fill = Y)) +
  geom_bar(aes(x = Y))+
  ggtitle("Number of samples in each class", subtitle = "Original dataset")+
  xlab("")+
  ylab("Samples")+
  scale_y_continuous(expand = c(0,0))+
  scale_x_discrete(expand = c(0,0))+
  theme(legend.position = "none", 
        legend.title = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank())

Dapat terlihat bahwa peubah peubah respon imbalance, perlu dilakukan penanganan, salah satunya dengan menggunakan undersampling.

3.2.3.1 Undersampling Balancing

set.seed(1034)
data_training_balance <- ovun.sample(Y ~ ., data =data_training, method = "under",N = 16804)$data
table(data_training_balance$Y)

## 
##    0    1 
## 8402 8402

4. Hasil dan Pembahasan

4.1 Pemodelan Random Forest

replace_outliers <- function(x, removeNA = TRUE) {
  pressure_height <- x
  qnt <- quantile(pressure_height, probs=c(.25, .75), na.rm = removeNA)
  caps <- quantile(pressure_height, probs=c(.05, .95), na.rm = removeNA)
  H <- 1.5 * IQR(pressure_height, na.rm = removeNA)
  pressure_height[pressure_height < (qnt[1] - H)] <- caps[1]
  pressure_height[pressure_height > (qnt[2] + H)] <- caps[2]
  pressure_height
}


data_training_balance$X1 <- replace_outliers(data_training_balance$X1)
data_training_balance$X2 <- replace_outliers(data_training_balance$X2)
data_training_balance$X3 <- replace_outliers(data_training_balance$X3)
data_training_balance$X4 <- replace_outliers(data_training_balance$X4)
data_training_balance$X5 <- replace_outliers(data_training_balance$X5)
data_training_balance$X6 <- replace_outliers(data_training_balance$X6)
data_training_balance$X7 <- replace_outliers(data_training_balance$X7)
data_training_balance$X8 <- replace_outliers(data_training_balance$X8)
data_training_balance$X9 <- replace_outliers(data_training_balance$X9)
data_training_balance$X10 <- replace_outliers(data_training_balance$X10)
data_training_balance$X11 <- replace_outliers(data_training_balance$X11)

x1_y <- ggplot(data_training_balance, aes(x = X1, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X1 vs Y")
x2_y <- ggplot(data_training_balance, aes(x = X2, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X2 vs Y")

x3_y <- ggplot(data_training_balance, aes(x = X3, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X3 vs Y")

x4_y <- ggplot(data_training_balance, aes(x = X4, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X4 vs Y")

x5_y <- ggplot(data_training_balance, aes(x = X5, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X5 vs Y")

x6_y <- ggplot(data_training_balance, aes(x = X6, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X6 vs Y")

x7_y <- ggplot(data_training_balance, aes(x = X7, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X7 vs Y")

x8_y <- ggplot(data_training_balance, aes(x = X8, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X8 vs Y")

x9_y <- ggplot(data_training_balance, aes(x = X9, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X9 vs Y")

x10_y <- ggplot(data_training_balance, aes(x = X10, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X10 vs Y")

x11_y <- ggplot(data_training_balance, aes(x = X11, y = Y)) +
  geom_boxplot() +
  theme_minimal() +
  labs(title = "X11 vs Y")

plot_grid(x1_y, x2_y, x3_y, x4_y, x5_y, x6_y, x7_y, x8_y, x9_y, x10_y, x11_y)

Sebelum memodelkan dengan random forest, perlu dicek apakah variansinya mendekati nol atau tidak.

# each factor has been converted before 
nzero_var <- nearZeroVar(data_training)

# exclude each variable that has low variance
phone_rf <- data_training[,-nzero_var]
ncol(phone_rf)

## [1] 0

Hasil pengecekan menggunakan fungsi nearZeroVar diatas menunjukan tidak ada prediktor yang memiliki variansi rendah, sehingga dapat dilanjutkan ke proses membagi data (cross validation)

set.seed(1034)
# Assuming you want to perform 10-fold cross-validation
fitControl <- trainControl(
  method = "cv",
  number = 10,
  verboseIter = TRUE
)

Sebelum membuat model, dilakukan cross validation dengan membagi 10 fold data. Setelah dilakukan cross validation maka dapat dibuat model Random FOrestnya.

rf_model <- train(Y ~ ., data = data_training, method="rf", 
                   metric="Accuracy",tuneLength=10, trControl=fitControl,
                   ntree=500)

## + Fold01: mtry= 2 
## - Fold01: mtry= 2 
## + Fold01: mtry= 3 
## - Fold01: mtry= 3 
## + Fold01: mtry= 4 
## - Fold01: mtry= 4 
## + Fold01: mtry= 5 
## - Fold01: mtry= 5 
## + Fold01: mtry= 6 
## - Fold01: mtry= 6 
## + Fold01: mtry= 7 
## - Fold01: mtry= 7 
## + Fold01: mtry= 8 
## - Fold01: mtry= 8 
## + Fold01: mtry= 9 
## - Fold01: mtry= 9 
## + Fold01: mtry=10 
## - Fold01: mtry=10 
## + Fold01: mtry=11 
## - Fold01: mtry=11 
## + Fold02: mtry= 2 
## - Fold02: mtry= 2 
## + Fold02: mtry= 3 
## - Fold02: mtry= 3 
## + Fold02: mtry= 4 
## - Fold02: mtry= 4 
## + Fold02: mtry= 5 
## - Fold02: mtry= 5 
## + Fold02: mtry= 6 
## - Fold02: mtry= 6 
## + Fold02: mtry= 7 
## - Fold02: mtry= 7 
## + Fold02: mtry= 8 
## - Fold02: mtry= 8 
## + Fold02: mtry= 9 
## - Fold02: mtry= 9 
## + Fold02: mtry=10 
## - Fold02: mtry=10 
## + Fold02: mtry=11 
## - Fold02: mtry=11 
## + Fold03: mtry= 2 
## - Fold03: mtry= 2 
## + Fold03: mtry= 3 
## - Fold03: mtry= 3 
## + Fold03: mtry= 4 
## - Fold03: mtry= 4 
## + Fold03: mtry= 5 
## - Fold03: mtry= 5 
## + Fold03: mtry= 6 
## - Fold03: mtry= 6 
## + Fold03: mtry= 7 
## - Fold03: mtry= 7 
## + Fold03: mtry= 8 
## - Fold03: mtry= 8 
## + Fold03: mtry= 9 
## - Fold03: mtry= 9 
## + Fold03: mtry=10 
## - Fold03: mtry=10 
## + Fold03: mtry=11 
## - Fold03: mtry=11 
## + Fold04: mtry= 2 
## - Fold04: mtry= 2 
## + Fold04: mtry= 3 
## - Fold04: mtry= 3 
## + Fold04: mtry= 4 
## - Fold04: mtry= 4 
## + Fold04: mtry= 5 
## - Fold04: mtry= 5 
## + Fold04: mtry= 6 
## - Fold04: mtry= 6 
## + Fold04: mtry= 7 
## - Fold04: mtry= 7 
## + Fold04: mtry= 8 
## - Fold04: mtry= 8 
## + Fold04: mtry= 9 
## - Fold04: mtry= 9 
## + Fold04: mtry=10 
## - Fold04: mtry=10 
## + Fold04: mtry=11 
## - Fold04: mtry=11 
## + Fold05: mtry= 2 
## - Fold05: mtry= 2 
## + Fold05: mtry= 3 
## - Fold05: mtry= 3 
## + Fold05: mtry= 4 
## - Fold05: mtry= 4 
## + Fold05: mtry= 5 
## - Fold05: mtry= 5 
## + Fold05: mtry= 6 
## - Fold05: mtry= 6 
## + Fold05: mtry= 7 
## - Fold05: mtry= 7 
## + Fold05: mtry= 8 
## - Fold05: mtry= 8 
## + Fold05: mtry= 9 
## - Fold05: mtry= 9 
## + Fold05: mtry=10 
## - Fold05: mtry=10 
## + Fold05: mtry=11 
## - Fold05: mtry=11 
## + Fold06: mtry= 2 
## - Fold06: mtry= 2 
## + Fold06: mtry= 3 
## - Fold06: mtry= 3 
## + Fold06: mtry= 4 
## - Fold06: mtry= 4 
## + Fold06: mtry= 5 
## - Fold06: mtry= 5 
## + Fold06: mtry= 6 
## - Fold06: mtry= 6 
## + Fold06: mtry= 7 
## - Fold06: mtry= 7 
## + Fold06: mtry= 8 
## - Fold06: mtry= 8 
## + Fold06: mtry= 9 
## - Fold06: mtry= 9 
## + Fold06: mtry=10 
## - Fold06: mtry=10 
## + Fold06: mtry=11 
## - Fold06: mtry=11 
## + Fold07: mtry= 2 
## - Fold07: mtry= 2 
## + Fold07: mtry= 3 
## - Fold07: mtry= 3 
## + Fold07: mtry= 4 
## - Fold07: mtry= 4 
## + Fold07: mtry= 5 
## - Fold07: mtry= 5 
## + Fold07: mtry= 6 
## - Fold07: mtry= 6 
## + Fold07: mtry= 7 
## - Fold07: mtry= 7 
## + Fold07: mtry= 8 
## - Fold07: mtry= 8 
## + Fold07: mtry= 9 
## - Fold07: mtry= 9 
## + Fold07: mtry=10 
## - Fold07: mtry=10 
## + Fold07: mtry=11 
## - Fold07: mtry=11 
## + Fold08: mtry= 2 
## - Fold08: mtry= 2 
## + Fold08: mtry= 3 
## - Fold08: mtry= 3 
## + Fold08: mtry= 4 
## - Fold08: mtry= 4 
## + Fold08: mtry= 5 
## - Fold08: mtry= 5 
## + Fold08: mtry= 6 
## - Fold08: mtry= 6 
## + Fold08: mtry= 7 
## - Fold08: mtry= 7 
## + Fold08: mtry= 8 
## - Fold08: mtry= 8 
## + Fold08: mtry= 9 
## - Fold08: mtry= 9 
## + Fold08: mtry=10 
## - Fold08: mtry=10 
## + Fold08: mtry=11 
## - Fold08: mtry=11 
## + Fold09: mtry= 2 
## - Fold09: mtry= 2 
## + Fold09: mtry= 3 
## - Fold09: mtry= 3 
## + Fold09: mtry= 4 
## - Fold09: mtry= 4 
## + Fold09: mtry= 5 
## - Fold09: mtry= 5 
## + Fold09: mtry= 6 
## - Fold09: mtry= 6 
## + Fold09: mtry= 7 
## - Fold09: mtry= 7 
## + Fold09: mtry= 8 
## - Fold09: mtry= 8 
## + Fold09: mtry= 9 
## - Fold09: mtry= 9 
## + Fold09: mtry=10 
## - Fold09: mtry=10 
## + Fold09: mtry=11 
## - Fold09: mtry=11 
## + Fold10: mtry= 2 
## - Fold10: mtry= 2 
## + Fold10: mtry= 3 
## - Fold10: mtry= 3 
## + Fold10: mtry= 4 
## - Fold10: mtry= 4 
## + Fold10: mtry= 5 
## - Fold10: mtry= 5 
## + Fold10: mtry= 6 
## - Fold10: mtry= 6 
## + Fold10: mtry= 7 
## - Fold10: mtry= 7 
## + Fold10: mtry= 8 
## - Fold10: mtry= 8 
## + Fold10: mtry= 9 
## - Fold10: mtry= 9 
## + Fold10: mtry=10 
## - Fold10: mtry=10 
## + Fold10: mtry=11 
## - Fold10: mtry=11 
## Aggregating results
## Selecting tuning parameters
## Fitting mtry = 2 on full training set

rf_model

## Random Forest 
## 
## 44996 samples
##    11 predictor
##     2 classes: '0', '1' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 40497, 40496, 40497, 40497, 40497, 40496, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa    
##    2    0.8208507  0.1798544
##    3    0.8198951  0.1885809
##    4    0.8203619  0.1976598
##    5    0.8189841  0.1944756
##    6    0.8192730  0.1987395
##    7    0.8192064  0.2004271
##    8    0.8180506  0.1973184
##    9    0.8190953  0.2037226
##   10    0.8180062  0.2004989
##   11    0.8179841  0.2050177
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.

Setelah model random forest terbentuk, maka diukur nilai keakuratan dari model tersebut. Oleh karena model random forest yang digunakan merupakan model klasifikasi maka dalam mengecek keakuratannya menggunakan confussion matrix.

confusionMatrix(rf_model)

## Cross-Validated (10 fold) Confusion Matrix 
## 
## (entries are percentual average cell counts across resamples)
##  
##           Reference
## Prediction    0    1
##          0 79.2 15.8
##          1  2.2  2.9
##                             
##  Accuracy (average) : 0.8209

Berdasarkan hasil confussion matrix tersebut didapatkan nilai keakuratannya sebesar 80,9%. Setelah mendapatkan nilai keakuratan modelnya, dilihat pula variabel prediktor yang paling mempengaruhi model.

varImp(rf_model)

## rf variable importance
## 
##     Overall
## X2   100.00
## X9    96.79
## X6    54.10
## X4    53.33
## X8    40.57
## X5    40.08
## X1    27.93
## X7    27.74
## X10   25.24
## X3    13.12
## X11    0.00

Berdasarkan hasil analisis tersebut, terlihat bahwa variabel prediktor yang memiliki pengaruh paling tinggi terhadap prediksi adalah x2.

4.2 Pemodelan XGBoost

library(ggstatsplot)

## Warning: package 'ggstatsplot' was built under R version 4.3.2

## You can cite this package as:
##      Patil, I. (2021). Visualizations with statistical details: The 'ggstatsplot' approach.
##      Journal of Open Source Software, 6(61), 3167, doi:10.21105/joss.03167

library(finetune)

## Warning: package 'finetune' was built under R version 4.3.2

doParallel::registerDoParallel()

plot_intro(data_training)

ggcorrmat(data_training,
          title = "Relationship between numeric variables",
  subtitle = "nganu",
  ggcorrplot.args = list(outline.color = "black", hc.order = TRUE))

Data Spliting

basic_split <- initial_split(data = data_training,
                             prop = 0.8,
                             strata = "Y")
tidy(basic_split) %>% count(Data)

df.train <- training(basic_split)
df.test <- testing(basic_split)
dim(df.train);dim(df.test)

## [1] 35996    12

## [1] 9000   12

# Cross validation folds from training dataset
set.seed(123)
folds <- vfold_cv(df.train, strata = Y)

Data Eksplorasi

ggcorrmat(df.train,
          title = "Relationship between numeric variables",
  subtitle = "nganu",
  ggcorrplot.args = list(outline.color = "black", hc.order = TRUE))

XGBoost With Tuning Model 4

Pra-Process

df.data_training3 <- recipe(Y ~., data = data_training) %>%
  step_normalize(all_numeric_predictors()) %>%
  step_downsample(Y) %>% 
  step_tomek(Y)

data.df3 <- df.data_training3 %>% 
  prep() %>% 
  bake(new_data = NULL) %>% 
  glimpse()

## Rows: 14,086
## Columns: 12
## $ X1  <dbl> 0.17275910, -0.59495214, -0.52315181, -0.08682672, -0.46239768, -0…
## $ X2  <dbl> -0.66140948, -0.97983423, -0.57621785, 0.38857911, 0.96451990, -0.…
## $ X3  <dbl> 0.11552369, -0.76730978, -0.59074309, -0.21799118, -0.29646527, -0…
## $ X4  <dbl> 0.249754834, -0.886234359, 0.046918498, 0.029181939, -0.095497071,…
## $ X5  <dbl> 0.28930900, 0.60186643, 0.16188157, 0.55400596, -0.88376453, -1.73…
## $ X6  <dbl> -0.43789507, -0.69355658, -0.49814006, -0.37689069, -0.01681296, -…
## $ X7  <dbl> 0.2042700, -0.2284415, 0.3808483, 0.7924282, -0.3502935, -1.211196…
## $ X8  <dbl> -0.41979119, 1.37791475, -0.41979119, -0.21719540, -0.41979119, -0…
## $ X9  <dbl> -0.60474011, 1.70809507, -0.60474011, -0.41609136, -0.60474011, 0.…
## $ X10 <dbl> -0.7078902, -0.5011214, 0.1191853, 1.0082915, 1.3597986, 0.1812160…
## $ X11 <dbl> -0.2807994, 0.1322851, 0.8345286, 0.6692948, 0.6692948, 0.8345286,…
## $ Y   <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …

Melakukan praproses data secara bertahap dengan melakukan normalisasi data terhadap seluruh peubah prediktor, downsampling dan tomek link yang berfungsi untuk melakukan undersampling terhadap data Y yang tidak balance.

# Setup a model specification
xgb_spec4 <-boost_tree(
  trees = tune(),
  tree_depth = tune(), 
  min_n = tune(),
  loss_reduction = tune(),                    ## first three: model complexity
  sample_size = tune(), mtry = tune(),        ## randomness
  learn_rate = tune()                         ## step size
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")
xgb_spec4

## Boosted Tree Model Specification (classification)
## 
## Main Arguments:
##   mtry = tune()
##   trees = tune()
##   min_n = tune()
##   tree_depth = tune()
##   learn_rate = tune()
##   loss_reduction = tune()
##   sample_size = tune()
## 
## Computational engine: xgboost

Mendefinisikan model XGBoost dengan hyperparameter yang akan dilakukan tuning parameter. Hyperparameter yang digunakan adalah trees, tree_depth, min_n, loss_reduction, sample_size, mtry, dan learn_rate. Berdasarkan R, trees adalah banyaknya pohon yang dilatih, tree_depth adalah kedalaman atau kompleksitas pohon yang dilatih, min_n adalah minimum sampel data yang dibutuhkan untuk menghasilkan cabang pohon baru, sample_size adalah proporsi sampel latih yang digunakan untuk melatih setiap pohon, mtry adalah banyaknya peubah prediktor yang digunakan secara acak dalam pembangunan setiap pohon, dan learn_rate adalah tingkat kecepatan model belajar atau evaluasi dari model-model sebelumnya.

Grid Search Parameter

xgb_grid4 <- grid_latin_hypercube(
  trees(),
  tree_depth(),
  min_n(),
  loss_reduction(),
  sample_size = sample_prop(),
  finalize(mtry(range = c(1,11)), df.data_training3),
  learn_rate(),
  size = 20
)

Mendefinisikan Grid Search Parameter yang nantinya akan dilakukan Grid Search Tuning. Grid Search Tuning merupakan pencarian hyperparameter terbaik dengan menggunakan metode Grid Search.

Grid Search Tuning

library(finetune)
doParallel::registerDoParallel()

# Passing to workflow formula and Model specification
xgb_wf4 <- workflow() %>%
  add_recipe(df.data_training3) %>%
  add_model(xgb_spec4) %>% 
  tune_grid(resamples= folds,
            metrics = metric_set(accuracy,
                           bal_accuracy, roc_auc),
            grid=xgb_grid4,
            control=control_grid(save_workflow = TRUE))
xgb_wf4

Mendefinisikan formula workflow dengan menggunakan data yang sudah dilakukan praproses dan menggunakan model XGBoost yang sudah didefinisikan sebelumnya. Selain itu, di dalam workflow ini terdapat sintaks tune_grid, yang mana berfungsi untuk melakukan Grid search tuning.

Visualisasi Hasil

xgb_wf4 %>%
  collect_metrics() %>%
  filter(.metric == "bal_accuracy") %>%
  select(mean, mtry:sample_size) %>%
  pivot_longer(mtry:sample_size,
               names_to = "parameter",
               values_to = "value") %>%
  ggplot(aes(value, mean, color = parameter)) +
  geom_point(show.legend = FALSE)+
  facet_wrap(~parameter, scales = "free_x")

Sebaran hyperparameter yang sudah dituning memiliki nilai yang berbeda-beda dalam setiap iterasinya. Nilai-nilai unik hyperparameter dari seluruh iterasi dapat dilihat pada grafik di atas.

show_best(xgb_wf4, "bal_accuracy")

Dengan menggunakan parameter estimator binary, maka didapatkan rata-rata balanced accuracy tertinggi yang didapatkan adalah sebesar 0.7014772 dengan standard error sebesar 0.003673297.

best_auc4 <- select_best(xgb_wf4, "bal_accuracy")
best_auc4

Berdasarkan hasil di atas diketahui bahwa pada processor1_Model18 memiliki nilai-nilai parameter terbaik untuk memodelkan XGBoost dengan menormalisasi data, downscalling, dan tomek link.

xgb_wft4 <- workflow() %>%
  add_recipe(df.data_training3) %>%
  add_model(xgb_spec4)
final_xgb4 <- finalize_workflow(xgb_wft4, best_auc4)
final_xgb4

## ══ Workflow ════════════════════════════════════════════════════════════════════
## Preprocessor: Recipe
## Model: boost_tree()
## 
## ── Preprocessor ────────────────────────────────────────────────────────────────
## 3 Recipe Steps
## 
## • step_normalize()
## • step_downsample()
## • step_tomek()
## 
## ── Model ───────────────────────────────────────────────────────────────────────
## Boosted Tree Model Specification (classification)
## 
## Main Arguments:
##   mtry = 9
##   trees = 903
##   min_n = 38
##   tree_depth = 4
##   learn_rate = 0.0250297973660991
##   loss_reduction = 0.00000000366424942564637
##   sample_size = 0.219117428692989
## 
## Computational engine: xgboost

# extract_fit_parsnip() 
library(vip)

## Warning: package 'vip' was built under R version 4.3.2

## 
## Attaching package: 'vip'

## The following object is masked from 'package:utils':
## 
##     vi

final_xgb4 %>%
  fit(data = data.df3) %>%
  extract_fit_parsnip() %>%
  vip()

Variabel X9, X2, dan X10 merupakan tiga variabel yang sering muncul dalam model XGBoost. Sehingga, dapat disimpulkan variabel tersebut merupakan variabel penting dari model XGBoost

Final Model

final_rs4 <- last_fit(final_xgb4, basic_split,
                     metrics = metric_set(accuracy, bal_accuracy, roc_auc))

## Warning: package 'xgboost' was built under R version 4.3.2

final_rs4 %>%
  collect_metrics()

show_best(xgb_wf4, "bal_accuracy")

final_rs4 %>%
  collect_predictions() 

Visualisasi Final Model

final_rs4 %>%
  collect_predictions() %>%
  roc_curve(Y, .pred_1, event_level="second") %>%
  autoplot()

xgb_wf41 <- fit_best(x = xgb_wf4,metric = "bal_accuracy")

Confussion Matrix

pred_xgb <- xgb_wf41 %>% 
                  predict(new_data = data_training,type = "class")
pred_xgb

pred_xgb <- pred_xgb %>% 
                 #menambahkan kolom truth
                 mutate(truth=data_training$Y)
pred_xgb

confussion_matrix <- pred_xgb %>%
                      conf_mat(truth=truth,estimate=.pred_class)

table <- confussion_matrix$table
specificity <- specificity(table)
sensitivity <- sensitivity(table)

autoplot(confussion_matrix,type = "heatmap")+
  scale_fill_gradient(low = "#F4AFAB",high = "#EE847E")

## Scale for fill is already present.
## Adding another scale for fill, which will replace the existing scale.

balanced_accuracy <- (specificity + sensitivity) / 2
balanced_accuracy 

## [1] 0.7090746

Nilai confussion matrix yang digunakan adalah sensitivity dan specificity. Berdasarkan confussion matrix di atas, diperoleh nilai sensitivity sebesar dan specificity sebesar

Nilai Prediksinya

saveRDS(xgb_wf41,file = "nn_credit_model.rds")

new_pred <- readRDS("nn_credit_model.rds") %>% 
  predict(new_data = data_testing[-12],type = "class")
new_pred

5. Kesimpulan

• Jumlah pelanggan prabayar yang tidak berpotensi ditawari layanan lewat fasilitas perbankan lebih banyak dibandingkan dengan pelanggan yang berpotensi ditawari dengan proporsi tidak berpotensi sebesar proporsinya 81.33%.

• Semakin banyak frekuensi dan durasi melakukan panggilan per bulan maka semakin besar biaya transaksi panggilan yang dikeluarkan.

• Semakin banyak pemakaian data per bulan pada pelanggan prabayar maka semakin besar pula biaya transaksi yang akan dikeluarkan.

• Klasifikasi dengan model XGBoost lebih baik dibandingkan dengan model Random Forest dengan akurasi terbaik pada model XGBoosting + Normalisasi + Tomek Link