Naive Bayes Classifier

Concept: Bayes Theorem

Naive Bayes didasari oleh Bayes’ Theorem of Probability. Bayes Theorem membahas terkait peluang kejadian dependen (dependent events)

  • Kejadian Independen (saling bebas/tdk mempengaruhi)
    1. Kemungkinan hujan hari ini, dengan kemungkinan nasabah mengambil kredit
    2. Kejadian saya makan siang dengan nasi padang, dengan Indonesia menang Thomas Cup
  • Kejadian Dependen (saling mempengaruhi)
    1. Kemungkinan memenangkan Thomas cup jika diketahui keadaan stamina atlet
    2. Kemungkinan banjir di Jakarta jika diketahui adanya hujan deras di Bogor

Kejadi Independent

Kejadian A dan kejadian B terjadi bersamaan

\[P(A \cap B) = P(A) \times P(B)\]

Contoh Kasus: Cobalah hitung peluan dadu muncul angka 4 pada lemparan pertama dan peluang menucul angka 6 pada lemparan kedua?

  • Perhitungan Event A: Peluang dadu muncul angka 4 pada lemparan pertama \(P(A) = 1/6\)
  • Perhitungan Event B: Peluang dadu muncul angka 6 pada lemparan kedua \(P(B) = 1/6\)

\[P(A \cap B) = P(A) \times P(B) = \frac{1}{6} \times \frac{1}{6} = \frac{1}{36}\] > Maka, peluang dadu muncul angka 4 pada lemparan pertama dan dadu muncul angka 6 pada lemparan kedua adalah 1/36.

Illustrasi penghitungan peluang independent event:

Dependent Event

Kejadian A terjadi jika diketahui kejadian B telah terjadi a.k.a peluang bersyarat. Peluang A Bersyarat B.

Untuk menghitung peluang kejadian A, perlu menggunakan Bayes Theorem:

\[P(A|B) = \frac{P(B|A) P(A)}{P(B|A) P(A)\ +\ P(B|\neg A) P(\neg A)}\]

Atau

\[P(A|B) = \frac{P(A \cap B) P(A)}{P(B \cap A) P(A)\ +\ P(B \cap A | \neg A) P(\neg A)}\]

Keterangan:

  • \(P(A|B)\) / \(P(A \cap B)\) = Peluang terjadi A jika diketahui B telah terjadi
  • \(P(A)\) = Peluang terjadi A
  • \(P(B|A)\) / \(P(B \cap A)\) = Peluang terjadi B jika diketahui A telah terjadi
  • Simbol \(\neg\) (negasi) menandakan kejadian tersebut tidak terjadi.

Illustrasi penghitungan peluang independent event:

Warm Up Case: Market Analysis

Sebagai seorang marketing analyst, kita ingin meningkatkan penjualan dengan menargetkan customer dengan karakteristik tertentu. Dari data historis 400 customer yang sudah diprospek, kita peroleh informasi tentang gender, umur, dan kategori gaji serta apakah dia membeli produk kita atau tidak.

# Please run the code down below
library(dplyr)

cust_behaviour <- read.csv("data_input/Customer_Behaviour.csv", 
                           stringsAsFactors = T)

glimpse(cust_behaviour)
#> Rows: 400
#> Columns: 4
#> $ Gender    <fct> Male, Male, Female, Female, Male, Male, Female, Female, Male…
#> $ Age       <fct> < 30, 30-50, < 30, < 30, < 30, < 30, < 30, 30-50, < 30, 30-5…
#> $ Salary    <fct> Low, Low, Medium, Medium, Medium, Medium, Medium, High, Low,…
#> $ Purchased <fct> No, No, No, No, No, No, No, Yes, No, No, No, No, No, No, No,…

Deskripsi data:

  • Gender: Jenis Kelamin (Male, Female)
  • Age: Range usia (< 30, 30-50, > 50)
  • Salary: Kategori Gaji Customer (Low, Medium, High)
  • Purchased: Apakah klien membeli produk kita atau tidak (Yes, No)

Pertanyaan:

Jika ada seorang customer perempuan dengan nama Diva, yang usianya masih di bawah 30 tahun dan memiliki kategori gaji yang tinggi. Berapakan peluang Diva membeli produk?

Asumsi Naive Bayes

Naive Bayes mengasumsikan bahwa tiap prediktor saling independent atau tidak berkaitan satu sama lain. Secara matematis:

Untuk mempersingkat notasi, kita simbolkan kejadian \(A, B, C\) (prediktornya) sebagai:

  • \(A\): Gender = Female
  • \(B\): Age < 30
  • \(C\): Salary = High

\[P(A\ \cap\ B\ \cap\ C\ |\ Purchase) = P(A\ |\ Purchase) \times P(B\ |\ Purchase) \times P(C\ |\ Purchase)\]

\[P(A\ \cap\ B\ \cap\ C\ |\ \neg Purchase) = P(A\ |\ \neg Purchase) \times P(B\ |\ \neg Purchase) \times P(C\ |\ \neg Purchase)\]

Sehingga:

\[P(Purchase| A\ \cap\ B\ \cap\ C) = \frac{P(Purchase) \ P(A\ |\ Purchase)\ P(B\ |\ Purchase)\ P(C\ |\ Purchase)}{P(Purchase) \ P(A\ |\ Purchase)\ P(B\ |\ Purchase)\ P(C\ |\ Purchase)\ +\ P(\neg Purchase) \ P(A\ |\neg Purchase)\ P(B\ |\neg Purchase)\ P(C\ |\neg Purchase)}\]

Perhitungan manual

Mari kita cari satu per satu peluang yang dibutuhkan:

  1. Peluang seorang cutomer membeli \(P(Purchase)\) dan Peluan seorang cutomer tidak membeli \(P(\neg Purchase)\)
  • Tabel Frekuensi Customer Membeli & Tidak membeli
# Proporsi customer membeli dan tidak membeli
prop.table(table(cust_behaviour$Purchased))
#> 
#>     No    Yes 
#> 0.6425 0.3575
  • Perhitungan Peluang
# Peluang Customer Membeli
p_purchase <- 0.3575

# Peluang Customer Tidak Membeli
p_not_purchase <- 0.6425
  1. Peluang seorang cutomer gender female membeli \(P(A\ |\ Purchase)\) dan Peluang seorang cutomer gender female tidak membeli \(P(A\ |\neg Purchase)\)
  • Tabel Frekuensi Gender Membeli & Tidak membeli
# Please run the code down below
table(cust_behaviour$Gender, cust_behaviour$Purchased)
#>         
#>           No Yes
#>   Female 127  77
#>   Male   130  66
  • Perhitungan peluang customer ber-Gender Female diketahui dia membeli produk.

\(P(A\ |\ Purchase)\)

# Please type your code down below
p_female_purchase <- 77/ (77 + 66)
  • Perhitungan peluang customer ber-Gender Female diketahui dia tidak membeli produk.

\(P(A\ |\neg Purchase)\)

# Please type your code down below
p_female_not_purchase <- 127/ (127 + 130)
  1. Peluang seorang cutomer dengan umur < 30 tahun membeli \(P(B\ |\ Purchase)\) dan Peluang seorang cutomer dengan umur < 30 tahun tidak membeli \(P(B\ |\neg Purchase)\)
  • Tabel Frekuensi customer dengan umur < 30 tahun Membeli & Tidak membeli
# Please run the code down below
table(cust_behaviour$Age, cust_behaviour$Purchased)
#>        
#>          No Yes
#>   < 30   96   4
#>   > 50    4  45
#>   30-50 157  94
  • Perhitungan peluang customer dengan umur < 30 tahun diketahui dia membeli produk.

\(P(B\ |\ Purchase)\)

# Please type your code down below
p_age30_purchase <-  4 / (4 + 45 + 94)
  • Perhitungan peluang customer dengan umur < 30 tahun diketahui dia tidak membeli produk.

\(P(B\ |\neg Purchase)\)

# Please type your code down below
p_age30_not_purchase <- 96 / (96 + 4 + 157)
  1. Peluang seorang cutomer dengan salary high membeli \(P(C\ |\ Purchase)\) dan Peluang seorang cutomer dengan salary high tidak membeli \(P(C\ |\neg Purchase)\)
  • Tabel Frekuensi customer dengan salary high Membeli & Tidak membeli
# Please run the code down below
table(cust_behaviour$Salary, cust_behaviour$Purchased)
#>         
#>           No Yes
#>   High    19  75
#>   Low     56  39
#>   Medium 182  29
  • Perhitungan peluang customer dengan salary high diketahui dia membeli produk.

\(P(C\ |\ Purchase)\)

# Please type your code down below
p_high_purchase <- 75 / (75 + 39 + 29)
  • Perhitungan peluang customer dengan salary high diketahui dia tidak membeli produk.

\(P(C\ |\neg Purchase)\)

# Please type your code down below
p_high_not_purchase <- 19 / (19 + 56 + 182)
  1. Terakhir, kita masukkan peluang yang telah dihitung ke dalam rumus:

\(P(Purchase| A\ \cap\ B\ \cap\ C) = \frac{P(Purchase) \ P(A\ |\ Purchase)\ P(B\ |\ Purchase)\ P(C\ |\ Purchase)}{P(Purchase) \ P(A\ |\ Purchase)\ P(B\ |\ Purchase)\ P(C\ |\ Purchase)\ +\ P(\neg Purchase) \ P(A\ |\neg Purchase)\ P(B\ |\neg Purchase)\ P(C\ |\neg Purchase)}\)

# Please run the code down below
(p_purchase * p_female_purchase * p_age30_purchase * p_high_purchase) /
  (p_purchase * p_female_purchase * p_age30_purchase * p_high_purchase +
     p_not_purchase * p_female_not_purchase * p_age30_not_purchase * p_high_not_purchase)
#> [1] 0.243622

naiveBayes() function

Dengan menggunakan function naiveBayes() dari package e1071, kita tidak perlu melakukan perhitungan manual.

Terdapat 2 cara dalam membuat model menggunakan function naiveBayes() :

  1. Menggunakan argumen naiveBayes(formula, data)
  • formula: formula y~x, dimana y: target variabel, x: prediktor variabel
  • data: data yang digunakan untuk target dan prediktor variabel
  1. Menggunakan argumen naiveBayes(x, y)

  • x: prediktor variabel dari data yang digunakan

  • y: target variabel dari data yang digunakan

  • Pembuatan Model & Interpretasi

# Please run the code down below

#install.packages("e1071")
library(e1071)
model_naive <- naiveBayes(formula = Purchased ~ Age + Gender + Salary, 
                          data = cust_behaviour)

Model Naive Bayes menyimpan informasi tentang nilai peluang dependen antara target dengan setiap feature dalam bentuk prop.table(). Kita bisa periksa nilainya dengan perhitungan manual:

# Please run the code down below
model_naive
#> 
#> Naive Bayes Classifier for Discrete Predictors
#> 
#> Call:
#> naiveBayes.default(x = X, y = Y, laplace = laplace)
#> 
#> A-priori probabilities:
#> Y
#>     No    Yes 
#> 0.6425 0.3575 
#> 
#> Conditional probabilities:
#>      Age
#> Y           < 30       > 50      30-50
#>   No  0.37354086 0.01556420 0.61089494
#>   Yes 0.02797203 0.31468531 0.65734266
#> 
#>      Gender
#> Y        Female      Male
#>   No  0.4941634 0.5058366
#>   Yes 0.5384615 0.4615385
#> 
#>      Salary
#> Y           High        Low     Medium
#>   No  0.07392996 0.21789883 0.70817121
#>   Yes 0.52447552 0.27272727 0.20279720
  • Prediksi

Melalukan prediksi dengan function predict()

Syntax: predict(object model, newdata, type)

Terdapat parameter tambahan yang akan kita gunakan pada fungsi predict(), yaitu parameter type. Parameter type dapat kita isi dengan:

  • type = "raw" mengembalikan nilai peluang untuk masing-masing kelas
  • type = "class" mengembalikan label kelasnya (default threshold 0.5

Contoh prediksi dengan menggunakan type = raw

Membuat dataframe untuk diprediksi

# Please run the code down below
diva <- data.frame(Gender = "Female", 
                    Age = "< 30",
                    Salary = "High")
# Please run the code down below
predict(model_naive, 
        newdata = diva, 
        type = "raw")
#>            No      Yes
#> [1,] 0.756378 0.243622

Contoh prediksi dengan menggunakan type = class

# Please run the code down below
predict(model_naive, 
        newdata = diva, 
        type = "class")
#> [1] No
#> Levels: No Yes
Summary Karakteristik Naive Bayes:

Hubungan prediktor dengan target saling dependen (berhubungan).

Hubungan anatara prediktor saling independen (tidak berhubungan).
Tiap prediktor memiliki bobot yang sama untuk menghasilkan prediksi.

Laplace Smoothing

Pada kasus tertentu, dapat terjadi data scarcity, yaitu kondisi dimana suatu prediktor tidak hadir sama sekali di salah satu kelas. Misalkan dari data Customer_Behaviour sebelumnya, pada customer yang melakukan Purchase sama sekali tidak ada yang ber-Gender Female, sehingga tabel frekuensinya menjadi sebagai berikut:

#>        No Purchase Purchase
#> Female         127        0
#> Male           130      143

Dari tabel di atas, kita peroleh: \(P(Gender = Female\ |\ Purchase) = 0\). Apabila tabel frekuensi untuk prediktor lainnya tetap sama, maka peluang Tiara sebagai Female dengan Age < 30 dengan High Salary untuk membeli produk adalah:

\[P(Purchase\ |\ Age <30 \ \cap\ Gender = Female\ \cap\ Salary = High ) \\ = \frac{\frac{143}{143+257}\ \frac{4}{4+45+94}\ \frac{0}{0+143}\ \frac{75}{75+39+29}} {\frac{143}{143+257}\ \frac{4}{4+45+94}\ \frac{0}{0+143}\ \frac{75}{75+39+29} + \frac{257}{143+257}\ \frac{96}{96+4+157}\ \frac{127}{127+130}\ \frac{19}{19+56+182}} = 0\]

Ini adalah karakteristik kedua dari Naive Bayes: Skewness Due To Scarcity. Ketika terdapat suatu prediktor yang frekuensi nilainya 0 untuk salah satu kelas (pada kasus ini Female untuk Purchase = Yes), maka model secara otomatis memprediksi bahwa peluangnya adalah 0 untuk kondisi tersebut, tanpa memperdulikan nilai dari prediktor yang lainnya. Dengan kata lain, setiap ada customer ber-gender Female maka model kita akan langsung memprediksi dia sebagai tidak membeli. Model menjadi bias atau kurang akurat dalam melakukan prediksi.

Berikut adalah solusinya:

  • Strategi 1: Menghilangkan prediktor yang bermasalah

Prediktor yang bermasalah tidak digunakan untuk pembuatan model. Namun, cara ini mungkin kurang tepat kalau prediktor tersebut memang punya pengaruh besar terhadap hasil prediksi, sehingga ketika dihilangkan maka hasil prediksi justru kurang baik. Selain itu, dengan bertambahnya data, ada kemungkinan frekuensinya berubah dari yang sebelumnya tidak ada menjadi ada

  • Strategi 2: Menggunakan Laplace Smoothing

Kita ingin memastikan tidak ada observasi yang nol, namun juga proporsi tidak berubah jauh dari aslinya. Solusi alternatifnya menggunakan Laplace Smoothing, yaitu dengan cara menambahkan frekuensi dari setiap prediktor sebanyak angka tertentu (biasanya 1), sehingga tidak ada lagi prediktor yang memiliki nilai 0.

Contoh pada kasus di atas dengan menggunakan laplace = 1:

Tabel Frekuensi Purchased (TETAP, karena bukan predictor)

\[\begin {matrix} No & Yes \\\hline257 & 143\end{matrix}\]

Tabel Frekuensi Gender

\[\begin {matrix}& Female & Male \\\hline\neg Purchase & 127+1 & 130+1 \\Purchase & 0+1 & 143+1\end{matrix}\]

Tabel Frekuensi Age

\[\begin {matrix}& <30 & >50 & 30-50 \\\hline\neg Purchase & 96+1 & 4+1 & 157+1 \\Purchase & 4+1 & 45+1 & 94+1 \\\end{matrix}\]

Tabel Frekuensi Salary

\[\begin {matrix}& High & Low & Medium \\\hline\neg Purchase & 19+1 & 56+1 & 182+1 \\Purchase & 75+1 & 39+1 & 29+1 \\\end{matrix}\]

Jika kita hitung kembali, dengan laplace smoothing, peluang Tiara dalam membeli produk dari permasalahan data scarcity adalah:

(143/(143+257) * 1/(1+144) * 5/(5+46+95) * 76/(76+40+30)) /
  (143/(143+257) * 1/(1+144) * 5/(5+46+95) * 76/(76+40+30) +
  257/(143+257) * 128/(128+131) * 97/(97+5+158) * 20/(20+57+183))
#> [1] 0.004800184

Walaupun peluangnya sangat kecil, tetapi setidaknya dengan metode Laplace Smoothing kita dapat memastikan model tidak terlalu ekstrim dalam mengklasifikasikan observasi serta tetap dapat mempertimbangkan nilai peluang dari prediktor lainnya.

Dengan menggunakan function naiveBayes(), kita cukup menambahkan parameter laplace = 1:

# Please run the code down below

# Modeling
model_naive2 <- naiveBayes(formula = Purchased ~ . , 
                           data = cust_behaviour, 
                           laplace = 1)

# Predict
predict(model_naive2, newdata = diva, type = "raw")
#>             No       Yes
#> [1,] 0.7266279 0.2733721

Text Mining w/ Naive Bayes

Text Mining adalah salah satu metode analisis data yang fokus utamanya adalah mencari informasi dan pola-pola dari data yang tidak terstruktur, yaitu data teks. Data teks disebut tidak terstruktur karena:

  • Satu kalimat terdiri dari beberapa kata yang jumlahnya berbeda-beda tiap kalimat.
  • Adanya typo (salah ketik), penyingkatan kata (you menjadi u), ataupun simbol-simbol tidak bermakna sehingga perlu dilakukan cleansing.
  • Adanya perbedaan bahasa yang digunakan sehingga perlu mencari kosa kata yang cocok.

Berikut ilustrasi workflow dari text mining:

Study Case: Spam Classifier

Business Question: Berdasarkan kata-kata pada SMS, kita ingin melakukan klasifikasi apakah suatu SMS termasuk spam atau bukan (ham)?

  • Kelas positif: spam
  • Kelas negatif: ham (not spam)

Read Data

# Please run the code down below
sms_raw <- read.csv("data_input/spam.csv",
                    stringsAsFactors = FALSE,
                    encoding = "UTF-8")

head(sms_raw)

Data Wrangling

  • Adakah kolom yang tidak diperlukan?
  • Adakah kolom yang tipe datanya perlu disesuaikan?
# Please type your code down below
sms_clean <- sms_raw %>% 
  select(-X , -X.1 , -X.2) %>% 
  mutate(v1 = as.factor(v1))

Exploratory Data Analysis (EDA)

Silahkan ambil 5 sample text yang termasuk spam, kemudian amati kata-kata apa saja yang dapat menjadi indikator (prediktor) bahwa suatu text adalah spam?

# Please type your code down below
sms_clean %>% 
  filter(v1 == 'spam') %>% 
  head(5)

Apa kata-kata yang berpotensial mengindikasi bahwa suatu text adalah spam? - Free

Data Preprocessing

Text preprocessing adalah suatu proses untuk menyeleksi data text agar menjadi lebih terstruktur lagi dengan melalui serangkaian tahapan. Berikut beberapa tahapan dalam data text pre-processing.

Text to Corpus

Corpus adalah kumpulan dari dokumen. Pada kasus ini, satu dokumen ekuivalen dengan satu observasi SMS. Di dalam satu SMS bisa terdapat satu atau lebih kalimat.

Salah satu package yang bisa kita gunakan untuk text mining adalah tm. Pengubahan dari vector text menjadi corpus bisa dilakukan menggunakan function VCorpus()

  • Transformasi data menjadi bentuk corpus
# Please type your code down below

library(tm)

sms.corpus <- VCorpus(VectorSource(sms_clean$v2))
  • Melihat text melalui dataframe
# Please run the code down below
sms_clean[1,2]
#> [1] "Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat..."
  • Melihat text melalui isi dokumen (corpus)
# Please run the code down below
sms.corpus[[1]]$content
#> [1] "Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat..."

Untuk melihat beberapa content sekaligus, kita dapat menggunakan lapply()

# Please run the code down below
lapply(sms.corpus[1:3]$content, as.character)
#> [[1]]
#> [1] "Go until jurong point, crazy.. Available only in bugis n great world la e buffet... Cine there got amore wat..."
#> 
#> [[2]]
#> [1] "Ok lar... Joking wif u oni..."
#> 
#> [[3]]
#> [1] "Free entry in 2 a wkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receive entry question(std txt rate)T&C's apply 08452810075over18's"

Text Cleasing

Text Cleansing perlu kita lakukan untuk merapikan dan menghilangkan informasi yang kurang penting data text kita. Dalam melakukan text cleansing kita akan menggunakan fungsi tm_map() dari package tm.

Berikut parameter yang dapat kita gunakan pada fungsi tersebut:

  • x = : Parameter ini akan di-isi dengan object corpus
  • FUN = : Parameter ini akan kita isi dengan fungsi untuk melakukan text cleansing, atau fungsi tersebut akan kita bungkus dengan content_transformer() jika fungsi yang digunakan bukan berasal dari library tm.

Agar kita memiliki pembanding data sebelum dilakukan text cleansing dan sesudah, mari kita coba panggil konten SMS ke-9:

# Please run the code down below
sms.corpus[[9]]$content
#> [1] "WINNER!! As a valued network customer you have been selected to receive a 900 prize reward! To claim call 09061701461. Claim code KL341. Valid 12 hours only."
  • Case-Folding: Mengubah semua text menjadi lowercase

Tahapan pertama yang biasanya dilakukan adalah tahapan case folding. Tahapan ini hampir selalu disertakan ketika melakukan text preprocessing.

Mengapa? Karena data yang kita miliki tidak selalu terstruktur dan konsisten dalam penggunaan huruf kapital. Jadi, peran dari case folding adalah untuk menyamaratakan penggunaan huruf kapital. Misalnya data teks yang kita dapat berupa tulisan “DaTA SCIence” maka dengan case folding artinya kita mengubah semua huruf menjadi huruf kecil (lowercase) semua.

Berikut adalah cara untuk melakukan case-folding

# Please type your code down below
sms.corpus <- tm_map(x = sms.corpus, 
                     FUN = content_transformer(tolower))

# inspect content sms ke-9
sms.corpus[[9]]$content
#> [1] "winner!! as a valued network customer you have been selected to receive a 900 prize reward! to claim call 09061701461. claim code kl341. valid 12 hours only."
  • Menghapus angka & stopwords (kata sambung)

Angka maupun kata sambung bisa dibilang tidak penting karena bisanya kedua hal tersebut tidak memiliki makna tersendiri. Maka dari itu bisa kita coba hilangkan saja.

# Please type your code down below

# Menghapus angka
sms.corpus <- tm_map(x = sms.corpus, 
                     FUN = removeNumbers)

# inspect content sms ke-9
sms.corpus[[9]]$content
#> [1] "winner!! as a valued network customer you have been selected to receive a  prize reward! to claim call . claim code kl. valid  hours only."
# Please type your code down below
sms.corpus <- tm_map(x = sms.corpus, 
                     FUN = removeWords, stopwords("English"))

# cek content sms ke-9
sms.corpus[[9]]$content
#> [1] "winner!!   valued network customer    selected  receive   prize reward!  claim call . claim code kl. valid  hours ."
  • Menghapus tanda baca

Selain menghilangkan angka maupun kata sambung, kita juga dapat menghilangkan tanda baca. Untuk menghilangkan tanda baca, kita harus menggunakan fungsi DIY.

# Please run the code down below
transformer <- content_transformer(FUN = function(x, pattern){
  gsub(x = x, 
       pattern = pattern, 
       replacement = " ") 
})
# Please run the code down below

# replace ".", "/", "@", "-" with a white space
# Ingin me-replace tanda / dengan spasi
sms.corpus <- tm_map(sms.corpus, transformer, "/")

#ingin me-replace tanda @ dengan spasi
sms.corpus <- tm_map(sms.corpus, transformer, "@")
sms.corpus <- tm_map(sms.corpus, transformer, "-")
sms.corpus <- tm_map(sms.corpus, transformer, "\\.")

# cek content ke-9
sms.corpus[[9]]$content
#> [1] "winner!!   valued network customer    selected  receive   prize reward!  claim call   claim code kl  valid  hours  "
  • Stemming

Proses stemming merupakan tahapan dimana kita akan mengembalikan sebuah kata menjadi kata dasar, sebagai contoh kata bahasa Inggris walking, walked, walks menjadi walk.

# Please run the code down below

library(SnowballC)
wordStem(c("do", "doing", "kicked", "kick"))
#> [1] "do"   "do"   "kick" "kick"
# Please type your code down below
sms.corpus <- tm_map(x = sms.corpus, 
                     FUN = stemDocument) 

# cek content ke-9 
sms.corpus[[9]]$content
#> [1] "winner!! valu network custom select receiv prize reward! claim call claim code kl valid hour"
  • Menghapus whitespace

Hal ini diperlukan karena pada proses tokenizing (selanjutnya), kata akan dipotong berdasarkan karakter spasi.

# Please type your code down below

# remove white space
sms.corpus <- tm_map(x = sms.corpus, 
                     FUN = stripWhitespace)

# inspect content sms ke-9
sms.corpus[[9]]$content
#> [1] "winner!! valu network custom select receiv prize reward! claim call claim code kl valid hour"

Summary singkat, secara umum tahapan yang sering dilakukan untuk text cleansing adalah:

  • Case-folding
  • Remove numbers
  • Remove stopwords
  • Remove punctuation
  • Stemming
  • Remove white space

Document-Term Matrix (DTM)

Sampai di tahap ini, data kita masih berupa text. Pertanyaannya bagaimana cara model kita belajar apabila prediktornya masih berupa text?

Data perlu diubah menjadi Document Term Matrix:

  • 1 kolom = 1 prediktor kata
  • 1 baris = 1 dokumen text/sms

Tahapan pemecahan tiap kata di text menjadi 1 term disebut Tokenization. Hasil tokenization akan disusun menadi Document Term Matrix. Untuk membuat data kita menjadi DTM, kita bisa menggunakan fungsi DocumentTermMatrix()

# Please type your code down below
sms.dtm <- DocumentTermMatrix(x = sms.corpus)

Hasil dari DTM dapat kita inspeksi dengan menggunakan fungsi inspect()

# cek singkat struktur dtm
inspect(sms.dtm)
#> <<DocumentTermMatrix (documents: 5572, terms: 8004)>>
#> Non-/sparse entries: 43544/44554744
#> Sparsity           : 100%
#> Maximal term length: 42
#> Weighting          : term frequency (tf)
#> Sample             :
#>       Terms
#> Docs   &lt;#&gt; call can come free get just know now will
#>   1085         0    0   0    1    0   1    0    0   0   12
#>   1579        18    0   0    0    0   0    0    0   0    0
#>   1863         0    0   0    0    0   0    0    1   0    0
#>   2158         0    0   0    0    0   0    0    0   0    0
#>   2370         0    0   0    0    1   0    0    0   0    0
#>   2380         1    0   1    0    0   0    0    0   0    0
#>   2434         6    0   3    0    1   1    0    0   0    0
#>   2848         0    0   0    0    0   0    0    0   0    0
#>   3016         2    0   0    0    0   0    0    0   0    0
#>   5105         0    0   0    0    1   0    0    0   0    0

Glossary:

  • documents: Jumlah data SMS
  • terms: kata yang unique di seluruh SMS kita
  • non-sparse: nilai yang bukan 0 pada matrix
  • sparse: nilai yang 0 pada matrix

Mari kita amati SMS ke 1085 yang sudah di-cleansing, kita dapat konfirmasi bahwa kata will muncul sebanyak 12 kali:

# Please run the code down below
sms.corpus[[1085]]$content
#> [1] "love start attract feel need everi time around first thing come thought start day end everi time dream love will everi breath name life happen around life will name cri will give happi take sorrow will readi fight anyon will love will craziest thing love will proov anyon girl beauti ladi whole planet will alway sing prais love will start make chicken curri end maki sambar life will beauti will get everi morn thank god day like say lot will tell later"

Cross-Validation

Proses Spliting

Split data menjadi sms_train dan sms_test dengan perbandingan 75-25.

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

# Index Sampling
index <- sample(nrow(sms.dtm), nrow(sms.dtm)*0.75)

# Implementasi Splitting ke Data Train
sms_train <- sms.dtm[index,]

# Implementasi Splitting ke Data Test
sms_test <- sms.dtm[-index,]

Pemisahan Target & Prediktor

Kita akan melakukan pemisahan antara target & prediktor, karena kita akan mencoba untuk membuat model Naive Bayes dengan cara kedua nantinya.

# label untuk train dan test, tersimpan pada dataframe sms_celan

# Label data train
label_train <- sms_clean[index, "v1"]

# Label data test
label_test <- sms_clean[-index, "v1"]

Further Preprocessing

Setelah melakukan tahapan cross validation, terdapat 2 tahapan lagi yang perlu kita lakukan. Tujuan dari tambahan proses pada data kita adalah untuk membuat model lebih mudah dalam mempelajari pola-pola yang terjadi.

Remove Infrequent Words

Bisa kita lihat, jumlah prediktor yang kita miliki sangat banyak. Padahal tidak semua kata tersebut muncul di setiap SMS. Kita akan menguangi jumlah prediktor dengan mengambil kata-kata yang cukup sering muncul, misalnya muncul di setidaknya 20 sms.

Gunakan function findFreqTerms():

# Please type your code down below
sms_freq <- findFreqTerms(x = sms_train, # object data train
                          lowfreq = 20) # minimal frekuensi

length(sms_freq)
#> [1] 325

Note: Penentuan lowfreq = 20 tidak mutlak dan dapat diubah-ubah untuk feature selection. Semakin besar lowfreq, semakin sedikit terms yang kita gunakan sebagai prediktor.

Kita akan mengambil kata-kata pada sms_train dan sms_test sesuai dengan kata-kata pada sms_freq dengan melakukan subseting:

# Please type your code down below

# Data Train
sms_train <-  sms_train[, sms_freq] 

# Data Test
sms_test <-  sms_test[, sms_freq]

Bernoulli Converter

Nilai pada matrix sms_train masih berupa frekuensi. Untuk perhitungan peluang, frekuensi akan diubah menjadi muncul (1) atau tidak (0).

Caranya dengan menggunakan Bernoulli Converter.

  • Jika frekuensi > 0, maka bernilai 1 (muncul)
  • Jika frekuensi = 0, maka bernilai 0 (tidak muncul)

Kita bisa melakukan ini, karena Naive Bayes tidak memberikan bobot terhadap setiap prediktor yang ada. Selain itu, proses ini akan meringankan proses komputasi.

# Please run the code down below
bernoulli_conv <- function(x){
  
  x <- as.factor(ifelse(x > 0, 1, 0)) 
  return(x)
  
}

Selanjutnya, terapkan bernoulli_conv ke sms_train dan sms_test:

Untuk menerapkan fungsi bernoulli_conv(), kita akan memanfaatkan fungsi apply(), berikut beberapa parameter pada fungsi apply()

  • X = parameter ini untuk memberitahu object data
  • MARGIN = parameter diperuntuhkan untuk memberitahu fungsi bernoulli_conv() akan di-implementasikan pada kolom atau baris
    • MARGIN = 1 -> mengaplikasikan FUN by baris
    • MARGIN = 2 -> mengaplikasikan FUN by kolom, karena kita ingin tetap matrix berupa DocumentTermMatrix, gunakan parameter ini.
  • FUN = Fungsi apa yang akan digunakan
# Please type your code down below

# Data train
sms_train_bn <- apply(X = sms_train, 
                      MARGIN = 2, 
                      FUN = bernoulli_conv)

# Data test
sms_test_bn <- apply(X = sms_test, 
                     MARGIN = 2, 
                     FUN = bernoulli_conv)

Mari cek hasilnya:

sms_train_bn[15:25, 35:40]
#>       Terms
#> Docs   can cant car care cash chanc
#>   4239 "0" "0"  "0" "0"  "0"  "0"  
#>   3718 "0" "0"  "0" "0"  "0"  "0"  
#>   1137 "1" "0"  "0" "0"  "0"  "0"  
#>   1987 "0" "0"  "0" "0"  "0"  "0"  
#>   1997 "0" "0"  "0" "0"  "0"  "0"  
#>   3834 "0" "0"  "0" "0"  "0"  "0"  
#>   2975 "0" "0"  "0" "0"  "0"  "0"  
#>   3946 "0" "0"  "0" "0"  "0"  "0"  
#>   2988 "0" "0"  "0" "0"  "0"  "0"  
#>   4157 "0" "0"  "0" "0"  "0"  "0"  
#>   2331 "0" "0"  "0" "0"  "0"  "0"

Modelling

Pada proses modelling kali ini kita akan menggunakan metode kedua, yaitu dengan menggunakan metode berikut ini:

Menggunakan argumen naiveBayes(x, y)

  • x: prediktor variabel dari data yang digunakan
  • y: target variabel dari data yang digunakan
# Please type your code down below
naive_spam <- naiveBayes(x = sms_train_bn, 
                         y = label_train, 
                         laplace = 1)

Prediction

Setelah membuat model, mari kita coba lakukan prediksi.

 # Please type your code down below
sms_pred_class <- predict(naive_spam, sms_test_bn, "class")

head(sms_pred_class)
#> [1] ham  spam ham  ham  ham  ham 
#> Levels: ham spam

Model Evaluation

Confusion Matrix

# Please type your code down below

library(caret)

confusionMatrix(data = sms_pred_class, 
                reference = label_test, 
                positive = "spam")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  ham spam
#>       ham  1204   23
#>       spam   14  152
#>                                              
#>                Accuracy : 0.9734             
#>                  95% CI : (0.9636, 0.9812)   
#>     No Information Rate : 0.8744             
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.8764             
#>                                              
#>  Mcnemar's Test P-Value : 0.1884             
#>                                              
#>             Sensitivity : 0.8686             
#>             Specificity : 0.9885             
#>          Pos Pred Value : 0.9157             
#>          Neg Pred Value : 0.9813             
#>              Prevalence : 0.1256             
#>          Detection Rate : 0.1091             
#>    Detection Prevalence : 0.1192             
#>       Balanced Accuracy : 0.9285             
#>                                              
#>        'Positive' Class : spam               
#>

ROC dan AUC

Sebelum kita membahas tentang ROC & AUC, mari kita coba cek proporse dari kelas target kita:

# Please run the code down below
prop.table(table(sms_clean$v1))
#> 
#>       ham      spam 
#> 0.8659368 0.1340632

Jika kita coba lihat, dari jumlah proporsi target kita tidak balanced. Maka dari itu, ketika kita melihat nilai accuracy pada hasil confusion matrix, tidak dapat kita percaya.

Accuracy memiliki kekurangan untuk memperlihatkan kebaikan model dalam mengklasifikasi ke kedua kelas. Mengatasi kekurangan accuracy tersebut, hadir ROC dan AUC sebagai alat evaluasi selain Confusion Matrix.

Receiver-Operating Curve (ROC) adalah kurva yang menggambarkan nilai True Positive Rate dan False Positive Rate pada setiap kemungkinan threshold. Area Under Curve (AUC) adalah area di bawah kurva ROC.

Keduanya dapat menggambarkan kebaikan model dalam mengklasifikasikan kedua belah kelas.

Model yang baik:

  • Kurva ROC membentuk L terbalik dan sudut tengah di kiri atas
  • AUC mendekati 1

Tahapan

  • Step 1: Predict dalam bentuk peluang
# Please type your code down below
spam_prob <- predict(object = naive_spam, 
                     newdata = sms_test_bn, 
                     type = "raw")

head(spam_prob) 
#>                     ham         spam
#> [1,] 0.8828534310611811 0.1171465689
#> [2,] 0.0000000003686327 0.9999999996
#> [3,] 0.9997303432068110 0.0002696568
#> [4,] 0.9954532240518041 0.0045467759
#> [5,] 0.9400228395666025 0.0599771604
#> [6,] 0.9998947022166202 0.0001052978
  • Step 2. Buat objek prediction dengan fungsi prediction()

Fungsi prediction() akan melakukan transformasi hasil probability menjadi sebuah bentuk prediksi yang dapat dibuatkan sebuah kurva ROC AUC nantinya. Pada fungsi tersebut terdapat 2 parameter yang akan digunakan, yaitu:

  • predictions = untuk mengambil nilai predictions kelas positif yang masih berbentuk probability
  • labels = untuk mengubah target kelas positif menjadi 1 dan 0
# Please type your code down below
library(ROCR)

sms_roc <- prediction(predictions = spam_prob[,'spam'], 
                      labels = ifelse(label_test == 'spam', 1, 0))
  • Step 3. Membuat curva ROC

Setelah berhasil membuat hasil prediksinya, kita akan menampilkannya dalam bentuk kurva. Untuk membuat kurva kita akan menggunakan syntax berikut ini:

plot(performance(prediction.obj = ..., measure = "tpr", x.measure = "fpr"))

# Please type your code down below
plot(performance(prediction.obj = sms_roc, 
                 measure = "tpr", 
                 x.measure = "fpr"))

  • Step 4. Kalkulasi AUC

Selain memanfaatkan bentuk visualisasi, kita dapat melihat nilai AUC dengan menggunakan fungsi performace(). Pada fungsi tersebut, kita akan menggunakan 2 parameter berikut ini.

  • prediction.obj = object yang menyimpan hasil prediksi dari fungsi prediction()
  • measure = untuk melihat hasil measurementnya, kita akan isi dengan “auc”
# Please type your code down below
sms_auc <- performance(prediction.obj = sms_roc, 
                       measure = "auc")

sms_auc@y.values
#> [[1]]
#> [1] 0.97289

Insight: Model diindikasikan baik dan bisa memisahkan kelas positif dan negatif dengan baik. Model dapat mengklasifikasikan ke kelas positif maupun ke kelas negatif.

Decision Tree

Decision Tree merupakan tree-based model yang cukup sederhana dengan performa yang robust/powerful untuk prediksi. Decision Tree menghasilkan visualisasi berupa pohon keputusan yang dapat diinterpretasi dengan mudah.

Note: Decision Tree tidak hanya terbatas pada kasus Classification, namun dapat digunakan pada kasus Regression. Pada course ini fokus kita ke kasus Classification karena idenya sama.

Struktur

Mari memahami bagaimana struktur dari Decision Tree dan istilah yang sering digunakan. Berikut contoh untuk menentukan apakah weekend ini kita akan beraktifitas keluar atau tidak:

  • Root Node: Percabangan pertama dalam menentukan nilai target, biasa disebut sebagai predictor utama.
  • Interior Node: Percabangan selanjutnya yang menggunakan predictor lain apabila root node tidak cukup dalam menentukan target.
  • Terminal/Leaf Node: Keputusan akhir berupa nilai target yang diprediksi.

Pertanyaan selanjutnya, bagaimana Decision Tree memilih predictor pada setiap percabangannya?

  • Secara intuitif, Decision Tree memilih predictor yang sebisa mungkin meng-homogen-kan target variable pada leaf node nya. Contoh: Observasi 100% Yes ketika Outlook (cuaca) bernilai Overcast (berawan).
  • Tingkat kehomogenan ini dapat dikuantifikasi menggunakan Entropy dan Information Gain.

Entropy & Information Gain

Bagaimana rule terbentuk?

Decision Tree membuat rule dengan memilih predictor yang dapat membuat homogen target. Oleh karena itu pemilihannya berdasarkan,

  • Entropy: tingkat kehomogenan data
    • 0 -> semakin seragam/teratur/homogen (semuanya yes/semuanya no)
    • 1 -> semakin beragam/tidak teratur/non-homogen (50:50 yes dan no)

Kelompok data yang diharapkan setelah dilakukan percabangan adalah kelompok yang memiliki entropy rendah.

Untuk memilih prediktor mana yang menjadi root node, dihitunglah perubahan entropy yaitu selisih antara entropy sebelum dan sesudah dilakukan percabangan menggunakan variable predictor.

  • Information Gain: penurunan entropy, sebelum vs setelah percabangan

Predictor yang dipilih adalah predictor yang menghasilkan penurunan entropy paling besar, berarti membuat data setelah pemisahan semakin homogen. Perubahan entropy inilah yang disebut Information Gain.

Prediktor yang dipilih pada setiap percabangan adalah predictor yang menghasilkan information gain terbesar.

Contoh:

Misalkan saya mencatat perilaku saya dalam menentukan apakah saya pergi makan ke restoran/tidak sebagai berikut:

dine <- read.csv("data_input/dineout.csv",
                 sep = ";",
                 stringsAsFactors = T)
dine
  • Budget: Budget yang saya miliki (High atau Low)
  • Distance: Jarak restoran dari rumah saya (Far atau Near)
  • Friend: Apakah ada teman yang menemani? (Available atau Absent)
  • Dine.Out: Keputusan apakah makan di restoran atau tidak (Yes atau No)

Tujuan Decision Tree yaitu memisahkan data menjadi kelompok-kelompok kecil berdasarkan variable tertentu sehingga dihasilkan data yang homogen. Sehingga prosesnya:

Visualisasi Decision Tree:

Case: Diabetes

Business Question & Read data

diab <- read.csv("data_input/diabetes.csv", 
                 stringsAsFactors = T)

head(diab)

Data Description:

  • pregnant: Number of times pregnant
  • glucose: Plasma glucose concentration (glucose tolerance test)
  • pressure: Diastolic blood pressure (mm Hg)
  • triceps: Triceps skin fold thickness (mm)
  • insulin: 2-Hour serum insulin (mu U/ml)
  • mass: Body mass index (weight in kg/(height in m)^2)
  • pedigree: Diabetes pedigree function
  • age: Age (years)
  • diabetes: Test for Diabetes

Target: diabetes

Data Preparation & EDA

# proportion of class target
prop.table(table(diab$diabetes))
#> 
#>       neg       pos 
#> 0.6510417 0.3489583

Insight: Insight masih balance

Cross Validation

Split data menjadi diab_train dan diab_test dengan proporsi 80:20

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

index <- sample(nrow(diab), nrow(diab) * 0.8)
diab_train <- diab[index,]
diab_test <- diab[-index,]

Cek proporsi kelas di data train:

prop.table(table(diab_train$diabetes))
#> 
#>       neg       pos 
#> 0.6449511 0.3550489

disclaimer: pada kasus ini sebenarnya data masih cukup balance, namun mari kita coba pelajari cara balancing data.

Data Pre-processing: Balancing Target Classes*

  • upsample: menduplikat kelas minoritas hingga seimbang dengan mayoritas
    • 90 vs 10 -> 90 vs 90 (50:50)
    • bila jumlah data sedikit (sebaiknya min 300 utk tiap kelas)
    • kekurangan: hanya menduplikat data yg ada, tidak tambah data baru
  • downsample: mengurangi kelas mayoritas hingga seimbang dengan minoritas
    • 90 vs 10 -> 10 vs 10 (50:50)
    • bila jumlah data banyak
    • kekurangan: kehilangan sejumlah informasi, namun kalau data banyak tidak begitu berpengaruh

Berikut code nya:

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

# upsample
diab_train_up <- upSample(x = diab_train %>% select(-diabetes), # prediktor
                          y = diab_train$diabetes, # target
                          yname = "diabetes") # nama kolom target
# cek class balance
prop.table(table(diab_train_up$diabetes))
#> 
#> neg pos 
#> 0.5 0.5

Modelling

Buat model untuk memprediksi diabetes menggunakan seluruh prediktor:

# library(partykit)
model_diabetes <- ctree(formula = diabetes ~ ., 
                        data = diab_train_up)
# visualisasi decision tree

plot(model_diabetes, type = "simple")

# print rule
model_diabetes
#> 
#> Model formula:
#> diabetes ~ pregnant + glucose + pressure + triceps + insulin + 
#>     mass + pedigree + age
#> 
#> Fitted party:
#> [1] root
#> |   [2] glucose <= 127
#> |   |   [3] pregnant <= 6
#> |   |   |   [4] mass <= 28.8
#> |   |   |   |   [5] age <= 48: neg (n = 117, err = 0.9%)
#> |   |   |   |   [6] age > 48: neg (n = 9, err = 44.4%)
#> |   |   |   [7] mass > 28.8
#> |   |   |   |   [8] pedigree <= 0.498
#> |   |   |   |   |   [9] age <= 30
#> |   |   |   |   |   |   [10] triceps <= 12: neg (n = 16, err = 37.5%)
#> |   |   |   |   |   |   [11] triceps > 12: neg (n = 77, err = 6.5%)
#> |   |   |   |   |   [12] age > 30: neg (n = 45, err = 44.4%)
#> |   |   |   |   [13] pedigree > 0.498: neg (n = 83, err = 45.8%)
#> |   |   [14] pregnant > 6
#> |   |   |   [15] pedigree <= 0.84
#> |   |   |   |   [16] glucose <= 99: neg (n = 20, err = 10.0%)
#> |   |   |   |   [17] glucose > 99
#> |   |   |   |   |   [18] age <= 41: pos (n = 29, err = 24.1%)
#> |   |   |   |   |   [19] age > 41: neg (n = 23, err = 30.4%)
#> |   |   |   [20] pedigree > 0.84: pos (n = 13, err = 0.0%)
#> |   [21] glucose > 127
#> |   |   [22] glucose <= 157
#> |   |   |   [23] mass <= 26.2: neg (n = 21, err = 14.3%)
#> |   |   |   [24] mass > 26.2: pos (n = 180, err = 28.3%)
#> |   |   [25] glucose > 157: pos (n = 159, err = 8.2%)
#> 
#> Number of inner nodes:    12
#> Number of terminal nodes: 13

note: tiap prediktor bisa digunakan pada cabang / node lebih dari 1 kali (digunakan pada beberapa cabang)

Interpretation:

  • Bila pasien memiliki kadar glukosa darah > 127 dan kadar glukosa darah <= 157, mass > 26.2, maka diprediksi positif.

Prediction

Lakukan prediksi ke data test dan hasilkan label prediksinya!

  • Fungsi: predict()
  • Type:
    • "response" = label kelas (default threshold 0.5)
    • "prob" = peluang ke kelas negatif dan positif
# prediksi ke data train
train_pred <- predict(object = model_diabetes, 
                      newdata = diab_train_up, 
                      type = "response")

# prediksi ke data test
test_pred <- predict(object = model_diabetes, 
                     newdata = diab_test, 
                     type = "response")

Model evaluation

# Confusion Matrix: data train
confusionMatrix(data = train_pred, 
                reference = diab_train_up$diabetes, 
                positive = "pos")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction neg pos
#>        neg 325  86
#>        pos  71 310
#>                                              
#>                Accuracy : 0.8018             
#>                  95% CI : (0.7723, 0.829)    
#>     No Information Rate : 0.5                
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.6035             
#>                                              
#>  Mcnemar's Test P-Value : 0.2639             
#>                                              
#>             Sensitivity : 0.7828             
#>             Specificity : 0.8207             
#>          Pos Pred Value : 0.8136             
#>          Neg Pred Value : 0.7908             
#>              Prevalence : 0.5000             
#>          Detection Rate : 0.3914             
#>    Detection Prevalence : 0.4811             
#>       Balanced Accuracy : 0.8018             
#>                                              
#>        'Positive' Class : pos                
#> 
# Confusion Matrix: data test
confusionMatrix(data = test_pred, 
                reference = diab_test$diabetes, 
                positive = "pos")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction neg pos
#>        neg  75  22
#>        pos  29  28
#>                                           
#>                Accuracy : 0.6688          
#>                  95% CI : (0.5885, 0.7425)
#>     No Information Rate : 0.6753          
#>     P-Value [Acc > NIR] : 0.6054          
#>                                           
#>                   Kappa : 0.2713          
#>                                           
#>  Mcnemar's Test P-Value : 0.4008          
#>                                           
#>             Sensitivity : 0.5600          
#>             Specificity : 0.7212          
#>          Pos Pred Value : 0.4912          
#>          Neg Pred Value : 0.7732          
#>              Prevalence : 0.3247          
#>          Detection Rate : 0.1818          
#>    Detection Prevalence : 0.3701          
#>       Balanced Accuracy : 0.6406          
#>                                           
#>        'Positive' Class : pos             
#>

Performa Metrics:

  • train: 0.7828
  • test: 0.5600

Apakah performa model konsisten di data train maupun data test? tidak konsisten, hanya bagus di train dan amat buruk di test.

Kondisi Model:

  • Overfitting: model baik di data train, namun amat buruk di data test -> tidak diinginkan
    • karena model terlalu kompleks -> decision tree -> tree prunning
  • Underfitting: model buruk di data train maupun di data test -> tidak diinginkan
    • karena model terlalu sederhana -> linear/log regression -> ganti model
  • Just Right: model baik di data train, dan menurun sedikit (selisih < 0.1) -> yg kita inginkan

Decision Tree rentan overfitting karena bisa membuat rule terlalu kompleks/terlalu spesifik menyesuaikan data train nya. Model hanya menghafal bukan belajar pola. Sehingga ketika digunakan untuk data baru, rule nya tidak cocok dan prediksi menjadi buruk.

Untuk mengatasinya bisa gunakan tree prunning.

Pruning and Tree Size

Decision Tree perlu tahu kapan berhenti membuat cabang sehingga pohon lebih sederhana. Pemotongan cabang disebut sebagai Pruning. Secara umum, terbagi atas 2 cara:

  • Pre-Pruning: set parameter di awal -> buat model
  • Post-Pruning: buat model (parameter default) -> atur ulang parameter bila diperlukan

Parameter pruning pada function ctree():

  • mincriterion: Nilai 1-\(\alpha\) -> tingkat signifikansi (signifikansi prediktor)
    0.95 -> p-value harus < 0.05 untuk node dapat membuat cabang.
    0.90 -> p-value harus < 0.10 untuk node dapat membuat cabang.
    0.97 -> p-value harus < 0.03 untuk node dapat membuat cabang.
    default: 0.95
  • minsplit: minimal observasi di tiap cabang (internal node) setelah splitting.
    Bila tidak terpenuhi, tidak dilakukan percabangan.
    default: 20
  • minbucket: minimal observasi di terminal node.
    Bila tidak terpenuhi, tidak dilakukan percabangan.
    default: 7

Untuk prunning tree:

  • mincriterion: nilainya diperbesar
  • minsplit: nilainya diperbesar
  • minbucket: nilainya diperbesar

Coba lakukan prunning untuk mendapatkan performa model yang lebih baik!

# model tuning
model_diabetes_tuned <- ctree(formula = diabetes ~ .,
                             data = diab_train_up,
                             control = ctree_control(mincriterion = 0.97,
                                                     minsplit = 20,
                                                     minbucket = 10))
# prediksi ke data train
train_pred_tuned <- predict(object = model_diabetes_tuned, 
                      newdata = diab_train_up, 
                      type = "response")

# prediksi ke data test
test_pred_tuned <- predict(object = model_diabetes_tuned, 
                     newdata = diab_test, 
                     type = "response")
# Confusion Matrix: data train
confusionMatrix(data = train_pred_tuned, 
                reference = diab_train_up$diabetes, 
                positive = "pos")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction neg pos
#>        neg 325  86
#>        pos  71 310
#>                                              
#>                Accuracy : 0.8018             
#>                  95% CI : (0.7723, 0.829)    
#>     No Information Rate : 0.5                
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.6035             
#>                                              
#>  Mcnemar's Test P-Value : 0.2639             
#>                                              
#>             Sensitivity : 0.7828             
#>             Specificity : 0.8207             
#>          Pos Pred Value : 0.8136             
#>          Neg Pred Value : 0.7908             
#>              Prevalence : 0.5000             
#>          Detection Rate : 0.3914             
#>    Detection Prevalence : 0.4811             
#>       Balanced Accuracy : 0.8018             
#>                                              
#>        'Positive' Class : pos                
#> 
# Confusion Matrix: data test
confusionMatrix(data = test_pred_tuned, 
                reference = diab_test$diabetes, 
                positive = "pos")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction neg pos
#>        neg  75  22
#>        pos  29  28
#>                                           
#>                Accuracy : 0.6688          
#>                  95% CI : (0.5885, 0.7425)
#>     No Information Rate : 0.6753          
#>     P-Value [Acc > NIR] : 0.6054          
#>                                           
#>                   Kappa : 0.2713          
#>                                           
#>  Mcnemar's Test P-Value : 0.4008          
#>                                           
#>             Sensitivity : 0.5600          
#>             Specificity : 0.7212          
#>          Pos Pred Value : 0.4912          
#>          Neg Pred Value : 0.7732          
#>              Prevalence : 0.3247          
#>          Detection Rate : 0.1818          
#>    Detection Prevalence : 0.3701          
#>       Balanced Accuracy : 0.6406          
#>                                           
#>        'Positive' Class : pos             
#>

note: bila dari hasil tuning tree pruning tidak memperbaiki model: masih overfit, maka sebaiknya berpindah ke model lain.

Ensemble Method

Wisdom of the Crowd: the collective knowledge of a group of people as expressed through their aggregated actions or opinions, regarded as an alternative to specialist or expert knowledge.

Ensemble method adalah metode yang menggabungkan prediksi dari beberapa model machine learning menjadi 1 prediksi tunggal. Tujuannya adalah untuk meningkatkan performa model. Contoh model ensemble method adalah Random Forest.

Random Forest

Random Forest adalah salah satu jenis Ensemble Method yang terdiri dari banyak Decision Tree. Masing-masing Decision Tree memiliki karakteristik masing-masing dan tidak saling berhubungan. Random Forest memanfaatkan konsep Bagging (Bootstrap and Aggregation) dalam pembuatannya. Berikut adalah prosesnya:

  • Proses 1: Bootstrap sampling: Membuat data dengan random sampling (with replacement) dari data keseluruhan dan mengizinkan adanya baris yang terduplikat.
  • Proses 2: Dibuat 1 decision tree untuk masing-masing data hasil bootstrap. Digunakan parameter mtry untuk memilih banyaknya calon prediktor secara random (Automatic Feature Selection)
  • Proses 3: Melakukan prediksi terhadap observasi yang baru untuk setiap Decision Tree.
  • Proses 4: Aggregation: Menghasilkan satu prediksi tunggal untuk memprediksi.
    • Kasus klasifikasi: majority voting
    • Kasus regresi: rata-rata nilai target

Kelebihan Random Forest:

  • Automatic feature selection: Prediktor dipilih secara random pada pembuatan Decision Tree.
  • Terdapat out-of-bag error sebagai pengganti evaluasi model.

Study Case: Fitbit

Business Question: Kita adalah seorang analis dari perusahaan teknologi yang mengeluarkan product wearable fitness gadgets. Gadget tersebut dapat memprediksi secara otomatis untuk memberikan warning apabila suatu gerakan belum dilakukan secara optimal.

Buatlah sebuah model random forest yang dapat mengklasifikasi kelima label gerakan (classe) sebagai berikut:

  • Class A: Exactly according to specification
  • Class B: Throwing elbows to the front
  • Class C: Lifting the dumbbell only halfway
  • Class D: Lowering the dumbbell only halfway
  • Class E: Throwing the hips to the front

Read Data

fb <- read.csv("data_input/fitbit.csv", stringsAsFactors = T)
dim(fb)
#> [1] 19622   158
head(fb)

Data Preprocessing

  • Near Zero Variance

Kekurangan dari Random Forest adalah membutuhkan waktu komputasi yang cukup lama. Hal ini dapat diatasi dengan membuang predictor yang variansinya mendekati nol (dianggap kurang informatif). Kita dapat mengeceknya dengan function nearZeroVar() dari package caret:

# Please type your code down below
library(caret)

n0_var <- nearZeroVar(fb)

Hasil dari penggunaan fungsi nearZeroVar() adalah index kolom dari dataframe dan dari index kolom tersebut, terindikasi memiliki variansi yang sangat rendah (mendekati 0). Maka dari itu kita bisa menghilangkan kolom-kolom tersebut.

# Please type your code down below
fb <- fb[, -n0_var]
length(n0_var)
#> [1] 101

Ternyata ada 101 kolom yang dianggap sebagai nearZeroVar, sehingga data kita yang semulanya 158 kolom hanya tersisa 57 kolom.

Cross Validation

Splitting training dan testing dataset dengan proporsi 80:20.

RNGkind(sample.kind = "Rounding")
set.seed(100)
library(rsample)
index_fb <- sample(nrow(fb), nrow(fb)*0.8)
train_fb <- fb[index_fb,]
test_fb <- fb[-index_fb,]
# cek proporsi kelas target data train
prop.table(table(train_fb$classe))
#> 
#>         1         2         3         4         5 
#> 0.2852137 0.1918201 0.1746831 0.1628337 0.1854494

Model Fitting

Membuat model Random Forest menggunakan fb_train dengan 5-fold cross validation, kemudian proses tersebut diulang sebanyak 3 kali.

# JANGAN DI RUN!

# set.seed(417)
# 
# ctrl <- trainControl(method = "repeatedcv",
#                      number = 5, # k-fold
#                      repeats = 3) # repetisi
# 
# fb_forest_2 <- train(classe ~ .,
#                    data = fb_train,
#                    method = "rf", # random forest
#                    trControl = ctrl)
# 
# saveRDS(fb_forest, "fb_forest_2.RDS") # simpan model

Ilustrasi untuk trainControl(method = "repeatedcv", number = 5, repeats = 3) dapat dilihat pada Google Sheets

Ilustrasi untuk train() di atas dapat dilihat pada Google Sheets

Salah satu kelemahan Random Forest adalah pembuatan model yang membutuhkan waktu yang cukup lama. Practice yang baik saat selesai melakukan training adalah menyimpan model tersebut ke dalam bentuk file RDS dengan function saveRDS() agar model dapat langsung digunakan tanpa harus training dari awal.

# read model
fb_forest <- readRDS("fb_forest.RDS")
fb_forest
#> Random Forest 
#> 
#> 15697 samples
#>    56 predictor
#>     5 classes: '1', '2', '3', '4', '5' 
#> 
#> No pre-processing
#> Resampling: Cross-Validated (5 fold, repeated 3 times) 
#> Summary of sample sizes: 12557, 12557, 12559, 12557, 12558, 12557, ... 
#> Resampling results across tuning parameters:
#> 
#>   mtry  Accuracy   Kappa    
#>    2    0.9957743  0.9946543
#>   31    0.9990020  0.9987376
#>   60    0.9980676  0.9975556
#> 
#> Accuracy was used to select the optimal model using the largest value.
#> The final value used for the model was mtry = 31.

Pada summary model di atas, dilakukan beberapa kali percobaan mtry (jumlah predictor random yang digunakan saat splitting node). Secara default akan dicoba sebanyak 3 nilai mtry, yaitu:

  1. Minimal mtry = 2
  2. Maksimal mtry sebanyak jumlah predictor (numerik + dummy variable). Pada kasus ini, terdapat 55 predictor numerik dan 5 dummy variable dari predicyot kategorikal
  3. Rata-rata mtry minimal dan maksimal

Model yang dipilih adalah mtry = 31 dengan nilai Accuracy tertinggi ketika diujikan ke data hasil bootstrap sampling (atau data in-sample, bisa dianggap sebagai data train seperti pada pembuatan model).

Out-of-Bag (OOB) Error

Pada tahap Bootstrap sampling, terdapat data yang tidak digunakan dalam pembuatan model, ini yang disebut sebagai data Out-of-Bag (OOB). Model Random Forest akan menggunakan data OOB sebagai data test untuk melakukan evaluasi dengan cara menghitung error. Error inilah yang disebut sebagai OOB Error. Dalam kasus klasifikasi, OOB error merupakan persentase data OOB yang misklasifikasi.

library(randomForest)
fb_forest$finalModel
#> 
#> Call:
#>  randomForest(x = x, y = y, mtry = param$mtry) 
#>                Type of random forest: classification
#>                      Number of trees: 500
#> No. of variables tried at each split: 31
#> 
#>         OOB estimate of  error rate: 0.08%
#> Confusion matrix:
#>      1    2    3    4    5  class.error
#> 1 4470    0    0    0    0 0.0000000000
#> 2    2 3032    1    0    0 0.0009884679
#> 3    0    4 2731    0    0 0.0014625229
#> 4    0    0    3 2585    1 0.0015449981
#> 5    0    0    0    1 2867 0.0003486750
(1 - 0.0008)*100
#> [1] 99.92

Nilai OOB Error pada model fb_forest sebesar 0.08%. Dengan kata lain, akurasi model pada data OOB adalah 99.92%!

Note: In practice, ketika membuat model Random Forest, kita tidak diwajibkan untuk splitting training-testing dataset di awal. Hal ini karena OOB sudah dapat mengestimasi performa model di unseen data.

fb_test_pred <- predict(fb_forest, newdata = test_fb, type = "raw") #menghasilkan kelas
head(fb_test_pred)
#> [1] 1 1 1 1 1 1
#> Levels: 1 2 3 4 5
confusionMatrix(data = fb_test_pred, reference = as.factor(test_fb$classe))
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction    1    2    3    4    5
#>          1 1103    0    0    0    0
#>          2    0  786    0    0    0
#>          3    0    0  680    0    0
#>          4    0    0    0  660    0
#>          5    0    0    0    0  696
#> 
#> Overall Statistics
#>                                                
#>                Accuracy : 1                    
#>                  95% CI : (0.9991, 1)          
#>     No Information Rate : 0.281                
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 1                    
#>                                                
#>  Mcnemar's Test P-Value : NA                   
#> 
#> Statistics by Class:
#> 
#>                      Class: 1 Class: 2 Class: 3 Class: 4 Class: 5
#> Sensitivity             1.000   1.0000   1.0000   1.0000   1.0000
#> Specificity             1.000   1.0000   1.0000   1.0000   1.0000
#> Pos Pred Value          1.000   1.0000   1.0000   1.0000   1.0000
#> Neg Pred Value          1.000   1.0000   1.0000   1.0000   1.0000
#> Prevalence              0.281   0.2003   0.1732   0.1682   0.1773
#> Detection Rate          0.281   0.2003   0.1732   0.1682   0.1773
#> Detection Prevalence    0.281   0.2003   0.1732   0.1682   0.1773
#> Balanced Accuracy       1.000   1.0000   1.0000   1.0000   1.0000

Interpretation

Pada machine learning model, terdapat trade-off antara sisi interpretability dan performance. Performance Random Forest dapat diunggulkan dibandingkan model yang lain, namun tidak terlalu dapat diinterpretasi karena banyak faktor random yang terlibat. Namun setidaknya kita dapat melihat predictor apa saja yang paling penting dalam pembuatan Random Forest melalui variable importancenya:

varImp(fb_forest)
#> rf variable importance
#> 
#>   only 20 most important variables shown (out of 60)
#> 
#>                      Overall
#> raw_timestamp_part_1 100.000
#> num_window            58.600
#> roll_belt             45.994
#> pitch_forearm         27.061
#> magnet_dumbbell_z     21.709
#> magnet_dumbbell_y     18.956
#> yaw_belt              16.727
#> pitch_belt            15.780
#> roll_forearm          14.340
#> accel_dumbbell_y       7.650
#> roll_dumbbell          6.667
#> accel_forearm_x        6.610
#> accel_belt_z           6.473
#> magnet_dumbbell_x      6.070
#> total_accel_dumbbell   5.936
#> accel_dumbbell_z       5.246
#> magnet_belt_y          5.211
#> magnet_belt_z          5.004
#> yaw_dumbbell           3.181
#> magnet_forearm_z       3.163

Nilai importance berasal dari perhitungan Gini Importance yang konsepnya sama dengan Information Gain, hanya berbeda rumus saja.

SUMMARY

  1. K-fold cross validation adalah metode cross validation dimana data akan dibagi menjadi \(k\) bagian sama banyak. Setiap bagian akan digunakan menjadi data test secara bergantian.
  2. Random Forest merupakan salah satu model ensemble method, yaitu menggunakan banyak Decision Tree untuk menghasilkan 1 prediksi tunggal.
  3. Proses Bagging digunakan dalam pembuatan Random Forest:
  1. Bootstraping: random sampling (baris) with replacement (mengizinkan adanya duplikasi)
  2. Pembuatan Decision Tree untuk masing-masing data Bootstrap. Parameter mtry: banyaknya predictor yang dicoba untuk splitting
  3. Aggregation: menghasilkan 1 prediksi tunggal. Untuk kasus klasifikasi menggunakan majority voting
  1. Kelebihan Random Forest:
  • Performa model yang sangat baik (baik di data train maupun test)
  • Feature selection secara otomatis (parameter mtry)
  • Terdapat Out-of-Bag sample sebagai pengganti testing data
  1. Kekurangan Random Forest:
  • Kurang dapat diinterpretasi (black-box model)
  • Training cost yang sangat besar (dari segi hardware maupun waktu) # SUMMARY
  1. K-fold cross validation adalah metode cross validation dimana data akan dibagi menjadi \(k\) bagian sama banyak. Setiap bagian akan digunakan menjadi data test secara bergantian.
  2. Random Forest merupakan salah satu model ensemble method, yaitu menggunakan banyak Decision Tree untuk menghasilkan 1 prediksi tunggal.
  3. Proses Bagging digunakan dalam pembuatan Random Forest:
  1. Bootstraping: random sampling (baris) with replacement (mengizinkan adanya duplikasi)
  2. Pembuatan Decision Tree untuk masing-masing data Bootstrap. Parameter mtry: banyaknya predictor yang dicoba untuk splitting
  3. Aggregation: menghasilkan 1 prediksi tunggal. Untuk kasus klasifikasi menggunakan majority voting
  1. Kelebihan Random Forest:
  • Performa model yang sangat baik (baik di data train maupun test)
  • Feature selection secara otomatis (parameter mtry)
  • Terdapat Out-of-Bag sample sebagai pengganti testing data
  1. Kekurangan Random Forest:
  • Kurang dapat diinterpretasi (black-box model)
  • Training cost yang sangat besar (dari segi hardware maupun waktu)