Bahan Kuliah Pemodelan Klasifikasi - Prodi Statistika Terapan - IPB University
Definisi Diskretisasi
Andaikan dataset berisi \(N\) observasi, proses diskretisasi terhadap variabel numerik \(A\) adalah mengubah nilai variabel tersebut menjadi m interval \(D = \{ [d_0, d_1], (d_1, d_2], \ldots, (d_{m-1}, d_m] \}\), dengan \(d_0\) adalah nilai terkecil, dm adalah nilai terbesar, dan \(d_i < d_{i+1}\), untuk \(i = 0, 1, \ldots ,m-1\).
Istilah lain yang digunakan bergantian dengan istilah diskretisasi adalah binning dan kategorisasi.
Kita banyak melakukan ini pada data yang asalnya numerik menjadi beberapa kategori baru. Misalnya saja, pada data pendapatan per bulan yang merupakan peubah numerik, kita dapat mengelompokkan menjadi beberapa kategori yaitu:
- kurang dari 3 juta
- 3 s.d 5 juta
- lebih dari 5 juta
Unsupervised Discretization
Akan dipaparkan penggunaan fungsi classIntervals (pada package classInt) untuk dua teknik diskretisasi unsupervised yaitu:
- equal width discretization, dan
- equal frequency discretization
In equal width, the continuous range of a feature is divided into intervals that have an equal width and each interval represents a bin. The arity can be calculated by the relationship between the chosen width for each interval and the total length of the attribute range.
In equal frequency, an equal number of continuous values are placed in each bin. Thus, the width of each interval is computed by dividing the length of the attribute range by the desired arity.
Sebagai gambaran berikut perbedaan hasil diskretisasi Equal Width dan Equal Frequency data menjadi 4 (empat) kelas.
Garis putus-putus adalah breakpoints. Karena ada 4 kelas, maka ada 5 (lima) titik batas. Pada teknik equal width, jarak antar titik batas sama lebar. Pada teknik equal frequency, banyaknya titik amatan antar batas yang sama banyak.
Kita mulai dulu dengan mempraktekkan implementasi teknik equal width pada suatu vektor numerik x berikut ini. Opsi style=‘equal’ merupakan opsi untuk menggunakan algoritma equal width.
Pada program di bawah ini, hasil proses diskretisasi disimpan dalam variabel dengan nama “eqwid” dan salah satu yang menarik untuk diketahui adalah titik-titik batas antar selang/bin yang didapatkan, yang ada pada objek eqwid$brks.
library(classInt)## Loading required package: spData## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source'))`x <- c(15, 4, 21, 11, 16, 18, 24, 26, 28)
#equal width dengan bin/kategori sebanyak 4
eqwid <- classIntervals(x, 4, style = 'equal')
eqwid$brks## [1] 4 10 16 22 28Perhatikan bahwa data memiliki nilai paling kecil 4 dan paling besar 28, sehingga range-nya adalah 28-4=24. Karena akan dibagi menjadi 4 bin/selang yang sama lebar dengan teknik equal width, maka lebar setiap selang adalah 24/4 = 6. Karenanya, batas setiap selang adalah 4, 10, 16, 22, 28…. masing-masing jaraknya 6. Selang pertama adalah antara 4-10, selang kedua 10-16, selang ketiga 16-22, dan selang keempat 22-28.
Fungsi cut selanjutnya dapat kita pergunakan untuk mengelompokkan nilai-nilai asal dari vektor x ke dalam bin yang sesuai dengan batas-batas yang sudah didapatkan. Berikut ilustrasinya, dimana objek “x.eqwid” menyimpan kode nomer bin 1, 2, 3, dan 4, tergantung pada nilai variabel x.
Perintah cbind digunakan untuk menggabungkan nilai x asal dan kode/label kategorinya supaya mudah terlihat
x.eqwid <- cut(x, breaks=eqwid$brks, include.lowest=TRUE)
cbind(x, x.eqwid)## x x.eqwid
## [1,] 15 2
## [2,] 4 1
## [3,] 21 3
## [4,] 11 2
## [5,] 16 2
## [6,] 18 3
## [7,] 24 4
## [8,] 26 4
## [9,] 28 4Sebagai contoh, amatan pertama bernilai 15, maka ini akan masuk pada kategori ke-2 yaitu selang nilai 10 s/d 16, sedangkan amatan terakhir yang bernilai 28 masuk pada kategori ke-4 yaitu selang nilai 22 s/d 28.
Karena metode yang digunakan adalah equal width, maka yang dibuat sama adalah lebar selangnya, sedangkan banyaknya amatan/data di masing-masing selang akan berbeda tergantung pada sebaran datanya. Perintah berikut menyajikan tabel frekuensi amatan di setiap selang/bin.
table(x.eqwid)## x.eqwid
## [4,10] (10,16] (16,22] (22,28]
## 1 3 2 3Nampak bahwa selang pertama hanya berisi 1 amatan, selang kedua berisi 3 amatan, dst.
OK, sekarang kita coba lakukan diskretisasi terhadap vektor x menggunakan teknik equal frequency. FUngsi yang digunakan tetap sama yaitu classIntervals namun opsi yang digunakan adalah “style=‘quantile’”.
#equal freq sebanyak 4 bin/selang
eqfreq <- classIntervals(x, 4, style = 'quantile')
eqfreq$brks## [1] 4 15 18 24 28Dapat diperhatikan bahwa jarak antar titik-titik batas tidak seragam. Ada yang lebar seperti yang pertama yaitu 4 s/d 15, tapi ada yang sempit seperti yang kedua yaitu 15 s/d 18.
x.eqfreq <- cut(x, breaks=eqfreq$brks, include.lowest=TRUE)
cbind(x, x.eqwid, x.eqfreq)## x x.eqwid x.eqfreq
## [1,] 15 2 1
## [2,] 4 1 1
## [3,] 21 3 3
## [4,] 11 2 1
## [5,] 16 2 2
## [6,] 18 3 2
## [7,] 24 4 3
## [8,] 26 4 4
## [9,] 28 4 4Tentu saja, meskipun tekniknya equal frequency, banyaknya amatan di setiap kelas tidak persis sama banyak. Apalagi kalau banyaknya amatan secara keseluruhan bukan kelipatan banyaknya selang.
Berikut ini tabel frekuensi dari selang/bin hasil teknik equal frequency. Tidak semuanya persis sama karena ada 9 amatan dan dibuat 4 bins, tapi sebaran banyaknya amatan masing-masing kelas relatif seragam yaitu 2.
table(x.eqfreq)## x.eqfreq
## [4,15] (15,18] (18,24] (24,28]
## 3 2 2 2Modifikasi Batas Bin/Selang
Dalam beberapa kasus, kita perlu melakukan modifikasi dari batas-batas selang hasil algoritma yang kita jalankan. Hal ini perlu dilakukan antara lain karena ada beberapa bin yang sangat sedikit amatannya.
Sebagai ilustrasi, mari kita coba melakukan diskretisasi terhadap variabel BILL_AMT3 yang ada pada dataframe kredit (sebelumnya import dulu datanya dari file cccc.csv).
Proses diskretisasi dilakukan dengan teknik equal width menjadi sebanyak 20 bins. FUngsi table kita gunakan untuk menghasilkan tabel frekuensi setiap bin/selang.
kredit <- read.csv("D:/cccc.csv")
diskret <- classIntervals(kredit$BILL_AMT3, 20, style="equal")
bill.diskret <- cut(kredit$BILL_AMT3, diskret$brks, include.lowest = TRUE)
table(bill.diskret)## bill.diskret
## [-6.15e+04,2.48e+04] (2.48e+04,1.11e+05] (1.11e+05,1.97e+05]
## 12903 8073 1993
## (1.97e+05,2.84e+05] (2.84e+05,3.7e+05] (3.7e+05,4.56e+05]
## 642 240 98
## (4.56e+05,5.42e+05] (5.42e+05,6.29e+05] (6.29e+05,7.15e+05]
## 37 8 4
## (7.15e+05,8.01e+05] (8.01e+05,8.88e+05] (8.88e+05,9.74e+05]
## 0 1 0
## (9.74e+05,1.06e+06] (1.06e+06,1.15e+06] (1.15e+06,1.23e+06]
## 0 0 0
## (1.23e+06,1.32e+06] (1.32e+06,1.41e+06] (1.41e+06,1.49e+06]
## 0 0 0
## (1.49e+06,1.58e+06] (1.58e+06,1.66e+06]
## 0 1LIhat bahwa selang-selang pada bagian akhir relatif tidak ada amatan yang tercakup di dalamnya. Hanya 5 selang pertama saja yang mencakup lebih dari 100 amatan. Andaikan kemudian kita lakukan modifikasi menjadi 6 selang saja, dimana selang nomer 6, 7, dst kita gabung saja menjadi satu.
Trik yang bisa dilakukan adalah dengan membuang batas selang dari vektor diskret$brks. Unsur yang dibuang adalah unsur pada urutan ke-7 hingga ke-20. Sehingga yang bisa dilakukan adalah sebagai berikut
diskret$brks <- diskret$brks[-(7:20)]
bill.diskret <- cut(kredit$BILL_AMT3, diskret$brks, include.lowest = TRUE)
table(bill.diskret)## bill.diskret
## [-6.15e+04,2.48e+04] (2.48e+04,1.11e+05] (1.11e+05,1.97e+05]
## 12903 8073 1993
## (1.97e+05,2.84e+05] (2.84e+05,3.7e+05] (3.7e+05,1.66e+06]
## 642 240 149Sekarang kita hanya punya enam selang, dengan selang ke-6 adalah gabungan dari 15 selang sebelumnya.
Ilustrasi Efek Diskretisasi terhadap Kualitas Prediksi Model Regresi Logistik
Pada bagian ini akan diilustrasikan efek diskretisasi dalam meningkatkan kualitas prediksi model regresi logistik.
Ilustrasi yang diberikan akan disusun dalam bentuk sebagai berikut. Pertama, kita akan memiliki sebuah data yang terdiri atas satu peubah kelas (sebagai peubah respon, Y) dan satu peubah numerik (sebagai peubah penjelas/prediktor, X).
Data kita bagi menjadi dua dengan proporsi 70:30 secara acak. Bagian 70% disebut sebagai data training, bagian 30% untuk testing.
Model regresi logistik dibuat menggunakan data training dengan model Y ~ X. Dan selanjutnya dilihat akurasi prediksinya pada data testing.
Pada tahap selanjutnya dilakukan diskretisasi peubah X menjadi Xdiskret. Kemudian dibuat model kedua dengan data training, dalam bentuk Y ~ Xdiskret. Selanjutnya dilihat akurasi prediksinya pada data testing.
Kita akan membandingkan akurasi prediksi dari kedua cara pemodelan
Kita mulai dengan membaca data dan mempartisi data menjadi data training dan testing.
#membaca data
data <- read.csv("D:/disk01.csv", header=TRUE)
#membagi data menjadi dua bagian
library(caret)## Loading required package: lattice## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 3.5.3set.seed(1000)
acak <- createDataPartition(data$class, p=0.3, list=FALSE)
#membuat data testing
data_test <- data[acak,]
#membuat data training
data_train <- data[-acak,] Kemudian membuat model regresi logistik dengan X asli, dilanjutkan dengan menghitung akurasi pada data testing.
#membuat model dari data training
model.asli <- glm(class~x, data=data_train, family="binomial")
#memprediksi data testing
prediksi.prob.asli <- predict(model.asli, newdata=data_test, type="response")
prediksi.asli <- ifelse(prediksi.prob.asli > 0.5, 1, 0)
#nilai akurasi model pertama
mean(data_test$class == prediksi.asli)## [1] 0.5729847Selanjutnya kita buat model kedua dengan x yang didiskretisasi.
#diskretisasi equal width pada x data training
diskret <- classIntervals(data_train$x, 10, style = 'equal')
data_train$x.diskret <- cut(data_train$x, breaks=diskret$brks, include.lowest=TRUE)
#pemodelan dengan x hasil diskretisasi
model.disk <- glm(class ~ x.diskret, data=data_train, family="binomial")
#diskretisasi equal width pada x data testing
data_test$x.diskret <- cut(data_test$x, breaks=diskret$brks, include.lowest=TRUE)
#memprediksi data testing
prediksi.prob.disk <- predict(model.disk, data_test, type="response")
prediksi.disk <- ifelse(prediksi.prob.disk> 0.5, 1, 0)
#nilai akurasi model kedua
mean(data_test$class == prediksi.disk)## [1] 0.7603486Terlihat bahwa akurasi model kedua (dengan X hasil diskretisasi) lebih besar dibandingkan dengan model pertama (dengan X asli). Akurasi meningkat dari sekitar 57.3% menjadi 76.0%
Mengapa bisa meningkat?
Hal ini dikarenakan pola hubungan X dengan P(class=1) tidak berupa hubungan yang monoton naik atau monoton turun membentuk huruf S (s-curve) seperti yang dihipotesiskan oleh model regresi logistik.
pola pada data adalah sebagai berikut
tabel <- table(data_train$x.diskret, data_train$class)
proporsi <- prop.table(tabel, margin=1)
barplot(1-t(proporsi))
Bukan pola yang naik terus atau turun terus, tapi polanya turun…terus naik… Pada situasi seperti demikian, diskretisasi mampu memperbaiki kualitas model regresi logistik untuk menghasilkan prediksi dengan ketepatan yang lebih tinggi.