# Cara mengisi nilai missing
library(zoo)

z <- zoo(c(NA, 2, NA, 1, 4, 5, 2, NA))

na.fill(object = z, fill = 0)
#> 1 2 3 4 5 6 7 8 
#> 0 2 0 1 4 5 2 0

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 peluang 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.

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(A \cap B) P(A)\ +\ P(A \cap B | \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.

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 memanfaatkan kejadian dependent events, namun menerapkan asumsi Naive pada hubungan antar prediktornya:

  1. Hubungan prediktor dengan target variabel saling dependen
  2. Hubungan antar prediktor saling independen

Saat prediktor berupa kata “Gender”, “Age”, “Salary”, kemunculan masing-masing kata dianggap kejadian independen. Sehingga dapat dituliskan seperti di bawah ini:

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)
p_female_purchase + p_female_not_purchase
#> [1] 1.032625
  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 type your code 

#install.packages("e1071")
library(e1071)
model_naive <- naiveBayes(formula = Purchased ~ .,
                          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:
#>      Gender
#> Y        Female      Male
#>   No  0.4941634 0.5058366
#>   Yes 0.5384615 0.4615385
#> 
#>      Age
#> Y           < 30       > 50      30-50
#>   No  0.37354086 0.01556420 0.61089494
#>   Yes 0.02797203 0.31468531 0.65734266
#> 
#>      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 type your code down below
predict_result <- 
predict(object = model_naive,
        newdata = diva,
        type = "raw")

predict_result[ ,1]
#>       No 
#> 0.756378
ifelse(test = predict_result[ ,1] > 0.8, yes = "No", no = "Yes")
#>    No 
#> "Yes"

Contoh Kasus, Kapan kita harus mengganti model kita?

Model Naive dengan 400 data yang sudah kita miliki: -Acc: 80%

Ketika kita memliki 400 data baru, dan kita coba cek hasil confusion matrixnya dengan model yang ada - Acc: 60%

Contoh prediksi dengan menggunakan type = class

# Please type your code down below
predict(object = model_naive,
        newdata = diva,
        type = "class")
#> [1] No
#> Levels: No Yes

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
Karakteristik Naive Bayes:

Asumsi: * Asumsi Naive: ~ antar prediktor independent ~ antar prediktor memiliki bobot yang sama untuk melakukan prediksi * Asumsi Bayes: antara prediktor & target saling dependent

Pros & Cons: * Kelebihan: + waktu training cepat (karena asumsi “naive” nya) + sering dijadikan base classifier (acuan) untuk dibandingkan dengan model yang lebih kompleks + baik untuk kasus text classification/text analysis yang bisa memiliki prediktor kata yang amat banyak. * Kekurangan: - skewness due to data scarcity: jika ada salah satu prediktor yang nilainya 0 di salah satu kelas target, maka model akan langsung memprediksi peluang = 0 (mutlak) sehingga model menjadi bias.

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)?

Target: Spam/Ham

  • Kelas positif: Spam karena SMS spam itu lebih penting untuk dideteksi dibandingkan dengan SMS ham
  • Kelas negatif: Ham

Read Data

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

head(sms_raw)

Note: Unicode -> untuk mengubah sebuah teks menjadi bentuk yang lebih universal (Credit: Ka Reinhard)

Data Wrangling

  • Adakah kolom yang tidak diperlukan? X, X1 & X2
  • Adakah kolom yang tipe datanya perlu disesuaikan? v1 -> Tipe Data Factor
# Please type your code down below
sms_clean <- 
sms_raw %>% 
  select(-c(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 %in% "spam") %>% 
  head(5)

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

  • Free
  • Prize
  • Winner
  • Reward
  • Send
  • Call
  • Week
  • Claim
  • Update

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()

lapply(X = sms.corpus[1:5]$content, FUN = 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"
#> 
#> [[4]]
#> [1] "U dun say so early hor... U c already then say..."
#> 
#> [[5]]
#> [1] "Nah I don't think he goes to usf, he lives around here though"
# 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"

— End of Day 1 —

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)

# cek 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."

Catatan: Ketika kita menghilangkan angka dan masih tersisa tempat untuk angka tersebut (atau bisa disebut spasi berlebih)

# Menghapus stopwords
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 ."

Catatan: removeWords akan menghilangkan kata sambung dan kata ganti orang

Untuk menghilangkan kata bagian terkahir: https://stackoverflow.com/questions/65270957/remove-the-last-few-capital-letters-on-r

  • 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, # Menjelaskan/mengdefinisikan data apa yg kita gunakan 
       pattern = pattern,  # Kita akan mengdefinisikan simbol atau patter yg terjadi pada data
       replacement = " ") # penggantinya
})
# 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  "
sms.corpus <- tm_map(sms.corpus, transformer, "!")

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

Catatan: Kita perlu menambahkan \ ketika kita ingin mengganti simbol yang memiliki maksud atau tujuan khsus pada bahasa R.

  • 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 -> Untuk mengubah huruf kapital menjadi huruf kecil
  • Remove numbers -> Menghilangkan angka
  • Remove stopwords -> Menghilangkan kata sambung
  • Remove punctuation -> Menghilangkan tanda baca
  • Stemming -> Mengembalikan sebuah kata ke kata dasar
  • Remove white space -> Untuk menghilangkan spasi berlebih

Tujuan adalah menyeragamkan setiap kata yang muncul -> Untuk mempermudah mesin kita dalam belajar

Saya sedang menuju ke Algoritma, bersama Mas Kevin

saya sedang menuju algoritma bersama mas kevin saya sedang menuju algoritma bersama mas kevin

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: 7629)>>
#> Non-/sparse entries: 43470/42465318
#> 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] 327

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]
inspect(sms_test)
#> <<DocumentTermMatrix (documents: 1393, terms: 327)>>
#> Non-/sparse entries: 5479/450032
#> Sparsity           : 99%
#> Maximal term length: 9
#> Weighting          : term frequency (tf)
#> Sample             :
#>       Terms
#> Docs   &lt;#&gt; call can day get got just know now will
#>   1122         0    1   0   0   0   0    0    0   1    0
#>   2012         1    0   1   0   1   0    0    1   0    0
#>   2090         0    1   0   0   2   1    0    0   0    0
#>   3016         2    0   0   4   0   0    0    0   0    0
#>   3482         0    1   0   0   0   0    0    0   1    0
#>   4115         0    0   1   0   0   0    0    0   0    0
#>   4311         0    0   2   0   1   0    1    0   0    0
#>   4727         0    1   0   0   1   0    0    0   0    0
#>   4801         0    2   0   0   1   1    0    1   1    0
#>   5105         0    0   0   0   0   0    0    0   0    0

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   camera can cant car care cash
#>   4239 "0"    "0" "0"  "0" "0"  "0" 
#>   3718 "0"    "0" "0"  "0" "0"  "0" 
#>   1137 "0"    "1" "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) # opsional

Prediction

Setelah membuat model, mari kita coba lakukan prediksi.

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

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   24
#>       spam   14  151
#>                                              
#>                Accuracy : 0.9727             
#>                  95% CI : (0.9627, 0.9806)   
#>     No Information Rate : 0.8744             
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.8727             
#>                                              
#>  Mcnemar's Test P-Value : 0.1443             
#>                                              
#>             Sensitivity : 0.8629             
#>             Specificity : 0.9885             
#>          Pos Pred Value : 0.9152             
#>          Neg Pred Value : 0.9805             
#>              Prevalence : 0.1256             
#>          Detection Rate : 0.1084             
#>    Detection Prevalence : 0.1184             
#>       Balanced Accuracy : 0.9257             
#>                                              
#>        'Positive' Class : spam               
#>

Pemahaman Bisnis:

Kita dengan model Naive ini, bisa filter sms yang SPAM.

Precision & Recall???????

Ketika kita ingin memilih salah satu nilai metriks, perhatikan FP & FN - False Positive: Diprediksi SPAM tapi Aktualnya HAM - False Negative: Diprediksti HAM tapi Aktualnya SPAM

Rumus Precsion: TP / (TP + FP) - Jika kita ingin nilai Presisi kita tinggi, kita harus mengurangi FP - Jika nilai FP kita tekan, maka kondisi email HAM dianggap SPAM semakin sedikit

Rumus Recall: TP / (TP + FN) - Jika kita ingin nilai Recall tinggi, kita harus mengurangi FN - Jika nilai FN kita tekan, makan kondisi email SPAM dianggap HAM semakin sedikit

Tergantung Preferens: - Kita ingin sedikit mungkin menahan SPAM: RECALL - Kita ingin mengirimkan email promosi: PRESISI

— End of Day 2 —

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

Catatan: Jika kita mendapatkan hasil ROC seperti garis putus-putus berwarna merah, terdapat 2 pendekatan yang dapat kita lakukan:

  • Menambahkan data
  • Menganti model

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")

spam_prob %>% 
  head(3)
#>                     ham         spam
#> [1,] 0.9022491297527760 0.0977508702
#> [2,] 0.0000000003523873 0.9999999996
#> [3,] 0.9997918872136035 0.0002081128
  • 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(test = label_test %in% "spam", yes = 1, no = 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", # true positive
                 x.measure = "fpr")) # false positive

  • 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.9743279

Catatan:

Sebuah model dikatakan kurang baik, ketika nilai AUC nya kurang dari 0.5.

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

  • Cek structur data
# Please type your code
glimpse(diab)
#> Rows: 768
#> Columns: 9
#> $ pregnant <int> 6, 1, 8, 1, 0, 5, 3, 10, 2, 8, 4, 10, 10, 1, 5, 7, 0, 7, 1, 1…
#> $ glucose  <int> 148, 85, 183, 89, 137, 116, 78, 115, 197, 125, 110, 168, 139,…
#> $ pressure <int> 72, 66, 64, 66, 40, 74, 50, 0, 70, 96, 92, 74, 80, 60, 72, 0,…
#> $ triceps  <int> 35, 29, 0, 23, 35, 0, 32, 0, 45, 0, 0, 0, 0, 23, 19, 0, 47, 0…
#> $ insulin  <int> 0, 0, 0, 94, 168, 0, 88, 0, 543, 0, 0, 0, 0, 846, 175, 0, 230…
#> $ mass     <dbl> 33.6, 26.6, 23.3, 28.1, 43.1, 25.6, 31.0, 35.3, 30.5, 0.0, 37…
#> $ pedigree <dbl> 0.627, 0.351, 0.672, 0.167, 2.288, 0.201, 0.248, 0.134, 0.158…
#> $ age      <int> 50, 31, 32, 21, 33, 30, 26, 29, 53, 54, 30, 34, 57, 59, 51, 3…
#> $ diabetes <fct> pos, neg, pos, neg, pos, neg, pos, neg, pos, pos, neg, pos, n…
  • Cek Class Imbalance
# Please type your code
prop.table(table(diab$diabetes))
#> 
#>       neg       pos 
#> 0.6510417 0.3489583

Sebuah taret dikatakan tidak seimbang ketika perbandingannya 80:20

Cross Validation

Index Cross Validation

Split data menjadi diab_train dan diab_test dengan proporsi 80:20

# Please run the code down below
RNGkind(sample.kind = "Rounding")
set.seed(100)

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

Stratified Cross Validation

Selain menggunkan index untuk membagi data train dan test. Kita dapat memanfaatkan salah satu library(rsample) untuk melakukan cross validation. Berikut intuisi dari beberapa fungsi yang akan kita gunakan,

  • Fungsi pertama yang akan kita gunakan adalah initial_split(), fungsi ini diperuntuhkan untuk menentukan proporsi pembagian.
    • data =: dataframe yang akan digunakan
    • prop =: proporsi pembagian
    • strata =: kolom target variable

Setelah menentukan proporsi pembagiannya, kita bisa membagi datanya untuk data train dan test dengan menggunakan, 2 fungsi berikut ini:

  • training(): untuk data train
  • test(): untuk data test
library(rsample)
RNGkind(sample.kind = "Rounding")
set.seed(123)

splitter <- initial_split(data = diab, 
                          prop = 0.8, 
                          strata = "diabetes")

data_train <- training(splitter)
data_test <- testing(splitter)

Cek proporsi kelas di data train:

# Please run the code down below
prop.table(table(diab_train$diabetes))
#> 
#>       neg       pos 
#> 0.6449511 0.3550489
# Please run the code down below
prop.table(table(data_train$diabetes))
#> 
#>       neg       pos 
#> 0.6514658 0.3485342

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

Syntax: upSample(x = ..., y = ..., yname = ...) x = Prediktor y = Target variable yname = nama kolom target

  • downsample: mengurangi kelas mayoritas hingga seimbang dengan minoritas

    Syntax: downSample(x = ..., y = ..., yname = ...) x = Predikt y = Target variab yname = nama kolom target

Catatan: Kapan kita pakai UpSample & DownSample:

  • Kita bisa menggunakan UpSample ketika data kita tidak terlalu banyak

Contoh: kita hanya memiliki 1000 observasi

  • Kelas mayoritasnya 900 obs

  • Kelas minoritasnya 100 obs -> datanya akan ditambah 800

  • Sehingga total data kita menjadi 1800

  • Kita bisa menggunakan DownSample ketika data kita banyak

Contoh: kita memiliki 1juta observasi

  • Kelas mayoritasnya 850rb obs -> akan direduksi menjadi 150rb

  • Kelas minoritas 150rb obs

  • Metode SMOTE -> intuisu dari metode itu -+ sama dengan UpSample

Ref SMOTE: https://rpubs.com/VicNP/UBL-SmoteClassif

Berikut code nya:

# Please type your code down below
RNGkind(sample.kind = "Rounding")
set.seed(100)

# Metode Upsampling
diab_train_up <- upSample(x = diab_train %>% select(-diabetes),
                          y = diab_train$diabetes,
                          yname = "diabetes")

# Metode Downsampling
diab_train_down <- downSample(x = diab_train %>% select(-diabetes),
                          y = diab_train$diabetes,
                          yname = "diabetes")
table(diab_train_up$diabetes)
#> 
#> neg pos 
#> 396 396
table(diab_train_down$diabetes)
#> 
#> neg pos 
#> 218 218

Modelling

Buat model untuk memprediksi diabetes menggunakan seluruh prediktor, dengan menggunakan fungsi ctree() dari library(partykit). Pada fungsi tersebut terdapat 2 parameter wajib, yaitu parameter formula & data.

# Please type your code down below
model_diabetes <- 
ctree(formula = diabetes ~ .,
      data = diab_train_up)

Hasil dari pembuatan model dapat kita visualisasikan dengan menggunakan fungsi plot()

# Please type your code down below
plot(model_diabetes, type = "simple")

Prediction

Lakukan prediksi ke data train dan test, dengan menampilkan 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

Pada evaluasi model kali ini, kita akan membandingkan peforma pada data train dan data test.

# Please type your code down below

# 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                
#> 
# Please type your code down below

# 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: 78%
  • test: 56%
  • Perbedaan: 22%

Apakah performa model konsisten di data train maupun data test? tidak

Kondisi Model:

  • Overfitting: model baik di data train, namun amat buruk di data test
  • Underfitting: model buruk di data train maupun di data test
  • 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)
    default: 0.95
  • minsplit: minimal observasi di tiap cabang (internal node) setelah splitting.
    default: 20
    Bila tidak terpenuhi, tidak dilakukan percabangan.
  • minbucket: minimal observasi di terminal node.
    default: 7
    Bila tidak terpenuhi, tidak dilakukan percabangan.

Untuk prunning tree:

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

Coba lakukan prunning untuk mendapatkan performa model yang lebih baik!

# Please type your code down below
model_diabetes_tuned <- ctree(formula = diabetes ~ .,
                             data = diab_train_up,
                             control = ctree_control(mincriterion = 0.97,
                                                     minsplit = 30,
                                                     minbucket = 15))

plot(model_diabetes_tuned, type = "simple")

Hasil dari model baru tersebut akan kita coba prediksi kembali ke data train dan data test kita, lalu kita lihat peformanya.

# Please type your code down below

# 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 = data_test, 
                     type = "response")

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

# 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 309  78
#>        pos  87 318
#>                                              
#>                Accuracy : 0.7917             
#>                  95% CI : (0.7617, 0.8195)   
#>     No Information Rate : 0.5                
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.5833             
#>                                              
#>  Mcnemar's Test P-Value : 0.5334             
#>                                              
#>             Sensitivity : 0.8030             
#>             Specificity : 0.7803             
#>          Pos Pred Value : 0.7852             
#>          Neg Pred Value : 0.7984             
#>              Prevalence : 0.5000             
#>          Detection Rate : 0.4015             
#>    Detection Prevalence : 0.5114             
#>       Balanced Accuracy : 0.7917             
#>                                              
#>        'Positive' Class : pos                
#> 
# Confusion Matrix: data test
confusionMatrix(data = test_pred_tuned, 
                reference = data_test$diabetes, 
                positive = "pos")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction neg pos
#>        neg  77  11
#>        pos  23  43
#>                                          
#>                Accuracy : 0.7792         
#>                  95% CI : (0.7054, 0.842)
#>     No Information Rate : 0.6494         
#>     P-Value [Acc > NIR] : 0.0003315      
#>                                          
#>                   Kappa : 0.5388         
#>                                          
#>  Mcnemar's Test P-Value : 0.0592297      
#>                                          
#>             Sensitivity : 0.7963         
#>             Specificity : 0.7700         
#>          Pos Pred Value : 0.6515         
#>          Neg Pred Value : 0.8750         
#>              Prevalence : 0.3506         
#>          Detection Rate : 0.2792         
#>    Detection Prevalence : 0.4286         
#>       Balanced Accuracy : 0.7831         
#>                                          
#>        'Positive' Class : pos            
#>

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)
table(fb$new_window)
#> 
#>    no   yes 
#> 19216   406

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 Run The Code Down Below

fb <- fb[, -n0_var]

length(n0_var)
#> [1] 101

Cross Validation

Splitting training dan testing dataset dengan proporsi 80:20.

# Please run the code down below
library(rsample)
RNGkind(sample.kind = "Rounding")
set.seed(100)

# Index Sampling
index_fb <- sample(nrow(fb), nrow(fb)*0.8)

# Splitting Data Train
train_fb <- fb[index_fb,]

# Splitting Data Test
test_fb <- fb[-index_fb,]

Model Fitting

  • K-Fold Cross Validation

Biasanya kita melakukan cross validation dengan membagi data menjadi data train dan test. K-Fold Cross Validation membagi data sebanyak k bagian sama banyak, sehingga tiap bagian sempat dijadikan data train dan data test.

Proporsi untuk setiap data train & testnya akan tergantung dari jumlah data dan berapa banyak fold (pembagian) yang dilakukan.

Sebagai contoh, kita memiliki 100 data dan akan dibagi menjadi 5 fold.

Total data test = 100 rows / 5 folds = 20 rows

Total data train = 100 rows - 20 rows = 80 rows

Manfaat:

  • memperbanyak data untuk training dan testing.
  • bagus untuk model yang menganut banyak unsur random (bergantung pada banyaknya percobaan membuat model/training model) -> random forest

Berikut adalah contoh preparasi set parameter untuk 5-fold cross validation, kemudian proses tersebut diulang sebanyak 3 kali.

Fungsi yang akan kita gunakan adalah trainControl() yang berasal dari library(caret). Pada fungsi tersebut terdapat 3 parameter yang dapat kita isi:

  • method: parameter ini dapat kita isi dengan “repeatedcv”
  • number: berapa jumlah cross validation yang ingin dibuat
  • repeats: berapa banyak repetisi
# mengatur k-fold untuk random forest
RNGkind(sample.kind = "Rounding")
set.seed(100)

ctrl <- trainControl(method = "repeatedcv", # metode k-fold
                     number = 5, # k-fold
                     repeats = 3) # repetisi

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

Additional note: semakin banyak k (number) dan repeats -> komputasi semakin lama

  • Model Random Forest

Membuat model Random Forest menggunakan fb_train dan menggunakan k-fold yang sudah kita persiapkan di atas.

Dalam pembuatan model random forest, kita akan menggunakan fungsi train() yang berasal dari library(caret). Pada fungsti tersebut terdapat 4 parameter yang perlu kita isi:

  • x = Parameter ini akan kita isi dengan target variable beserta prediktor yang akan digunakan
  • data = Parameter ini untuk menentukan objek data yang akan kita gunakan
  • method = Parameter ini untuk membertahu fungsi train() metode apa yang akan digunakan, dalam kasus ini akan kita isi dengan “rf”
  • trControl = Parameter ini akan kita isi dengan K-Fold yang sudah dipersiapkan
# JANGAN DI RUN!
# 
# 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 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("model/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.

Interpretasi 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 Out-of-Bag (OOB) data. OOB data dapat diibaratkan unseen data/data test. Model random forest akan otomatis menghitung OOB error untuk mengetahui performa random forest di OOB data atau diibaratkan sebagai unseen data.

Untuk mengetahui OOB error:

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
# accuracy: 1-error
100-0.08
#> [1] 99.92

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

Prediction

Pada kasus ini tidak perlu lagi dilakukan prediksi, namun bila performa random forest ingin dibandingkan dengan model lain, dapat dilakukan prediksi ke data test pula:

  • Fungsi: predict()
  • Type:
    • "raw" = label kelas (default threshold 0.5)
    • "prob" = peluang ke kelas negatif dan positif
# predict
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
# evaluation to fb_test
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 dengan menggunakan fungsi varImp():

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