ML: Classification

Dalam machine learning dan statistik, classification / klasifikasi adalah bentuk pendekatan supervised learning untuk memprediksi label dari suatu data dengan tipe kategorikal. Hal ini berbeda dengan regresi dimana label atau targetnya adalah data dengan tipe numerik.

klasifikasi: - variabel target: kategorik - variabel prediktor: kategorik dan/atau numerik

Contoh prediksi:
- Spam/no spam?
- Loan default/no default?
- Customer churn/non churn?
- …
- Yes/no?
- 1/0? (Positive/Negative?)

Logistic Regression

Logistic Regression adalah algoritma untuk kasus klasifikasi yang digunakan untuk melakukan fitting kurva regresi, y=f(x), di mana y adalah variabel kategorik. Kita bisa katakan bahwa Logistic Regression adalah kasus spesial dari Linear Regression.

Linear Regression vs Logistic Regression

Ide dari logistic regression mulanya berangkat dari model linear regression. Bedanya:
- Linear regression: digunakan untuk memprediksi angka kontinyu dengan range -Inf to Inf
- Logistic regression: digunakan untuk memprediksi probability dengan range: 0 to 1.

Berikut adalah fungsi linear regression :

\[y = b_0 + b_1x_1\]

Untuk mendapatkan persamaan dari logistic regression, kita hanya perlu mengganti y dengan log of odds

\[log(\frac{p}{1-p}) = b_0 + b_1x_1 \] \[p= \frac{1}{1+e^{-y}}=\frac{1}{1+e^{-(b_0 + b_1x_1)}}\]

Basic Intuition

Probability

Pada dasarnya, ketika kita melakukan klasifikasi, kita akan menghitung peluang. Tidak seperti Linear Regression yang menghitung targetnya secara langsung, logistic regression akan menghitung peluang suatu target itu berada pada kategori tertentu.

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

Contoh:

Saat H-2 Lebaran, terdapat 100 penerbangan di Soekarno-Hatta airport, dari 100 penerbangan tersebut, terdapat 20 penerbangan delay. Berapakah peluang suatu penerbangan delay di Soekarno-Hatta?

p_delay <- 20/100
p_delay
#> [1] 0.2

Peluang penerbangan tidak delay (on time)

p_ot <- 80/100
p_ot
#> [1] 0.8

Odds

Odds merupakan bentuk lain dari peluang, yaitu perbandingan antara peluang kejadian terjadi(biasanya kejadian yang diinginkan)/probabilitas kejadian tidak terjadi(biasanya kejadian yang tidak diinginkan).

\[odds = \frac{P(yes)}{1-P(yes)} = \frac{P(yes)}{P(no)}\]

Contoh:

Dari contoh problem sebelumnya. Berapa odds penerbangan terbang tepat waktu??

# odds on time
odds_ot <- p_ot/p_delay
odds_ot
#> [1] 4

✏️ Interpretasi: Kejadian penerbangan tepat waktu itu 4 kali lebih mungkin dibandingkan dengan kejadian penerbangan delay

Berapa range nilai dari odds?

# min
p <- 0
p/(1-p)
#> [1] 0
# max
p <- 1
p/(1-p)
#> [1] Inf
  • Peluang: [0,1]
  • Odds: [0,inf]

Log of Odds

Log of odds adalah nilai odds yang dilogaritmikan.

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

Berapakah log(odds) dari penerbangan tepat waktu?

log_odds_ot <- log(odds_ot)
log_odds_ot
#> [1] 1.386294

Nilai log of odds tidak bisa diinterpretasikan. Log of Odds dihasilkan oleh Logistic Regression. Nilai log of odds dapat diubah ke bentuk odds dan peluang sehingga dapat digunakan untuk klasifikasi.

💭 Discussion: Bagaimana cara untuk mengubah nilai log(odds) ke peluang?

log(odds) -> odds

odds <- exp(log_odds_ot)

odds -> peluang

\[p = \frac{odds}{1+odds}\]

odds/(odds+1)
#> [1] 0.8

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 mampu menjembatani antara nilai yang dihasilkan oleh model regresi, ke rentang nilai peluang.

Logit dan Inverse Logit

Terdapat cara lain:

  • logit(): peluang -> log of odds
  • inv.logit(): log of odds -> peluang
library(gtools)

# log_odds_ot = logit(p_ot)
log_odds_ot
#> [1] 1.386294
logit(p_ot)
#> [1] 1.386294
# p_ot = inv.logit(log_odds_ot)
p_ot
#> [1] 0.8
inv.logit(log_odds_ot)
#> [1] 0.8

Fungsi glm() & Interpretasi

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

Load Data

library(dplyr)
# 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
anyNA(honors)
#> [1] FALSE

Data Wrangling

cek struktur data, kolom mana yang memiliki tipe data belum tepat

# Ubah tipe data
honors <- honors %>% 
  mutate(
female = as.factor(female),
hon = as.factor(hon)
)
glimpse(honors)
#> Rows: 200
#> Columns: 5
#> $ female <fct> 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    <fct> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, …

Build Model

📌 Cara membuat model Logistic Regression

Gunakan fungsi glm(), dengan parameter:

  • formula : tempat mendefinisikan target dan predictor (y~x)
  • data : data yang digunakan untuk membuat model
  • family : “binomial”

Tanpa Prediktor

model_null <- glm(formula = hon~1,
                  data = honors,
                  family = "binomial")
summary(model_null)
#> 
#> Call:
#> glm(formula = hon ~ 1, family = "binomial", data = honors)
#> 
#> 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

📈 Informasi coefficients:

Intercept: -1.1255 -> log of odds dari target variabel(honors=1)

Berikut pembuktiannya:

# Jumlah honor=1 dan honor=0
table(honors$hon)
#> 
#>   0   1 
#> 151  49
(49/200)/(151/200)
#> [1] 0.3245033
# probability student honors
49/(151+49)
#> [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 atau peluang.

# log of odds -> odds
exp(-1.12546)
#> [1] 0.3245032
# log of odds -> probability 
inv.logit(-1.12546)
#> [1] 0.2449999

📈 Interpretasi odds: - kejadian student untuk lulus mendapatkan honors itu 0.32 kali lebih mungkin dibandingkan tidakk mendapatkan honors

📈 Interpretasi peluang: - peluang student untuk lulus mendapatkan honors itu adalah 0.24

Satu Prediktor Kategorik

❓Buat model untuk memprediksi honors berdasarkan gender female:

model_f <- glm(formula = hon~female,
               data = honors,
               family = "binomial")
  
summary(model_f)
#> 
#> Call:
#> glm(formula = hon ~ female, family = "binomial", data = honors)
#> 
#> 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

y = mx +c y = 0.5928x + -1.4709

✏️ Informasi Coefficients:

  • Intercept: -1.4709 -> log of odds student laki-laki mendapatkan honors (female=0)

  • female1: 0.5928 -> log of odds ratio student female mendapatkan honors dibandingkan dengan student male mendapatkan honors

📈 Interpretasi:

Odds:

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

5:1 1:1

  • Kejadian student female mendapatkan honors 1,8 KALI lebih mungkin dibandingkan student male mendapatkan honors

Peluang:

Misalkan student pertama adalah seorang wanita, berapa probability dia mendapat honors?

formula: log_odd_hon = b0 + b1*female

formula: log_odd_hon = -1.4709 + 0.5928*female

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

# log of odds -> probability
inv.logit(log_odds_f)
#> [1] 0.2935717
  • peluang student perempuan mendapatkan honors adalah 0.2935717

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

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

# log of odds -> probability
inv.logit(log_odds_m)
#> [1] 0.1868059
  • peluang student pria mendapatkan honors adalah 0.1868059

⚙️ [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
exp(log(o_female/o_male))
#> [1] 1.809015

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

log(o_male)
#> [1] -1.470852

Satu Prediktor Numerik

Buat model untuk memprediksi honors berdasarkan nilai math:

model_math <- glm(hon~math,
                  data = honors,
                  family = "binomial")

summary(model_math)
#> 
#> Call:
#> glm(formula = hon ~ math, family = "binomial", data = honors)
#> 
#> 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

✏️ Informasi Coefficients:

  • Intercept: log of odds ketika nilai math = 0
  • Math: 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.

Contoh:

log_odds_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
log_odds_hon52 <-  -9.79394 +  0.15634  * 52
log_odds_hon53 <-  -9.79394 +  0.15634  * 53

log_odds_hon53-log_odds_hon52
#> [1] 0.15634
exp(log_odds_hon53-log_odds_hon52)
#> [1] 1.169224
exp(log_odds_hon52)
#> [1] 0.1893307
exp(log_odds_hon52)*exp(log_odds_hon53-log_odds_hon52)
#> [1] 0.2213699
exp(log_odds_hon53)
#> [1] 0.2213699
  • kejadian student yang memiliki nilai math sebesar 53 mendapat honor 1.169224 kali lebih mungkin dibanding student yang memiliki nilai math sebesar 52

💡 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

Lebih dari 1 Prediktor

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

  1. Interpretasi dari coefficient yang diperoleh

  2. Diva memperoleh nilai math sebesar 70, berapa peluang Diva mendapatkan honors?

  3. Yusraf memperoleh nilai math sebesar 60, berapa peluang Yusraf mendapatkan honors?

💡 Hints:

  1. Membuat model
  2. Interpretasi coefficient
  3. Prediksi secara manual
model_fm <- glm(formula = hon ~ female + math,
                data = honors,
                family = "binomial")

summary(model_fm)
#> 
#> Call:
#> glm(formula = hon ~ female + math, family = "binomial", data = honors)
#> 
#> 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

✏️ Informasi Coefficients:

  1. Intercept: log of odds student mandapatkan honors ketika student memiliki nilai math=0 dengan gender male (female=0)
  2. math:
  • Slope bernilai positif: meningkatkan probability ke target kita (dalam kasus ini lulus honors)
  1. female1:
  • Slope bernilai positif: meningkatkan probability ke target kita (dalam kasus ini lulus honors)

📈 Interpretasi koefisien:

cari odds dari masing masing predictor:

# odds koefisien female dan math
exp(model_fm$coefficients)
#>   (Intercept)       female1          math 
#> 0.00002027841 2.62560049264 1.17847586504

female = 2.63

Kejadian student female mendapatkan honors 2.63 KALI lebih mungkin dibandingkan student male mendapatkan honors, dengan syarat variable lain memiliki nilai yang sama.

math = 1.18

Setiap kenaikan 1 poin di math akan meningkatkan kemungkinan student lulus dengan honors sebesar 1.18 KALI, dengan syarat variable lain memiliki nilai yang sama.

📝 Notes:

  • Yang dimaksud dengan “variable lain memiliki nilai yang sama”
    • perubahan nilai math dengan variabel female yang sama dan write = 67 , contoh:
      • Diva : F | 87 | 67
      • Kinan: F | 88 | 67
    • perubahan variabel female dengan nilai math yang sama, contoh:
      • Diva : F | 87
      • Yusraf: M | 87
  1. Diva memperoleh nilai math sebesar 70, berapa peluang Diva mendapatkan honors?
hon_diva <- inv.logit(-10.80595 + 0.96531*1 +0.16422*70)
hon_diva
#> [1] 0.8395333
  1. Yusraf memperoleh nilai math sebesar 60, berapa peluang Yusraf mendapatkan honors?
hon_yusraf <- inv.logit(-10.80595 + 0.96531*0 +0.16422*60)
hon_yusraf
#> [1] 0.2783321

⚙️ Pengaplikasian pada Klasifikasi:

prob_dd <- c(hon_diva,hon_yusraf)
prob_dd
#> [1] 0.8395333 0.2783321

Convert peluang ke kategorik dengan fungsi ifelse() dengan parameter

  • test: kondisi yang diuji
  • yes : hasil jika kondisi terpenuhi
  • no : hasil jika kondisi tidak terpenuhi
# ifelse()
ifelse( test = prob_dd >= 0.5,
        yes  = 1,
        no   = 0)
#> [1] 1 0
hon_tyo = inv.logit(-10.80595 + 0.96531*0 +0.16422*89)
hon_tyo
#> [1] 0.9783239
ifelse( test = hon_tyo >= 0.5,
        yes  = 1,
        no   = 0)
#> [1] 1

📍 Additional! Apa yang harus dilakukan Yusraf agar ia dapat lulus dengan predikat honors?

Jawab:

  • prob minimum agar diklasifikasikan kelas hon = 1 adalah 0.5
  • maka odds minimum = 0.5/(1-0.5) = 1
  • maka log of odds minimum = log(1) = 0
  • maka untuk memperoleh nilai math minimum kita gunakan persamaan
    • \(-10.8059538 + 0.9653096*0 + 0.1642220*math = 0\)
    • \(0.1642220*math = 10.8059538\)
    • \(math = 10.8059538/0.1642220\)
10.8059538/0.1642220
#> [1] 65.80089

agar Yuraf lulus dengan honors, yusraf perlu mendapatkan nilai math minimal 66

hon_yus2 <- inv.logit(-10.8059538 + 0.9653096*0 +  0.1642220*66)
hon_yus2
#> [1] 0.5081738
ifelse( test = hon_yus2 >= 0.5,
        yes =  1,
        no =  0)
#> [1] 1

Null & Residual Deviance

summary(model_fm)
#> 
#> Call:
#> glm(formula = hon ~ female + math, family = "binomial", data = honors)
#> 
#> 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 deviance: menunjukkan error model tanpa prediktor
  • Residual deviance: menunjukkan error model dengan prediktor

Pilih model dengan nilai residual deviance paling rendah.

# residual deviance
model_null$deviance # wo/ predictor
#> [1] 222.71
model_f$deviance # w/ female
#> [1] 219.6062
model_math$deviance # w/ math
#> [1] 167.0732
model_fm$deviance # w/ female + math
#> [1] 161.3454

nilai deviance tidak bisa di interpretasikan secara langsung, nilai ini harus dibandingkan dengan model_null atau model lainnya.

Reference: https://bookdown.org/egarpor/SSS2-UC3M/logreg-deviance.html


Selanjutnya kita akan coba membuat model honors menggunakan semua variabel prediktor:

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)
#> 
#> Coefficients:
#>                 Estimate   Std. Error z value Pr(>|z|)
#> (Intercept)  -2176.87191 282900.61004  -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 yang aneh dari model_all?

🧐 Cek proporsi nilai write terhadap variabel 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

Ketika nilai write < 61, maka honors = 0 dan ketika write >=61, maka honors = 1. Variabel write membagi kelas target secara sempurna, sehingga variabel ini disebut perfect separator.

📝 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 algoritma tidak mencapai kondisi stabil hingga iterasi ke-25 (default max), salah satu penyebabnya adalah adanya kondisi perfect separation.

Perfect Separation

Perfect Separation adalah sebuah kondisi ketika ada 1 variabel yang dapat memisahkan kelas target secara sempurna. Pada kasus ini nilai write dapat memisahkan kelas hon dengan baik.

💡 Ada 2 hal yang dapat kita lakukan

  1. Jika kita mau menggunakan variabel ini, tidak usah membuat model machine learning, cukup ifelse saja

  2. Jika tidak mau menggunakan variabel ini, maka jangan gunakan variabel ini sebagai predictor

🔎 Untuk mendeteksi ada atau tidaknya perfect separation:

  1. Ada nilai coefficient yang sangat besar

  2. P-value dari semua variabel cenderung tidak signifikan

  3. Nilai Residual Deviances mendekati 0

Membuat model tanpa variabel write

honors_no_write <- honors %>% 
  select(-write) #drop kolom write

model_no_w <-  glm(formula = hon ~ ., 
                   data = honors_no_write, 
                   family = "binomial")
summary(model_no_w)
#> 
#> Call:
#> glm(formula = hon ~ ., family = "binomial", data = honors_no_write)
#> 
#> 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

AIC

AIC (Akaike Information Criterion) menggambarkan banyaknya informasi yang hilang dari suatu model. Semakin kecil AIC, semakin sedikit informasi yang hilang.

model_null$aic # wo/ predictor
#> [1] 224.71
model_f$aic # w/ female
#> [1] 223.6062
model_math$aic # w/ math
#> [1] 171.0732
model_fm$aic # w/ female + math
#> [1] 167.3454
model_no_w$aic # wo/ write
#> [1] 164.1696

Assumption

Logistic Regression menganut 3 asumsi:

  1. 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)

  2. Independence of Observations: antar observasi saling independen & tidak berasal dari pengukuran berulang (repeated measurement).

  3. Multicollinearity: antar prediktor tidak saling berkorelasi terlalu kuat (hingga nilai 1 / -1) -> uji vif() dari library car

Untuk lebih memahami bagian asumsi, berikut data penerbangan pesawat dalam flight_sm.csv

flight <- read.csv("data_input/flight_sm.csv")
head(flight)

Dekspripsi kolom:

  • Year, Month, DayofMonth, DayofWeek: self-explanatory
  • Carrier: maskapai
  • CRSDepTime & CRSArrTime: jadwal departure & arrival (hhmm)
  • DepDel15: status delay (1 = delay)
  • OriginState, DestState: lokasi keberangkatan & tujuan

💬 Discussion: Buat model flight_model untuk memprediksi DepDel15 berdasarkan Month dan DayofWeek, kemudian interpretasikan koefisien2nya!

flight_model <- glm(DepDel15 ~ Month + DayofWeek, data = flight, family = "binomial")
summary(flight_model)
#> 
#> Call:
#> glm(formula = DepDel15 ~ Month + DayofWeek, family = "binomial", 
#>     data = flight)
#> 
#> Coefficients:
#>              Estimate Std. Error z value             Pr(>|z|)    
#> (Intercept) -0.935641   0.013900 -67.312 < 0.0000000000000002 ***
#> Month       -0.060895   0.001718 -35.454 < 0.0000000000000002 ***
#> DayofWeek   -0.004576   0.001710  -2.676              0.00744 ** 
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 541635  on 538362  degrees of freedom
#> Residual deviance: 540365  on 538360  degrees of freedom
#> AIC: 540371
#> 
#> Number of Fisher Scoring iterations: 4

Interpretasi koefisien tiap variabel

# Month
exp(flight_model$coefficients[2])
#>     Month 
#> 0.9409219
# DayofWeek
exp(flight_model$coefficients[3])
#> DayofWeek 
#> 0.9954342
  • Kejadian delay akan 0.94 KALI lebih mungkin terjadi untuk pesawat yang terbang di bulan setelahnya (Jan > Feb > … > Des)
  • Kejadian delay akan 0.995 KALI lebih mungkin terjadi untuk pesawat yang terbang di hari setelahnya (Senin > Selasa > … > Minggu)

Bukankah ini suatu logical fallacy?

Inilah bentuk model tidak memenuhi asumsi Linearity of Predictor & Log of Odds.

❓ Apa yang harus dilakukan untuk memperbaiki model?

flight$Month <- as.factor(flight$Month)
flight$DayofWeek <- as.factor(flight$DayofWeek)

# pembuatan model baru
flight_model2 <- glm(DepDel15 ~ Month + DayofWeek, data = flight, family = "binomial")
summary(flight_model2)
#> 
#> Call:
#> glm(formula = DepDel15 ~ Month + DayofWeek, family = "binomial", 
#>     data = flight)
#> 
#> Coefficients:
#>             Estimate Std. Error  z value             Pr(>|z|)    
#> (Intercept) -1.34623    0.01196 -112.608 < 0.0000000000000002 ***
#> Month5      -0.10637    0.01292   -8.235 < 0.0000000000000002 ***
#> Month6       0.35314    0.01222   28.899 < 0.0000000000000002 ***
#> Month7       0.23991    0.01225   19.585 < 0.0000000000000002 ***
#> Month8      -0.01661    0.01270   -1.308                0.191    
#> Month9      -0.36450    0.01382  -26.368 < 0.0000000000000002 ***
#> Month10     -0.32892    0.01351  -24.350 < 0.0000000000000002 ***
#> DayofWeek2  -0.16516    0.01275  -12.954 < 0.0000000000000002 ***
#> DayofWeek3  -0.05737    0.01251   -4.586      0.0000045233803 ***
#> DayofWeek4   0.22770    0.01206   18.879 < 0.0000000000000002 ***
#> DayofWeek5   0.13083    0.01224   10.690 < 0.0000000000000002 ***
#> DayofWeek6  -0.29298    0.01384  -21.172 < 0.0000000000000002 ***
#> DayofWeek7  -0.08550    0.01280   -6.677      0.0000000000243 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 541635  on 538362  degrees of freedom
#> Residual deviance: 534556  on 538350  degrees of freedom
#> AIC: 534582
#> 
#> Number of Fisher Scoring iterations: 4

Insight:

  • Month ke-6 dan Month ke-7 memiliki kemungkinan paling tinggi untuk Delay