library(readxl)
library(car)

## Loading required package: carData

Data

Import Data

Sebuah operator telekomunikasi seluler akan menjajagi kerja sama dengan sebuah bank untuk meningkatkan angka recharge pelanggan pra-bayar melalui channel perbankan (ATM, internet banking, dsb). Mereka ingin memperoleh model yang dapat digunakan untuk memprediksi pelanggan mana saja yang potensial untuk diajak menggunakan channel tersebut.

data <- read_excel('Tugas_STA581.xlsx')
data <- data[-1]

Digunakan package readxl untuk membaca data excel ke dalam bentuk dataframe di R.

head(data)

## # A tibble: 6 × 12
##      X1    X2    X3    X4    X5    X6    X7    X8    X9   X10   X11     Y
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1   257 13643    27 0.780 0.963  5217 0.769   768 30006   6.3   4.7     1
## 2    24 13897    15 0.739 0.906 18025 0.291  2368 39954   7.3   5.3     1
## 3     1   760     1 0.5   1      3275 0.962  2542 43544   1.3   1.3     0
## 4   627 41160    97 0.707 0.998  2864 0.723     0     0   9.3   5       0
## 5    42 19002    38 0.750 0.964  2794 0.748     0     0   4     1       0
## 6    65 38253    43 0.779 1      1122 1         5  1719  17    14.7     1

Sebelumnya dilakukan pembagian data ke dalam data latih dan data uji yang selanjutnya data yang sama ini akan dipakai menjadi data latih dan data uji di semua metode.

Eksplorasi Data

Statistik Deskriptif

library(sjmisc)
eksp_data <- data
eksp_data$Y <- as.factor(eksp_data$Y)
as.data.frame(descr(eksp_data))

##    var        type label     n NA.prc         mean           sd           se
## 1   X1     numeric    X1 50000      0 1.106676e+02 1.806347e+02 8.078230e-01
## 4   X2     numeric    X2 50000      0 2.790754e+04 2.736161e+04 1.223649e+02
## 5   X3     numeric    X3 50000      0 4.023486e+01 5.120954e+01 2.290160e-01
## 6   X4     numeric    X4 50000      0 7.342076e-01 1.395345e-01 6.240174e-04
## 7   X5     numeric    X5 50000      0 8.824384e-01 1.950748e-01 8.724011e-04
## 8   X6     numeric    X6 50000      0 6.745711e+03 7.915107e+03 3.539743e+01
## 9   X7     numeric    X7 50000      0 7.718046e-01 2.549293e-01 1.140078e-03
## 10  X8     numeric    X8 50000      0 9.468719e+02 2.260855e+03 1.011085e+01
## 11  X9     numeric    X9 50000      0 1.614417e+04 2.682608e+04 1.199699e+02
## 2  X10     numeric   X10 50000      0 7.129130e+00 4.841823e+00 2.165329e-02
## 3  X11     numeric   X11 50000      0 3.676492e+00 2.414185e+00 1.079656e-02
## 12   Y categorical     Y 50000      0 1.867200e-01 3.896905e-01 1.742749e-03
##              md      trimmed             range          iqr      skew
## 1  4.700000e+01 7.218118e+01     4130 (0-4130) 1.170000e+02  4.657092
## 4  2.209200e+04 2.385257e+04 638172 (0-638172) 2.600850e+04  3.929080
## 5  2.400000e+01 3.022100e+01     1007 (0-1007) 4.000000e+01  3.717217
## 6  7.498324e-01 7.485643e-01           1 (0-1) 1.035349e-01 -2.745926
## 7  9.702921e-01 9.286175e-01           1 (0-1) 1.437488e-01 -2.588062
## 8  3.975000e+03 5.284058e+03 244444 (0-244444) 7.839000e+03  3.215393
## 9  8.626017e-01 8.155916e-01           1 (0-1) 3.416490e-01 -1.314261
## 10 7.300000e+01 4.329732e+02   59611 (0-59611) 9.250000e+02  5.749438
## 11 2.514500e+03 1.042832e+04 504086 (0-504086) 2.443125e+04  3.386872
## 2  6.000000e+00 6.523237e+00     30.7 (0-30.7) 6.400000e+00  1.207519
## 3  3.000000e+00 3.349972e+00     35.7 (0-35.7) 2.700000e+00  1.991754
## 12 0.000000e+00 1.084000e-01           1 (0-1) 0.000000e+00  1.607904

Keterangan:

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 sesama operator
X6 : rata-rata penghasilan dari transaksi SMS per bulan (Rp)
X7 : persentase transaksi SMS sesama 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
Y : status kepotensialan pelanggan untuk diajak menggunakan channel perbankan. (1 = potensial, 0 = tidak potensial)

Proporsi Pelanggan Potensial dan Tidak Potensial

library(ggplot2)

ggplot(eksp_data, aes(x = factor(1), fill = Y)) + geom_bar(width = 1) + scale_fill_brewer(palette="Set2") + coord_polar("y") + stat_count(geom = "text", aes(label = stat(count)), position=position_stack(vjust=0.5), colour="white")

## Warning: `stat(count)` was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Dari plot di atas diperoleh bahwa dari 50000 pelanggan yang diamati, sebanyak 9336 pelanggan merupakan pelanggan potensial dan sebanyak 40664 sisanya bukan merupakan pelanggan yang potensial untuk diajak menggunakan channel perbankan.

Box Plot untuk Peubah Penjelas Kontinu

Sebelumnya dibuat fungsi untuk menambahkan teks ke dalam grafik. Kemudian dilihat persebaran masing-masing perubah penjelasnya sebagai berikut.

get_box_stats <- function(y, upper_limit = max(y) * 1.15) {
  return(data.frame(
    y = 0.95 * upper_limit,
    label = paste(
      "Count =", length(y), "\n",
      "Mean =", round(mean(y), 2), "\n",
      "Median =", round(median(y), 2), "\n"
    )
  ))
}
annotations <- function(data, y1, y2, y3){
  return(data.frame(
    x = c(round(min(data), 2), round(mean(data), 2), round(max(data), 2)),
    y = c(y1, y2, y3),
    label = c("Min:", "Mean:", "Max:")
  ))
}

Plot untuk X1

ggplot(eksp_data, aes(x = X1, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.9, vjust = 0.5)

ggplot(eksp_data, aes(X1)) +
  geom_histogram(color = "#000000", fill = "#82638F") +
  geom_text(data = annotations(eksp_data$X1, 31000, 15000, 1000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata durasi melakukan panggilan per bulan untuk kelompok pelanggan tidak potensial lebih besar daripada rata-rata durasi melakukan panggilan per bulan pada kelompok pelanggan potensial. Dilihat dari selisih median dan rata-rata yang tidak terlalu besar, mengindikasikan bahwa tidak ada perbedaan mencolok antara dua kelompok pelanggan berdasarkan rata-rata durasi panggilan yang dilakukan selama satu bulan. Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa banyak pelanggan yang melakukan panggilan dalam durasi yang lama.

Plot untuk X2

ggplot(eksp_data, aes(x = X2, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.9, vjust = 0.8)

ggplot(eksp_data, aes(X2)) +
  geom_histogram(color = "#000000", fill = "#32635A") +
  geom_text(data = annotations(eksp_data$X2, 14000, 24000, 1000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata penghasilan yang diperoleh dari transaksi panggilan per bulan untuk kelompok pelanggan potensial (Rp32,448) lebih besar daripada rata-rata penghasilan yang diperoleh dari transaksi panggilan per bulan pada kelompok pelanggan tidak potensial (Rp26,864). Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa terdapat pelanggan yang mengeluarkan biaya yang sangat besar untuk melakukan panggilan selama satu bulan dibandingkan dengan pelanggan lainnya.

Plot untuk X3

ggplot(eksp_data, aes(x = X3, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.7, vjust = 0.8)

ggplot(eksp_data, aes(X3)) +
  geom_histogram(color = "#000000", fill = "#DF527A") +
  geom_text(data = annotations(eksp_data$X3, 21000, 19000, 1000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata frekuensi melakukan panggilan per bulan untuk kelompok pelanggan tidak potensial lebih besar daripada rata-rata frekuensi melakukan panggilan per bulan pada kelompok pelanggan potensial. Dilihat dari selisih median dan rata-rata yang tidak terlalu besar, mengindikasikan bahwa tidak ada perbedaan mencolok antara dua kelompok pelanggan berdasarkan rata-rata frekuensi panggilan yang dilakukan selama satu bulan. Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa banyak pelanggan yang melakukan panggilan dalam frekuensi yang sangat sering.

Plot untuk X4

ggplot(eksp_data, aes(x = X4, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.7, vjust = 0.75)

ggplot(eksp_data, aes(X4)) +
  geom_histogram(color = "#000000", fill = "#7629AA") +
  geom_text(data = annotations(eksp_data$X4, 1500, 10000, 1500), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa presentase panggilan di jam kerja untuk kelompok pelanggan tidak potensial memiliki nilai yang hampir sama dengan pelanggan potensial. Hal ini mengindikasikan bahwa tidak ada perbedaan mencolok antara dua kelompok pelanggan berdasarkan presentase panggilan di jam kerja, yakni sebesar 75%. Peubah yang diamati memiliki nilai pencilan kiri yang cukup besar, disimpulkan bahwa banyak pelanggan baik yang potensial maupun tidak potensial yang sangat jarang melakukan panggilan di jam kerja bahkan tidak sama sekali, namun ada pula pencilan kanan yang mengindikasikan bahwa ada pelanggan yang lebih sering bahkan hampir selalu melakukan panggilan ketika jam kerja.

Plot untuk X5

ggplot(eksp_data, aes(x = X5, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 2.8, vjust = 0.7)

ggplot(eksp_data, aes(X5)) +
  geom_histogram(color = "#000000", fill = "#536AA6") +
  geom_text(data = annotations(eksp_data$X5, 1500, 5000, 23000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diagram di atas menunjukkan bahwa baik pelanggan tidak potensial maupun yang potensial, mayoritas keduanya secara rata-rata melakukan panggilan dengan nomor tujuan sama operator yakni sebesar 85% untuk pelanggan potensial dan 89% untuk pelanggan tidak potensial dari keseluruhan panggilan yang dilakukan. Terlihat bahwa banyak pencilan di kiri, mengindikasikan bahwa banyak pula pelanggan yang melakukan panggilan ke beda operator dengan presentase panggilan sesama operator yang kecil bahkan ada yang bernilai 0 (tidak melakukan panggilan sesama operator sama sekali) .

Plot untuk X6

ggplot(eksp_data, aes(x = X6, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.8, vjust = 0.8)

ggplot(eksp_data, aes(X6)) +
  geom_histogram(color = "#000000", fill = "#CC6283") +
  geom_text(data = annotations(eksp_data$X6, 27000, 17000, 1000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh juga bahwa rata-rata penghasilan dari transaksi SMS per bulan untuk pelanggan potensial dan tidak potensial adalah sebesar Rp5.851 dan Rp6.951, dan keduanya memiliki beberapa pencilan kanan yang artinya terdapat pelanggan baik yang potensial maupun tidak yang memiliki penghasilan dari transaksi SMS per bulan dengan nominal yang sangat besar (hingga mendekati Rp150.000 untuk pelanggan non potensial dan hingga mendekati Rp250.000 untuk pelanggan tidak potensial).

Plot untuk X7

ggplot(eksp_data, aes(x = X7, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 4, vjust = 0.8)

ggplot(eksp_data, aes(X7)) +
  geom_histogram(color = "#000000", fill = "#CC7203") +
  geom_text(data = annotations(eksp_data$X7, 2000, 3000, 13000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diagram di atas menunjukkan bahwa baik pelanggan tidak potensial maupun yang potensial, mayoritas keduanya secara rata-rata mengirim SMS ke nomor tujuan sama operator yakni sebesar 75% untuk pelanggan potensial dan 78% untuk pelanggan tidak potensial dari keseluruhan SMS yang dikirim Terlihat bahwa banyak pencilan di kiri, mengindikasikan bahwa banyak pula pelanggan yang mengirim SMS ke beda operator dengan presentase SMS sesama operator yang kecil bahkan ada yang bernilai 0 (tidak mengirim SMS ke sesama operator sama sekali) .

Plot untuk X8

ggplot(eksp_data, aes(x = X8, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.9, vjust = 0.8)

ggplot(eksp_data, aes(X8)) +
  geom_histogram(color = "#000000", fill = "#DD0925") +
  geom_text(data = annotations(eksp_data$X8, 39000, 41000, 1000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata pemakaian data per bulan (MB) untuk kelompok pelanggan potensial lebih besar daripada rata-rata pemakaian data per bulan pada kelompok pelanggan tidak potensial yakni sebesar 1542 MB dibandingkan 810 MB. Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa terdapat pelanggan yang menggunakan data dengan kapasitas yang yang sangat besar dalam satu bulan.

Plot untuk X9

ggplot(eksp_data, aes(x = X9, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.9, vjust = 0.8)

ggplot(eksp_data, aes(X9)) +
  geom_histogram(color = "#000000", fill = "#AF7283") +
  geom_text(data = annotations(eksp_data$X9, 30000, 31000, 1000), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata penghasilan dari pemakaian data per bulan untuk kelompok pelanggan potensial lebih besar daripada rata-rata pemakaian data per bulan pada kelompok pelanggan tidak potensial yakni sebesar Rp29166 dibandingkan Rp13154. Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa terdapat pelanggan yang mengeluarkan biaya dalam menggunakan data dengan kapasitas yang yang sangat besar dalam satu bulan.

Plot untuk X10

ggplot(eksp_data, aes(x = X10, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.9, vjust = 0.8)

ggplot(eksp_data, aes(X10)) +
  geom_histogram(color = "#000000", fill = "#AC9029") +
  geom_text(data = annotations(eksp_data$X10, 500, 4000, 300), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata frekuensi melakukan recharge pulsa per bulan untuk kelompok pelanggan tidak potensial lebih besar daripada rata-rata frekuensi melakukan recharge pulsa per bulan pada kelompok pelanggan potensial yakni sebesar 7-8 kali dibanding 5-6 kali. Dilihat dari selisih rata-rata yang tidak terlalu besar, mengindikasikan bahwa tidak ada perbedaan mencolok antara dua kelompok pelanggan berdasarkan rata-rata frekuensi panggilan yang dilakukan selama satu bulan. Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa ada pelanggan yang melakukan recharge pulsa dalam frekuensi yang sangat sering.

Plot untuk X11

ggplot(eksp_data, aes(x = X11, y = Y, group = Y)) + geom_boxplot(fill = c("#999162", "#668291")) + stat_summary(fun.data = get_box_stats, geom = "text", hjust = 0.8, vjust = 0.8)

ggplot(eksp_data, aes(X11)) +
  geom_histogram(color = "#000000", fill = "#FF7929") +
  geom_text(data = annotations(eksp_data$X11, 1000, 11500, 400), aes(x = x, y = y, label = paste(label, x)), size = 3, fontface = "bold")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Diperoleh bahwa rata-rata banyak wilayah yang dikunjungi pelanggan per bulan untuk kelompok pelanggan tidak potensial lebih besar daripada rata-rata banyak wilayah yang dikunjungi pelanggan per bulan pada kelompok pelanggan potensial yakni sebesar 3-4 kali dibanding 2-3 kali. Peubah yang diamati memiliki nilai pencilan kanan yang cukup jauh, disimpulkan bahwa ada pelanggan yang mengunjungi banyak sekali wilayah dalam satu bulan.

Periksa NA dan NULL

sum(is.na(data))

## [1] 0

sum(is.null(data))

## [1] 0

Dilakukan pemeriksaan data apakah mengandung nilai NA dan NULL yang selanjutnya dilakukan penanganan lebih lanjut. Jika NA atau NULL masih terdapat pada data, memungkinkan data tidak dapat dilakukan analisis karena perhitungan terhadap data dengan amatan NA atau NULL akan menghasilkan nilai NA atau NULL. Dari sintaks di atas diperoleh data sudah tidak mengandung NA atau NULL.

Matriks Korelasi dan Heatmap

round(cor(data[,-12], use = "complete.obs"),2)

##        X1    X2    X3    X4    X5    X6    X7    X8    X9   X10   X11
## X1   1.00  0.40  0.58  0.06  0.24  0.10  0.13 -0.07 -0.14  0.35  0.28
## X2   0.40  1.00  0.59  0.15  0.13  0.19  0.07 -0.10 -0.10  0.37  0.31
## X3   0.58  0.59  1.00  0.13  0.23  0.17  0.15 -0.09 -0.18  0.39  0.34
## X4   0.06  0.15  0.13  1.00  0.38  0.05  0.18 -0.03 -0.08  0.05  0.06
## X5   0.24  0.13  0.23  0.38  1.00  0.08  0.52 -0.10 -0.21  0.23  0.21
## X6   0.10  0.19  0.17  0.05  0.08  1.00  0.14 -0.08 -0.14  0.44  0.31
## X7   0.13  0.07  0.15  0.18  0.52  0.14  1.00 -0.06 -0.11  0.16  0.15
## X8  -0.07 -0.10 -0.09 -0.03 -0.10 -0.08 -0.06  1.00  0.54 -0.07 -0.04
## X9  -0.14 -0.10 -0.18 -0.08 -0.21 -0.14 -0.11  0.54  1.00 -0.11 -0.04
## X10  0.35  0.37  0.39  0.05  0.23  0.44  0.16 -0.07 -0.11  1.00  0.77
## X11  0.28  0.31  0.34  0.06  0.21  0.31  0.15 -0.04 -0.04  0.77  1.00

Diperoleh bahwa nilai koefisien korelasi untuk semua peubah penjelas berada di bawah 0.5 yang berarti korelasi tidak terlalu kuat untuk masing-masing peubah penjelas. Kecuali pada korelasi X1 dan X3 yang bernilai 0.58, korelasi X2 dan X3 yang bernilai 0.59, korelasi X5 dan X7 yang bernilai 0.52, korelasi X8 dan X9 serta korelasi X10 dan X11 yang mengindikasikan terdapat korelasi sedang hingga cukup kuat. Adanya korelasi yang cukup kuat berpotensi terjadi multikolinearitas antar peubah penjelas yang menganggu analisis regresi logistik yang akan dilakukan termasuk pada algoritma klasifikasi yang lain. Untuk lebih jelasnya, akan dilakukan uji multikolinearitas di bagian selanjutnya.

Algoritma Klasifikasi

Algoritma klasifikasi secara umum adalah fungsi yang menimbang peubah penjelas atau input sehingga outputnya memisahkan satu kelas menjadi nilai positif dan kelas lainnya menjadi nilai negatif. Klasifikasi merupakan algoritma supervised learning di mana data sudah memiliki peubah respon yang nantinya akan dikomparasikan dengan hasil prediksi berdasarkan data latih untuk diambil nilai akurasinya. Penggunaan algoritma klasifikasi sudah banyak dipakai dan dirasakan manfaatnya, seperti penggolongan e-mail spam, deteksi penyakit, prediksi keputusan pelanggan dalam membeli barang di supermarket, dan lain-lain.

Terdapat dua jenis pengklasifikasi yang umum dipakai, yaitu:

Binary classifier , di mana data diklasifikasikan ke dalam dua kategori dikotomik, sebagaimana yang akan dilakukan dalam laporan ini, dan
Multi-class classifier , di mana data diklasifikasikan ke dalam lebih dari dua kategori.

Beberapa tipe/jenis algoritma klasifikasi antara lain: Regresi Logistik, SVM, K-Nearest Neighbours, Naive Bayes, Classification Tree, Random Forest Classification, Artificial Neural Network, Gradient Boosting Classifier, XGBoost, dan lain-lain. Dalam laporan ini, akan digunakan beberapa algoritma klasifikasi yang telah disebutkan sebelumnya. Nantinya, akan diperiksa kebaikan hasil klasifikasi berdasarkan kriteria-kriteria berikut antara lain:

Matriks Konfusi

Matriks konfusi merupakan tabel yang menjelaskan kinerja model. Matriks ini terdiri dari hasil prediksi dalam bentuk ringkasan, yang memiliki jumlah total prediksi yang benar dan prediksi yang salah.

	Actual Positive	Actual Negative
Predicted Positive	True Positive (TP)	False Positive (FP)
Predicted Negative	False Negative (FN)	True Negative (TN)

Di mana nilai akurasi diukur dengan rumus: \[Accuracy = \frac{TP+TN}{Total Population}\]

Sensitivitas

Sensitivitas menjelaskan berapa banyak kasus positif aktual yang dapat diprediksi dengan benar dengan model yang telah dibuat. Sensitivitas adalah ukuran akurasi yang berguna jika False Negative lebih diperhatikan daripada False Positive. Ukuran klasifikasi ini sangat penting digunakan di dunia medis untuk mendiagnosa penyakit. Sensitivitas dirumuskan dengan: \[Sensitivitas = \frac{TP}{TP + FN}\]

Spesifisitas

Sebaliknya, spesifisitas adalah berapa banyak kasus negatif aktual yang dapat diprediksi dengan benar menggunakan model yang telah dibuat. Spesifisitas dapat dihitung dengan: \[Spesifisitas = \frac{TN}{TN+FP}\]

Kurva AUC-ROC

ROC ( Receiver Operating Characteristic Curve) merupakan sebuah kurva yang mengukur rata-rata akurasi pada ambang/treshold yang berbeda-beda. Nilai akurasi didapat dari luasan di bawah garis kurva ROC yang disebut AUC ( Area Under the Curve). Kurva ROC diplotkan berdasarkan nilai sensitivitas dan 1-spesifisitas pada sumbu X dan Y nya.

SMOTE

Metode Synthetic Minority Over-sampling Technique (SMOTE) merupakan metode yang populer diterapkan dalam rangka menangani ketidak seimbangan kelas. Teknik ini mensintesis sampel baru dari kelas minoritas untuk menyeimbangkan dataset dengan cara sampling ulang sampel kelas minoritas.

knitr::include_graphics("/Users/User/Documents/RFiles/jpgs/0*MaZhmNw4iqK4M086.png")

Sumber: Emilia Orellana (Medium)

set.seed(2022)
sample <- sample(c(TRUE, FALSE), nrow(data), replace=TRUE, prob=c(0.8,0.2))
train  <- data[sample, ]
test   <- data[!sample, ]

Dalam hal ini, ketidakseimbangan kelas dalam data train dilihat dalam grafik berikut:

library(lattice)
barchart(as.factor(train$Y), col='maroon')

SMOTE dilakukan sebagai berikut:

library(smotefamily)
smote_data <- SMOTE(data[,-12], data$Y)
newdata <- smote_data$data
barchart(newdata$class, col = 'navy')

set.seed(2022)
newdata$class <- as.numeric(newdata$class)
sample <- sample(c(TRUE, FALSE), nrow(newdata), replace=TRUE, prob=c(0.8,0.2))
newtrain  <- newdata[sample, ]
newtest   <- newdata[!sample, ]

barchart(as.factor(newtrain$class), col='navy')

Terlihat bahwa data sudah balance dan siap digunakan dalam klasifikasi.

Regresi Logistik Biner

Analisis regresi logistik biner adalah suatu regresi logistik antara peubah respon (Y) dan peubah penjelas (X) dimana Y menghasilkan 2 kategori yaitu 0 dan 1 (Hosmer dan Lemeshow, 1989). Dalam regresi logistik biner, keberadaan amatan pencilan tidak memberikan pengaruh besar dikarenakan bentuk kurva sigmoid dari model regresi logistik yang terbentuk, sehingga penanganan amatan pencilan tidak dilakukan dalam algoritma klasifikasi ini. Namun karena terjadi imbalance data di mana proporsi pelanggan potensial dan tidak potensial tidak seimbang, maka perlu dilakukan SMOTE terlebih dahulu.

Membentuk Model Logistik dan Periksa Multikolinearitas

Sebelum dilakukan klasifikasi dengan regresi logistik, dilakukan pengujian multikolinearitas agar asumsi regresi logistik terpenuhi.

log_mod <- glm(class~., data=newdata, family = 'binomial')
vif(log_mod)

##       X1       X2       X3       X4       X5       X6       X7       X8 
## 1.710233 1.901263 2.245941 1.218377 1.669123 1.354815 1.366262 1.402690 
##       X9      X10      X11 
## 1.553027 3.429118 2.785899

Diperoleh nilai VIF pada keseluruhan peubah penjelas < 5, artinya data terbebas dari multikolinearitas antar peubah penjelas.

Pemodelan Logistik Biner

Sebelumnya, dilakukan validasi silang 10 lipatan yang kemudian memisahkan data menjadi data latih dan data uji sebanyak 10 menggunakan fungsi trainControl() sebagai berikut:

library(caret)
train_ctrl <- trainControl(method = 'cv', number = 10)

Dilakukan pemodelan regresi logistik biner dengan membagi data menjadi data uji dan data latih terlebih dahulu. Menggunakan data yang telah dilakukan SMOTE sebelumnya, diperoleh hasil sebagai berikut:

set.seed(2022)
log_data <- newdata
log_data$class <- as.factor(log_data$class)
log_model <- train(as.factor(class)~., data = log_data, method = 'glm', family='binomial', trControl=train_ctrl, na.action=na.omit)
print(log_model$results)

##   parameter  Accuracy     Kappa  AccuracySD    KappaSD
## 1      none 0.6865703 0.3699402 0.005229062 0.01037868

print(log_model$resample)

##     Accuracy     Kappa Resample
## 1  0.6748718 0.3464339   Fold01
## 2  0.6888462 0.3745317   Fold02
## 3  0.6896950 0.3761301   Fold03
## 4  0.6891424 0.3751547   Fold04
## 5  0.6824359 0.3619401   Fold05
## 6  0.6901679 0.3771355   Fold06
## 7  0.6875641 0.3721337   Fold07
## 8  0.6820920 0.3611436   Fold08
## 9  0.6922584 0.3806456   Fold09
## 10 0.6886297 0.3741532   Fold10

plot(x=1:10, y=log_model$resample$Accuracy, xlab='Fold', ylab='Akurasi', type='b'); points(x=which.max(log_model$resample$Accuracy),  y=max(log_model$resample$Accuracy), col='red', pch=20); axis(1, at = seq(1,10, by=1))

Diperoleh berdasarkan validasi silang 10 lipat, diperoleh nilai akurasi terbesar pada lipatan 9. Sementara rata-rata akurasi yang diperoleh adalah sebesar:

mean(log_model$resample$Accuracy)

## [1] 0.6865703

Berdasarkan validasi silang 10 lipat yang telah dilakukan diperoleh rata-rata nilai akurasi sebesar 68.66% yang artinya model mampu mengklasifikasikan 68.66% kelas amatan secara benar.

Rangkuman dari model yang dibentuk adalah sebagai berikut:

summary(log_model)

## 
## Call:
## NULL
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -5.977e-01  5.172e-02 -11.557   <2e-16 ***
## X1           5.876e-04  6.405e-05   9.174   <2e-16 ***
## X2           1.947e-05  4.486e-07  43.394   <2e-16 ***
## X3           1.451e-05  2.518e-04   0.058   0.9540    
## X4           1.185e+00  6.423e-02  18.455   <2e-16 ***
## X5          -5.103e-01  5.374e-02  -9.495   <2e-16 ***
## X6           2.157e-05  1.294e-06  16.675   <2e-16 ***
## X7           9.262e-02  3.813e-02   2.429   0.0151 *  
## X8          -8.350e-06  4.355e-06  -1.917   0.0552 .  
## X9           2.395e-05  4.109e-07  58.284   <2e-16 ***
## X10         -1.468e-01  3.656e-03 -40.167   <2e-16 ***
## X11         -8.213e-02  6.635e-03 -12.379   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 108001  on 78007  degrees of freedom
## Residual deviance:  93487  on 77996  degrees of freedom
## AIC: 93511
## 
## Number of Fisher Scoring iterations: 4

Diperoleh beberapa peubah penjelas yang signifikan dalam menjelaskan/mempengaruhi status pelanggan adalah kecuali X3 (rata-rata frekuensi panggilan per bulan) dan X7 (presentase transaksi SMS sesama operator). Model yang terbentuk adalah sebagai berikut: \[g(x)=\log(\frac{\hat{\pi}}{1-\hat{\pi}})=-0.5805+0.00063X_1+0.0002X_2+1.154X_4-0.4788X_5+0.000022X_6-0.0000009X_8+0.000024X_9-0.11511X_10-0.07725X_11\] *model tanpa menyertakan peubah tidak signifikan

Kemudian dilakukan evaluasi kebaikan model klasifikasi dengan matriks konfusi.

log_test <- test
log_test$Y <- as.factor(log_test$Y)
log_conf <- confusionMatrix(log_test$Y, predict(log_model, newdata = test, type = 'raw'), positive = "1", mode = 'everything')
log_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 6076 2110
##          1  667 1159
##                                           
##                Accuracy : 0.7226          
##                  95% CI : (0.7137, 0.7314)
##     No Information Rate : 0.6735          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.2884          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.3545          
##             Specificity : 0.9011          
##          Pos Pred Value : 0.6347          
##          Neg Pred Value : 0.7422          
##               Precision : 0.6347          
##                  Recall : 0.3545          
##                      F1 : 0.4550          
##              Prevalence : 0.3265          
##          Detection Rate : 0.1158          
##    Detection Prevalence : 0.1824          
##       Balanced Accuracy : 0.6278          
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai-nilai akurasi sebagai berikut:

Diperoleh nilai akurasi sebesar 72.26%, yang artinya model logistik yang terbentuk mampu mengklasifikasikan 72.26% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 35.45% yang artinya model logistik mampu mengklasifikasikan 35.45% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 90.11% yang artinya model logistik mampu mengklasifikasikan 90.11% pelanggan tidak potensial (0) secara tepat.

library(pROC)

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

log_roc <- roc(test$Y, predict(log_model, newdata = test, type = 'prob')$`1`, plot = T)

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

log_roc$auc

## Area under the curve: 0.7514

Diperoleh nilai AUC sebesar 75.14% yang artinya model mampu mengklasifikasikan 75.15% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan regresi logistik diperoleh ukuran-ukuran akurasi sebagai berikut:

log_df <- data.frame(Metode = 'RegLog',
                     Akurasi = log_conf$overall[1],
                     Sensitivitas = log_conf$byClass[1],
                     Spesifisitas = log_conf$byClass[2],
                     AUC = log_roc$auc)
log_df

##          Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy RegLog 0.7226328    0.3545427    0.9010826 0.7514094

ANN

Artificial Neural Network (ANN) atau Jaringan Saraf Tiruan merupakan salah satu pemodelan kompleks yang dapat memprediksi bagaimana ekosistem merespon perubahan variabel lingkungan dengan terinspirasi oleh cara kerja sistem saraf biologis, khususnya pada sel otak manusia dalam memproses informasi. Algoritma yang paling populer digunakan oleh ANN adalah supervised learning. Namun, hal tersebut tidak menutup kemungkinan bahwa ANN dapat digunakan untuk algoritma semi-supervised dan unsupervised learning. Dikarenakan model ANN terinspirasi oleh sistem saraf biologis manusia, arsitekturnya pun dibuat seperti struktur otak manusia dimana terdiri dari neuron yang saling terhubung satu sama lain dan bentuk yang kompleks dan nonlinier.

Dalam hal ini, akan dilakukan ANN dengan package mlr3 dan mlr3learners.

ann_data <- newdata
ann_train <- newtrain
ann_test <- test

Artificial Neural Network ini memiliki kemampuan yang luar biasa untuk mendapatkan informasi dari data yang rumit atau tidak tepat sehingga permasalahan yang tidak terstruktur dan sulit didefinisikan dapat diatasi. Selain itu, ANN juga memiliki kemampuan untuk melakukan perhitungan secara paralel sehingga proses komputasi menjadi lebih cepat dan dapat membangun representasi dari informasi yang diterimanya selama proses pembelajaran secara mandiri. Dilakukan pembentukan tugas dengan menggunakan fungsi TaskClassif$new().

library(mlr3)
library(mlr3learners)
ann_data$class <- as.factor(ann_data$class)
task_ann <- TaskClassif$new(id="ann",backend = ann_data,
                                target = "class",positive ="1")

Kemudian dilakukan tuning parameter untuk size atau banyak neurons dari hidden layer ANN.

ann_hyper <- expand.grid(
  size = c(1:10), #Maximum depth of each tree
  accuracy = 0)
nrow(ann_hyper)

## [1] 10

Kemudian dibentuk model dengan parameter-parameter yang di-tuning. Diperoleh hasil akurasi yang berbeda-beda sesuai dengan ukuran hidden layer nya sebagai berikut:

for(i in 1:nrow(ann_hyper)) {
  set.seed(2022)
  ann.learner <- lrn('classif.nnet', size = i)
  ann.rsmp <- rsmp("holdout", ratio = 0.8)
  ann_train_test <- resample(task = task_ann,
                               learner = ann.learner,
                               resampling = ann.rsmp,
                               store_models = TRUE)
  ann_pred <- as.data.table(ann_train_test$prediction())
  ann_conf <- confusionMatrix(ann_pred$truth, ann_pred$response)
  ann_hyper$accuracy[i] <- ann_conf$overall[1]
}

## INFO  [10:42:39.528] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  14
## initial  value 43608.322078 
## iter  10 value 43202.378350
## iter  20 value 43154.743493
## iter  30 value 43099.584427
## iter  40 value 42922.149557
## iter  50 value 42480.305244
## iter  60 value 41706.062292
## iter  70 value 41404.886140
## iter  80 value 41067.605820
## iter  90 value 40858.220477
## iter 100 value 40830.538458
## final  value 40830.538458 
## stopped after 100 iterations
## INFO  [10:42:43.319] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  27
## initial  value 43495.842614 
## iter  10 value 43193.739001
## iter  20 value 43160.464603
## iter  30 value 42875.176312
## iter  40 value 42430.554047
## iter  50 value 42292.597475
## iter  60 value 41993.333626
## iter  70 value 41331.433459
## iter  80 value 41265.348481
## iter  90 value 41264.751456
## iter 100 value 41246.523332
## final  value 41246.523332 
## stopped after 100 iterations
## INFO  [10:42:47.614] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  40
## initial  value 46348.840470 
## iter  10 value 41845.125047
## iter  20 value 41373.966389
## iter  30 value 41089.606789
## iter  40 value 41060.342050
## iter  50 value 41030.964182
## iter  60 value 41023.326731
## iter  70 value 41019.546437
## iter  80 value 40775.911506
## iter  90 value 40323.239945
## iter 100 value 39312.213619
## final  value 39312.213619 
## stopped after 100 iterations
## INFO  [10:42:55.083] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  53
## initial  value 46536.337465 
## iter  10 value 42631.085151
## iter  20 value 41987.186645
## iter  30 value 41448.879295
## iter  40 value 41343.050068
## iter  50 value 41325.909480
## iter  60 value 41320.311366
## iter  70 value 41288.186301
## iter  80 value 41285.286671
## iter  90 value 41284.774670
## final  value 41284.568515 
## converged
## INFO  [10:43:01.595] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  66
## initial  value 56013.949469 
## iter  10 value 42651.157414
## iter  20 value 42383.033910
## iter  30 value 41993.949837
## iter  40 value 41144.030551
## iter  50 value 40972.253542
## iter  60 value 40895.943509
## iter  70 value 40885.988792
## iter  80 value 40882.670078
## iter  90 value 40795.323796
## iter 100 value 40775.318379
## final  value 40775.318379 
## stopped after 100 iterations
## INFO  [10:43:10.767] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  79
## initial  value 60312.531479 
## iter  10 value 43226.516147
## iter  20 value 42060.491703
## iter  30 value 41419.021870
## iter  40 value 41392.155387
## iter  50 value 41387.094415
## iter  60 value 41385.502671
## iter  70 value 41346.521506
## iter  80 value 41323.531021
## iter  90 value 41315.141175
## iter 100 value 41299.609707
## final  value 41299.609707 
## stopped after 100 iterations
## INFO  [10:43:19.482] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  92
## initial  value 65237.870641 
## iter  10 value 41611.798829
## iter  20 value 40909.584219
## iter  30 value 40835.312740
## iter  40 value 40799.485528
## iter  50 value 40768.160690
## iter  60 value 40761.798901
## iter  70 value 40750.990201
## iter  80 value 40741.366506
## iter  90 value 40736.029584
## iter 100 value 40735.251999
## final  value 40735.251999 
## stopped after 100 iterations
## INFO  [10:43:31.767] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  105
## initial  value 43365.672022 
## iter  10 value 41599.167859
## iter  20 value 41240.242934
## iter  30 value 41110.333156
## iter  40 value 41053.814917
## iter  50 value 41032.294926
## iter  60 value 41025.140010
## iter  70 value 41024.179945
## iter  80 value 41019.859747
## iter  90 value 41011.021898
## iter 100 value 41009.503036
## final  value 41009.503036 
## stopped after 100 iterations
## INFO  [10:43:45.080] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  118
## initial  value 48241.569136 
## iter  10 value 41597.711102
## iter  20 value 41009.346196
## iter  30 value 40947.309908
## iter  40 value 40942.809862
## iter  50 value 40915.784827
## iter  60 value 40911.306505
## iter  70 value 40898.302754
## iter  80 value 40885.157255
## iter  90 value 40883.387164
## iter 100 value 40882.308492
## final  value 40882.308492 
## stopped after 100 iterations
## INFO  [10:43:58.639] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  131
## initial  value 44106.261003 
## iter  10 value 41605.858402
## iter  20 value 41312.331601
## iter  30 value 41242.688684
## iter  40 value 41111.430541
## iter  50 value 41081.095305
## iter  60 value 41053.358755
## iter  70 value 41050.500637
## iter  80 value 40971.542333
## iter  90 value 40882.515402
## iter 100 value 40851.748747
## final  value 40851.748747 
## stopped after 100 iterations

ann_hyper

##    size  accuracy
## 1     1 0.5746058
## 2     2 0.6210742
## 3     3 0.6387002
## 4     4 0.6190873
## 5     5 0.6338290
## 6     6 0.6165876
## 7     7 0.6283169
## 8     8 0.6197923
## 9     9 0.6215229
## 10   10 0.6203051

plot(x=1:10, y=ann_hyper$accuracy, xlab='Size', ylab='Akurasi', type='b'); points(x=which.max(ann_hyper$accuracy),  y=max(ann_hyper$accuracy), col='red', pch=20); axis(1, at = seq(1,10, by=1))

Final size ANN

Kemudian dibentuk model berdasarkan ukuran dengan akurasi terbaik:

learner_nn <- lrn("classif.nnet", size=9)
learner_nn

## <LearnerClassifNnet:classif.nnet>: Single Layer Neural Network
## * Model: -
## * Parameters: size=9
## * Packages: mlr3, mlr3learners, nnet
## * Predict Types:  response, [prob]
## * Feature Types: integer, numeric, factor, ordered
## * Properties: multiclass, twoclass, weights

ann_rsmp <- rsmp("holdout", ratio = 0.8)

set.seed(2022)
ann_train_test <- resample(task = task_ann,
                               learner = learner_nn,
                               resampling = ann_rsmp,
                               store_models = TRUE)

## INFO  [10:44:12.452] [mlr3] Applying learner 'classif.nnet' on task 'ann' (iter 1/1)
## # weights:  118
## initial  value 48241.569136 
## iter  10 value 41597.711102
## iter  20 value 41009.346196
## iter  30 value 40947.309908
## iter  40 value 40942.809862
## iter  50 value 40915.784827
## iter  60 value 40911.306505
## iter  70 value 40898.302754
## iter  80 value 40885.157255
## iter  90 value 40883.387164
## iter 100 value 40882.308492
## final  value 40882.308492 
## stopped after 100 iterations

Setelah itu, dilakukan prediksi dan diperoleh hasil prediksi berikut:

ann_pred <- as.data.table(ann_train_test$prediction())
head(ann_pred)

##    row_ids  truth response    prob.1    prob.0
##      <int> <fctr>   <fctr>     <num>     <num>
## 1:       1      1        0 0.4280875 0.5719125
## 2:       3      1        1 0.6299836 0.3700164
## 3:       6      1        1 0.6299836 0.3700164
## 4:       7      1        0 0.4280875 0.5719125
## 5:      13      1        1 0.6299836 0.3700164
## 6:      14      1        1 0.6299836 0.3700164

Ukuran akurasi klasifikasi dengan ANN diperoleh sebagai berikut:

ann_conf <- confusionMatrix(ann_pred$truth, ann_pred$response, mode = 'everything')
ann_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    1    0
##          1 4368 3051
##          0 2854 5329
##                                           
##                Accuracy : 0.6215          
##                  95% CI : (0.6139, 0.6291)
##     No Information Rate : 0.5371          
##     P-Value [Acc > NIR] : < 2e-16         
##                                           
##                   Kappa : 0.2403          
##                                           
##  Mcnemar's Test P-Value : 0.01075         
##                                           
##             Sensitivity : 0.6048          
##             Specificity : 0.6359          
##          Pos Pred Value : 0.5888          
##          Neg Pred Value : 0.6512          
##               Precision : 0.5888          
##                  Recall : 0.6048          
##                      F1 : 0.5967          
##              Prevalence : 0.4629          
##          Detection Rate : 0.2800          
##    Detection Prevalence : 0.4755          
##       Balanced Accuracy : 0.6204          
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai-nilai akurasi sebagai berikut:

Diperoleh nilai akurasi sebesar 62.15%, yang artinya model ANN yang terbentuk mampu mengklasifikasikan 62.15% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 60.48% yang artinya model ANN mampu mengklasifikasikan 60.48% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 63.59% yang artinya model ANN mampu mengklasifikasikan 63.59% pelanggan tidak potensial (0) secara tepat.

ann_roc <- roc(ann_pred$truth, ann_pred$prob.1, direction = ">", plot = T)

## Setting levels: control = 1, case = 0

ann_roc$auc

## Area under the curve: 0.641

Diperoleh nilai AUC sebesar 64.1% yang artinya model mampu mengklasifikasikan 64.1% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan ANN diperoleh ukuran-ukuran akurasi sebagai berikut:

ann_df <- data.frame(Metode = 'ANN',
                     Akurasi = ann_conf$overall[1],
                     Sensitivitas = ann_conf$byClass[1],
                     Spesifisitas = ann_conf$byClass[2],
                     AUC = ann_roc$auc)
ann_df

##          Metode   Akurasi Sensitivitas Spesifisitas      AUC
## Accuracy    ANN 0.6215229    0.6048186    0.6359189 0.640966

Classification Tree

Konsep dari decision tree adalah mengubah data menjadi aturan-aturan keputusan. Manfaat utama dari penggunaan decision tree adalah kemampuannya untuk mem-break down proses pengambilan keputusan yang kompleks menjadi lebih simple, sehingga pengambil keputusan akan lebih menginterpretasikan solusi dari permasalahan. Classification tree adalah penggunaan decision tree pada peubah respon bersifat kategorik.

library(rpart)
library(rpart.plot)

clas_test <- test
clas_train <- newtrain
clas_data <- newdata

clas_tree <- rpart(data = clas_train, as.factor(class)~., control = rpart.control(cp = 0, minsplit = 5000),
                   method = 'class')
rpart.plot(clas_tree, extra = 'auto', box.palette="RdBu", shadow.col="gray", nn=TRUE)

Diperoleh pohon sebagaimana di atas diperoleh beberapa peubah yang berkontribusi dalam menyusun pohon antara lain X9, X5, X10, X11, X2, dan X8.

clas_pred <- predict(clas_tree, clas_test)
clas_predict <- ifelse(clas_pred[,2] > 0.5, 1, 0)
clas_conf <- confusionMatrix(as.factor(clas_predict), as.factor(clas_test$Y))
clas_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 5336  692
##          1 2850 1134
##                                           
##                Accuracy : 0.6462          
##                  95% CI : (0.6368, 0.6556)
##     No Information Rate : 0.8176          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.187           
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.6518          
##             Specificity : 0.6210          
##          Pos Pred Value : 0.8852          
##          Neg Pred Value : 0.2846          
##              Prevalence : 0.8176          
##          Detection Rate : 0.5330          
##    Detection Prevalence : 0.6021          
##       Balanced Accuracy : 0.6364          
##                                           
##        'Positive' Class : 0               
##

Diperoleh nilai-nilai akurasi sebagai berikut:

Diperoleh nilai akurasi sebesar 64.62%, yang artinya model classification tree yang terbentuk mampu mengklasifikasikan 64.62% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 65.18% yang artinya model classification tree mampu mengklasifikasikan 65.18% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 62.10% yang artinya model classification tree mampu mengklasifikasikan 62.10% pelanggan tidak potensial (0) secara tepat.

clas_roc <- roc(clas_test$Y, clas_pred[,2], direction = "<", plot = T)

## Setting levels: control = 0, case = 1

clas_roc$auc

## Area under the curve: 0.6766

Diperoleh nilai AUC sebesar 67.66% yang artinya model mampu mengklasifikasikan 67.66% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan classification tree diperoleh ukuran-ukuran akurasi sebagai berikut:

clas_df <- data.frame(Metode = 'ClasTree',
                     Akurasi = clas_conf$overall[1],
                     Sensitivitas = clas_conf$byClass[1],
                     Spesifisitas = clas_conf$byClass[2],
                     AUC = clas_roc$auc)
clas_df

##            Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy ClasTree 0.6462245    0.6518446    0.6210296 0.6765881

Random Forest

Random Forest adalah kombinasi dari masing – masing tree yang baik kemudian dikombinasikan ke dalam satu model. Random Forest bergantung pada sebuah nilai vector random dengan distribusi yang sama pada semua pohon yang masing masing decision tree memiliki kedalaman yang maksimal. Random Forest adalah classifier yang terdiri dari classifier yang berbentuk pohon {$h(x, \theta_k), k=1. ...$} dimana $\theta_k$ adalah random vector yang diditribusikan secara independen dan masing masing tree pada sebuah unit kan memilih class yang paling popular pada input x.

library(randomForest)

## randomForest 4.7-1.1

## Type rfNews() to see new features/changes/bug fixes.

## 
## Attaching package: 'randomForest'

## The following object is masked from 'package:ggplot2':
## 
##     margin

rf_data <- newdata
rf_train <- newtrain
rf_test <- test

Model RF dibentuk dengan menggunakan fungsi randomForest() dan kemudian diperoleh hasil akurasi sebagai berikut:

set.seed(2022)
rf_model <- randomForest(data=rf_train,
               as.factor(class)~.,
               ntree=500)
rf_pred <- predict(rf_model, rf_test, type="prob")
rf_predict <- ifelse(rf_pred[,2] > 0.5, 1, 0)
rf_conf <- confusionMatrix(as.factor(rf_predict), as.factor(rf_test$Y), positive = "1", mode='everything')
rf_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 7983  170
##          1  203 1656
##                                           
##                Accuracy : 0.9627          
##                  95% CI : (0.9588, 0.9664)
##     No Information Rate : 0.8176          
##     P-Value [Acc > NIR] : < 2e-16         
##                                           
##                   Kappa : 0.876           
##                                           
##  Mcnemar's Test P-Value : 0.09754         
##                                           
##             Sensitivity : 0.9069          
##             Specificity : 0.9752          
##          Pos Pred Value : 0.8908          
##          Neg Pred Value : 0.9791          
##               Precision : 0.8908          
##                  Recall : 0.9069          
##                      F1 : 0.8988          
##              Prevalence : 0.1824          
##          Detection Rate : 0.1654          
##    Detection Prevalence : 0.1857          
##       Balanced Accuracy : 0.9411          
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai-nilai akurasi sebagai berikut:

Diperoleh nilai akurasi sebesar 96.27%, yang artinya model random forest yang terbentuk mampu mengklasifikasikan 96.27% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 90.69% yang artinya model random forest mampu mengklasifikasikan 90.69% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 97.52% yang artinya model random forest mampu mengklasifikasikan 97.52% pelanggan tidak potensial (0) secara tepat.

rf_roc <- roc(rf_test$Y, rf_pred[,2], direction = "<", plot = T)

## Setting levels: control = 0, case = 1

rf_roc$auc

## Area under the curve: 0.9854

Diperoleh nilai AUC sebesar 98.54% yang artinya model mampu mengklasifikasikan 98.54% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan random forest diperoleh ukuran-ukuran akurasi sebagai berikut:

rf_df <- data.frame(Metode = 'Rand Forest',
                     Akurasi = rf_conf$overall[1],
                     Sensitivitas = rf_conf$byClass[1],
                     Spesifisitas = rf_conf$byClass[2],
                     AUC = rf_roc$auc)
rf_df

##               Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy Rand Forest 0.9627447    0.9069003    0.9752016 0.9854496

Gradient Boosting Machine

Gradient boosting merupakan algoritma klasifikasi machine learning yang menggunakan ensamble dari decision tree untuk memprediksi nilai. Gradient boosting termasuk supervised learning berbasis decision tree yang dapat digunakan untuk klasifikasi. Gradient boosting dimulai dengan menghasilkan pohon klasifikasi awal dan terus menyesuaikan pohon baru melalui minimalisasi fungsi kerugian.

gbm_data <- newdata
gbm_train <- newtrain
gbm_test <- test

Kemudian dilakukan tuning hyperparameter yang terdiri dari interaction.depth dan n.minobsinnode.

hyper_grid <- expand.grid(
  interaction.depth = c(2, 5, 7,9), #Maximum depth of each tree
  optimal_trees = 0, 
  min_RMSE = 0,
  n.minobsinnode = c(1000, 500, 100,50,25)# minimum number of observations in the terminal nodes of the trees
)
nrow(hyper_grid)

## [1] 20

Diperoleh hasil akurasi sebagai berikut:

library(gbm)

## Loaded gbm 2.1.9

## This version of gbm is no longer under development. Consider transitioning to gbm3, https://github.com/gbm-developers/gbm3

for(i in 1:nrow(hyper_grid)) {
  set.seed(2022)
  gbm.tune <- gbm(
    formula = class ~ .,
    distribution = "gaussian",
    data = gbm_train,
    n.trees = 1000,
    interaction.depth = hyper_grid$interaction.depth[i],
    n.minobsinnode = hyper_grid$n.minobsinnode[i],
    train.fraction = 0.75,
    n.cores = NULL,
    verbose = FALSE
  )
  hyper_grid$optimal_trees[i] <- which.min(gbm.tune$valid.error)
  hyper_grid$min_RMSE[i] <- sqrt(min(gbm.tune$valid.error))
}
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:randomForest':
## 
##     combine

## The following object is masked from 'package:car':
## 
##     recode

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

hyper_grid %>% 
  arrange(min_RMSE) %>%
  head(10)

##    interaction.depth optimal_trees  min_RMSE n.minobsinnode
## 1                  9           961 0.3476861            100
## 2                  9           991 0.3479426             50
## 3                  9           999 0.3490881             25
## 4                  7           992 0.3510181            100
## 5                  7           991 0.3524183             50
## 6                  7           990 0.3537450             25
## 7                  9           993 0.3551541            500
## 8                  5           999 0.3578984            100
## 9                  5           999 0.3590691             50
## 10                 7           993 0.3595155            500

Dibentuk model optimal dengan hyperparameter yang telah diperoleh berdasarkan nilai RMSE terkecil:

gbm_final <- gbm(formula = class~.,
                 distribution = 'gaussian',
                 data = gbm_train,
                 n.trees = 961,
                 interaction.depth = 9,
                 n.minobsinnode = 100,
                 n.cores = NULL,
                 verbose = FALSE)
summary(gbm_final, cBars = 10,
        method = relative.influence, las = 2)

##     var   rel.inf
## X11 X11 44.933366
## X9   X9 10.763530
## X5   X5  9.870490
## X10 X10  9.409837
## X2   X2  5.653997
## X8   X8  4.997715
## X7   X7  4.348277
## X1   X1  3.238389
## X3   X3  2.435343
## X6   X6  2.396183
## X4   X4  1.952872

Dilakukan prediksi sebagai berikut:

gbm_pred <- predict(object=gbm_final, newdata=gbm_test)

## Using 961 trees...

Dan diperoleh ukuran kebaikan klasifikasi sebagai berikut:

gbm_predict <- ifelse(gbm_pred > 0.5, 1, 0)
gbm_conf <- confusionMatrix(as.factor(gbm_test$Y), as.factor(gbm_predict), mode = 'everything', positive = "1")
gbm_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 7983  203
##          1 1360  466
##                                           
##                Accuracy : 0.8439          
##                  95% CI : (0.8366, 0.8509)
##     No Information Rate : 0.9332          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.3056          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.69656         
##             Specificity : 0.85444         
##          Pos Pred Value : 0.25520         
##          Neg Pred Value : 0.97520         
##               Precision : 0.25520         
##                  Recall : 0.69656         
##                      F1 : 0.37355         
##              Prevalence : 0.06682         
##          Detection Rate : 0.04654         
##    Detection Prevalence : 0.18238         
##       Balanced Accuracy : 0.77550         
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai-nilai akurasi sebagai berikut:

Diperoleh nilai akurasi sebesar >80%, yang artinya model gradient boosting yang terbentuk mampu mengklasifikasikan >80% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar >70% yang artinya model gradient boosting mampu mengklasifikasikan >70% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar >70% yang artinya model gradient boosting mampu mengklasifikasikan >70% pelanggan tidak potensial (0) secara tepat.

gbm_roc <- roc(gbm_test$Y, gbm_pred, direction = "<", plot = T)

## Setting levels: control = 0, case = 1

gbm_roc$auc

## Area under the curve: 0.8257

Diperoleh nilai AUC sebesar >80% yang artinya model mampu mengklasifikasikan >80% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan XGBoost diperoleh ukuran-ukuran akurasi sebagai berikut:

gbm_df <- data.frame(Metode = 'GBM',
                     Akurasi = gbm_conf$overall[1],
                     Sensitivitas = gbm_conf$byClass[1],
                     Spesifisitas = gbm_conf$byClass[2],
                     AUC = gbm_roc$auc)
gbm_df

##          Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy    GBM 0.8438873     0.696562    0.8544365 0.8257252

XGBoost

Algoritma XGBoost merupakan salah satu algoritma yang paling populer dan paling banyak digunakan karena algoritma ini termasuk algoritma yang powerful. Pada dasarnya, algoritma ini sama dengan algoritma gradient boost hanya saja menggunakan beberapa proses tambahan sehingga lebih powerful. Proses tersebut adalah pemangkasan, newton boosting, dan parameter pengacakan ekstra. Proses pemangkasan atau penyusutan proporsional simpul daun digunakan untuk meningkatkan generalisasi model. Proses newton boosting adalah proses untuk menyediakan rute langsung sehingga tidak memerlukan penurunan gradient. Proses pengacakan parameter bertujuan untuk mengurangi korelasi antar tree sehingga dapat meningkatkan kekuatan algoritma ensemble.

xgb_data <- newdata
xgb_train <- newtrain
xgb_test <- test

Sebelum dilakukan pembentukan model, terlebih dahulu dilakukan pembentukan matriks untuk data latih dan data uji sebagai berikut:

library(xgboost)

## 
## Attaching package: 'xgboost'

## The following object is masked from 'package:dplyr':
## 
##     slice

xgboost_train = xgb.DMatrix(data=as.matrix(xgb_train[,-12]), label=as.matrix(xgb_train[,12]))
xgboost_test = xgb.DMatrix(data=as.matrix(xgb_test[,-12]), label=as.matrix(xgb_test[,12]))

Tuning hyperparameter dilakukan untuk menentukan hyperparameter terbaik dan menghasilkan RMSE terkecil. Hyperparameter yang ditunig antara lain max.depth dan nrounds.

xgb_hyper <- expand.grid(
  max.depth = c(6, 7, 8, 9, 10), #Maximum depth of each tree
  optimal_trees = 0, 
  min_RMSE = 0,
  nrounds = c(200, 250))
nrow(xgb_hyper)

## [1] 10

Diperoleh hasil tuning sebagai berikut:

library(dplyr)
xgb_hyper %>% 
  arrange(min_RMSE) %>%
  head(10)

##    max.depth optimal_trees  min_RMSE nrounds
## 1         10           250 0.2949326     250
## 2         10           200 0.3247409     200
## 3          9           250 0.3563089     250
## 4          9           200 0.3823304     200
## 5          8           250 0.3995940     250
## 6          8           200 0.4201255     200
## 7          7           250 0.4492649     250
## 8          7           200 0.4662930     200
## 9          6           250 0.4833894     250
## 10         6           200 0.4960950     200

Kemudian dibentuk model berdasarkan hyperparameter terbaik sebagai berikut:

summary(xgb_final)

##                Length  Class              Mode       
## handle               1 xgb.Booster.handle externalptr
## raw            6232324 -none-             raw        
## niter                1 -none-             numeric    
## evaluation_log       2 data.table         list       
## call                14 -none-             call       
## params               2 -none-             list       
## callbacks            2 -none-             list       
## feature_names       11 -none-             character  
## nfeatures            1 -none-             numeric

Ukuran kebaikan klasifikasi diukur sebagai berikut:

xgb_pred <- predict(xgb_final, xgboost_test)
xgb_predict <- ifelse(xgb_pred > 0.5, 1, 0)
xgb_conf <- confusionMatrix(as.factor(xgb_test$Y), as.factor(xgb_predict), positive = "1", mode='everything')
xgb_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 8051  135
##          1  270 1556
##                                           
##                Accuracy : 0.9595          
##                  95% CI : (0.9555, 0.9633)
##     No Information Rate : 0.8311          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.8604          
##                                           
##  Mcnemar's Test P-Value : 2.766e-11       
##                                           
##             Sensitivity : 0.9202          
##             Specificity : 0.9676          
##          Pos Pred Value : 0.8521          
##          Neg Pred Value : 0.9835          
##               Precision : 0.8521          
##                  Recall : 0.9202          
##                      F1 : 0.8848          
##              Prevalence : 0.1689          
##          Detection Rate : 0.1554          
##    Detection Prevalence : 0.1824          
##       Balanced Accuracy : 0.9439          
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai akurasi sebesar 95.95%, yang artinya model XGBoost yang terbentuk mampu mengklasifikasikan 95.95% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 92.02% yang artinya model XGBoost mampu mengklasifikasikan 92.02% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 96.76% yang artinya model XGBoost mampu mengklasifikasikan 96.76% pelanggan tidak potensial (0) secara tepat.

xgb_roc <- roc(xgb_test$Y, xgb_pred, direction = "<", plot = T)

## Setting levels: control = 0, case = 1

xgb_roc$auc

## Area under the curve: 0.9713

Diperoleh nilai AUC sebesar 97.13% yang artinya model mampu mengklasifikasikan 97.13% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan XGBoost diperoleh ukuran-ukuran akurasi sebagai berikut:

xgb_df <- data.frame(Metode = 'XGBoost',
                     Akurasi = xgb_conf$overall[1],
                     Sensitivitas = xgb_conf$byClass[1],
                     Spesifisitas = xgb_conf$byClass[2],
                     AUC = xgb_roc$auc)
xgb_df

##           Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy XGBoost 0.9595485    0.9201656     0.967552 0.9712559

KNN

K-Nearest Neighbor termasuk salah satu algoritma paling sederhana yang digunakan dalam machine learning untuk regresi dan klasifikasi. KNN mengikuti strategi “bird of a feather” dalam menentukan di mana data baru sebaiknya ditempatkan. Algoritma KNN mengasumsikan bahwa sesuatu yang mirip akan ada dalam jarak yang berdekatan atau bertetangga. Artinya data-data yang cenderung serupa akan dekat satu sama lain.

KNN menggunakan semua data yang tersedia dan mengklasifikasikan data atau kasus baru berdasarkan ukuran kesamaan atau fungsi jarak. Data baru kemudian ditugaskan ke kelas tempat sebagian besar data tetangga berada. Tujuan dari algoritma k-nearest neighbor adalah untuk mengidentifikasi tetangga terdekat dari titik kueri yang diberikan, sehingga kita dapat menetapkan label kelas ke titik tersebut.

knn_data <- newdata
knn_test <- test
knn_train <- newtrain

Untuk menjalankan algoritma KNN, sebelumnya data yang mengandung outliers dinormalisasi sebagai berikut:

normalize <- function(x){
  return((x - min(x)) / (max(x) - min(x)))
}

norm_train <- as.data.frame(lapply(knn_train[,-12], normalize))
norm_test <- as.data.frame(lapply(knn_test[,-12], normalize))
y_train <- knn_train[,12]
y_test <- knn_test[,12]
norm_train2 <- cbind(norm_train, y_train)
norm_test2 <- cbind(norm_test, y_test)

KNN bekerja berdasarkan prinsip bahwa setiap titik data yang berdekatan satu sama lain akan berada di kelas yang sama. Dengan kata lain, KNN mengklasifikasikan titik data baru berdasarkan kemiripan. Diperoleh hasil pemodelan dengan KNN sebagai berikut:

knn_trctrl <- trainControl(method = "cv", number = 10)
knn_final <- train(as.factor(class)~., 
                   data = norm_train2,
                   method = "knn",
                   trControl = knn_trctrl,
                   tuneGrid = data.frame(k=1))
knn_final$results

##   k  Accuracy     Kappa  AccuracySD     KappaSD
## 1 1 0.7348489 0.4716901 0.003860691 0.007552203

Dan dilakukan prediksi dengan model yang terbentuk, diperoleh nilai kebaikan klasifikasi data prediksi sebagai berikut:

knn_pred <- predict(knn_final, norm_test2)
knn_conf <- confusionMatrix(as.factor(norm_test2$Y), knn_pred, mode = 'everything', positive = "1")
knn_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 7633  553
##          1  129 1697
##                                           
##                Accuracy : 0.9319          
##                  95% CI : (0.9268, 0.9367)
##     No Information Rate : 0.7753          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.7905          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.7542          
##             Specificity : 0.9834          
##          Pos Pred Value : 0.9294          
##          Neg Pred Value : 0.9324          
##               Precision : 0.9294          
##                  Recall : 0.7542          
##                      F1 : 0.8327          
##              Prevalence : 0.2247          
##          Detection Rate : 0.1695          
##    Detection Prevalence : 0.1824          
##       Balanced Accuracy : 0.8688          
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai akurasi sebesar 93.19%, yang artinya model KNN yang terbentuk mampu mengklasifikasikan 93.19% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 75.42% yang artinya model KNN mampu mengklasifikasikan 75.42% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 98.34% yang artinya model KNN mampu mengklasifikasikan 98.34% pelanggan tidak potensial (0) secara tepat.

knn_roc <- roc(norm_test2$Y, as.numeric(knn_pred), direction = "<", plot = T)

## Setting levels: control = 0, case = 1

knn_roc$auc

## Area under the curve: 0.9309

Diperoleh nilai AUC sebesar 93.09% yang artinya model mampu mengklasifikasikan 93.09% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan KNN diperoleh ukuran-ukuran akurasi sebagai berikut:

knn_df <- data.frame(Metode = 'KNN',
                     Akurasi = knn_conf$overall[1],
                     Sensitivitas = knn_conf$byClass[1],
                     Spesifisitas = knn_conf$byClass[2],
                     AUC = knn_roc$auc)
knn_df

##          Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy    KNN 0.9318817    0.7542222    0.9833806 0.9308997

Ensemble : RF, GBM, XGB dengan Majority Vote

Dilakukan pula ensemble (mengombinasikan 3 hasil klasifikasi yaitu GBM, XGB, dan Random Forest) dan didapatkan akurasi sebagai berikut:

pred <- data.frame(RF = rf_predict,
                   GBM = gbm_predict,
                   XGB = xgb_predict)
pred$majority <- ifelse((pred$RF+pred$GBM+pred$XGB)/3 > 0.5, 1, 0)
ens_conf <- confusionMatrix(as.factor(test$Y), as.factor(pred$majority), mode = 'everything', positive = "1")
ens_conf

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 8079  107
##          1  275 1551
##                                           
##                Accuracy : 0.9618          
##                  95% CI : (0.9579, 0.9655)
##     No Information Rate : 0.8344          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.8673          
##                                           
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.9355          
##             Specificity : 0.9671          
##          Pos Pred Value : 0.8494          
##          Neg Pred Value : 0.9869          
##               Precision : 0.8494          
##                  Recall : 0.9355          
##                      F1 : 0.8904          
##              Prevalence : 0.1656          
##          Detection Rate : 0.1549          
##    Detection Prevalence : 0.1824          
##       Balanced Accuracy : 0.9513          
##                                           
##        'Positive' Class : 1               
##

Diperoleh nilai akurasi sebesar 96.12%, yang artinya proses Ensemble XGB, GBM, dan RF yang terbentuk mampu mengklasifikasikan 96.12% kelas pelanggan secara tepat ke dalam pelanggan tidak potensial (0) atau pelanggan potensial (1).
Diperoleh nilai sensitivitas sebesar 93.26% yang artinya proses Ensemble XGB, GBM, dan RF mampu mengklasifikasikan 93.26% pelanggan potensial (1) secara tepat.
Diperoleh nilai spesifisitas sebesar 96.69% yang artinya proses Ensemble XGB, GBM, dan RF mampu mengklasifikasikan 96.69% pelanggan tidak potensial (0) secara tepat.

Diperoleh pula kurva ROC dan nilai AUC sebagai berikut:

ens_roc <- roc(test$Y, pred$majority, direction = "<", plot = T)

## Setting levels: control = 0, case = 1

ens_roc$auc

## Area under the curve: 0.9182

Diperoleh nilai AUC sebesar 91.76% yang artinya model mampu mengklasifikasikan 91.76% kelas dengan benar. Sehingga, berdasarkan klasifikasi dengan KNN diperoleh ukuran-ukuran akurasi sebagai berikut:

ens_df <- data.frame(Metode = 'Ensemble',
                     Akurasi = ens_conf$overall[1],
                     Sensitivitas = ens_conf$byClass[1],
                     Spesifisitas = ens_conf$byClass[2],
                     AUC = ens_roc$auc)
ens_df

##            Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy Ensemble 0.9618458    0.9354644    0.9670816 0.9181632

Comparisons

df <- rbind(log_df, ann_df, clas_df, rf_df, gbm_df, xgb_df, knn_df, ens_df)
df

##                Metode   Akurasi Sensitivitas Spesifisitas       AUC
## Accuracy       RegLog 0.7226328    0.3545427    0.9010826 0.7514094
## Accuracy1         ANN 0.6215229    0.6048186    0.6359189 0.6409660
## Accuracy2    ClasTree 0.6462245    0.6518446    0.6210296 0.6765881
## Accuracy3 Rand Forest 0.9627447    0.9069003    0.9752016 0.9854496
## Accuracy4         GBM 0.8438873    0.6965620    0.8544365 0.8257252
## Accuracy5     XGBoost 0.9595485    0.9201656    0.9675520 0.9712559
## Accuracy6         KNN 0.9318817    0.7542222    0.9833806 0.9308997
## Accuracy7    Ensemble 0.9618458    0.9354644    0.9670816 0.9181632

plot(x=0:7, y=df$Akurasi, xlab='Metode', ylab='Akurasi', type='b'); points(x=which.max(df$Akurasi)-1,  y=max(df$Akurasi), col='red', pch=20); axis(1, at = seq(1,8, by=1))

plot(x=0:7, y=df$Sensitivitas, xlab='Metode', ylab='Sensitivitas', type='b'); points(x=which.max(df$Sensitivitas)-1,  y=max(df$Sensitivitas), col='red', pch=20); axis(1, at = seq(1,8, by=1))

plot(x=0:7, y=df$Spesifisitas, xlab='Metode', ylab='Spesifisitas', type='b'); points(x=which.max(df$Spesifisitas)-1,  y=max(df$Spesifisitas), col='red', pch=20); axis(1, at = seq(1,8, by=1))

plot(x=0:7, y=df$AUC, xlab='Metode', ylab='AUC', type='b'); points(x=which.max(df$AUC)-1,  y=max(df$AUC), col='red', pch=20); axis(1, at = seq(1,8, by=1))

ggroc(list(LogReg = log_roc, ANN = ann_roc, ClasTree = clas_roc, RF = rf_roc, GBoost = gbm_roc,
           XGBoost = xgb_roc, KNN = knn_roc, Ensemble = ens_roc), 
      aes = c('colour')) + labs(colour = 'Method')

Kesimpulan

Berdasarkan nilai AUC, diperoleh bahwa metode Random Forest menghasilkan nilai AUC tertinggi. Sementara berdasarkan akurasi, metode Gradient Boosting Machine merupakan metode yang terbaik. Namun, dikarenakan waktu eksekusi gradient boosting yang sangat lama, maka diputuskan bahwa akan metode klasifikasi dan prediksi terbaik dalam laporan ini adalah dengan menggunakan Random Forest.

Tugas STA1581 R

2022-11-25

Data

Import Data

Eksplorasi Data

Statistik Deskriptif

Proporsi Pelanggan Potensial dan Tidak Potensial

Box Plot untuk Peubah Penjelas Kontinu

Plot untuk X1

Plot untuk X2

Plot untuk X3

Plot untuk X4

Plot untuk X5

Plot untuk X6

Plot untuk X7

Plot untuk X8

Plot untuk X9

Plot untuk X10

Plot untuk X11

Periksa NA dan NULL

Matriks Korelasi dan Heatmap

Algoritma Klasifikasi

SMOTE

Regresi Logistik Biner

Membentuk Model Logistik dan Periksa Multikolinearitas

Pemodelan Logistik Biner

ANN

Final size ANN

Classification Tree

Random Forest

Gradient Boosting Machine

XGBoost

KNN

Ensemble : RF, GBM, XGB dengan Majority Vote

Comparisons

Kesimpulan