Analisis Regresi Logistik Biner
Alfazrin Banapon
Desember 07, 2017
Regresi Logistik
Regresi Logistik digunakan untuk mencari hubungan hubungan variabel dependen (Y) yang bersifat dichotomus (bersakala nominal atau ordinal dengan 2 kategori) atau polychotomus (berskala nominal atau ordinal > 2 kategori) dengan satu atau lebih variabel independen (X) yang bersifat kontinu atau kategorik (Agresti, 2007)
Salah satu regresi logistik yang sangat sederhana adalah resgresi logistik biner. Regresi logistik biner merupakan suatu metode analisis data yang digunakan untuk mencari hubungan variabel dependen (Y) yang bersifat biner atau dichotomus dengan variabel independen (X) yang bersifat polikotomus (Hosmer & Lemeshow, 1989)
dt <- read.csv("D:\\Conference dan Lomba\\Lomba\\SSO UNS 2018\\SSO\\data_training.csv", sep=";")
head(dt)## Age BMI Glucose Insulin HOMA Leptin Adiponectin Resistin
## 1 48 23.50000 70 2.707 0.4674087 8.8071 9.702400 7.99585
## 2 83 20.69049 92 3.115 0.7068973 8.8438 5.429285 4.06405
## 3 82 23.12467 91 4.498 1.0096511 17.9393 22.432040 9.27715
## 4 68 21.36752 77 3.226 0.6127249 9.8827 7.169560 12.76600
## 5 86 21.11111 92 3.549 0.8053864 6.6994 4.819240 10.57635
## 6 49 22.85446 92 3.226 0.7320869 6.8317 13.679750 10.31760
## MCP.1 Obesity
## 1 417.114 Tipe 1
## 2 468.786 Tipe 1
## 3 554.697 Tipe 1
## 4 928.220 Tipe 1
## 5 773.920 Tipe 1
## 6 530.410 Tipe 1str(dt)## 'data.frame': 99 obs. of 10 variables:
## $ Age : int 48 83 82 68 86 49 76 73 75 34 ...
## $ BMI : num 23.5 20.7 23.1 21.4 21.1 ...
## $ Glucose : int 70 92 91 77 92 92 118 97 83 78 ...
## $ Insulin : num 2.71 3.12 4.5 3.23 3.55 ...
## $ HOMA : num 0.467 0.707 1.01 0.613 0.805 ...
## $ Leptin : num 8.81 8.84 17.94 9.88 6.7 ...
## $ Adiponectin: num 9.7 5.43 22.43 7.17 4.82 ...
## $ Resistin : num 8 4.06 9.28 12.77 10.58 ...
## $ MCP.1 : num 417 469 555 928 774 ...
## $ Obesity : Factor w/ 2 levels "Tipe 1","Tipe 2": 1 1 1 1 1 1 1 1 1 1 ...Data Eksploratif
library(plotrix)## Warning: package 'plotrix' was built under R version 3.5.3obesity = table(dt$Obesity) #melihat jumlah setiap JK
obesity=c(42,57)
label=c("Tipe 1 = ","Tipe 2 = ")
persen=round(obesity/sum(obesity)*100) ##buat persentase
label=paste(label,persen)
label=paste(label,'%',sep ='')
pie3D(obesity,labels=label,col=c('yellow','blue'),
main="Persentase Obesitas")
Pie chart menunjukkan bahwa presentase penderita obesitas tipe 2 lebih besar daripada tipe 1 pada dataset yang digunakan
library(plyr)
mu <- ddply(dt, "Obesity", summarise, grp.mean=mean(Age))
head(mu)## Obesity grp.mean
## 1 Tipe 1 57.33333
## 2 Tipe 2 57.87719library(ggplot2)## Warning: package 'ggplot2' was built under R version 3.5.3ggplot(dt, aes(x=Age, fill=Obesity, color=Obesity)) +
geom_histogram(aes(y =..density..), bins=30) +
geom_density(alpha=.2) +
geom_vline(data=mu, aes(xintercept=grp.mean, color=Obesity),
linetype="dashed") +
labs(title="Histogram for Age", x="Age", y="Density")
Berdasarkan hisotgram dan density plot dari age diatas, dapat disimpulkan bahwa berdasarkan data yang ada peluang tertinggi bahwa rata-rata penderita obestitas tipe 1 dan tipe 2 adalah kurang lebih pada usia 57 tahun. Sedangkan peluang tertinggi seseorang menderita diabetes tipe 1 saat berada pada interval umur 45 tahun dan tipe 2 pada umur 70 tahun
Pengujian Multikolinearitas
library("PerformanceAnalytics")## Warning: package 'PerformanceAnalytics' was built under R version 3.5.3## Loading required package: xts## Warning: package 'xts' was built under R version 3.5.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 3.5.3##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legendchart.Correlation(dt[,1:9], histogram=TRUE, pch=19)
Berdasarkan hasil pengujian korelasi antar variabel independen, terdapat beberapa variabel yang mempunyai ukuran korelasi > 0.6, sehingga mengindikasikan bahwa terdapat multikolinearitas, Maka variabel-variabel tersebut tidak diikutkan dalam pemodelan regresi logistik biner
Analisis Regresi Logistik Biner
Salah satu model statistika yang dapat digunakan untuk menganalisis pola hubungan antara sekumpulan variabel independen dengan suatu variabel dependen bertipe kategorik. Tujuannya adalah untuk memprediksi probabilitas terjadinya atau tidak terjadinya event berdasarkan nilai-nilai prediktor yang ada. Event merupakan status variabel respon yang menjadi pokok perhatian (diberi nilai kode yang lebih tinggi daripada nonevent) dan untuk mengklasifikasikan subjek penelitian berdasarkan ambang (treshold) probabilitas.
logit1 <- glm(Obesity~Age+BMI+Leptin+Adiponectin+Resistin
+MCP.1, data = dt, family = binomial(link="logit"))Pengujian Signfikansi Parameter (uji overall)
Pengujian ini dilakukan untuk melihat koefisein parameter secara keseluruhan terhadap variabel dependen. Hipotesis nol dalam pengujian ini adalah seluruh paramater = 0 atau tidak variabel independen yang memberikan pengaruh terhadap variabel dependen. H0 ditolak jika nilai G2 lebih besar chi square tabel.
library(pscl)## Warning: package 'pscl' was built under R version 3.5.3## Classes and Methods for R developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University
## Simon Jackman
## hurdle and zeroinfl functions by Achim ZeileispR2(logit1)## llh llhNull G2 McFadden r2ML
## -63.04284193 -67.48081893 8.87595400 0.06576650 0.08575446
## r2CU
## 0.11523477qchisq(0.95, 6)## [1] 12.59159Berdasarkan hasil pengujian serentak, menunjukkan bahwa nilai G2 = 8.87595400 < chisquare tabel = 12.59159, maka tolak H0 artinya bahwa seluruh parameter = 0 atau dapat disimpulkan bahwa tidak satupun variabel indpenden yang memberikan pengaruh terhadap variabel dependen
uji parsial
Pengujian parsial dilakukan untuk mengetahui pengaruh variabel independen secara masing-masing terhadap variabel dependen, tolak hipotesis 0 jika p value < alfa 5% atau |nilai z| > tabel normal
summary(logit1)##
## Call:
## glm(formula = Obesity ~ Age + BMI + Leptin + Adiponectin + Resistin +
## MCP.1, family = binomial(link = "logit"), data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.6601 -1.1662 0.6913 1.0429 1.6095
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.392e+00 1.815e+00 0.767 0.4433
## Age 2.206e-03 1.387e-02 0.159 0.8737
## BMI -8.280e-02 5.604e-02 -1.477 0.1395
## Leptin 8.297e-03 1.412e-02 0.587 0.5569
## Adiponectin -3.932e-05 3.348e-02 -0.001 0.9991
## Resistin 4.974e-02 2.687e-02 1.851 0.0642 .
## MCP.1 3.590e-04 7.473e-04 0.480 0.6309
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 134.96 on 98 degrees of freedom
## Residual deviance: 126.09 on 92 degrees of freedom
## AIC: 140.09
##
## Number of Fisher Scoring iterations: 4qnorm(0.95, 1)## [1] 2.644854Pengujian parameter secara parisal menunjukkan bahwa nilai p value > alfa 5% atau |nilai z| < tabel normal, sehingga menolak hipotesis 0 bahwa tidak ada parameter yang signifikan memberikan pengaruh terhdadap variabel dependen pada tingkat kesalahan 5%.
Karena tidak ada parameter yang signifikan maka parameter dengan nilai p value tertinggi akan dikelaurkan dan dilakukan pengujian kembali
logit2 <- glm(Obesity~Age+BMI+Leptin+Resistin
+MCP.1, data = dt,
family =binomial(link="logit"))
summary(logit2)##
## Call:
## glm(formula = Obesity ~ Age + BMI + Leptin + Resistin + MCP.1,
## family = binomial(link = "logit"), data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.6603 -1.1663 0.6912 1.0429 1.6094
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.3905922 1.4994680 0.927 0.3537
## Age 0.0022094 0.0135176 0.163 0.8702
## BMI -0.0827816 0.0534917 -1.548 0.1217
## Leptin 0.0082950 0.0139727 0.594 0.5527
## Resistin 0.0497438 0.0260509 1.909 0.0562 .
## MCP.1 0.0003590 0.0007473 0.480 0.6309
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 134.96 on 98 degrees of freedom
## Residual deviance: 126.09 on 93 degrees of freedom
## AIC: 138.09
##
## Number of Fisher Scoring iterations: 4logit3 <- glm(Obesity~BMI+Leptin+Resistin
+MCP.1, data = dt,
family =binomial(link="logit"))
summary(logit3)##
## Call:
## glm(formula = Obesity ~ BMI + Leptin + Resistin + MCP.1, family = binomial(link = "logit"),
## data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.6475 -1.1566 0.6825 1.0404 1.6196
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.5216106 1.2693816 1.199 0.2306
## BMI -0.0828929 0.0534435 -1.551 0.1209
## Leptin 0.0084023 0.0139368 0.603 0.5466
## Resistin 0.0495268 0.0259286 1.910 0.0561 .
## MCP.1 0.0003561 0.0007447 0.478 0.6326
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 134.96 on 98 degrees of freedom
## Residual deviance: 126.11 on 94 degrees of freedom
## AIC: 136.11
##
## Number of Fisher Scoring iterations: 4logit4 <- glm(Obesity~BMI+Leptin+Resistin, data = dt,
family =binomial(link="logit"))
summary(logit4)##
## Call:
## glm(formula = Obesity ~ BMI + Leptin + Resistin, family = binomial(link = "logit"),
## data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7954 -1.1592 0.7376 1.0354 1.5577
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.492848 1.264820 1.180 0.2379
## BMI -0.076129 0.051271 -1.485 0.1376
## Leptin 0.007003 0.013580 0.516 0.6061
## Resistin 0.054577 0.024285 2.247 0.0246 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 134.96 on 98 degrees of freedom
## Residual deviance: 126.35 on 95 degrees of freedom
## AIC: 134.35
##
## Number of Fisher Scoring iterations: 4logit5 <- glm(Obesity~BMI+Resistin, data = dt,
family =binomial(link="logit"))
summary(logit5)##
## Call:
## glm(formula = Obesity ~ BMI + Resistin, family = binomial(link = "logit"),
## data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7008 -1.1752 0.7195 1.0220 1.4796
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.27871 1.19126 1.073 0.2831
## BMI -0.06175 0.04273 -1.445 0.1484
## Resistin 0.05492 0.02404 2.285 0.0223 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 134.96 on 98 degrees of freedom
## Residual deviance: 126.61 on 96 degrees of freedom
## AIC: 132.61
##
## Number of Fisher Scoring iterations: 4logit6 <- glm(Obesity~Resistin, data = dt,
family =binomial(link="logit"))
summary(logit6)##
## Call:
## glm(formula = Obesity ~ Resistin, family = binomial(link = "logit"),
## data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7068 -1.1652 0.7659 1.0526 1.2669
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.36446 0.35640 -1.023 0.3065
## Resistin 0.04874 0.02290 2.129 0.0333 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 134.96 on 98 degrees of freedom
## Residual deviance: 128.75 on 97 degrees of freedom
## AIC: 132.75
##
## Number of Fisher Scoring iterations: 4logit7 <- glm(Obesity~Resistin-1, data = dt,
family =binomial(link="logit"))
summary(logit7)##
## Call:
## glm(formula = Obesity ~ Resistin - 1, family = binomial(link = "logit"),
## data = dt)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2816 -1.2686 0.8227 1.0050 1.1358
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## Resistin 0.03077 0.01239 2.484 0.013 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 137.24 on 99 degrees of freedom
## Residual deviance: 129.84 on 98 degrees of freedom
## AIC: 131.84
##
## Number of Fisher Scoring iterations: 4Pemilihan Model Terbaik
Pemilihan model terbaik berdasarkan nilai Akaike Information Criterion (AIC), AIC adalah metode yang dapat digunakan untuk memilih model regresi terbaik yang ditemukan oleh Akaike dan Schwarz (Grasa, 1989). Menurut metode AIC, model regresi terbaik adalah model regresi yang mempunyai nilai AIC terkecil. Adapun nilai AIC untuk setiap model adalah :
model_logit <- c("Model 1","Model 2","Model 3","Model 4", "Model 5",
"Model 6", "Model 7")
AIC <- c(logit1$aic,logit2$aic,logit3$aic,logit4$aic, logit5$aic, logit6$aic, logit7$aic)
kriteria <- data.frame(model_logit,AIC)
kriteria ## model_logit AIC
## 1 Model 1 140.0857
## 2 Model 2 138.0857
## 3 Model 3 136.1124
## 4 Model 4 134.3451
## 5 Model 5 132.6128
## 6 Model 6 132.7489
## 7 Model 7 131.8388AIC terkecil adalah model 7, sehingga model yang akan digunkan untuk pemodelan obesitas dan memprediksi peluang obesitas adalah Model 7
Uji Kesesuaian Model
Pengujian kesesuain model menggunakan uji Hosmer-Lemeshow Goodness of Fit Test dengan hipotesis 0 adalah Model sesuai (tidak terdapat perbedaan yang sginifikan antara pengamatan dengan kemungkinan hasil prediksi), hipotesis 0 ditolak jika p value < alfa 5% atau nilai chsquare > chisquare tabel
library(ResourceSelection)## Warning: package 'ResourceSelection' was built under R version 3.5.3## ResourceSelection 0.3-5 2019-07-22hoslem.test(logit7$y, fitted(logit7))##
## Hosmer and Lemeshow goodness of fit (GOF) test
##
## data: logit7$y, fitted(logit7)
## X-squared = 12.707, df = 8, p-value = 0.1223qchisq(0.95, 8)## [1] 15.50731Nilai chsquare = 12.707 < chisquare tabel = 15.50731, yang artinya model sesuai atau tidak ada perbedaan antara hasil pengamatan dengan kemungkinan hasil prediksi
pR2(logit7)## llh llhNull G2 McFadden r2ML
## -64.91940171 -67.48081893 5.12283444 0.03795771 0.05042979
## r2CU
## 0.06776633Untuk mengukur kebaikan model juga dapat dilakukan dengan meilhat nilai koefisien determinasi, nilai koefisien determinasi pada model terbaik ini adalah 0.03795771 atau 3.80%
atau dapat juga dihitung dengan perintah berikut:
logitt <- glm(Obesity~1, data=dt, family= binomial(link="logit"))
1-as.vector(logLik(logit7)/logLik(logitt)) ## [1] 0.03795771Kalsifikasi Model
Pada bagian ini, akan digunakan untuk membangun model machine learning untuk mengklasifikasikan obesitas tipe 1 dan tipe 2.
Split Data
Langkah awal yang dilakukan adalah membagi data menjadi data latih dan data uji deng proprosi 80%:20%
set.seed(111)
ind <- sample(2, nrow(dt), replace = TRUE, prob = c(0.8, 0.2))
latih <- dt[ind==1,]
uji <- dt[ind==2,]Membuat Model Regresi Logistik
dalam membangun model ini digunakan seluruh parameter utuk memprediksi obesitas
model <- glm(Obesity~Age+BMI+Leptin+Adiponectin+Resistin
+MCP.1, data=latih, family=binomial(link="logit"))
model##
## Call: glm(formula = Obesity ~ Age + BMI + Leptin + Adiponectin + Resistin +
## MCP.1, family = binomial(link = "logit"), data = latih)
##
## Coefficients:
## (Intercept) Age BMI Leptin Adiponectin
## 2.1310357 -0.0066615 -0.0906771 0.0018484 -0.0162773
## Resistin MCP.1
## 0.0454835 0.0007809
##
## Degrees of Freedom: 84 Total (i.e. Null); 78 Residual
## Null Deviance: 117.3
## Residual Deviance: 108.2 AIC: 122.2Prediksi
library(dplyr)## Warning: package 'dplyr' was built under R version 3.5.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:plyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionprobabilitas <- model %>% predict(uji, type = "response")
prediksi <- ifelse(probabilitas> 0.5, "Tipe 1", "Tipe 2")
tab1 <- table(Predicted = prediksi, Actual=uji$Obesity)
tab1## Actual
## Predicted Tipe 1 Tipe 2
## Tipe 1 2 5
## Tipe 2 1 6testAcc=(sum(diag(tab1))/sum(tab1))*100
round(testAcc,2)## [1] 57.14Hasil prediksi menunjukkan bahwa berdasarkan data uji, dari 14 observasi terdapat 3 observasi pasien menderita diabetes tipe 1. Model berhasil memprediksi dengan tepat sebanyak 2 pasien, sedangkan sisanya diprediksi diabetes tipe 2. Serta terdapat 11 observasi pasien menderita diabetes tipe 2 dan model berhasil memprediksi dengan tepat sebanyak 6 pasien sedangkan 5 pasien lainnya diprediksi obesitas tipe 1. Sehingga keakuratan model dalam memprediksi adalah 57.14%.