Training Objectives

Mempelajari algoritma klasifikasi dari dasar, menyelidiki dasar matematika yang mendukung algoritma logistic regression dan algoritma nearest neighbors.

  • Logistic Regression
    • Memahami Peluang (Odds)
    • Log Peluang (Log of Odds)
    • Kurva Sigmoid
    • Fungsi glm
  • Prediksi Tetangga Terdekat

Logistic Regression

Logistic Regression adalah algoritma untuk kasus klasifikasi yang disesuaikan dari kurva regresi, y=f(x), di mana y adalah variabel kategorik. Tujuan dari logistik regression yaitu melakukan prediksi probability dengan menggunakan model regresi linier (yang dapat digunakan untuk klasifikasi).

  • Binary: ketika y adalah biner
  • Multiclass: ketika y lebih dari 2 kategori

Output dari logistic regression berupa log of odds.

Linear Regression vs Logistic Regression

Basic Intuition

Probability

Pada dasarnya, ketika kita melakukan klasifikasi, kita akan menghitung peluang.

\[P(yes) = \frac{n(yes)}{n(yes) + n(no)}\]

Contoh:

Anda adalah student Algoritma yang akan mengerjakan kuis C1. Pada batch sebelumnya, ada 24 dari 30 student yang berhasil mengerjakan kuis. Apakah Anda akan lulus pada kuis C1 ini?

# Probabilitas: 
24/30
#> [1] 0.8
  • Kesimpulan: kemungkinan besar lulus
  • Berapa range probabilitas? 0 sampai 1
  • Berapa range hasil prediksi model regresi linear? -inf sampai inf

Odds

Odds merupakan bentuk lain dari probabilitas, yaitu perbandingan antara probabilitas kejadian terjadi/probabilitas kejadian tidak terjadi.

\[\frac{p}{(1-p)}\]

p = probabilitas suatu kejadian terjadi

❓Contoh 1:

Berapa odds dari Anda lulus mengerjakan kuis C1?

# odds
p_lulus = 0.8
p_lulus/(1-p_lulus)
#> [1] 4

📈 Interpretasi:

  • Kejadian seseorang lulus kuis adalah 4 KALI lebih mungkin dibandingkan tidak lulus kuis.

❓Contoh 2:

Anda hendak berpergian menggunakan pesawat dari Soekarno Hatta Airport. Bila diketahui dari 100 penerbangan di Soekarno Hatta, terdapat 25 pesawat Delay. Berapa odds pesawat Anda On Time?

# probability
p = 75/100
# odds
p/(1-p)
#> [1] 3

📈 Interpretasi:

  • kejadian pesawat on time 3 kali lebih mungkin dibandingkan kejadian pesawat delay

⁉️ Knowledge Check:

Apabila nilai odds = 1 berarti probabilitasnya?

1:1 -> 50:50 (punya peluang yang sama besar)

Berapa range nilai dari odds?

# odds: p/1-p
# min
p  <-  0
p/(1-p)
#> [1] 0
# max
p <-  1
p/(1-p)
#> [1] Inf
  • Probability: 0 sampai 1
  • Odds : 0 sampai tak hingga (inf)

Log of Odds

Log of odds adalah nilai odds yang dilogaritmikkan:

\[logit(p) = log(\frac{p}{1-p})\]

Berapakah log(odds) dari penerbangan tepat waktu?

p = 75/100
log(p/(1-p))
#> [1] 1.098612

Berapa range nilai log of odds?

# min
p <- 0
log(p/(1-p))
#> [1] -Inf
# max
p <- 1
log(p/(1-p))
#> [1] Inf

📝 Notes:

  • Range
    • Probability: [0, 1]
    • Odds : [0, inf]
    • Log of odds: [-inf, inf]
  • Odds dan log of odds -> jembatan dari hasil regresi linier ke bentuk peluang
  • Logistic regression menghasilkan Log of Odds.
  • Nilai Log of Odds tidak dapat diinterpretasikan, tetapi dapat dikembalikan ke kedua bentuk lainnya dengan tujuan berikut
    • odds : interpretasi variabel
    • probability : melakukan klasifikasi berdasarkan peluang

Terdapat cara lain:

  • logit(): probability -> log of odds (jarang dipakai)
  • inv.logit(): log of odds -> probability
library(gtools)
# probability -> log of odds dengan `logit()`
p <- 0.75
f_lods <- logit(p)
# log of odds -> peluang dengan `inv.logit()`
inv.logit(f_lods)
#> [1] 0.75

Fungsi inv.logit() ini juga biasa disebut sigmoid function.

# sigmoid function
curve(inv.logit(x), from = -10, to=10, 
      xlab = "Log of Odds", 
      ylab = "Probabolity")

📝 Kesimpulan:

  • Logistic regression konsepnya sama dengan regresi linier, tapi digunakan untuk kasus klasifikasi
  • output dari logistic regression adalah log of odds
  • log of odds diubah ke bentuk probability dengan fungsi inv.logit()

Fungsi glm() & Interpretasi

Anda adalah seorang analis performa student di universitas. Anda ditugaskan untuk memprediksi status kelulusan siswa dengan honors (cumlaude).

Load Data

# read & inspect data
honors <- read.csv("data_input/sample.csv") %>% 
  select(-femalexmath)

glimpse(honors)
#> Rows: 200
#> Columns: 5
#> $ female <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
#> $ read   <int> 57, 68, 44, 63, 47, 44, 50, 34, 63, 57, 60, 57, 73, 54, 45, 42,…
#> $ write  <int> 52, 59, 33, 44, 52, 52, 59, 46, 57, 55, 46, 65, 60, 63, 57, 49,…
#> $ math   <int> 41, 53, 54, 47, 57, 51, 42, 45, 54, 52, 51, 51, 71, 57, 50, 43,…
#> $ hon    <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, …

Deskripsi kolom:

  • female: gender of student (1 for female, 0 for male)
  • read: score in reading test
  • write: score in writing test
  • math: score in math test
  • hon: status of graduating in honors (1 for honors, 0 for not honors)

Check Missing Value

# cek missing value
colSums(is.na(honors))
#> female   read  write   math    hon 
#>      0      0      0      0      0

tidak ada missing value

Data Wrangling

# Ubah tipe data
honors <- honors %>% 
  mutate(female = as.factor(female), 
         hon = as.factor(hon))

# cek data
str(honors)
#> 'data.frame':    200 obs. of  5 variables:
#>  $ female: Factor w/ 2 levels "0","1": 1 2 1 1 1 1 1 1 1 1 ...
#>  $ read  : int  57 68 44 63 47 44 50 34 63 57 ...
#>  $ write : int  52 59 33 44 52 52 59 46 57 55 ...
#>  $ math  : int  41 53 54 47 57 51 42 45 54 52 ...
#>  $ hon   : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
# eksplorasi singkat
summary(honors)
#>  female       read           write            math       hon    
#>  0: 91   Min.   :28.00   Min.   :31.00   Min.   :33.00   0:151  
#>  1:109   1st Qu.:44.00   1st Qu.:45.75   1st Qu.:45.00   1: 49  
#>          Median :50.00   Median :54.00   Median :52.00          
#>          Mean   :52.23   Mean   :52.77   Mean   :52.65          
#>          3rd Qu.:60.00   3rd Qu.:60.00   3rd Qu.:59.00          
#>          Max.   :76.00   Max.   :67.00   Max.   :75.00

Build Model

📌 Cara membuat model Logistic Regression

Gunakan fungsi glm(), parameternya: formula : tempat mendefinisikan target dan predictor (y~x) data : data yang digunakan untuk membuat model family : gunakan “binomial” bila ingin menggunakan logistic regression pada pemodelan ini

Tanpa Prediktor

model_null <- glm(formula = hon~1,
                  data = honors,
                  family = "binomial")
summary(model_null)
#> 
#> Call:
#> glm(formula = hon ~ 1, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.7497  -0.7497  -0.7497  -0.7497   1.6772  
#> 
#> Coefficients:
#>             Estimate Std. Error z value         Pr(>|z|)    
#> (Intercept)  -1.1255     0.1644  -6.845 0.00000000000762 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 222.71  on 199  degrees of freedom
#> AIC: 224.71
#> 
#> Number of Fisher Scoring iterations: 4

📈 Interpretasi dari summary model

Intercept: -1.1255 -> log of odds dari target variable

Berikut pembuktiannya:

# probability
table(honors$hon)
#> 
#>   0   1 
#> 151  49
# probability student honors
49/200
#> [1] 0.245
# probability ke log of odds
logit(49/200)
#> [1] -1.12546

📈 Interpretasi:

Log of odds tidak dapat diinterpretasikan. Untuk interpretasi, nilai log of odds kita ubah ke odds.

# log of odds -> odds
exp( -1.1255)
#> [1] 0.3244902
# log of odds -> probability 
inv.logit( -1.1255)
#> [1] 0.2449925

Kejadian student lulus dengan honors adalah 0.32 KALI lebih mungkin dibandingkan lulus tanpa honors. Probabilitas student lulus dengan predikat honors adalah 0.245 Students lebih mungkin untuk lulus tanpa predikat honors

1 Prediktor Kategorik

❓Buat model untuk memprediksi honors berdasarkan gender female:

glm(y ~ x1 + x2 , data, family = "binomial")

model_f <- glm(formula = hon ~ female,
               data = honors,
               family = "binomial")
summary(model_f)
#> 
#> Call:
#> glm(formula = hon ~ female, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.8337  -0.8337  -0.6431  -0.6431   1.8317  
#> 
#> Coefficients:
#>             Estimate Std. Error z value     Pr(>|z|)    
#> (Intercept)  -1.4709     0.2690  -5.469 0.0000000453 ***
#> female1       0.5928     0.3414   1.736       0.0825 .  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 219.61  on 198  degrees of freedom
#> AIC: 223.61
#> 
#> Number of Fisher Scoring iterations: 4

✏️ Informasi Coefficients:

  • Intercept: -1.4709
  • female1: 0.5928

📈 Interpretasi:

# odds female dapat honors
exp(0.5928)
#> [1] 1.809047

Kejadian student female memperoleh honors adalah 1.8 KALI lebih mungkin dibandingkan student male mendapat honors

Memiliki gender female menaikan kemungkinan student mendaparkan honors

⚙️ Contoh Aplikasi

Misalkan student ke-1 adalah seorang wanita, berapa probability dia mendapat honors?

formula: hon = m*female + c

hon =

# log of odds
log_odds_f <- -1.4709 + 0.5928*1

# log of odds -> probability
inv.logit(log_odds_f)
#> [1] 0.2935717

Misalkan student ke-2 adalah seorang laki-laki, berapa probability dia mendapat honors?

formula: hon = m*female + c

hon =

# log of odds
log_odds_m <- -1.4709 + 0.5928*0

# log of odds -> probability
inv.logit(log_odds_m)
#> [1] 0.1868059
ifelse(c(log_odds_f, log_odds_m) > 0.5, "honors", "not honors")
#> [1] "not honors" "not honors"

Threshold 0.5 -> student baik laki laki maupun perempuan tidak mendapat honors - jenis kelamin perempuan : 0.29 - jenis kelamin laki-laki : 0.18

⚙️ [Opsional] Perhitungan manual memperoleh nilai intercept dan slope

Female: log of odds ratio dari student female mendapatkan honors dibandingkan student male mendapatkan honors.

# proportion
table(female = honors$female, honors = honors$hon)
#>       honors
#> female  0  1
#>      0 74 17
#>      1 77 32
# peluang dapat honors
p_female <- 32/(32+77) # female dapat honors/total female
p_male <- 17/(17+74) # male dapat honors/total male

# odds 
o_female <- p_female/(1-p_female)
o_male <- p_male/(1-p_male)

# log of odds
log(o_female/o_male)
#> [1] 0.5927822

Intercept: log of odds dari student male yang mendapatkan honors (basis)

log(o_male)
#> [1] -1.470852

1 Prediktor Numerik

Buat model untuk memprediksi honors berdasarkan nilai math:

model_math <- glm(formula = hon~math,
                  data = honors,
                  family = "binomial")
summary(model_math)
#> 
#> Call:
#> glm(formula = hon ~ math, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -2.0332  -0.6785  -0.3506  -0.1565   2.6143  
#> 
#> Coefficients:
#>             Estimate Std. Error z value        Pr(>|z|)    
#> (Intercept) -9.79394    1.48174  -6.610 0.0000000000385 ***
#> math         0.15634    0.02561   6.105 0.0000000010294 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 167.07  on 198  degrees of freedom
#> AIC: 171.07
#> 
#> Number of Fisher Scoring iterations: 5

y = b0 + b1x1 y = -9.79394 + 0.15634math

✏️ Informasi Coefficients:

  • Intercept: -9.79394 nilai log of odds ketika nilai math = 0
  • Math: 0.15634 kenaikan nilai log of odds setiap nilai math bertambah 1

📈 Interpretasi:

# log of odds -> odds
exp(0.15634)
#> [1] 1.169224

Setiap kenaikan 1 nilai pada math maka odds seseorang mendapatkan honor naik sebesar 1.17 KALI.

⚙️ [Opsional] Perhitungan manual memperoleh nilai slope

baseline nilai numerik:

median(honors$math)
#> [1] 52

hon = -9.79394 + 0.15634 * math

Student ke-1 memiliki nilai math 52, student kedua 53. Hitung masing-masing log of oddsnya, berapa selisihnya? (tanpa memperdulikan gender)

# log of odds
hon52 <- -9.79394 + 0.15634 * 52  
hon53 <- -9.79394 + 0.15634 * 53

hon53-hon52
#> [1] 0.15634

selisih == slope

💡 Tips cara cepat interpretasi:

  • Kalau coefficientnya positif (+) -> meningkatkan peluang ke target kita (dalam kasus ini lulus honors)
  • Kalau coefficientnya negatif (-) -> menurunkan peluang ke target kita

Divedeeper

Buatlah model yang dapat memprediksi seseorang akan lulus dengan predikat honors berdasarkan gender dan nilai math nya, kemudian jawablah pertanyaan berikut:

  1. Interpretasi dari coefficient yang peroleh
  2. Kevin memperoleh nilai math sebesar 60, berapa peluang Kevin mendapatkan honors?
  3. Wulan memperoleh nilai math sebesar 80, berapa peluang Wulan mendapatkan honors?
# buat model
model_fm <- glm(formula = hon~female+math,
                data = honors,
                family = "binomial")
summary(model_fm)
#> 
#> Call:
#> glm(formula = hon ~ female + math, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.8494  -0.6506  -0.3471  -0.1361   2.5105  
#> 
#> Coefficients:
#>              Estimate Std. Error z value        Pr(>|z|)    
#> (Intercept) -10.80595    1.61654  -6.685 0.0000000000232 ***
#> female1       0.96531    0.41599   2.321          0.0203 *  
#> math          0.16422    0.02665   6.161 0.0000000007206 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 161.35  on 197  degrees of freedom
#> AIC: 167.35
#> 
#> Number of Fisher Scoring iterations: 5

Jawab: 1. Interpretasi coefficient

# pake fungsi coef
coef(model_fm)
#> (Intercept)     female1        math 
#> -10.8059538   0.9653096   0.1642220
# akses nilainya secara langsung
model_fm$coefficients
#> (Intercept)     female1        math 
#> -10.8059538   0.9653096   0.1642220
exp(model_fm$coefficients)
#>   (Intercept)       female1          math 
#> 0.00002027841 2.62560049264 1.17847586504

coefficient math: setiap kenaikan 1 nilai math meningkatkan kemungkinan seseorang mendapatkan honors sebesar 1.178 kali dengan catatan semua prediktor lain nilainya sama

coefficient female: kemungkinan female lulus honors 2.62 kali lebih mungkin dibandingkan male lulus honors dengan catatan semua prediktor lain nilainya sama

📝 Notes:

  • Yang dimaksud dengan “variable lain memiliki nilai yang sama”
    • variabel female nilainya harus sama (sama-sama female), contoh:
      • Wulan: F | 88
      • Kevin: M | 88

Jawab: 2 dan 3. Mencari nilai peluang Prediksi manual menggunakan model logistic regression untuk melakukan klasifikasi. Hint: Log of odds yang dihasilkan model logistic regression dapat diubah ke bentuk probability. Probability yang didapatkan dapat digunakan untuk menentukan kelas pada klasifikasi.

Final formula:

hon = (Intercept) + (slope_female1 * female) + (slope_math * math)

kevin_score <- -10.8059538 + 0.9653096*0 + 0.1642220*60
  
wulan_score <- -10.8059538 + 0.9653096*1 + 0.1642220*80

pred_kw <- inv.logit(c(kevin_score, wulan_score))

Hasil prediksi (gunakan fungsi ifelse())

ifelse(test = pred_kw > 0.5, 
       yes = "honors", 
       no = "not honors")
#> [1] "not honors" "honors"

Kesimpulan: - kevin diprediksi tidak mendapatkan honors - wulan diprediksi mendapatkan honors

Bonus! Apa yang harus dilakukan Kevin agar ia dapat lulus dengan predikat honors?

# nilai minimal agar log of odds kevin bernilai 0
10.8059538 / 0.1642220
#> [1] 65.80089

minimal Kevin harus dapat nilai math sebesar 66

kevin_score_upd <- inv.logit(-10.8059538 + 0.9653096*0 + 0.1642220*66)

ifelse(kevin_score_upd>0.5, "honors", "not honors")
#> [1] "honors"

📝 Knowledge Check Day 1:

  1. Jenis target variabel pada kasus klasifikasi machine learning adalah…
  • Diksrit atau Numerikal
  • Kontinu atau Numerikal
  • Diskrit atau Kategorikal
  • Kontinu atau Kategorikal
  1. Untuk membuat model logistic regression kita dapat menggunakan fungsi glm(y ~ x, data, family = "binomial"). Nilai coefficients merupakan…
  • Probability
  • Odds
  • Log of odds
  1. Untuk dapat menginterpretasi model logistic regression kita membutuhkan nilai…

  • Probability

  • Odds (menggunakan fungsi: exp())

  • Log of odds

    • Interpretasi koefisien dapat dilakukan dan berbeda untuk masing-masing kondisi:
      • tanpa prediktor
      • 1 prediktor kategorik
      • 1 prediktor numerik
      • banyak prediktor
  1. Bila koefisien variable / slope bernilai positif artinya:
  • Variabel tersebut berpengaruh untuk menaikan probabilitas terhadap variabel target
  • Variabel tersebut tidak berpengaruh untuk menaikan probabilitas terhadap variabel target
  • Variabel tersebut berpengaruh untuk menurunkan probabilitas terhadap variabel target
  1. Untuk melakukan klasifikasi dari hasil logistic regression, nilai log of odds diubah kebentuk probability dengan cara…
  • exp()
  • inv.logit()
  • log()

yang kemudian ditentukan kelasnya berdasarkan batas tertentu (misal = 0.5).

Summary day 1

  1. Klasifikasi adalah suatu metode supervised machine learning yang digunakan untuk melakukan prediksi variabel target dengan sifat kategorik
  2. Proses klasifikasi merupakan proses perhitungan peluang (seberapa mungkin suatu kategori terjadi)
  3. Logistic regression menggunakan regresi linear untuk memprediksi peluang (sehingga dapat digunakan untuk klasifikasi)
  4. ada 3 bentuk probability hyang harus kita pahami
  • Probability range : 0 hingga 1
  • odds range : 0 hingga inf
  • log of odds range: inf hingga inf

bentuk umum dari model logistic regression Y= B0 + B1x1 + B2x2+….. log of odds : nilai Y, B0, B1 odds : ketika ingin menginterpretasikan nilai koef (B0, B1, B2, ..), bisa menggunakan fungsi exp() probability : ketika ingin mengetahui label dari data yang diprediksi, biasanya yang diubah menjadi probability adalah nilai Y.

  1. function yang digunakan untuk membuat model logistic adalah glm()
  • formula : y ~ x (y merupakan target dan x adalah predictor. tanda “~” sebagai pemisah) y ~ 1 : memprediksi y tanpa predictor y ~ x1 + x2 : memprediksi y dengan predictor x1 dan x2 y ~ . : memprediksi y dengan semua predictor yang ada pada data
  • data : data yang digunakan dalam proses pembuatan model
  • family : menunjukkan jenis regresi apa yang ingin digunakan. gunakan “binomial” bila ingin menggunakan logistik regression. gunakan gausian bila ingin menggunakan linear model

—End of Day 1—

summary(model_fm)
#> 
#> Call:
#> glm(formula = hon ~ female + math, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.8494  -0.6506  -0.3471  -0.1361   2.5105  
#> 
#> Coefficients:
#>              Estimate Std. Error z value        Pr(>|z|)    
#> (Intercept) -10.80595    1.61654  -6.685 0.0000000000232 ***
#> female1       0.96531    0.41599   2.321          0.0203 *  
#> math          0.16422    0.02665   6.161 0.0000000007206 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 161.35  on 197  degrees of freedom
#> AIC: 167.35
#> 
#> Number of Fisher Scoring iterations: 5

Null & Residual Deviance

Deviance is defined as the difference of likelihoods between the fitted model and the perfect (saturated) model. Deviance digunakan sebagai indikator goodness of fit suatu model.

  • Null deviance: Null deviance menunjukkan error ketika model tanpa prediktor
  • Residual deviance: residual deviance menunjukkan error ketika model dengan seluruh prediktor
  • Num of iteration : iterasi/perulangan untuk mendapatkan model terbaik

Ambilah model dengan nilai residual deviance paling rendah.

model_null$deviance # model tanpa prediktor
#> [1] 222.71
model_f$deviance # model dengan female sebagai prediktor 
#> [1] 219.6062
model_math$deviance # model dengan math sebagai prediktor
#> [1] 167.0732
model_fm$deviance # model dengan female + math sebagai prediktor
#> [1] 161.3454
summary(model_null)
#> 
#> Call:
#> glm(formula = hon ~ 1, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.7497  -0.7497  -0.7497  -0.7497   1.6772  
#> 
#> Coefficients:
#>             Estimate Std. Error z value         Pr(>|z|)    
#> (Intercept)  -1.1255     0.1644  -6.845 0.00000000000762 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 222.71  on 199  degrees of freedom
#> AIC: 224.71
#> 
#> Number of Fisher Scoring iterations: 4

Mari buat model model_all untuk memprediksi honors berdasarkan semua prediktor yang ada:

model_all <- glm(formula = hon~.,
                 data = honors,
                 family = "binomial")
#> Warning: glm.fit: algorithm did not converge
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
summary(model_all)
#> 
#> Call:
#> glm(formula = hon ~ ., family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>          Min            1Q        Median            3Q           Max  
#> -0.000245237  -0.000000021  -0.000000021  -0.000000021   0.000176979  
#> 
#> Coefficients:
#>                 Estimate   Std. Error z value Pr(>|z|)
#> (Intercept)  -2176.87191 282900.61006  -0.008    0.994
#> female1         -4.44248  18078.08748   0.000    1.000
#> read             0.07478    489.40463   0.000    1.000
#> write           36.30917   4837.98255   0.008    0.994
#> math            -0.36898   1362.81267   0.000    1.000
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71004668627  on 199  degrees of freedom
#> Residual deviance:   0.00000013527  on 195  degrees of freedom
#> AIC: 10
#> 
#> Number of Fisher Scoring iterations: 25
  • ada warning! Menurut Anda sekalian, apa yang aneh dari hasil summary model_all di atas?
  • ada nilai p-value 1 (tidak ada significant codes)
  • residual deviance nya mendekati 0
# log of odds -> odds
exp(0.07478)
#> [1] 1.077647
exp(36.30917)
#> [1] 5873164613974824

setiap kenaikan 1 nilai write kemungkinan seseorang mendapatkan honors naik 5873164613974824 kali

table(honors$hon, honors$write)
#>    
#>     31 33 35 36 37 38 39 40 41 42 43 44 45 46 47 49 50 52 53 54 55 57 59 60 61
#>   0  4  4  2  2  3  1  5  3 10  2  1 12  1  9  2 11  2 15  1 17  3 12 25  4  0
#>   1  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  4
#>    
#>     62 63 65 67
#>   0  0  0  0  0
#>   1 18  4 16  7

📝 Notes:

  • glm.fit: fitted probabilities numerically 0 or 1 occurred -> warning bahwa bisa dihasilkan probability yang tepat 1 atau 0 (indikasi kondisi perfect separation)
  • glm.fit: algorithm did not converge -> warning bahwa algoritmanya tidak mencapai kondisi stabil hingga iterasi ke-25 (default), dapat terjadi salah satunya karena kondisi perfect separation.

Cek proporsi nilai write terhadap variable honors

table(honors$hon, honors$write)
#>    
#>     31 33 35 36 37 38 39 40 41 42 43 44 45 46 47 49 50 52 53 54 55 57 59 60 61
#>   0  4  4  2  2  3  1  5  3 10  2  1 12  1  9  2 11  2 15  1 17  3 12 25  4  0
#>   1  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  4
#>    
#>     62 63 65 67
#>   0  0  0  0  0
#>   1 18  4 16  7

Perfect Separation

Perfect Separation adalah sebuah kondisi dimana ada 1 variabel prediktor yang dapat memisahkan kelas target secara sempurna. Cara mendeteksi:

  • p-value besar sekali (1), tidak ada variable yang signifikan
  • nilai residual deviance mendekati 0
  • lihat koefisien dari model yang dibuat, ada variable dengan coefficient amat besar

Pada kasus ini, nilai write dapat memisahkan kelas honor dengan sempurna

Tidak disarankan menggunakan model dengan perfect separation, karena model amat bias pada salah satu variabel dan tidak mempertimbangkan variabel lainnya. Hal ini dapat membuat model tidak akurat (buruk) dalam memprediksi data baru.

Apa yang kita lakukan bila bertemu kondisi perfect separation:

  1. Jika kasus seperti ini kita terima, tidak usah membuat machine learning cukup ifelse saja
  2. Jika kasus ini tidak kita terima, maka jgn gunakan variabel ini sebagai predictor
honors2 <- honors %>% 
  select(-write)

# revisi model
model_all_w <- glm(formula = hon~. -write,
                   data = honors,
                   family = "binomial")

model_all_w2 <- glm(formula = hon~.,
                   data = honors2,
                   family = "binomial")

summary(model_all_w)
#> 
#> Call:
#> glm(formula = hon ~ . - write, family = "binomial", data = honors)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.8305  -0.6327  -0.3300  -0.1258   2.3896  
#> 
#> Coefficients:
#>              Estimate Std. Error z value         Pr(>|z|)    
#> (Intercept) -11.77025    1.71068  -6.880 0.00000000000597 ***
#> female1       0.97995    0.42163   2.324           0.0201 *  
#> read          0.05906    0.02655   2.224           0.0261 *  
#> math          0.12296    0.03128   3.931 0.00008442731719 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 156.17  on 196  degrees of freedom
#> AIC: 164.17
#> 
#> Number of Fisher Scoring iterations: 5
summary(model_all_w2)
#> 
#> Call:
#> glm(formula = hon ~ ., family = "binomial", data = honors2)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.8305  -0.6327  -0.3300  -0.1258   2.3896  
#> 
#> Coefficients:
#>              Estimate Std. Error z value         Pr(>|z|)    
#> (Intercept) -11.77025    1.71068  -6.880 0.00000000000597 ***
#> female1       0.97995    0.42163   2.324           0.0201 *  
#> read          0.05906    0.02655   2.224           0.0261 *  
#> math          0.12296    0.03128   3.931 0.00008442731719 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 222.71  on 199  degrees of freedom
#> Residual deviance: 156.17  on 196  degrees of freedom
#> AIC: 164.17
#> 
#> Number of Fisher Scoring iterations: 5
model_fm$deviance
#> [1] 161.3454

AIC

AIC = Jumlah informasi yang hilang. Diinginkan AIC yang semakin kecil.

model_null$aic 
#> [1] 224.71
model_f$aic
#> [1] 223.6062
model_math$aic 
#> [1] 171.0732
model_fm$aic 
#> [1] 167.3454
model_all_w$aic
#> [1] 164.1696

Nilai AIC tidak dimiliki oleh semua model -> biasanya untuk membandingkan antar model logistic regression. Kalau mau membandingkan model secara lebih baik (bisa untuk semua model) gunakan error.

Assumption

Logistic Regression menganut 3 asumsi:

  • Multicollinearity: antar prediktor tidak saling berkorelasi terlalu kuat (hingga nilai 1 / -1) -> uji vif() dari library car
  • Independence of Observations: antar observasi saling independen & tidak berasal dari pengukuran yang berhubungan satu sama lain -> kita harus ambil data secara random sampling
  • Linearity of Predictor & Log of Odds: cara interpretasi model mengacu pada asumsi ini (contoh: untuk variabel numerik, peningkatan 1 nilai akan meningkatkan log of odds).

Asumsi logistic regression menuntut kita untuk memahami data secara mendalam dan memastikan data sudah siap dipakai untuk membuat model.

Kita akan mencoba melakukan pembahasan tentang asumsi menggunakan data penerbangan pesawat flights_edit.csv

flights <- read.csv("data_input/flights_edit.csv")
head(flights)
  1. Buat model flight.model untuk memprediksi DepDel15 berdasarkan Month + DayofWeek, kemudian tampilkan hasil summary
flight.model <- glm(formula = DepDel15~Month+DayofWeek,
                    data = flights,
                    family = "binomial")
  
summary(flight.model)
#> 
#> Call:
#> glm(formula = DepDel15 ~ Month + DayofWeek, family = "binomial", 
#>     data = flights)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.7312  -0.6902  -0.6492  -0.6135   1.8855  
#> 
#> Coefficients:
#>              Estimate Std. Error z value            Pr(>|z|)    
#> (Intercept) -0.926861   0.032296 -28.699 <0.0000000000000002 ***
#> Month       -0.062459   0.003999 -15.619 <0.0000000000000002 ***
#> DayofWeek   -0.005851   0.003964  -1.476                0.14    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 100312  on 99998  degrees of freedom
#> Residual deviance: 100065  on 99996  degrees of freedom
#> AIC: 100071
#> 
#> Number of Fisher Scoring iterations: 4
  1. Interpretasi koefisien tiap variabel!
exp(flight.model$coefficients[2])
#>    Month 
#> 0.939452
exp(flight.model$coefficients[3])
#> DayofWeek 
#> 0.9941662

Nilai odds kurang dari 1 artinya pada bulan berikutnya akan memperkecil kemungkinan untuk delay

Nilai odds kurang dari 1 artinya pada hari berikutnya akan memperkecil kemungkinan untuk delay

  1. apakah terdapat multicolinearity pada model? ada ga sih hubungan antar predictor?
library(car)
vif(flight.model)
#>     Month DayofWeek 
#>  1.000012  1.000012
flights <- flights %>% 
  mutate(Month = as.factor(Month),
         DayofWeek = as.factor(DayofWeek))

flight.model <- glm(formula = DepDel15~Month+DayofWeek,
                    data = flights,
                    family = "binomial")

summary(flight.model)
#> 
#> Call:
#> glm(formula = DepDel15 ~ Month + DayofWeek, family = "binomial", 
#>     data = flights)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -0.8704  -0.7093  -0.6269  -0.5383   2.0686  
#> 
#> Coefficients:
#>             Estimate Std. Error z value             Pr(>|z|)    
#> (Intercept) -1.34692    0.02771 -48.611 < 0.0000000000000002 ***
#> Month5      -0.09491    0.03001  -3.163             0.001564 ** 
#> Month6       0.36353    0.02838  12.809 < 0.0000000000000002 ***
#> Month7       0.25606    0.02848   8.990 < 0.0000000000000002 ***
#> Month8      -0.03714    0.02972  -1.250             0.211286    
#> Month9      -0.37841    0.03231 -11.713 < 0.0000000000000002 ***
#> Month10     -0.31266    0.03143  -9.948 < 0.0000000000000002 ***
#> DayofWeek2  -0.19895    0.02959  -6.723    0.000000000017787 ***
#> DayofWeek3  -0.05338    0.02890  -1.847             0.064697 .  
#> DayofWeek4   0.20806    0.02797   7.438    0.000000000000102 ***
#> DayofWeek5   0.13247    0.02828   4.684    0.000002809421366 ***
#> DayofWeek6  -0.28909    0.03194  -9.052 < 0.0000000000000002 ***
#> DayofWeek7  -0.11055    0.02966  -3.727             0.000194 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 100312  on 99998  degrees of freedom
#> Residual deviance:  98967  on 99986  degrees of freedom
#> AIC: 98993
#> 
#> Number of Fisher Scoring iterations: 4

Classification Workflow

  1. Read Data + Data understanding
  2. Data Wrangling
  • ubah tipe data
  1. EDA
  • cek missing value
  • cek data duplicate
  1. Cross Validation
  2. Data Pre-Processing
  3. Build Model
  4. Predict
  5. Evaluation
  6. Model Tuning
  7. Final Model

Studi Kasus: Credit Risk Analysis

Buat model untuk memprediksi peluang customer akan gagal bayar pinjaman (loan default), untuk mengindikasikan apakah customer tersebut baik atau tidak untuk diberikan pinjaman.

Read Data

loans <- read.csv("data_input/loan2017Q4.csv")#, stringsAsFactors = T)
glimpse(loans)
#> Rows: 1,556
#> Columns: 16
#> $ initial_list_status <chr> "w", "f", "w", "w", "w", "w", "w", "w", "w", "w", …
#> $ purpose             <chr> "debt_consolidation", "debt_consolidation", "debt_…
#> $ int_rate            <dbl> 14.08, 9.44, 28.72, 13.59, 15.05, 10.91, 15.05, 10…
#> $ installment         <dbl> 675.99, 480.08, 1010.30, 484.19, 476.33, 130.79, 3…
#> $ annual_inc          <dbl> 156700, 50000, 25000, 175000, 109992, 49000, 65000…
#> $ dti                 <dbl> 19.11, 19.35, 65.58, 12.60, 10.00, 5.12, 22.38, 33…
#> $ verification_status <chr> "Source Verified", "Not Verified", "Verified", "No…
#> $ grade               <chr> "C", "B", "F", "C", "C", "B", "C", "B", "D", "D", …
#> $ revol_bal           <int> 21936, 5457, 23453, 31740, 2284, 2016, 14330, 2758…
#> $ inq_last_12m        <int> 3, 1, 0, 0, 3, 5, 0, 1, 8, 1, 0, 12, 4, 8, 1, 3, 0…
#> $ delinq_2yrs         <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,…
#> $ home_ownership      <chr> "MORTGAGE", "RENT", "OWN", "MORTGAGE", "MORTGAGE",…
#> $ not_paid            <int> 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1,…
#> $ log_inc             <dbl> 11.962088, 10.819778, 10.126631, 12.072541, 11.608…
#> $ verified            <int> 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
#> $ grdCtoA             <int> 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,…
  • initial_list_status: Either w (whole) or f (fractional).
  • purpose: one of credit_card, debt_consolidation, home_improvement, major_purchase and small_business
  • int_rate: Interest rate in percentages
  • installment: Monthly payment owed by the borrower
  • annual_inc: Self-reported annual income provided by the borrower / co-borrowers during application
  • dti: A ratio of the borrower’s total monthly debt payments on his/her total obligations to the self-reported monthly income
  • verification_status: is the reported income verified, not verified, or if the income source was verified
  • grade: software-assigned loan grade
  • revol_bal: total credit revolving balance (in the case of credit card, it refers to the portion of credit card spending that goes unpaid at the end of a billing cycle)
  • inq_last_12m: number of credit inquiries in the last 12 months
  • delinq_2yrs: number of 30+ days past-due incidences of delinquency in the borrower’s credit file for the past 2 years
  • home_ownership: one of MORTGAGE, OWN and RENT
  • not_paid: 0 for fully-paid loans, 1 for charged-off, past-due / grace period or defaulted
  • log_inc: log of annual_inc
  • verified: 0 for “Not verified” under verification_status, 1 otherwise
  • grdCtoA: 1 for a grade of A or B, and 0 for otherwise (note: mislabelled column)

Data Wrangling

Target: not_paid (paid = 0, not_paid = 1)

Adakah variabel yang tipe datanya belum sesuai? initial_list_status purpose
grade grdCtoA
home_ownership

# data wrangling
loans <- loans %>% 
  mutate_if(is.character, as.factor) %>% 
  mutate(not_paid = as.factor(not_paid),
         verified = as.factor(verified),
         grdCtoA = as.factor(grdCtoA))

# cek data kembali
glimpse(loans)
#> Rows: 1,556
#> Columns: 16
#> $ initial_list_status <fct> w, f, w, w, w, w, w, w, w, w, w, w, w, f, w, w, w,…
#> $ purpose             <fct> debt_consolidation, debt_consolidation, debt_conso…
#> $ int_rate            <dbl> 14.08, 9.44, 28.72, 13.59, 15.05, 10.91, 15.05, 10…
#> $ installment         <dbl> 675.99, 480.08, 1010.30, 484.19, 476.33, 130.79, 3…
#> $ annual_inc          <dbl> 156700, 50000, 25000, 175000, 109992, 49000, 65000…
#> $ dti                 <dbl> 19.11, 19.35, 65.58, 12.60, 10.00, 5.12, 22.38, 33…
#> $ verification_status <fct> Source Verified, Not Verified, Verified, Not Verif…
#> $ grade               <fct> C, B, F, C, C, B, C, B, D, D, F, C, C, E, B, C, C,…
#> $ revol_bal           <int> 21936, 5457, 23453, 31740, 2284, 2016, 14330, 2758…
#> $ inq_last_12m        <int> 3, 1, 0, 0, 3, 5, 0, 1, 8, 1, 0, 12, 4, 8, 1, 3, 0…
#> $ delinq_2yrs         <int> 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0,…
#> $ home_ownership      <fct> MORTGAGE, RENT, OWN, MORTGAGE, MORTGAGE, MORTGAGE,…
#> $ not_paid            <fct> 0, 1, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1,…
#> $ log_inc             <dbl> 11.962088, 10.819778, 10.126631, 12.072541, 11.608…
#> $ verified            <fct> 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
#> $ grdCtoA             <fct> 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0,…

Exploratory Data Analysis

Cek Indikasi multicolonierity

Berdasarkan deskripsi kolom, kita dapat melihat indikasi adanya multicolonierity antara beberapa prediktor (berdasarkan pemahaman data dan pengetahuan bisnis)

table(loans$grade, loans$grdCtoA)
#>    
#>       0   1
#>   A   0 210
#>   B   0 385
#>   C 464   0
#>   D 326   0
#>   E 118   0
#>   F  38   0
#>   G  15   0

kolom dengan indikasi multicolonierity (informasinya redundant): * grade dan grdCtoA * verified dan verification_status * annual_inc dan log_inc

Buang kolom log_inc, verification_status, grade

loans_clean <- loans %>% 
  select(-c(log_inc, verification_status, grade))
names(loans)
#>  [1] "initial_list_status" "purpose"             "int_rate"           
#>  [4] "installment"         "annual_inc"          "dti"                
#>  [7] "verification_status" "grade"               "revol_bal"          
#> [10] "inq_last_12m"        "delinq_2yrs"         "home_ownership"     
#> [13] "not_paid"            "log_inc"             "verified"           
#> [16] "grdCtoA"
names(loans_clean)
#>  [1] "initial_list_status" "purpose"             "int_rate"           
#>  [4] "installment"         "annual_inc"          "dti"                
#>  [7] "revol_bal"           "inq_last_12m"        "delinq_2yrs"        
#> [10] "home_ownership"      "not_paid"            "verified"           
#> [13] "grdCtoA"

Cek missing value

colSums(is.na(loans_clean))
#> initial_list_status             purpose            int_rate         installment 
#>                   0                   0                   0                   0 
#>          annual_inc                 dti           revol_bal        inq_last_12m 
#>                   0                   0                   0                   0 
#>         delinq_2yrs      home_ownership            not_paid            verified 
#>                   0                   0                   0                   0 
#>             grdCtoA 
#>                   0

Cek persebaran/pattern data

# explore with summary
summary(loans_clean)
#>  initial_list_status               purpose       int_rate      installment     
#>  f: 323              credit_card       :321   Min.   : 5.32   Min.   :  31.04  
#>  w:1233              debt_consolidation:996   1st Qu.:10.42   1st Qu.: 247.26  
#>                      home_improvement  :161   Median :14.08   Median : 381.23  
#>                      major_purchase    : 51   Mean   :14.71   Mean   : 468.72  
#>                      small_business    : 27   3rd Qu.:18.06   3rd Qu.: 635.86  
#>                                               Max.   :30.94   Max.   :1503.89  
#>    annual_inc           dti           revol_bal       inq_last_12m   
#>  Min.   :   2500   Min.   :  0.00   Min.   :     0   Min.   : 0.000  
#>  1st Qu.:  48000   1st Qu.: 11.00   1st Qu.:  4974   1st Qu.: 1.000  
#>  Median :  68000   Median : 17.18   Median : 10163   Median : 2.000  
#>  Mean   :  81630   Mean   : 18.86   Mean   : 15258   Mean   : 2.359  
#>  3rd Qu.:  95700   3rd Qu.: 24.53   3rd Qu.: 18094   3rd Qu.: 3.000  
#>  Max.   :1200000   Max.   :198.56   Max.   :258897   Max.   :18.000  
#>   delinq_2yrs      home_ownership not_paid verified grdCtoA
#>  Min.   :0.0000   MORTGAGE:776    0:778    0:578    0:961  
#>  1st Qu.:0.0000   OWN     :201    1:778    1:978    1:595  
#>  Median :0.0000   RENT    :579                             
#>  Mean   :0.3059                                            
#>  3rd Qu.:0.0000                                            
#>  Max.   :8.0000

Discussion: Adakah kira-kira variabel dengan nilai yang aneh? beberapa variabel numerik punya indikasi outliers, tetapi yang paling terlihat aneh adalah delinq_2yrs delinq_2yrs -> kayanya nilai 0 nya banyak banget

nrow(loans_clean)
#> [1] 1556
table(loans_clean$delinq_2yrs)
#> 
#>    0    1    2    3    4    5    6    7    8 
#> 1254  204   56   26    9    1    2    3    1
1254/1556
#> [1] 0.8059126
loans_clean <- loans_clean %>% 
  select(-delinq_2yrs)

Cek class-imbalance

prop.table(table(loans_clean$not_paid))
#> 
#>   0   1 
#> 0.5 0.5

Proporsi yang seimbang penting agar model klasifikasi mempelajari karakteristik setiap kelas secara seimbang, tidak dominan hanya satu kelas saja. Hal ini mencegah model bias terhadap model dengan nilai yang lebih besar proporsinya sehingga hanya baik untuk memprediksi 1 kelas saja.

Cross Validation

Jika kita ingin melakukan sebuah prediksi, maka kita tidak disarankan melihat nilai error pada data yang digunakan untuk melatih model, karena itu hanya menunjukkan bahwa model dapat memprediksi data lama tetapi belum tentu dapat memprediksi data baru. Data yang digunakan untuk melatih model kita sebut dengan data train, sedangkan data yang digunakan untuk mengevaluasi model disebut dengan data test.

Berikut beberapa kondisi yang dapat terjadi pada model:

  • Overfitting: Model terlalu bagus dalam mengikuti pola di data train, menyebabkan model kurang mampu memprediksi data baru
  • Underfitting: Model kurang bisa menangkap pola di data train
  • Optimum: Model mampu mengikui pola data train tetapi masih memiliki kemampuan yang baik dalam memprediksi data baru

Untuk mengevaluasi model dan melihat kemampuannya memprediksi data baru, data kita bagi menjadi 2: data train dan data test. Proses ini kita sebut dengan cross-validation.

  • split data
  • data train : data yang digunakan untuk melakukan training model / model fitting
  • data test : data yang digunakan untuk mengevaluasi model

Analogi:

  • 100 soal
  • 80 soal saya pakai untuk belajar (data train)
  • 20 soal saya pakai untuk ujian (data test)

tujuan dari cross validation adalah untuk mengetahui seberapa baik model untuk memprediksi unseen data.

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

# index sampling
index <- sample(x = nrow(loans_clean), size = nrow(loans_clean)*0.8)

# splitting
loans_train <- loans_clean[index,] # mengambil 80% dari total data untuk digunakan sebagai data train
loans_test <- loans_clean[-index,] # 20% sisanya digunakan sebagai data test
# intuisi set seed: mengunci random number kita
set.seed(123) 
sample(x = c("Kevin", "Tomy", "Algoritma"), size = 2)
#> [1] "Kevin" "Tomy"
nrow(loans_train)
#> [1] 1244
nrow(loans_test)
#> [1] 312
# re-check class imbalance
prop.table(table(loans_train$not_paid))
#> 
#>         0         1 
#> 0.4959807 0.5040193

proporsi kelas yang balance penting untuk data train karena kita akan melatih model menggunakan data train.

Build Model

Buatlah model logistic regression untuk memprediksi status loan (not_paid). Silahkan lakukan feature selection berdasarkan pertimbangan bisnis atau/dan statistik!

💡Hint:

  • fungsi: glm()
  • data: loans_train
  • y: not_paid
# model base
model_loans <- glm(formula = not_paid~.,
                   data = loans_train,
                   family = "binomial")

summary(model_loans)
#> 
#> Call:
#> glm(formula = not_paid ~ ., family = "binomial", data = loans_train)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -2.1245  -1.1256   0.6808   1.1290   1.6647  
#> 
#> Coefficients:
#>                               Estimate   Std. Error z value   Pr(>|z|)    
#> (Intercept)               -0.697331425  0.368017266  -1.895     0.0581 .  
#> initial_list_statusw      -0.045609904  0.145177593  -0.314     0.7534    
#> purposedebt_consolidation  0.120764481  0.152229204   0.793     0.4276    
#> purposehome_improvement    0.060314803  0.233414863   0.258     0.7961    
#> purposemajor_purchase      0.306076249  0.359744375   0.851     0.3949    
#> purposesmall_business      0.647207368  0.471415289   1.373     0.1698    
#> int_rate                   0.016699683  0.015819405   1.056     0.2911    
#> installment                0.001011847  0.000225449   4.488 0.00000719 ***
#> annual_inc                -0.000002996  0.000001259  -2.379     0.0173 *  
#> dti                        0.005471991  0.005597793   0.978     0.3283    
#> revol_bal                 -0.000001561  0.000003526  -0.443     0.6579    
#> inq_last_12m              -0.011914309  0.023455542  -0.508     0.6115    
#> home_ownershipOWN          0.378262234  0.188100773   2.011     0.0443 *  
#> home_ownershipRENT         0.120666700  0.133563972   0.903     0.3663    
#> verified1                  0.236640524  0.125378898   1.887     0.0591 .  
#> grdCtoA1                  -0.329885796  0.179903046  -1.834     0.0667 .  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 1724.5  on 1243  degrees of freedom
#> Residual deviance: 1647.4  on 1228  degrees of freedom
#> AIC: 1679.4
#> 
#> Number of Fisher Scoring iterations: 4
table(loans_clean$purpose)
#> 
#>        credit_card debt_consolidation   home_improvement     major_purchase 
#>                321                996                161                 51 
#>     small_business 
#>                 27

Interpretasi:

Mengubah log of odds ke nilai odds

exp(model_loans$coefficient)
#>               (Intercept)      initial_list_statusw purposedebt_consolidation 
#>                 0.4979122                 0.9554146                 1.1283591 
#>   purposehome_improvement     purposemajor_purchase     purposesmall_business 
#>                 1.0621709                 1.3580859                 1.9101989 
#>                  int_rate               installment                annual_inc 
#>                 1.0168399                 1.0010124                 0.9999970 
#>                       dti                 revol_bal              inq_last_12m 
#>                 1.0054870                 0.9999984                 0.9881564 
#>         home_ownershipOWN        home_ownershipRENT                 verified1 
#>                 1.4597457                 1.1282488                 1.2669856 
#>                  grdCtoA1 
#>                 0.7190058

Interpretasi untuk parameter:

purpose small business: Kemungkinan nasabah dengan purpose small business 1.9 KALI lebih mungkin untuk not paid dibandingkan dengan purpose credit card, dengan catatan variabel lainnya memiliki nilai yang sama

int_rate: Setiap kenaikan int_rate sebesar 1 satuan maka kecenderungan nasabah untuk gagal bayar naik sebesar 1.0168399 kali dengan catatan variabel lainnya konstan

Lakukan feature selection menggunakan stepwise (menghilangkan predictor satu persatu sampai didapat nilai AIC paling rendah) * stepwise: sama persis seperti linear model

# stepwise
model_step <- step(object = model_loans,
                   direction = "backward", 
                   trace = 0)

summary(model_step)
#> 
#> Call:
#> glm(formula = not_paid ~ installment + annual_inc + home_ownership + 
#>     verified + grdCtoA, family = "binomial", data = loans_train)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -1.8493  -1.1419   0.6999   1.1254   1.6383  
#> 
#> Coefficients:
#>                        Estimate   Std. Error z value    Pr(>|z|)    
#> (Intercept)        -0.286398493  0.168555220  -1.699     0.08929 .  
#> installment         0.001101418  0.000217259   5.070 0.000000399 ***
#> annual_inc         -0.000003569  0.000001138  -3.137     0.00171 ** 
#> home_ownershipOWN   0.376873393  0.186611468   2.020     0.04343 *  
#> home_ownershipRENT  0.147923501  0.127716614   1.158     0.24678    
#> verified1           0.248585159  0.124280033   2.000     0.04548 *  
#> grdCtoA1           -0.482879099  0.123357611  -3.914 0.000090605 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 1724.5  on 1243  degrees of freedom
#> Residual deviance: 1652.5  on 1237  degrees of freedom
#> AIC: 1666.5
#> 
#> Number of Fisher Scoring iterations: 4

📈 Interpretasi Model:

  • Variable yang meningkatkan peluang: installment, home_ownership, verified1
  • Variable yang menurunkan peluang: annual_inc, grdCtoA
  • Signifikansi Variable: semuanya

Summary day 2&3

  1. Melakukan model selection -> deviance, AIC
  • deviance: indikator goodness of fit sebuah model, nilai yang diinginkan adalah nilai paling rendah (terhadap perbandingan nilai deviance model lain). tidak bisa diinterpretasikan
  • AIC: jumlah informasi yang hilang, nilai makin kecil berarti model makin baik (informasi yang hilang semakin kecil)
  • dari deviance dan AIC kita bisa mendeteksi perfect separation (ketika sebuah variable prediktor membagi target variabel kita secara sempurna)
  1. Asumsi
  • No Multicollinierity: tidak ada korelasi yang tinggi antar sesama prediktor
  • Independence of Observations: asumsi dimana kita menganggap observasi pada data kita tidak saling berhubungan
  • Linearity of Predictor and Log of Odds: asumsi dasar dari interpretasi yang kita lakukan
  1. Classification Workflow *1. Read data & Data understanding
    • baca deskripsi datanya, gali informasinya
    • tentukan variable targetnya 2. Data wrangling (ubah tipe data) 3. EDA
    • cek missing value
    • cek class imbalance
    • cek distribusi data (statistika deskriptifnya)
    • cek indikasi multikol berdasarkan deskripsi data *4. Cross Validation
    • memisahkan data untuk dijadikan data train (melatih model) dan data test (evaluasi model)
    • cek class imbalance lagi *5. Data Preprocessing
    • terutama terhadap data train 6. Build model 7. Prediksi hasil model
    • Fungsi predict():
      • object: model yang digunakan untuk memprediksi
      • newdata: data yang ingin kita prediksi
      • type: link untuk log of odds, response untuk probability *8. Evaluasi (confusion matrix)
    • Akurasi - ditinjau true positive dan true negative
    • Recall/Sensitivity - ditinjau positivenya dari yang actualnya positive
    • Precision/Pos Pred Value - ditinjau positivenya dari yang prediksinya positive
    • Specificity - ditinjau negatifnya *9. Model Tuning
    • mengatur threshold untuk meningkatkan metrics yang ditinjau *10. Final Model

—END OF DAY 2— ___

Predict

predict(object model, newdata, type)

pada parameter type terdapat pilihan nilai:

  • link: menghasilkan log of odds
  • response: menghasilkan probability

Contoh: prediksi not_paid untuk 6 data teratas,

# log of odds
lods <- predict(object = model_step, 
                newdata = head(loans_test),
                type = "link")
lods
#>          6          8          9         10         26         38 
#> -0.8001278  0.0478935  0.2131328  0.2568868  0.6049750  0.4224801

💣 Dive Deeper:

Lakukan prediksi probability not_paid untuk data loans_test dan disimpan pada kolom baru bernama pred_Risk pada variable loans_test.

loans_test$pred_Risk <- predict(object = model_step,
                     newdata = loans_test,
                     type = "response")

Klasifikasikan data loans_test berdasarkan pred_Risk dan simpan pada kolom baru bernama pred_Label, gunakan threshold 0.5.

# ifelse(kondisi, benar, salah)
loans_test$pred_Label <- ifelse(test = loans_test$pred_Risk > 0.5,
                                yes = 1,
                                no = 0)
loans_test$pred_Label <- as.factor(loans_test$pred_Label)
class(loans_test$pred_Label)
#> [1] "factor"

📝 Notes:

Penentuan label yang menjadi angka 1 pada model logistic regression adalah berdasarkan levels.

  • kelas “0”, “1”
    • basis = 0,
    • probability mendekati 0 -> 0
    • probability mendekati 1 -> 1
  • kelas “honors” “non-honors”
    • basis = honors (level pertama, biasanya berdasarkan abjad)
    • probability mendekati 0 -> honors
    • probability mendekati 1 -> non-honors
# lihat hasil prediksi
loans_test %>% 
  select(pred_Risk,
         pred_Label,
         not_paid)

Tiap model pasti punya error. Kita ingin mendapatkan model dengan error prediksi sekecil mungkin.

Model Evaluation

table(predict = loans_test$pred_Label,
      actual = loans_test$not_paid)
#>        actual
#> predict  0  1
#>       0 94 54
#>       1 67 97

Setelah dilakukan prediksi menggunakan model, masih ada saja prediksi yang salah. Pada klasifikasi, kita mengevaluasi model berdasarkan confusion matrix:

  • Penentuan kelas:

    • kelas positif: kelas yang menjadi amatan
    • kelas negatif: kelas yang tidak menjadi amatan

  • Contoh kasus:

    • Machine learning untuk deteksi pasien covid:
      • kelas positif: terdeteksi covid
      • kelas negatif: terdeteksi sehat

  • Isi dari Confusion Matrix:

    • true positive (TP): diprediksi positif dan benar (prediksi positif; aktual positif)
    • true negative (TN): diprediksi negatif dan benar (prediksi negatif; aktual negatif)
    • false positive (FP): diprediksi positif namun salah (prediksi positif; aktual negatif)
    • false negative (FN): diprediksi negatif namun salah (prediksi negatif; aktual positif)

# confusion matrix
library(caret)
confusionMatrix(data = loans_test$pred_Label, 
                reference = loans_test$not_paid,
                positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction  0  1
#>          0 94 54
#>          1 67 97
#>                                           
#>                Accuracy : 0.6122          
#>                  95% CI : (0.5557, 0.6666)
#>     No Information Rate : 0.516           
#>     P-Value [Acc > NIR] : 0.0003933       
#>                                           
#>                   Kappa : 0.2256          
#>                                           
#>  Mcnemar's Test P-Value : 0.2753129       
#>                                           
#>             Sensitivity : 0.6424          
#>             Specificity : 0.5839          
#>          Pos Pred Value : 0.5915          
#>          Neg Pred Value : 0.6351          
#>              Prevalence : 0.4840          
#>          Detection Rate : 0.3109          
#>    Detection Prevalence : 0.5256          
#>       Balanced Accuracy : 0.6131          
#>                                           
#>        'Positive' Class : 1               
#>

4 metrics performa model: Accuracy, Sensitivity/Recall, Precision, Specificity

Accuracy

Seberapa banyak yang benar diprediksi dari keseluruhan data (positif maupun negatif).

TP+TN/TOTAL

# total data: nrow(loans.test)

(97+94)/nrow(loans_test)
#> [1] 0.6121795

Note: tidak ada batasan mutlak berapa akurasi yang dianggap akurat (sudah baik):

  • dikembalikan ke kebutuhan bisnis masing-masing.
  • proporsi kelas mayoritas: 60 positif, 40 negatif -> diusahakan lebih tinggi dibandingkan proporsi kelas awal -> akurasinya mau yang lebih tinggi dari 60%

Digunakan ketika:

  • kelas target sama penting:
    • mau memprediksi apakah customer masuk ke kelompok customer tertentu, dengan kasusnya kita punya strategi marketing untuk tiap kelompok.
  • data balance

Ada kondisi ketika accuracy bukanlah metrics terpenting. Umumnya ketika:

  • kita mementingkan salah satu kelas (misal, kelas target/positif)
  • data kita imbalance

Saat kita mementingkan kelas tertentu, maka kita dapat memilih antara menggunakan metrics Recall / Precision:

Sensitivity/Recall

Seberapa banyak yang benar diprediksi positif, dari yang reality-nya (aktualnya) positif.

TP/(TP+FN)

97/(97+54)
#> [1] 0.6423841

Precision/Pos Pred Value

Seberapa banyak yang benar diprediksi positif, dari yang diprediksi positif.

TP/(TP+FP)

97/(97+67)
#> [1] 0.5914634

Tahapan pemilihan recall/precision pada evaluasi model: 1. Definisikan kelas positifnya 2. Pahami resiko dari kesalahan prediksi (lihat dari FN dan FP-nya) 3. Pilih resiko yang paling tidak dapat ditolerir (resiko yang mau diminimalisir)

paid (0) — not_paid (1) pos

FN -> perusahaan merugi (pakai recall) TP/TP+FN FP -> kehilangan client (pakai precision)

93/(93+58)
#> [1] 0.615894
100/(100+56)
#> [1] 0.6410256

f1-score

non covid — covid (pos) FN -> penyebaran covid meningkat -> berpengaruh dengan ekonomi —- iiii FP -> mengisolasi orang yang sehat -> buang2 waktu/duit + pengaruh ke sosial orang tersebut —- i

Untuk memahaminya mari berdiskusi:

💣 Diskusi

ROLE PLAY:

  1. Seorang dokter ingin mendiagnosa pasien kanker menggunakan model machine learning. Pasien yang terdeteksi kanker akan diarahkan untuk pemeriksaan lanjutan. Untuk melihat kebaikan model, metrics mana yang lebih kita utamakan?
  • Target variabel = kanker/non-kanker
  • Kelas positif = kanker FP - orang2 yang diprediksi kanker ternyata sehat FN - orang2 yang diprediksi sehat ternyata kanker
  • Metrics = recall
  1. Kita ingin membuat model prediksi untuk mengklasifikasikan e-mail spam/ham. Metrics mana yang lebih kita utamakan?
  • Target variabel = spam/ham
  • Kelas positif = spam FN - email yang diprediksi ham ternyata spam FP - email yang diprediksi spam ternyata ham
  • Metrics = precision
  1. Bila ada seorang seller dan bosnya yang hendak menawarkan produk perusahaan ke 1000 calon pelanggan. Ingin dibuat model prediksi dimana positive = pelanggan membeli produk. Maka siapa yang mementingkan recall, siapa yang mementingkan precision, dan mengapa? FP: diprediksi beli ternyata ga beli FN: diprediksi ga beli ternyata beli

  • Bos: pa reynaldi - recall, tidak mau ada yang diprediksi tidak beli ternyata beli pa jeremia - recall, yang penting barangnya ada yang beli pa adhi - recall, yang penting kejual pa ibrahim - recall, cari cuan

  • Telemarketer: bu sofi - recall, tidak mau ada yang diprediksi tidak beli ternyata beli pa ibrahim - recall, cari bonus

Specificity

Seberapa banyak yang tepat diprediksi negatif, dari yang reality-nya negatif. Jarang dipakai karena kita tidak sering fokus pada kelas negatif.

TN/(TN+FP)

94/(94+67)
#> [1] 0.5838509
  1. Metrics yang baik untuk kasus loans adalah? (positif: not paid)

…

Bila hasil evaluasi (nilai metrics) belum memuaskan, dapat dilakukan Model Tuning:

📝 Notes: 1. ganti prediktor 2. ubah data pre-processingnya: misal upsample/downsample, scaling dll. 3. ganti modelnya (pakai model yang lebih robust) 4. ganti treshold prediction (tidak terlalu dianjurkan, karena bisa memaksakan): * geser mendekati 0: meningkatkan recall * geser mendekati 1: meningkatkan precision

# ifelse(kondisi, benar, salah)
# treshold diganti jadi 0.4 (direndahkan agar untuk meningkatkan recall)
loans_test$pred_Label_new <- ifelse(test = loans_test$pred_Risk > 0.4,
                                yes = 1,
                                no = 0)
loans_test$pred_Label_new <- as.factor(loans_test$pred_Label_new)

# confusion matrix
confusionMatrix(data = loans_test$pred_Label_new,
                reference = loans_test$not_paid,
                positive = "1")
#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction   0   1
#>          0  44  24
#>          1 117 127
#>                                              
#>                Accuracy : 0.5481             
#>                  95% CI : (0.491, 0.6042)    
#>     No Information Rate : 0.516              
#>     P-Value [Acc > NIR] : 0.1409             
#>                                              
#>                   Kappa : 0.1122             
#>                                              
#>  Mcnemar's Test P-Value : 0.00000000000000935
#>                                              
#>             Sensitivity : 0.8411             
#>             Specificity : 0.2733             
#>          Pos Pred Value : 0.5205             
#>          Neg Pred Value : 0.6471             
#>              Prevalence : 0.4840             
#>          Detection Rate : 0.4071             
#>    Detection Prevalence : 0.7821             
#>       Balanced Accuracy : 0.5572             
#>                                              
#>        'Positive' Class : 1                  
#>

nilai recall naik dari 0.64 jadi 0.84 setelah threshold diganti dari 0.5 menjadi 0.4

k-NN

k-NN adalah K-nearest neighboor. Metode ini akan mengkasifikasi data baru dengan membandingkan karakteristik data baru (data test) dengan data yang ada (data train). Kedekatan karakteristik tersebut diukur dengan Euclidean Distance hingga didapatkan jarak. Kemudian akan dipilih k tetangga terdekat dari data baru tersebut, kemudian ditentukan kelasnya menggunakan majority voting.

knitr::include_graphics("img/KNN.png")

Picking Optimum k

  • jangan terlalu besar: pemilihan kelas hanya berdasarkan kelas yang dominan dan mengabaikan pola kecil yang ternyata penting.
  • jangan terlalu kecil: kurang bisa menangkap pattern/pola data secara general
  • k optimum adalah akar dari jumlah data kita: sqrt(nrow(data))

Contoh kasus: jumlah data 400 (honors not-honors) -> kelas target = 2 k = sqrt(400) = 20 –> 21 / 19

jumlah data 900 (low medium high) -> kelas target = 3 k = 30 –> 32 / 28

  • untuk menghindari seri ketika majority voting:
    • k harus ganjil bila jumlah kelas target genap
    • k harus genap bila jumlah kelas target ganjil
    • k tidak boleh angka kelipatan jumlah kelas target
  • bila hasil majority voting seri, maka kelas akan dipilih secara random.

Summary Day 3

  1. Model KNN (k-nearest neighbour)
  • model ini memprediksi data berdasarkan perhitungan jarak
  • model ini menggunakan perhitungan Eucledian Distance
  • nilai k optimum didapatkan dari akar total data kita
  • prediktornya harus bertipe numerik

—END OF DAY 3— ___

Karakteristik k-NN

  • tidak membuat model: langsung mengklasifikasi saat itu juga
  • tidak belajar dari data, setiap ingin mengklasifikasi harus menyediakan data train lagi
  • tidak ada asumsi
  • dapat memprediksi multiclass
  • baik untuk prediktor numerik (karena mengklasifikasikan berdasarkan jarak), tidak baik untuk prediktor kategorik
  • robust: performa nya bagus -> error nya kecil
  • tidak interpretable

Breast Cancer Prediction

Business Question

Kanker payudara adalah kanker yang paling umum menyerang wanita di dunia. Kanker payudara dapat berupa kanker jinak (benign) atau sudah ganas (malignant). Kanker ganas dapat menyebar ke organ-organ tubuh lainnya. Pada kasus ini kita ingin membuat model untuk memprediksi apakah kanker masih jinak (benign) atau sudah ganas (malignant).

Read Data

wbcd <- read.csv("data_input/wisc_bc_data.csv")
# inspect data
str(wbcd)
#> 'data.frame':    569 obs. of  32 variables:
#>  $ id               : int  87139402 8910251 905520 868871 9012568 906539 925291 87880 862989 89827 ...
#>  $ diagnosis        : chr  "B" "B" "B" "B" ...
#>  $ radius_mean      : num  12.3 10.6 11 11.3 15.2 ...
#>  $ texture_mean     : num  12.4 18.9 16.8 13.4 13.2 ...
#>  $ perimeter_mean   : num  78.8 69.3 70.9 73 97.7 ...
#>  $ area_mean        : num  464 346 373 385 712 ...
#>  $ smoothness_mean  : num  0.1028 0.0969 0.1077 0.1164 0.0796 ...
#>  $ compactness_mean : num  0.0698 0.1147 0.078 0.1136 0.0693 ...
#>  $ concavity_mean   : num  0.0399 0.0639 0.0305 0.0464 0.0339 ...
#>  $ points_mean      : num  0.037 0.0264 0.0248 0.048 0.0266 ...
#>  $ symmetry_mean    : num  0.196 0.192 0.171 0.177 0.172 ...
#>  $ dimension_mean   : num  0.0595 0.0649 0.0634 0.0607 0.0554 ...
#>  $ radius_se        : num  0.236 0.451 0.197 0.338 0.178 ...
#>  $ texture_se       : num  0.666 1.197 1.387 1.343 0.412 ...
#>  $ perimeter_se     : num  1.67 3.43 1.34 1.85 1.34 ...
#>  $ area_se          : num  17.4 27.1 13.5 26.3 17.7 ...
#>  $ smoothness_se    : num  0.00805 0.00747 0.00516 0.01127 0.00501 ...
#>  $ compactness_se   : num  0.0118 0.03581 0.00936 0.03498 0.01485 ...
#>  $ concavity_se     : num  0.0168 0.0335 0.0106 0.0219 0.0155 ...
#>  $ points_se        : num  0.01241 0.01365 0.00748 0.01965 0.00915 ...
#>  $ symmetry_se      : num  0.0192 0.035 0.0172 0.0158 0.0165 ...
#>  $ dimension_se     : num  0.00225 0.00332 0.0022 0.00344 0.00177 ...
#>  $ radius_worst     : num  13.5 11.9 12.4 11.9 16.2 ...
#>  $ texture_worst    : num  15.6 22.9 26.4 15.8 15.7 ...
#>  $ perimeter_worst  : num  87 78.3 79.9 76.5 104.5 ...
#>  $ area_worst       : num  549 425 471 434 819 ...
#>  $ smoothness_worst : num  0.139 0.121 0.137 0.137 0.113 ...
#>  $ compactness_worst: num  0.127 0.252 0.148 0.182 0.174 ...
#>  $ concavity_worst  : num  0.1242 0.1916 0.1067 0.0867 0.1362 ...
#>  $ points_worst     : num  0.0939 0.0793 0.0743 0.0861 0.0818 ...
#>  $ symmetry_worst   : num  0.283 0.294 0.3 0.21 0.249 ...
#>  $ dimension_worst  : num  0.0677 0.0759 0.0788 0.0678 0.0677 ...

❓ Variabel target: diagnosis

B = Benign M = Malignant

Data Wrangling

Sesuaikan tipe data

# unique(wbcd$diagnosis)
wbcd_clean <- wbcd %>% 
  select(-id) %>% 
  mutate(diagnosis = ifelse(diagnosis == "B", "Benign", "Malignant"),
         diagnosis = as.factor(diagnosis))
  
wbcd_clean

Exploratory Data Analysis

  • cek proporsi kelas
prop.table(table(wbcd_clean$diagnosis))
#> 
#>    Benign Malignant 
#> 0.6274165 0.3725835

Insight: datanya masih cukup balance

  • cek range nilai tiap variable prediktor: range harus sama karena knn mengklasifikasikan berdasarkan jarak. kalau ada nilai yang tinggi sendiri dibanding yang lain, maka variable tersebut akan sangat mempengaruhi hasil klasifikasi dan mengabaikan variable yang lain.
# cek range nilai tiap variable
summary(wbcd_clean)
#>      diagnosis    radius_mean      texture_mean   perimeter_mean  
#>  Benign   :357   Min.   : 6.981   Min.   : 9.71   Min.   : 43.79  
#>  Malignant:212   1st Qu.:11.700   1st Qu.:16.17   1st Qu.: 75.17  
#>                  Median :13.370   Median :18.84   Median : 86.24  
#>                  Mean   :14.127   Mean   :19.29   Mean   : 91.97  
#>                  3rd Qu.:15.780   3rd Qu.:21.80   3rd Qu.:104.10  
#>                  Max.   :28.110   Max.   :39.28   Max.   :188.50  
#>    area_mean      smoothness_mean   compactness_mean  concavity_mean   
#>  Min.   : 143.5   Min.   :0.05263   Min.   :0.01938   Min.   :0.00000  
#>  1st Qu.: 420.3   1st Qu.:0.08637   1st Qu.:0.06492   1st Qu.:0.02956  
#>  Median : 551.1   Median :0.09587   Median :0.09263   Median :0.06154  
#>  Mean   : 654.9   Mean   :0.09636   Mean   :0.10434   Mean   :0.08880  
#>  3rd Qu.: 782.7   3rd Qu.:0.10530   3rd Qu.:0.13040   3rd Qu.:0.13070  
#>  Max.   :2501.0   Max.   :0.16340   Max.   :0.34540   Max.   :0.42680  
#>   points_mean      symmetry_mean    dimension_mean      radius_se     
#>  Min.   :0.00000   Min.   :0.1060   Min.   :0.04996   Min.   :0.1115  
#>  1st Qu.:0.02031   1st Qu.:0.1619   1st Qu.:0.05770   1st Qu.:0.2324  
#>  Median :0.03350   Median :0.1792   Median :0.06154   Median :0.3242  
#>  Mean   :0.04892   Mean   :0.1812   Mean   :0.06280   Mean   :0.4052  
#>  3rd Qu.:0.07400   3rd Qu.:0.1957   3rd Qu.:0.06612   3rd Qu.:0.4789  
#>  Max.   :0.20120   Max.   :0.3040   Max.   :0.09744   Max.   :2.8730  
#>    texture_se      perimeter_se       area_se        smoothness_se     
#>  Min.   :0.3602   Min.   : 0.757   Min.   :  6.802   Min.   :0.001713  
#>  1st Qu.:0.8339   1st Qu.: 1.606   1st Qu.: 17.850   1st Qu.:0.005169  
#>  Median :1.1080   Median : 2.287   Median : 24.530   Median :0.006380  
#>  Mean   :1.2169   Mean   : 2.866   Mean   : 40.337   Mean   :0.007041  
#>  3rd Qu.:1.4740   3rd Qu.: 3.357   3rd Qu.: 45.190   3rd Qu.:0.008146  
#>  Max.   :4.8850   Max.   :21.980   Max.   :542.200   Max.   :0.031130  
#>  compactness_se      concavity_se       points_se         symmetry_se      
#>  Min.   :0.002252   Min.   :0.00000   Min.   :0.000000   Min.   :0.007882  
#>  1st Qu.:0.013080   1st Qu.:0.01509   1st Qu.:0.007638   1st Qu.:0.015160  
#>  Median :0.020450   Median :0.02589   Median :0.010930   Median :0.018730  
#>  Mean   :0.025478   Mean   :0.03189   Mean   :0.011796   Mean   :0.020542  
#>  3rd Qu.:0.032450   3rd Qu.:0.04205   3rd Qu.:0.014710   3rd Qu.:0.023480  
#>  Max.   :0.135400   Max.   :0.39600   Max.   :0.052790   Max.   :0.078950  
#>   dimension_se        radius_worst   texture_worst   perimeter_worst 
#>  Min.   :0.0008948   Min.   : 7.93   Min.   :12.02   Min.   : 50.41  
#>  1st Qu.:0.0022480   1st Qu.:13.01   1st Qu.:21.08   1st Qu.: 84.11  
#>  Median :0.0031870   Median :14.97   Median :25.41   Median : 97.66  
#>  Mean   :0.0037949   Mean   :16.27   Mean   :25.68   Mean   :107.26  
#>  3rd Qu.:0.0045580   3rd Qu.:18.79   3rd Qu.:29.72   3rd Qu.:125.40  
#>  Max.   :0.0298400   Max.   :36.04   Max.   :49.54   Max.   :251.20  
#>    area_worst     smoothness_worst  compactness_worst concavity_worst 
#>  Min.   : 185.2   Min.   :0.07117   Min.   :0.02729   Min.   :0.0000  
#>  1st Qu.: 515.3   1st Qu.:0.11660   1st Qu.:0.14720   1st Qu.:0.1145  
#>  Median : 686.5   Median :0.13130   Median :0.21190   Median :0.2267  
#>  Mean   : 880.6   Mean   :0.13237   Mean   :0.25427   Mean   :0.2722  
#>  3rd Qu.:1084.0   3rd Qu.:0.14600   3rd Qu.:0.33910   3rd Qu.:0.3829  
#>  Max.   :4254.0   Max.   :0.22260   Max.   :1.05800   Max.   :1.2520  
#>   points_worst     symmetry_worst   dimension_worst  
#>  Min.   :0.00000   Min.   :0.1565   Min.   :0.05504  
#>  1st Qu.:0.06493   1st Qu.:0.2504   1st Qu.:0.07146  
#>  Median :0.09993   Median :0.2822   Median :0.08004  
#>  Mean   :0.11461   Mean   :0.2901   Mean   :0.08395  
#>  3rd Qu.:0.16140   3rd Qu.:0.3179   3rd Qu.:0.09208  
#>  Max.   :0.29100   Max.   :0.6638   Max.   :0.20750

Range tiap variabel berbeda sehingga perlu dilakukan feature rescaling di tahap data pre-processing.

Scaling

Scaling: menyamaratakan range variable prediktor

Scaling bisa menggunakan min-max normalization atau z-score standarization.

  1. Min-Max Normalization
  • Nilai yang dimanfaatkan adalah nilai min dan max
  • Rumus = x-min(x) / max(x)-min(x)
  • digunakan ketika kita tahu range pasti dari data
normalize <- function(x){
  return ( 
    (x - min(x))/(max(x) - min(x)) 
           )
}
# contoh:
normalize(c(1,2,3,4,5)) # memampatkan range nilai menjadi 0-1
#> [1] 0.00 0.25 0.50 0.75 1.00
  • kapan kita menggunakan min-max normalization?
    • ketika kita tahu nilai pasti dari range data kita / range-nya sudah fix
  1. Z-score Standarization
  • Mengandalkan nilai mean (rata-rata) dan sd
  • Rumus = (x-mean)/sd
  • Menggunakan fungsi scale()
  • digunakan ketika kita tidak tahu range pasti dari data
# contoh:
cth <- scale(c(1,2,3,4,5)) # data kita seberapa menyimpang (sd) dari pusatnya (mean)
scale(7, center = 3, scale = 1.581139)
#>          [,1]
#> [1,] 2.529822
#> attr(,"scaled:center")
#> [1] 3
#> attr(,"scaled:scale")
#> [1] 1.581139

Pada workflow machine learning, di tahap apa scaling dilakukan? ketika sudah dilakukan cross validation, yang di scaling pertama adalah data training. setelah itu informasi hasil scaling data training digunakan untuk melakukan scaling pada data testing. [ ] data yang sudah diolah pada data wrangling (keseluruhan data secara langsung) [ ] data training dan data testing menggunakan informasi masing masing
[X] data training, lalu informasi scaling di data training digunakan untuk scaling data testing

Note: untuk 1 data harus menggunakan 1 tipe scaling yang sama

Cross Validation

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

# index sampling
index <- sample(x = nrow(wbcd_clean),
                size = 0.8*nrow(wbcd_clean))

# splitting
wbcd_train <- wbcd_clean[index,]
wbcd_test <- wbcd_clean[-index,]
# recheck class balance
prop.table(table(wbcd_train$diagnosis))
#> 
#>    Benign Malignant 
#> 0.6307692 0.3692308

Insight: proporsi data setelah di cross validation tidak berbeda jauh dengan proporsi data awal (masih cukup balance)

Data Pre-processing

Untuk k-NN, dipisahkan antara prediktor dan label (target variabelnya).

library(dplyr)
# prediktor
wbcd_train_x <- select(wbcd_train, -diagnosis)
wbcd_test_x <- select(wbcd_test, -diagnosis)

# target (bentuknya harus vector)
wbcd_train_y <- wbcd_train[,"diagnosis"]
wbcd_test_y <- wbcd_test[,"diagnosis"]

Data prediktor akan discaling menggunakan z-score standarization. Data test juga harus discaling menggunakan parameter dari data train (karena menganggap data test adalah unseen data).

  • fungsi scale terdiri dari beberapa parameter
    • x = object yang ingin di scaling
    • center = nilai rata-rata/mean (diambil dari nilai center pada data train yang sudah discale)
    • scale = nilai standar deviasi (diambil dari nilai sd pada data train yang sudah discale)
# scaling data
wbcd_train_x_scale <- scale(x = wbcd_train_x)
wbcd_test_x_scale <- scale(x = wbcd_test_x,
                           center = attr(wbcd_train_x_scale,"scaled:center"),
                           scale = attr(wbcd_train_x_scale,"scaled:scale"))

k-NN tidak membuat model sehingga langsung ke predict.

Predict

# find optimum k
sqrt(nrow(wbcd_train))
#> [1] 21.33073

Target 2 kelas: B - Benign M - Malignant

Fungsi knn() tidak melakukan build model melainkan langsung memprediksi data train. Parameter pada fungsi knn(): - train : data train, prediktor, yang sudah discaling, tipe numerik - test : data test, prediktor, yang sudah discaling, tipe numerik - cl : data train, label (target) aktual (kategorikal) - k : jumlah k yang ditentukan dari nilai sqrt(nrow(data))

library(class) # package untuk fungsi `knn()`

wbcd_pred <- knn(train = wbcd_train_x_scale,
                 test = wbcd_test_x_scale,
                 cl = wbcd_train_y,
                 k = 21)

# cek hasil prediksi
head(wbcd_pred)
#> [1] Benign    Malignant Benign    Malignant Benign    Benign   
#> Levels: Benign Malignant

Model evaluation

# confusion matrix
library(caret)

confusionMatrix(data = wbcd_pred,
                reference = wbcd_test_y,
                positive = "Malignant")
#> Confusion Matrix and Statistics
#> 
#>            Reference
#> Prediction  Benign Malignant
#>   Benign        70         2
#>   Malignant      0        42
#>                                              
#>                Accuracy : 0.9825             
#>                  95% CI : (0.9381, 0.9979)   
#>     No Information Rate : 0.614              
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.9627             
#>                                              
#>  Mcnemar's Test P-Value : 0.4795             
#>                                              
#>             Sensitivity : 0.9545             
#>             Specificity : 1.0000             
#>          Pos Pred Value : 1.0000             
#>          Neg Pred Value : 0.9722             
#>              Prevalence : 0.3860             
#>          Detection Rate : 0.3684             
#>    Detection Prevalence : 0.3684             
#>       Balanced Accuracy : 0.9773             
#>                                              
#>        'Positive' Class : Malignant          
#>

Resiko: FN - diprediksi tidak ganas ternyata ganas -> orang dengan kanker tidak terdeteksi (perkembangan kankernya lebih cepat) FP - diprediksi ganas ternyata tidak ganas -> treatment untuk kanker padahal tidak terlalu dibutuhkan

Kesimpulannya: gunakan recall sebagai metrics

Logistic Regression & k-NN Comparation

Inclass Questions

  1. apa maksud dari degrees of freedom di summary model glm?