kAPSELD
riswan
June 17, 2020
REGRESI LOGISTIK UNTUK KLASIFIKASI BINER
Regresi logistik merupakan suatu algoritma dalam pengklasifikasian atau classifier yang dapat digunakan untuk memprediksi suatu kelas variabel. Dalam praktiknya, regresi logistik banyak digunakan dalam mengklasifikasikan 2 kelas dalam suatu variabel atau klasifikasi biner. Aplikasi regresi logistik menggunakan software R tidak jauh berbeda dengan regresi linear. Jika regresi linear menggunakan fungsi lm() untuk membangun model, maka regresi logistik menggunakan fungsi glm() untuk membangun modelnya.
- Data
Data untuk contoh ini adalah data heart disease sebanyak 303 observasi dan 14 variabel. Dari data ini akan diprediksi apakah seseorang terkena penyakit jantung atau tidak (variabel num) berdasarkan 13 variabel penjelas. Berikut adalah deskripsi dari data heart disease: Variabel yang akan diprediksi adalah variabel num, dengan mengasumsikan bahwa nilai 0 berarti jantung baik-baik saja, dan nilai 1, 2, 3, 4 berarti jantung terkena penyakit. Data heart disease dapat langsung diimpor menggunakan fungsi read.csv() dengan memasukkan alamat https://archive.ics.uci.edu/ml/machine-learning-databases/heart-disease/processed.cleveland.data yang merupakan sumber data tersebut.
heart <- read.table("https://archive.ics.uci.edu/ml/machine-learning-databases/heart-disease/processed.cleveland.data",header=FALSE,sep=",",na.strings = '?')
names(heart) <- c( "age", "sex", "cp", "trestbps", "chol","fbs", "restecg","thalach","exang", "oldpeak","slope", "ca", "thal", "num")head(heart)## age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal num
## 1 63 1 1 145 233 1 2 150 0 2.3 3 0 6 0
## 2 67 1 4 160 286 0 2 108 1 1.5 2 3 3 2
## 3 67 1 4 120 229 0 2 129 1 2.6 2 2 7 1
## 4 37 1 3 130 250 0 0 187 0 3.5 3 0 3 0
## 5 41 0 2 130 204 0 2 172 0 1.4 1 0 3 0
## 6 56 1 2 120 236 0 0 178 0 0.8 1 0 3 0- Ekplorasi Data
heart$num<-ifelse(heart$num==0,0,1)str(heart)## 'data.frame': 303 obs. of 14 variables:
## $ age : num 63 67 67 37 41 56 62 57 63 53 ...
## $ sex : num 1 1 1 1 0 1 0 0 1 1 ...
## $ cp : num 1 4 4 3 2 2 4 4 4 4 ...
## $ trestbps: num 145 160 120 130 130 120 140 120 130 140 ...
## $ chol : num 233 286 229 250 204 236 268 354 254 203 ...
## $ fbs : num 1 0 0 0 0 0 0 0 0 1 ...
## $ restecg : num 2 2 2 0 2 0 2 0 2 2 ...
## $ thalach : num 150 108 129 187 172 178 160 163 147 155 ...
## $ exang : num 0 1 1 0 0 0 0 1 0 1 ...
## $ oldpeak : num 2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
## $ slope : num 3 2 2 3 1 1 3 1 2 3 ...
## $ ca : num 0 3 2 0 0 0 2 0 1 0 ...
## $ thal : num 6 3 7 3 3 3 3 3 7 7 ...
## $ num : num 0 1 1 0 0 0 1 0 1 1 ...Variabel-variabel di atas semuanya berupa numerik, akan tetapi jika dilihat dari deskripsi data, ada beberapa variabel yang berupa kategorik yaitu variabel sex, cp, fbs, restecg, exang, slope, ca, thal, dan num sehingga variabel-variabel ini perlu diubah menjadi variabel yang berupa kategorik.
heart$sex<-as.factor(heart$sex)
heart$cp<-as.factor(heart$cp)
heart$fbs<-as.factor(heart$fbs)
heart$restecg<-as.factor(heart$restecg)
heart$exang<-as.factor(heart$exang)
heart$slope<-as.factor(heart$slope)
heart$ca<-as.factor(heart$ca)
heart$thal<-as.factor(heart$thal)
heart$num<-as.factor(heart$num)
str(heart)## 'data.frame': 303 obs. of 14 variables:
## $ age : num 63 67 67 37 41 56 62 57 63 53 ...
## $ sex : Factor w/ 2 levels "0","1": 2 2 2 2 1 2 1 1 2 2 ...
## $ cp : Factor w/ 4 levels "1","2","3","4": 1 4 4 3 2 2 4 4 4 4 ...
## $ trestbps: num 145 160 120 130 130 120 140 120 130 140 ...
## $ chol : num 233 286 229 250 204 236 268 354 254 203 ...
## $ fbs : Factor w/ 2 levels "0","1": 2 1 1 1 1 1 1 1 1 2 ...
## $ restecg : Factor w/ 3 levels "0","1","2": 3 3 3 1 3 1 3 1 3 3 ...
## $ thalach : num 150 108 129 187 172 178 160 163 147 155 ...
## $ exang : Factor w/ 2 levels "0","1": 1 2 2 1 1 1 1 2 1 2 ...
## $ oldpeak : num 2.3 1.5 2.6 3.5 1.4 0.8 3.6 0.6 1.4 3.1 ...
## $ slope : Factor w/ 3 levels "1","2","3": 3 2 2 3 1 1 3 1 2 3 ...
## $ ca : Factor w/ 4 levels "0","1","2","3": 1 4 3 1 1 1 3 1 2 1 ...
## $ thal : Factor w/ 3 levels "3","6","7": 2 1 3 1 1 1 1 1 3 3 ...
## $ num : Factor w/ 2 levels "0","1": 1 2 2 1 1 1 2 1 2 2 ...Variabel-variabel di atas sudah memiliki jenis variabel yang sesuai dengan deskripsi data. Langkah selanjutnya adalah melihat jumlah kelas pada variabel yang akan diprediksi.
levels(heart$num) = c("No Disease","Disease")
levels(heart$sex) = c("Female","Male")
table(heart$num)##
## No Disease Disease
## 164 139prop.table(table(heart$num))##
## No Disease Disease
## 0.5412541 0.4587459Jumlah kelas pada data menunjukkan proporsi yang cukup seimbang, sehingga dapat dikatakan tidak ada masalah imbalanced class pada data.
Barplot
counts <- table(heart$num,heart$sex)
barplot(counts, main="Sebaran Penyakit berdasarkan Jenis Kelamin",
xlab=" ", col=c("green","orange"),legend=rownames(counts), beside=TRUE)
Pie Chart
tablep <- table(heart$num)
lbls <- paste(names(tablep), "\n", tablep, sep="")
pie(tablep, labels =lbls, main="Pie Chart \n (with sample sizes)",
col=c("green","orange"))
Pie chart dari variabel respon menunjukkan kelas cukup seimbang, sedangkan bar chart di atas menunjukkan sebaran penyakit berdasarkan jenis kelamin dimana pada kelompok female jumlah pasien yang terdiagnosa penyakit jantung lebih kecil dibanding yang normal, sedangkan pada kelompok male jumlah pasien yang terdiagnosa penyakit jantung lebih besar dibanding yang normal.
- Stratifikasi Data
Stratifikasi data diperlukan untuk memastikan setiap kelas respon terambil dalam pengacakan. Stratifikasi data dilakukan dengan fungsi filter() dalam paket dplyr.
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionho <- filter(heart,num=="No Disease")
h1 <- filter(heart,num=="Disease")Data Training dan Data Testing
Data training digunakan untuk membangun model, sedangkan data testing digunakan untuk validasidengan pembagian training:testing 75%:25%. Pengambilan data secara acak menggunakan nilai seed 123. Penggunaan seed dilakukan agar hasil pengacakan tetap. Setiap nilai seed akan melakukan pengacakan yang berbeda sehingga hasil dari setiap nilai seed juga akan berbeda
set.seed (123)
acak.ho <- sample(1:nrow(ho), 0.75*nrow(ho))
acak.h1 <- sample(1:nrow(h1), 0.75*nrow(h1))
heart.tr <- rbind(ho[acak.ho,],h1[acak.h1,])
heart.test <- rbind(ho[-acak.ho,],h1[-acak.h1,])Regresi Logistik
Data training digunakan untuk membangun model regresi logistik dengan menggunakan fungsi glm() karena regresi logistik termasuk ke dalam generalized linear model dengan family = binomial.
model.reglog<-glm(num~.,data=heart.tr, family="binomial")
summary(model.reglog)##
## Call:
## glm(formula = num ~ ., family = "binomial", data = heart.tr)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.8716 -0.4780 -0.0941 0.2229 3.1704
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.569128 3.375627 -1.354 0.175875
## age -0.048363 0.030405 -1.591 0.111692
## sexMale 1.721434 0.646800 2.661 0.007780 **
## cp2 1.584564 0.974339 1.626 0.103887
## cp3 -0.185985 0.821515 -0.226 0.820896
## cp4 2.018014 0.857805 2.353 0.018646 *
## trestbps 0.043217 0.015613 2.768 0.005638 **
## chol 0.002155 0.005119 0.421 0.673811
## fbs1 -0.602295 0.729061 -0.826 0.408734
## restecg1 0.921719 3.477848 0.265 0.790990
## restecg2 1.041448 0.485970 2.143 0.032111 *
## thalach -0.032260 0.014009 -2.303 0.021290 *
## exang1 0.554687 0.547238 1.014 0.310768
## oldpeak 0.625304 0.305497 2.047 0.040673 *
## slope2 1.020027 0.577120 1.767 0.077154 .
## slope3 1.166929 1.122598 1.039 0.298577
## ca1 2.123990 0.615287 3.452 0.000556 ***
## ca2 2.973647 1.052502 2.825 0.004723 **
## ca3 2.408462 1.021868 2.357 0.018427 *
## thal6 -0.041940 1.167176 -0.036 0.971336
## thal7 1.496544 0.521397 2.870 0.004101 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 306.30 on 221 degrees of freedom
## Residual deviance: 131.86 on 201 degrees of freedom
## (5 observations deleted due to missingness)
## AIC: 173.86
##
## Number of Fisher Scoring iterations: 6Dari output di atas, variabel sex, cp, trestbps, ca, dan thal signifikan mempengaruhi respon (num) pada taraf nyata 5%. Pemilihan variabel juga dapat dilakukan dengan hanya memasukkan variabel-variabel yang signifikan mempengaruhi respon dan kemudian membandingkan nilai akurasinya. Dalam artikel ini akan dilakukan hanya pada model penuh (memasukkan semua variabel). Interpretasi untuk pengaruh setiap variabel dapat dilihat dari nilai rasio odds. Misalnya, untuk variabel sex memiliki nilai koefisien sebesar 1.683733 dengan reference category = female, nilai rasio odds nya adalah exp(1.683733) = 5.38 yang artinya untuk pasien laki-laki, odds untuk terkena penyakit jantung adalah 5.38 kali odds perempuan atau dapat dikatakan kecenderungan laki-laki untuk terkena penyakit jantung lebih besar dibanding perempuan.- Prediksi Variabel Respon pada Data Testing
Prediksi respon pada data testing dilakukan menggunakan threshold = 0.5 dimana jika nilai probabilitas prediksi > 0.5 maka akan diprediksi di kelas event (disease) dan sebaliknya akan diprediksi masuk di kelas non event (no disease).
prob.predik<-predict(model.reglog, heart.test, type="response")
prediksi<-ifelse(prob.predik>0.5,"Disease","No Disease")
pred.aktual<-data.frame(prediksi,heart.test$num)
head(pred.aktual)## prediksi heart.test.num
## 1 No Disease No Disease
## 2 No Disease No Disease
## 3 No Disease No Disease
## 10 No Disease No Disease
## 15 No Disease No Disease
## 18 No Disease No Disease- Akurasi
library(caret)## Loading required package: lattice## Loading required package: ggplot2confusionMatrix(as.factor(prediksi), heart.test$num)## Warning in confusionMatrix.default(as.factor(prediksi), heart.test$num): Levels
## are not in the same order for reference and data. Refactoring data to match.## Confusion Matrix and Statistics
##
## Reference
## Prediction No Disease Disease
## No Disease 35 8
## Disease 5 27
##
## Accuracy : 0.8267
## 95% CI : (0.7219, 0.9043)
## No Information Rate : 0.5333
## P-Value [Acc > NIR] : 9.7e-08
##
## Kappa : 0.6499
##
## Mcnemar's Test P-Value : 0.5791
##
## Sensitivity : 0.8750
## Specificity : 0.7714
## Pos Pred Value : 0.8140
## Neg Pred Value : 0.8438
## Prevalence : 0.5333
## Detection Rate : 0.4667
## Detection Prevalence : 0.5733
## Balanced Accuracy : 0.8232
##
## 'Positive' Class : No Disease
## Dari Output di atas, untuk hasil confusion matrix prediksi yang meleset cukup kecil yaitu 8 untuk false positive dan 5 untuk false negative.Nilai akurasi sebesar 82.67% menunjukkan bahwa hasil klasifikasi dengan regresi logistik pada data ini sudah cukup baik.