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
NObeyesdadyang dibagi menjadi 7 level yaitu:Insufficient Weight,Normal Weight,Overweight Level I,Overweight Level II,Obesity Type I,Obesity Type IIandObesity 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
- 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
- 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
- Nilai F1 Score metode logistik regression lebih tinggi dibandingkan metode KNN, sehingga metode logistik regresion lebih tepat digunakan pada dataset ini.