Klasifikasi Level Obesitas Berdasarkan Pola Hidup dan Kondisi Fisik Menggunakan Model Logistic Regression dan K-Nearest Neighbors

by Delvia

1. Introduction

1.1 Latar Belakang

Overweight dan obesitas merupakan faktor resiko utama penyakit kronis, seperti penyakit kardiovaskular yakni penyakit jantung dan stroke yang menjadi penyebab utama kematian di dunia. Overweight juga dapat berkembang menjadi penyakit diabetes yang seperti diketahui bahwa penyakit ini dapat menyebabkan kebutaan, amputasi kaki akibat luka (wound ulcer) dan dialisis (cuci darah) akibat komplikasi gagal ginjal. Overweight juga dapat menyebabkan gangguan pada otot dan sendi seperti osteoartritis yang tentunya hal ini akan menyebabkan berkurangnya kualitas produktif seseorang. Obesitas dapat menyebabkan berbagai gangguan lainnya seperi pada endometrium, payudara, ovarium, prostat, liver (hati), kandung kemih, ginjal dan usus.

Diambil dari laman WHO, obesitas telah berkembang menjadi endemi, dimana lebih dari 4 juta orang meninggal setiap tahun akibat overweight dan obesitas pada tahun 2017. Lju overweight dan obesitas terus mengalami perkembangan pada anak-anak dan orang dewasa. Dari tahun 1975 sampai 2016, prevalensi overweight dan obesitas secara global pada anak dan remaja umur 5-19 tahun telah meningkat empat kali lipat dari semula 4% menjadi 18%. Pada awalnya, overweight dan obesitas dianggap sebagai masalah hanya di negara berpenghasilan tinggi (negara maju), namun justru sekarang menjadi masalah di negara berpenghasilan rendah dan menengah, terutama di perkotaan. Sebagian besar anak yang overweight atau obesitas tinggal di negara berkembang, di mana peningkatannya 30% lebih tinggi dibandingkan negara maju.

1.2 Tujuan

Membuat dan mengevaluasi model klasifikasi logistik regression level obesitas berdasarkan pola hidup dan kondisi fisik Membuat dan mengevaluasi model K–Nearest Neighbors Membandingkan model logistic regression dan K-Nearesr Neighbors

2. Metode Penelitian

2.1 Data

Data yang digunakan pada pemodelan ini dapat diakses pada Kaggle. Berdasarkan referensi tersebut, diketahui bahwa dataset ini dibuat untuk tujuan memperkirakan level obesitas seseorang berdasarkan kebiasaan makan dan kondisi fisiknya. Penelitian ini diadakan di negara Mexico, Peru dan Colombia yang merupakan bagian dari region Amerika. Data ini terdiri dari 17 variabel dan 2111 rows, dimana level obesitas dirangkum dalam kolom NObeyesdad yang dibagi menjadi 7 level yaitu: Insufficient Weight, Normal Weight, Overweight Level I, Overweight Level II, Obesity Type I, Obesity Type II and Obesity Type III. Sebanyak 77% data disintesis menggunakan Weka tool dan filter SMOTE, 23% data dikumpulkan secara langsung dari user menggunakan web platform. Data ini dapat digunakan untuk kegunaan komputasi intelligent dalam mengidentifikasi level obesitas seseorang dan dapat menjadi rekomendasi dalam memonitor level obesitas.

2.2 Metode Analisis

Langkah-langkah yang dilakukan adalah:
* Melakukan data wrangling dan exploratory data analysis (EDA) dalam menyiapkan data
* Melakukan pembagian data menjadi data train untuk membentuk dan melatih model dan data test untuk menguji hasil prediksi model
* Melakukan pemodelan regresi logistic regression dan K-nearest neighbors
* Menginterpretasikan Model yang diperoleh
* Melakukan evaluasi model dengan menggunakan data train dan data test untuk pengujian kemudian membandingkan hasil evaluasi keduanya

3. Import Library

Berikut merupakan packages yang digunakan pada analisis data

library("RWeka")
library(dplyr)
library(gtools)
library(car)
library(caret)
library(haven)
library(nnet)
library(class)
library(rmdformats)
library(psych)
library(pracma)
library(ROCR)

4. Read Data

obesity <- read.arff("data input obesity/ObesityDataSet_raw_and_data_sinthetic.arff")
rmarkdown::paged_table(obesity)

5. Data Wrangling

Pada pemodelan klasifikasi ini, saya tidak akan menggunakan 7 level obesitas, karena ingin fokus terhadap overweight dan obesitas maka saya membagi level target NObeyesdad menjadi dua saja yakni No obes dan Overweight2-obes.

obesity$NObeyesdad <- as.numeric(as.factor(obesity$NObeyesdad))

# membagi variabel target menjadi dua kelas saja no obes dan Overweight2-obes
obesity_clean <- obesity %>% 
  mutate(NObeyesdad = as.factor(ifelse(NObeyesdad > 3, "Overweight2-obes", "No obes")))
glimpse(obesity_clean)
#> Rows: 2,111
#> Columns: 17
#> $ Gender                         <fct> Female, Female, Male, Male, Male, Male,…
#> $ Age                            <dbl> 21, 21, 23, 27, 22, 29, 23, 22, 24, 22,…
#> $ Height                         <dbl> 1.62, 1.52, 1.80, 1.80, 1.78, 1.62, 1.5…
#> $ Weight                         <dbl> 64.0, 56.0, 77.0, 87.0, 89.8, 53.0, 55.…
#> $ family_history_with_overweight <fct> yes, yes, yes, no, no, no, yes, no, yes…
#> $ FAVC                           <fct> no, no, no, no, no, yes, yes, no, yes, …
#> $ FCVC                           <dbl> 2, 3, 2, 3, 2, 2, 3, 2, 3, 2, 3, 2, 3, …
#> $ NCP                            <dbl> 3, 3, 3, 3, 1, 3, 3, 3, 3, 3, 3, 3, 3, …
#> $ CAEC                           <fct> Sometimes, Sometimes, Sometimes, Someti…
#> $ SMOKE                          <fct> no, yes, no, no, no, no, no, no, no, no…
#> $ CH2O                           <dbl> 2, 3, 2, 2, 2, 2, 2, 2, 2, 2, 3, 2, 3, …
#> $ SCC                            <fct> no, yes, no, no, no, no, no, no, no, no…
#> $ FAF                            <dbl> 0, 3, 2, 2, 0, 0, 1, 3, 1, 1, 2, 2, 2, …
#> $ TUE                            <dbl> 1, 0, 1, 0, 0, 0, 0, 0, 1, 1, 2, 1, 0, …
#> $ CALC                           <fct> no, Sometimes, Frequently, Frequently, …
#> $ MTRANS                         <fct> Public_Transportation, Public_Transport…
#> $ NObeyesdad                     <fct> No obes, No obes, No obes, No obes, Ove…

Description
- Gender : pria/wanita
- Age : usia
- Height : tinggi badan (m)
- Weight : berat badan (kg)
- family_history_with_overweight : ada/tidaknya riwayat keluarga penderita obesitas
- FAVC : sering menonsumsi makanan berkalori tinggi atau tidak food
- FCVC : jumlah berapa kali konsumsi sayuran dalam sehari
- NCP : jumlah makanan utama (makanan berat biasanya untuk lunch/dinner)
- CAEC : frekuensi konsumsi makanan ringan/nge-meal
- SMOKE : perokok/tidak
- CH2O : jumlah berapa liter air yang dikonsumsi dalam sehari
- SCC : apakah memonitoring jumlah kalori yang dikonsumsi atau tidak
- FAF : jumlah berapa jam melakukan aktivitas fisik dalam sehari
- TUE : berapa jam menggunakan gadget/komputer dalam sehari
- CALC : frekuensi mengonsumsi alkohol dalam sehari
- MTRANS : jenis transportasi yang digunakan apakah mobil/sepeda motor/motor/transportasi umum/berjalan
- NObeyesdad : level obesitas (Insufficient = 1, Normal = 2, Overweight I = 3, Overweight II = 4, Obes I = 5, Obes II = 6, Obes III = 7)
- BMI : indeks massa tubuh

Menghapus data duplikat

obesity_clean <- obesity_clean[!duplicated(obesity_clean),]

Inspeksi missing value

is.na(obesity_clean) %>% colSums()
#>                         Gender                            Age 
#>                              0                              0 
#>                         Height                         Weight 
#>                              0                              0 
#> family_history_with_overweight                           FAVC 
#>                              0                              0 
#>                           FCVC                            NCP 
#>                              0                              0 
#>                           CAEC                          SMOKE 
#>                              0                              0 
#>                           CH2O                            SCC 
#>                              0                              0 
#>                            FAF                            TUE 
#>                              0                              0 
#>                           CALC                         MTRANS 
#>                              0                              0 
#>                     NObeyesdad 
#>                              0

Business Insight

Kita perlu menghapus kolom Height dan Weight. Dari segi domain knowledge, tinggi dan berat badan merupakan faktor penentu untuk mengklasifikasikan level overweight/obesitas seseorang, sehingga tidak perlu parameter lain. Oleh karena itu, untuk menghindari bias pada model yang dibangun, maka kolom tersebut perlu untuk dihapus. Hal yang akan diprediksi adalah level obesitas NObeyesdad berdasarkan seluruh prediktor yang ada di dataset
* variable target (y): NObeyesdad
* variable prediktor (x): Gender, Age, family_history_with_overweight, FAVC, FCVC, NCP, CAEC, SMOKE, CH2O, SCC, FAF, TUE, CALC, MTRANS

# menghapus kolom height dan weight
obesity_clean <- obesity_clean[,-c(3,4)]
rmarkdown::paged_table(obesity_clean)

6. Exploratory Data Analysis (EDA)

Mari kita cek persebaran data numerik pada dataset

pairs.panels(obesity_clean[-c(1,5,6,8,11:13)])

Plot di atas menunjukkan visualisasi secara garis besar persebaran data seluruh variabel numerik pada dataset obesity_clean. Mari kita bedah satu per satu sebagai berikut.

summary(obesity_clean)
#>     Gender          Age        family_history_with_overweight  FAVC     
#>  Female:1035   Min.   :14.00   yes:1722                       yes:1844  
#>  Male  :1052   1st Qu.:19.92   no : 365                       no : 243  
#>                Median :22.85                                            
#>                Mean   :24.35                                            
#>                3rd Qu.:26.00                                            
#>                Max.   :61.00                                            
#>       FCVC            NCP                CAEC      SMOKE           CH2O      
#>  Min.   :1.000   Min.   :1.000   no        :  37   yes:  44   Min.   :1.000  
#>  1st Qu.:2.000   1st Qu.:2.697   Sometimes :1761   no :2043   1st Qu.:1.591  
#>  Median :2.396   Median :3.000   Frequently: 236              Median :2.000  
#>  Mean   :2.421   Mean   :2.701   Always    :  53              Mean   :2.005  
#>  3rd Qu.:3.000   3rd Qu.:3.000                                3rd Qu.:2.466  
#>  Max.   :3.000   Max.   :4.000                                Max.   :3.000  
#>   SCC            FAF              TUE                 CALC     
#>  yes:  96   Min.   :0.0000   Min.   :0.0000   no        : 636  
#>  no :1991   1st Qu.:0.1245   1st Qu.:0.0000   Sometimes :1380  
#>             Median :1.0000   Median :0.6309   Frequently:  70  
#>             Mean   :1.0128   Mean   :0.6630   Always    :   1  
#>             3rd Qu.:1.6781   3rd Qu.:1.0000                    
#>             Max.   :3.0000   Max.   :2.0000                    
#>                    MTRANS                NObeyesdad  
#>  Automobile           : 456   No obes         : 825  
#>  Motorbike            :  11   Overweight2-obes:1262  
#>  Bike                 :   7                          
#>  Public_Transportation:1558                          
#>  Walking              :  55                          
#> 
hist(obesity_clean$Age)

💡 Insight:
* Orang yang menjadi objek observasi pada dataset ini berada pada rentang umur 14 - 61 tahun, dan didominasi oleh umur 14-25 tahun

hist(obesity_clean$FCVC)

💡 Insight:
* Jumlah frekuensi konsumsi sayuran berada pada rentang 1 - 3 kali sehari, dimana frekuensi konsumsi 3 kali sehari adalah yang dominan

hist(obesity_clean$NCP)

💡 Insight:
* Jumlah makanan utama yang dikonsumsi dalam sehari berada pada rentang 1 - 4, dimana jumlah makanan utama 3 adalah yang dominan

hist(obesity_clean$CH2O)

💡 Insight:
* Jumlah air yang dikonsumsi berada pada rentang 1 - 3 liter/hari, dimana yang menjadi dominan adalah mengonsumsi 2 liter air/hari

hist(obesity_clean$FAF)

💡 Insight:

  • Aktivitas fisik/olahraga yang dilakukan dalam sehari berada pada rentang 0 - 3 jam/hari, dimana yang menjadi dominan adalah yang bernilai 0, artinya yang sama sekali tidak olahraga
hist(obesity_clean$TUE)

💡 Insight:

  • Waktu menggunakan gadget/komputer berada pada rentang 0 - 2 jam/hari, dimana yang menjadi dominan adalah yang bernilai 0, artinya yang sama sekali tidak menggunakannya.

7. Cross Validation

Cek class-imbalance

Cek Proporsi Variable target dari data secara keseluruhan

round(prop.table(table(obesity_clean$NObeyesdad)), digits=2)
#> 
#>          No obes Overweight2-obes 
#>              0.4              0.6

💡 Insight:
* Dari segi keseimbangan data, dapat dikatakan bahwa variable target dari data secara keseluruhan kita cukup seimbang

Variabel target kita terlihat memiliki proporsi kelas yang seimbang. Sebelum kita membangun model, kita harus memisahkan data menjadi data train dan test agar dapat memvalidasi performa model klasifikasi yang dibuat. Pisahkan data obesity_clean dengan pembagian proporsi 75% untuk data train dan 25% untuk data test. Tujuan dari cross validation adalah untuk mengetahui seberapa baik model untuk memprediksi unseen data.

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

index <- sample(x=nrow(obesity_clean),
                size=nrow(obesity_clean)*0.75)

obesity_train <- obesity_clean[index,]
obesity_test <- obesity_clean[-index,]

re-check proporsi data

prop.table(table(obesity_train$NObeyesdad))
#> 
#>          No obes Overweight2-obes 
#>        0.3961661        0.6038339

8. Model Logistik Regression

Model logistik regression adalah model klasifikasi yang digunakan untuk memprediksi probabilitas kelas tertentu berdasarkan variabel terikatnya (dalam hal ini adalah variabel target). Dalam praktiknya, algoritma logistik regression menganalisis hubungan antar variabel. Probabilitas digunakan untuk membedakan hasil akhir prediksi kelas target menggunakan fungsi sigmoid, dimana hasil numerik diubah menjadi probabilitas antara 0-1, tergantung pada apakah kejadian yang diharapkan terjadi atau tidak. Untuk prediksi biner, kita dapat membagi populasi menjadi dua kelompok dengan nilai cut-off 0.5. Misalnya, jika probabilitas di atas 0.5 maka kaan masuk ke dalam kelompok A dan sisanya akan masuk ke dalam kelompok B. Kelemahan logistik regression adalah rentan terhadap overfitting, terutama bila ada banyak variabel prediktor dalam model.

Beberapa metrik yang digunakan untuk mengevaluasi model klasifikasi adalah confusion matrix dimana hasilnya berupa:
* Accuracy : memprediksi dengan benar baik kelas positif maupun negatif TP+TN/TOTAL
* Precision/Pos Pred Value : memprediksi dengan benar kelas positif dari total prediksi kelas positif TP/(TP+FP)
* Recall/Sensitivity : memprediksi dengan benar kelas positif dari total aktual kelas positif TP/(TP+FN)
* Specificity : memprediksi dengan benar kelas negatif dari total aktual kelas negatif TN/(TN+FP)
* F-1 Score menggambarkan perbandingan rata-rata precision dan recall yang dibobotkan (2*Recall*Precision)/(Recall+Precision)

Selain itu, ada juga metrik lain yaitu Receiver Operating Characteristics (ROC) curve and Area Under Curve (AUC). ROC merupakan kurva yang menggambarkan hubungan antara True Positive Rate/tpr (Sensitivity atau Recall) dengan False Positive Rate/fpr (1-Specificity) pada setiap thresholdnya. Model yang baik idealnya memiliki tpr yang tinggi dan fpr yang rendah. AUC menunjukkan luas area di bawah kurva ROC. Semakin tinggi nilai AUC, semakin bagus performa modelnya. Nilai AUC yang paling bagus adalah 1. Baik ROC maupun AUC digunakan untuk mengukur seberapa baik model dalam membedakan kelas positif maupun negatif.

Model Fitting

Setelah membagi data menjadi data train dan test, mari kita melakukan fitting model yang pertama yaitu logistic regression menggunakan variabel NObeyesdad dengan menggunakan sebagian ataupun seluruh variabel sebagai prediktor model. Pertama, akan dibuat model dengan keseluruhan variabel prediktor, dengan variabel target adalah NObeyesdad.

model_all <- glm(NObeyesdad~., data = obesity_train, family = "binomial", trace=F)
summary(model_all)
#> 
#> Call:
#> glm(formula = NObeyesdad ~ ., family = "binomial", data = obesity_train, 
#>     trace = F)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -2.9779  -0.4217   0.3880   0.6345   3.2158  
#> 
#> Coefficients:
#>                                   Estimate Std. Error z value
#> (Intercept)                      -10.59846    1.39206  -7.614
#> GenderMale                         0.61817    0.16293   3.794
#> Age                                0.18624    0.01734  10.742
#> family_history_with_overweightno  -3.16936    0.28576 -11.091
#> FAVCno                             0.13455    0.25007   0.538
#> FCVC                               0.62255    0.15290   4.072
#> NCP                               -0.17445    0.10217  -1.707
#> CAECSometimes                      2.03252    0.86107   2.360
#> CAECFrequently                    -0.86431    0.90750  -0.952
#> CAECAlways                        -0.29408    1.00217  -0.293
#> SMOKEno                            0.49550    0.57772   0.858
#> CH2O                               0.25005    0.13012   1.922
#> SCCno                              2.05408    0.53760   3.821
#> FAF                               -0.36680    0.09299  -3.944
#> TUE                                0.13343    0.12725   1.049
#> CALCSometimes                     -0.31088    0.17224  -1.805
#> CALCFrequently                    -0.19512    0.42686  -0.457
#> CALCAlways                        -9.59664  324.74430  -0.030
#> MTRANSMotorbike                    1.98980    0.94602   2.103
#> MTRANSBike                        -1.73698    1.73237  -1.003
#> MTRANSPublic_Transportation        1.99430    0.23041   8.655
#> MTRANSWalking                     -0.05619    0.53919  -0.104
#>                                              Pr(>|z|)    
#> (Intercept)                        0.0000000000000267 ***
#> GenderMale                                   0.000148 ***
#> Age                              < 0.0000000000000002 ***
#> family_history_with_overweightno < 0.0000000000000002 ***
#> FAVCno                                       0.590544    
#> FCVC                               0.0000466850550339 ***
#> NCP                                          0.087754 .  
#> CAECSometimes                                0.018252 *  
#> CAECFrequently                               0.340891    
#> CAECAlways                                   0.769184    
#> SMOKEno                                      0.391067    
#> CH2O                                         0.054644 .  
#> SCCno                                        0.000133 ***
#> FAF                                0.0000800400346484 ***
#> TUE                                          0.294400    
#> CALCSometimes                                0.071083 .  
#> CALCFrequently                               0.647598    
#> CALCAlways                                   0.976425    
#> MTRANSMotorbike                              0.035436 *  
#> MTRANSBike                                   0.316024    
#> MTRANSPublic_Transportation      < 0.0000000000000002 ***
#> MTRANSWalking                                0.917001    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 2101.6  on 1564  degrees of freedom
#> Residual deviance: 1233.6  on 1543  degrees of freedom
#> AIC: 1277.6
#> 
#> Number of Fisher Scoring iterations: 11

Feature Selection

Feature selection adalah metode dimana predictor-predictor akan dikurangi atau ditambahkan satu per satu hingga diperoleh nilai AIC yang paling rendah. AIC menginterpretasikan jumlah informasi yang hilang. variabel prediktor yang pertama dikeluarkan adalah yang memiliki nilai p-value paling besar dan melebihi taraf signifikansi.Pertama kita akan melakukan feature selection yang pertama yaitu model_stepwise.

# stepwise
model_stepwise <- step(object = model_all,
                   direction = "backward",
                   trace = F)
summary(model_stepwise)
#> 
#> Call:
#> glm(formula = NObeyesdad ~ Gender + Age + family_history_with_overweight + 
#>     FCVC + NCP + CAEC + CH2O + SCC + FAF + MTRANS, family = "binomial", 
#>     data = obesity_train, trace = F)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -2.9824  -0.4330   0.3805   0.6480   3.2917  
#> 
#> Coefficients:
#>                                  Estimate Std. Error z value
#> (Intercept)                      -9.79815    1.23088  -7.960
#> GenderMale                        0.59103    0.16104   3.670
#> Age                               0.17711    0.01653  10.715
#> family_history_with_overweightno -3.15323    0.28220 -11.174
#> FCVC                              0.55505    0.14946   3.714
#> NCP                              -0.18619    0.10037  -1.855
#> CAECSometimes                     2.08302    0.84020   2.479
#> CAECFrequently                   -0.68184    0.88530  -0.770
#> CAECAlways                       -0.22058    0.97932  -0.225
#> CH2O                              0.24347    0.12888   1.889
#> SCCno                             2.01051    0.52504   3.829
#> FAF                              -0.33296    0.09049  -3.680
#> MTRANSMotorbike                   1.85504    0.93965   1.974
#> MTRANSBike                       -1.70861    1.76513  -0.968
#> MTRANSPublic_Transportation       1.94697    0.22877   8.511
#> MTRANSWalking                    -0.03768    0.53259  -0.071
#>                                              Pr(>|z|)    
#> (Intercept)                       0.00000000000000172 ***
#> GenderMale                                   0.000242 ***
#> Age                              < 0.0000000000000002 ***
#> family_history_with_overweightno < 0.0000000000000002 ***
#> FCVC                                         0.000204 ***
#> NCP                                          0.063581 .  
#> CAECSometimes                                0.013168 *  
#> CAECFrequently                               0.441197    
#> CAECAlways                                   0.821795    
#> CH2O                                         0.058883 .  
#> SCCno                                        0.000129 ***
#> FAF                                          0.000234 ***
#> MTRANSMotorbike                              0.048361 *  
#> MTRANSBike                                   0.333054    
#> MTRANSPublic_Transportation      < 0.0000000000000002 ***
#> MTRANSWalking                                0.943600    
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 2101.6  on 1564  degrees of freedom
#> Residual deviance: 1239.9  on 1549  degrees of freedom
#> AIC: 1271.9
#> 
#> Number of Fisher Scoring iterations: 6

Dari hasil summary model_stepwise, nilai AIC dan jumlah iterasi model lebih kecil dibandingkan model_all. Semakin kecil nilai AIC, maka semakin sedikit model kehilangan informasi penting, yang berarti hal ini akan semakin baik. Namun, selain AIC perlu juga memperhatikan nilai error yaitu RMSE. Namun, sebelum melihat nilai error, mari kita lakukan pemodelan feture selection yang lain yaitu forward dan both.

# model tanpa predictor
model_nopredictor <- glm(NObeyesdad~1, data=obesity_train, family = "binomial", trace=F)

# model forward
model_forward <- step(object=model_nopredictor,
                      direction = "forward",
                      list(lower=model_nopredictor, upper=model_all),
                      trace=F)
# model both
model_both <- step(object=model_nopredictor,
                      direction = "both",
                      list(upper=model_all),
                      trace=F)

Model Comparison

library(performance)
model_comparison <- compare_performance(model_nopredictor, model_all, model_stepwise, model_forward, model_both)
as.data.frame(model_comparison) %>% 
  select("Name","AIC","BIC","RMSE")
#>                Name      AIC      BIC      RMSE
#> 1 model_nopredictor 2103.565 2108.921 0.4890997
#> 2         model_all 1277.602 1395.426 0.3447512
#> 3    model_stepwise 1271.929 1357.619 0.3464743
#> 4     model_forward 1271.929 1357.619 0.3464743
#> 5        model_both 1271.929 1357.619 0.3464743

💡 Insight:
- Dari melihat perbandingan nilai AIC dan RMSE seluruh model, maka model yang akan dipilih adalah model_all karena memiliki nilai error RMSE yang paling kecil, meskipun dari nilai AIC nya lebih besar dibandingkan model feature selection (model_stepwise, model_forward, dan model_both).

Uji Multikolinearitas Model

vif(model_all)
#>                                    GVIF Df GVIF^(1/(2*Df))
#> Gender                         1.282391  1        1.132427
#> Age                            1.848223  1        1.359493
#> family_history_with_overweight 1.042212  1        1.020888
#> FAVC                           1.084631  1        1.041456
#> FCVC                           1.244163  1        1.115421
#> NCP                            1.097501  1        1.047617
#> CAEC                           1.209865  3        1.032261
#> SMOKE                          1.028464  1        1.014132
#> CH2O                           1.126987  1        1.061596
#> SCC                            1.045803  1        1.022645
#> FAF                            1.185513  1        1.088813
#> TUE                            1.129862  1        1.062950
#> CALC                           1.256626  3        1.038806
#> MTRANS                         1.969117  4        1.088388

Berdasarkan hasil vif() di atas tidak terdapat nilai yang lebih besar dari 10. Maka bisa diasumsikan tidak ada multicollinearity atau uji asumsi terpenuhi.

# Log of odds atau probabilitas
exp(coef(model_all))
#>                      (Intercept)                       GenderMale 
#>                    0.00002495435                    1.85553295600 
#>                              Age family_history_with_overweightno 
#>                    1.20470878951                    0.04203063927 
#>                           FAVCno                             FCVC 
#>                    1.14402453487                    1.86366608685 
#>                              NCP                    CAECSometimes 
#>                    0.83992049804                    7.63327376232 
#>                   CAECFrequently                       CAECAlways 
#>                    0.42134149641                    0.74521764577 
#>                          SMOKEno                             CH2O 
#>                    1.64131624567                    1.28408370519 
#>                            SCCno                              FAF 
#>                    7.79965703212                    0.69295028095 
#>                              TUE                    CALCSometimes 
#>                    1.14273830700                    0.73280293744 
#>                   CALCFrequently                       CALCAlways 
#>                    0.82273527732                    0.00006795698 
#>                  MTRANSMotorbike                       MTRANSBike 
#>                    7.31408957571                    0.17605184563 
#>      MTRANSPublic_Transportation                    MTRANSWalking 
#>                    7.34709411562                    0.94535928709

💡 Insight:
Beberapa insight yang dapat diambil dari hasil interpretasi function exp() di atas adalah:
- seseorang yang naik sepeda memiliki kemungkinan 0.176 kali lebih mungkin untuk terkena obesitas dibandingkan yang naik mobil
- seseorang yang berjalan kaki memiliki kemungkinan 0.945 kali lebih mungkin untuk terkena obesitas dibandingkan yang naik mobil
- Gender laki-laki memiliki kemungkinan 1.855 kali lebih mungkin terkena obesitas dibandingkan wanita

Prediction dan Evaluation Data Train & Data Test

Predict Data Train

obesity_train$pred_obes_train <- predict(model_all, obesity_train, type="response") # probabilitas

# Selanjutnya, kita akan atur agar probabilitas dari kolom `pred_obes_train` menjadi hasil klasifikasi nilai `pred_train_label`
obesity_train$pred_train_label <- ifelse(obesity_train$pred_obes_train < 0.5, "No obes", "Overweight2-obes") %>% 
  as.factor()

#lihat hasil prediksi data train jika dibandingkan kolom target NObeyesdad
visual1 <- obesity_train %>%
  select(pred_train_label, NObeyesdad)
head(visual1)
#>      pred_train_label       NObeyesdad
#> 654           No obes          No obes
#> 549           No obes          No obes
#> 1176 Overweight2-obes Overweight2-obes
#> 120           No obes Overweight2-obes
#> 1000 Overweight2-obes Overweight2-obes
#> 1032 Overweight2-obes Overweight2-obes

Evaluation Data Train

Confusion Matrix Data Train

cm_train <- confusionMatrix(data=as.factor(obesity_train$pred_train_label), reference = obesity_train$NObeyesdad, mode="everything")
cm_train
#> Confusion Matrix and Statistics
#> 
#>                   Reference
#> Prediction         No obes Overweight2-obes
#>   No obes              437               58
#>   Overweight2-obes     183              887
#>                                                
#>                Accuracy : 0.846                
#>                  95% CI : (0.8272, 0.8635)     
#>     No Information Rate : 0.6038               
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 0.6666               
#>                                                
#>  Mcnemar's Test P-Value : 0.000000000000001377 
#>                                                
#>             Sensitivity : 0.7048               
#>             Specificity : 0.9386               
#>          Pos Pred Value : 0.8828               
#>          Neg Pred Value : 0.8290               
#>               Precision : 0.8828               
#>                  Recall : 0.7048               
#>                      F1 : 0.7839               
#>              Prevalence : 0.3962               
#>          Detection Rate : 0.2792               
#>    Detection Prevalence : 0.3163               
#>       Balanced Accuracy : 0.8217               
#>                                                
#>        'Positive' Class : No obes              
#> 
  • Accuracy : 0.846
  • Sensitivity : 0.7048

  • Specificity : 0.9386

  • Precision/Pos Pred Value : 0.8828
  • F1 Score: 0.7839 Nilai confusion matrix yang diperoleh secara keseluruhan cukup tinggi.

ROC & AUC Data Train

# buat tabel hasil prediction terpisah dari data train
lr_train_table1 <- select(obesity_train, NObeyesdad) %>%
  bind_cols(NObeyesdad_predict = obesity_train$pred_train_label) %>%
  bind_cols(NObeyesdad_prob = obesity_train$pred_obes_train)

# ROC
lr_train_roc1 <- data.frame(prediction=round(lr_train_table1$NObeyesdad_prob, 4),
                      trueclass=as.numeric(lr_train_table1$NObeyesdad))

library(pROC)
# Create ROC curve
roc_train <- roc(lr_train_roc1$trueclass, lr_train_roc1$prediction) # membentuk kurva ROC, fungsi ini akan memperhitungkan nilai true positive rate (tpr) dan false positive rate (fpr) sebagai nilai range treshold yang akan dikembalikan sebagai kelas objek roc

# Plot ROC curve
plot(roc_train, col="blue", main="ROC Curve", print.thres=TRUE) #membentuk garis plot ROC, main untuk memberikan judul plot, print.thres untuk mencetak nilai treshold plot yaitu 0.597

# Add diagonal line
lines(x=c(0,1), y=c(0,1), lty=2, col="gray") # menambahkan garis diagonal dimana x dan y adalah titik start dan end garis, fungsi lty untuk menentukan tipe garis yaitu dashed, fungsi col untuk mewarnai garis diagonal

# Add AUC to plot
text(0.8, 0.2, paste("AUC =", round(auc(roc_train), 2)), cex=1.2) #menambahkan nilai AUC ke plot pakai fungsi text dimana 0.8 dan 0.2 adalah posisi dri teks, fungsi cex untuk menentukan ukuran teks

> Nilai AUC yang diperoleh sangat tinggi yaitu 0.89 yang artinya model dapat membedakan kelas positif dan negatif.

Predict Data Test

# prediksi kelas di data test
obesity_test$pred_obes_test <- predict(model_all, obesity_test, type="response") # probabilitas

# Selanjutnya, kita akan atur agar probabilitas dari kolom `pred_obes_test` menjadi hasil klasifikasi nilai `pred_test_label`
obesity_test$pred_test_label <- ifelse(obesity_test$pred_obes_test < 0.5, "No obes", "Overweight2-obes") %>%
  as.factor()

#lihat hasil prediksi data test jika dibandingkan kolom target NObeyesdad
visual2 <- obesity_test %>%
  select(pred_test_label, NObeyesdad)
head(visual2)
#>     pred_test_label       NObeyesdad
#> 8           No obes          No obes
#> 9  Overweight2-obes          No obes
#> 11          No obes Overweight2-obes
#> 15 Overweight2-obes          No obes
#> 18          No obes Overweight2-obes
#> 24 Overweight2-obes Overweight2-obes

Evaluation Data Test

Confusion Matrix Data Test

cm_test <- confusionMatrix(data=as.factor(obesity_test$pred_test_label), reference = obesity_test$NObeyesdad, mode="everything")
cm_test
#> Confusion Matrix and Statistics
#> 
#>                   Reference
#> Prediction         No obes Overweight2-obes
#>   No obes              149               16
#>   Overweight2-obes      56              301
#>                                                
#>                Accuracy : 0.8621               
#>                  95% CI : (0.8295, 0.8905)     
#>     No Information Rate : 0.6073               
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 0.7005               
#>                                                
#>  Mcnemar's Test P-Value : 0.000004303          
#>                                                
#>             Sensitivity : 0.7268               
#>             Specificity : 0.9495               
#>          Pos Pred Value : 0.9030               
#>          Neg Pred Value : 0.8431               
#>               Precision : 0.9030               
#>                  Recall : 0.7268               
#>                      F1 : 0.8054               
#>              Prevalence : 0.3927               
#>          Detection Rate : 0.2854               
#>    Detection Prevalence : 0.3161               
#>       Balanced Accuracy : 0.8382               
#>                                                
#>        'Positive' Class : No obes              
#> 
  • Accuracy : 0.8621
  • Sensitivity : 0.7268

  • Specificity : 0.9495

  • Precision : 0.9030
  • F1 Score : 0.8054 Nilai confusion matrix yang diperoleh nilainya cukup tinggi bahkan sedikit lebih tinggi dibanding data train. Hal ini bisa saja terjadi dan tidak menjadi masalah, selama nilai confusion data train nya memang sudah tinggi.

Dari perbandingan nilai metrik antara data train dengan data test (pada kasus kita yaitu akurasi dan recall), kita bisa mengetahui apakah model kita overfit atau tidak. Biasanya sebuah model dikatakan overfit jika perbedaannya mencapai lebih dari 10% (atau 0.1). Underfit kalau akurasi dan recall data testnya lebih bagus dbandingkan data train. Kesimpulan: Model tidak mengalami overfit maupun underfit.

ROC & AUC Data Test

# hasil prediction pada data test
lr_test_table1 <- select(obesity_test, NObeyesdad) %>% 
  bind_cols(NObeyesdad_predict = obesity_test$pred_test_label) %>% 
  bind_cols(NObeyesdad_prob = obesity_test$pred_obes_test)

# ROC
lr_test_roc1 <- data.frame(prediction=round(lr_test_table1$NObeyesdad_prob, 4),
                      trueclass=as.numeric(lr_test_table1$NObeyesdad))

library(pROC)
# Create ROC curve
roc_test <- roc(lr_test_roc1$trueclass, lr_test_roc1$prediction)# membentuk kurva ROC, fungsi ini akan memperhitungkan nilai true positive rate (tpr) dan false positive rate (fpr) sebagai nilai range treshold yang akan dikembalikan sebagai kelas objek roc

# Plot ROC curve
plot(roc_test, col="blue", main="ROC Curve", print.thres=TRUE)#membentuk garis plot ROC, main untuk memberikan judul plot, print.thres untuk mencetak nilai treshold plot yaitu 0.597

# Add diagonal line
lines(x=c(0,1), y=c(0,1), lty=2, col="gray")# menambahkan garis diagonal dimana x dan y adalah titik start dan end garis, fungsi lty untuk menentukan tipe garis yaitu dashed, fungsi col untuk mewarnai garis diagonal

# Add AUC to plot
text(0.8, 0.2, paste("AUC =", round(auc(roc_test), 2)), cex=1.2)#menambahkan nilai AUC ke plot pakai fungsi text dimana 0.8 dan 0.2 adalah posisi dri teks, fungsi cex untuk menentukan ukuran teks

> Nilai AUC yang di peroleh sangat tinggi dan hampir sama dengan data train yang berarti model dapat membedakan kelas positif dan negatif dengan baik.

9. Model Fitting K-Nearest Neighbor (K-NN)

Algoritma KNN mengasumsikan bahwa data yang mirip akan ada dalam jarak yang berdekatan atau bertetangga. Kedekatan karakteristik tersebut diukur dengan Euclidean Distance hingga didapatkan jarak. Kemudian akan dipilih k tetangga terdekat dari data baru tersebut, kemudian ditentukan kelasnya menggunakan kelas terbanyak. Algoritma KNN bersifat lazy learning, artinya tidak menggunakan data training untuk membuat model. Dengan kata lain, algoritma KNN tidak memiliki fase training, sekalipun ada sangat minim. Semua data training digunakan untuk testing/pengujian. Hal ini membuat proses training lebih cepat dan tahap testing lebih lambat serta cenderung overspending dari segi biaya, waktu dan memori. Selain itu, hasil dari model tidak dapat diinterpretasikan. Meskipun, model ini tergolong sebagai model klasifikasi yang paling sederhana namun cukup bagus adri segi performa.

Dalam menentukan nilai k, bila jumlah klasifikasi kita genap maka sebaiknya kita gunakan nilai k ganjil, dan begitu pula sebaliknya bila jumlah klasifikasi kita ganjil maka sebaiknya gunakan nilai k genap.

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

Model Fitting

Pada algoritma k-Nearest Neighbor, kita perlu melakukan satu tahap data pre-proses tambahan. Untuk setiap data train dan test yang kita miliki, hilangkan variabel kategorik kecuali variabel NObeyesdad. Pisahkan variabel prediktor dan target dari data train dan test.

# variabel prediktor pada `train`
train_x <- obesity_train %>% 
  select(-c(1,3,4,7,8,10,13,14,15,16,17))

# variabel prediktor pada `test`
test_x <- obesity_test %>% 
  select(-c(1,3,4,7,8,10,13,14,15,16,17))

# variabel target pada `train`
train_y <-obesity_train[, "NObeyesdad"]

# variabel target pada `test`
test_y <-obesity_test[,"NObeyesdad"]

Scaling

Ingatlah bahwa pengukuran jarak pada kNN sangat bergantung pada skala data dari variabel prediktor yang dimasukkan sebagai input model. Adanya prediktor yang memiliki range nilai yang amat berbeda dari prediktor lainnya dapat menyebabkan masalah pada model klasifikasi. Oleh karena itu, mari lakukan normalisasi data untuk menyamakan skala dari tiap variabel prediktor agar memiliki range nilai yang standar.

Untuk menormalisasi data train_x, silahkan gunakan fungsi scale(). Sementara itu, untuk menormalisasi data test, silahkan gunakan fungsi yang sama namun menggunakan atribut center dan scale yang didapat dari data train_x.

# scale train_x data
train_x_scale <- scale(train_x)
 
 
# scale test_x data
test_x_scale <- scale(x=test_x,
                      center=attr(train_x_scale, "scaled:center"),
                      scale=attr(train_x_scale, "scaled:scale"))

Mencari nilai k-optimum

Penentuan nilai k:
* jangan terlalu besar: pemilihan kelas hanya berdasarkan kelas yang dominan dan mengabaikan pola kecil yang ternyata penting
* jangan terlalu kecil: rentan mengklasifikasikan data baru ke kelas outlier
* k optimum adalah akar dari jumlah data kita: sqrt(nrow(data))

sqrt(nrow(obesity_train))
#> [1] 39.56008

karna data target kita ada 2, maka nilai K-optimum sebaiknya ganjil dan bukan kelipatan 39, misal 41

pred_model_knn <- knn(train = train_x_scale, test = test_x_scale, cl = train_y, k = 41)
head(pred_model_knn)
#> [1] No obes          Overweight2-obes No obes          Overweight2-obes
#> [5] Overweight2-obes Overweight2-obes
#> Levels: No obes Overweight2-obes

Model Evaluation

# confusion matrix
library(caret)

confusionMatrix(
  data=pred_model_knn,
  reference=test_y,
  positive="No obes",
  mode="everything"
)
#> Confusion Matrix and Statistics
#> 
#>                   Reference
#> Prediction         No obes Overweight2-obes
#>   No obes               88               32
#>   Overweight2-obes     117              285
#>                                            
#>                Accuracy : 0.7146           
#>                  95% CI : (0.6737, 0.753)  
#>     No Information Rate : 0.6073           
#>     P-Value [Acc > NIR] : 0.000000193845989
#>                                            
#>                   Kappa : 0.3543           
#>                                            
#>  Mcnemar's Test P-Value : 0.000000000005921
#>                                            
#>             Sensitivity : 0.4293           
#>             Specificity : 0.8991           
#>          Pos Pred Value : 0.7333           
#>          Neg Pred Value : 0.7090           
#>               Precision : 0.7333           
#>                  Recall : 0.4293           
#>                      F1 : 0.5415           
#>              Prevalence : 0.3927           
#>          Detection Rate : 0.1686           
#>    Detection Prevalence : 0.2299           
#>       Balanced Accuracy : 0.6642           
#>                                            
#>        'Positive' Class : No obes          
#> 

FN (False negative) - diprediksi Overweight2-obes ternyata No obes : 117
FP (False positive) - diprediksi No obes ternyata Overweight2-obes : 32
karena perbedaan nilai FN dan FP sangat jauh, maka parameter yang menjadi perhatian khusus adalah F1 score, karena F1 score mempertimbangkan recall dan presisi model.

10. Conclution

  1. Dari model logistic regression diperoleh hasil confusion matrix sebagai berikut:
  • Accuracy : 0.8621
  • Sensitivity : 0.7268

  • Specificity : 0.9495

  • Precision : 0.9030
  • F1 Score : 0.8054
  1. Dari model k-NN diperoleh hasil confusion matrix sebagai berikut:
  • Accuracy : 0.7146
  • Sensitivity : 0.4293

  • Specificity : 0.8991

  • Precision : 0.7333
  • F1 Score : 0.5415
  1. Nilai F1 Score metode logistik regression lebih tinggi dibandingkan metode KNN, sehingga metode logistik regresion lebih tepat digunakan pada dataset ini.