Formula Bayes Theorem:
\[P(A|B) = \frac{P(B|A) P(A)}{P(B)}\] atau
\[P(A|B) = \frac{P(B|A) P(A)}{P(B|A) P(A)\ +\ P(B|\neg A) P(\neg A)}\] dengan \(P(B) \neq 0\).
Keterangan:
\[P(A|B) = \frac{P(A \cap B)}{P(B)}\]
\[P(B|A) = \frac{P(B \cap A)}{P(A)}\]
Maka dengan menggunakan sifat point (2) dan (3):
\[P(B \cap A) = P(B|A)\times P(A)\] \[P(A \cap B) = P(B|A) \times P(A)\]
dan \[P(A \cap B) = P(A|B) \times P(B)\]
\[P(A|B) \times P(B) = P(B|A) \times P(A)\]
\[P(A|B) = \frac{P(B|A) \times P(A)}{P(B)}\]
Berdasarkan Law of Total Probability, persamaan di atas dapat dituliskan menjadi
\[ P(A|B) = \frac{P(B|A) \ P(A)}{P(B|A) \ P(A) + P(B|\neg A) \ P(\neg A)} \]
library(dplyr)
customer <- read.csv("data_input/Customer_Behaviour.csv", stringsAsFactors = T)Cek tipe data purchase
glimpse(customer)#> 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:
Dari model naiveBayes() kita mendapatkan dua
komponen:
Sama dengan proporsi atau persentase dari tiap kelas di target variabel tanpa melihat prediktor.
Memprediksi peluang dari prediktornya jika kita tahu historikal nilai target variabelnya.
library(e1071)
naive_gender <- naiveBayes(Purchased ~ Gender, data = customer)
naive_gender#>
#> 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
A-priori probabilites:
Conditional probabilities :
\[ P(A|B) = \frac{P(B|A)\ P(A)}{P(B|A)\ P(A) + P(B|\neg A)\ P(\neg A)} \]
Berapa peluang seorang membeli barang bila diketahui ia seorang wanita?
\[P(purchased|female) = \frac{P(female|purchased)\ P(purchased)}{P(female|purschased)\ P(purchased) + P(famele|\neg purchased)\ P(\neg purchased)}\]
Perhitungan manual
# Prediksi manual
(0.5384615 * 0.3575) / ((0.5384615 * 0.3575) + (0.4941634 * 0.6425))#> [1] 0.377451
Menggunakan fungsi predict:
predict(naive_gender, newdata = data.frame(Gender = "Female"), type = "raw")#> No Yes
#> [1,] 0.622549 0.377451
Case: Misalkan Diva adalah seorang Female dengan range usia < 30 dan kategori salary yang High. Berapa peluang Diva akan membeli produk?
Untuk mempersingkat notasi, kita simbolkan kejadian \(A, B, C\) (prediktornya) sebagai:
Dengan Bayes’ Theorem:
\[ P(Purchase| A\ \cap\ B\ \cap\ C) = \frac{P(Purchase) \ P(A\ \cap\ B\ \cap\ C\ |\ Purchase)}{P(Purchase) \ P(A\ \cap\ B\ \cap\ C\ |\ Purchase)\ + \ P(\neg Purchase) \ P(A\ \cap\ B\ \cap\ C\ |\ \neg Purchase)} \]
\[ P(A\ \cap\ B\ \cap\ C\ |\ \neg Purchase) = P(A\ |\ \neg Purchase) \times P(B\ |\ \neg Purchase) \times P(C\ |\ \neg Purchase) \]
\[ P(A\ \cap\ B\ \cap\ C\ |\ Purchase) = P(A\ |\ Purchase) \times P(B\ |\ Purchase) \times P(C\ |\ 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)} \]
Mari kita cari satu per satu peluang yang dibutuhkan:
#gunakan prop.table
prop.table(table(customer$Purchased))#>
#> No Yes
#> 0.6425 0.3575
p_purchase <- 0.3575
p_not_purchase <- 0.6425# gunakan table
table(customer$Purchased, customer$Gender)#>
#> Female Male
#> No 127 130
#> Yes 77 66
p_female_purchase <- 77/(77+66)
p_female_purchase#> [1] 0.5384615
p_female_not_purchase <- 127/(127+130)
p_female_not_purchase#> [1] 0.4941634
# gunakan table
table(customer$Purchased, customer$Age)#>
#> < 30 > 50 30-50
#> No 96 4 157
#> Yes 4 45 94
p_age30_purchase <- 4/(4+45+94)p_age30_not_purchase <- 96/(96+4+157)# gunakan table
table(customer$Purchased, customer$Salary)#>
#> High Low Medium
#> No 19 56 182
#> Yes 75 39 29
p_high_purchase <- 75/(75+39+29)p_high_not_purchase <- 19/(19+56+182)\[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)}\]
(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
Kesimpulan : Diva tidak membeli produk (prob < 0.5 default treshold yang digunakan untuk klasifikasi)
Sebuah perusahaan telekomunikasi bernama Telco Inc.
sedang mengalami masalah karena tingkat churn (pelanggan berhenti
berlangganan) cukup tinggi. Perusahaan ingin mengurangi jumlah chrun
dengan memberikan promo atau benefit lainnya kepada pelanggan yang
berpotensi churn agar mereka tetap berlangganan.
Sebagai seorang data saintis, kita diminta membuat sebuah model machine learning yang dapat memprediksi apakah seseorang akan churn atau tidak dengan menggunakan beberapa informasi terkait dengan pelanggan.
telco <- read.csv("data_input/Telco_Churn.csv", stringsAsFactors = T)
head(telco)Untuk perhitungan Naive Bayes dengan prediktor numerik, kita akan
memilih salah satu prediktor numerik yaitu tenure.
model_tenure <- naiveBayes(formula = Churn ~ tenure,
data = telco,
laplace = 1)
model_tenure#>
#> Naive Bayes Classifier for Discrete Predictors
#>
#> Call:
#> naiveBayes.default(x = X, y = Y, laplace = laplace)
#>
#> A-priori probabilities:
#> Y
#> No Yes
#> 0.7346301 0.2653699
#>
#> Conditional probabilities:
#> tenure
#> Y [,1] [,2]
#> No 37.56997 24.11378
#> Yes 17.97913 19.53112
Untuk prediktor numerik, isi Conditional Probabilities adalah mean (kolom pertama) dan standar deviasi (kolom ke-dua). Nilai-nilai ini akan digunakan untuk memetakan data pada distribusi normal.
Sekarang mari kita siapkan data baru, misalkan kita ingin memprediksi apakah seseorang dengan tenure = 60 akan churn atau tidak.
churn_tenure <- data.frame(tenure = 60)
churn_tenureMenghitung peluang:
menggunakan probability density function `
pba <- dnorm(60, mean = 17.53945, sd = 19.19223) # P(B|A)
pbna <- dnorm(60, mean = 37.58088, sd = 24.14455) # P(B|¬A)
pba#> [1] 0.001798573
pbna#> [1] 0.01073669
Menghitung peluang:
pa <- 0.2636444 # P(A)
pna <- 0.7363556 # P(¬A)Menghitung peluang \(P(A|B) = P(Churn = yes | tenure = 60)\)
pab <- (pba*pa)/((pba*pa) + (pbna*pna))
pab#> [1] 0.05658376
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 Rany 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.
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 \\ \hline 257 & 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 Rany 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
Misalkan saya mencatat perilaku saya dalam menentukan apakah saya pergi makan ke restoran selama 12 hari terakhir. Berikut saya menggunakan Decision Tree untuk menemukan pola perilaku sehingga dapat memprediksi keputusan kedepannya:
dine <- read.csv("data_input/dineout.csv",
sep = ";",
stringsAsFactors = T)
dineTujuan Decision Tree yaitu memisahkan data menjadi kelompok-kelompok kecil berdasarkan variable tertentu sehingga dihasilkan data yang homogen atau homogenitas tinggi. Ukuran homogenitas dapat dikuantifikasi dengan nilai entropy.
Entropy adalah ukuran ketidakteraturan (measure of disorder) dari sebuah kelompok data.
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.
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.
Rumus Entropy:
\[Entropy = \Sigma_{i=1}^c -p_i \ log_2 \ p_i\]
Apabila untuk binary classification (target dengan dua kelas), maka \(c = 2\) dapat dijabarkan menjadi:
\[Entropy = -\ p_1 \ log_2 \ p_1 -p_2 \ log_2 \ p_2\]
Dine.Out = YesDine.Out = NoPertama-tama hitung entropy dari variable target
Dine.Out sebelum dilakukan splitting:
table(dine$Dine.Out)#>
#> No Yes
#> 8 4
p1 <- 4/(8+4) # dine out = yes
p2 <- 8/(8+4) # dine out = no
entropy_awal <- - p1*log2(p1) - p2*log2(p2)
entropy_awal#> [1] 0.9182958
Selanjutnya, kita coba splitting data menggunakan predictor satu per satu predictor secara iteratif, kemudian pilih satu predictor yang mampu menghasilkan penurunan entropy atau information gain terbesar.
\[Information \ Gain = Entropy(parent) - (P_1 \ Entropy_1 + P_2 \ Entropy_2)\]
Budget = HighBudget = LowBudget = HighBudget = LowBudget:table(budget = dine$Budget, dine = dine$Dine.Out)#> dine
#> budget No Yes
#> High 2 4
#> Low 6 0
entropy_budget_high <- - 2/6*log2(2/6) - 4/6*log2(4/6)
entropy_budget_low <- - 6/6*log2(6/6)
entropy_budget <- 6/12 * entropy_budget_high +
6/12 * entropy_budget_low
entropy_budget#> [1] 0.4591479
ig_budget <- entropy_awal - entropy_budget
ig_budget#> [1] 0.4591479
Distance:table(distance = dine$Distance, dine = dine$Dine.Out)#> dine
#> distance No Yes
#> Far 5 1
#> Near 3 3
entropy_distance_far <- - 5/6*log2(5/6) - 1/6*log2(1/6)
entropy_distance_near <- - 3/6*log2(3/6) - 3/6*log2(3/6)
entropy_distance <- 6/12 * entropy_distance_far +
6/12 * entropy_distance_near
entropy_distance#> [1] 0.8250112
ig_distance <- entropy_awal - entropy_distance
ig_distance#> [1] 0.09328462
Friend:table(friend = dine$Friend, dine = dine$Dine.Out)#> dine
#> friend No Yes
#> Absent 5 2
#> Available 3 2
entropy_friend_absent <- - 5/7 * log2(5/7) - 2/7 * log2(2/7)
entropy_friend_available <- - 3/5 * log2(3/5) - 2/5 * log2(2/5)
entropy_friend <- 7/12*entropy_friend_absent + 5/12*entropy_friend_available
entropy_friend#> [1] 0.9080497
ig_friend <- entropy_awal - entropy_friend
ig_friend#> [1] 0.01024609
ig_budget#> [1] 0.4591479
ig_distance#> [1] 0.09328462
ig_friend#> [1] 0.01024609