Analisa yang dilakukan bertujuan untuk melihat dan memahami bagaimana usia, jenis kelamain, nyeri dada, tekanan darah, detak jantung, kadar kolestrol berhubungan dengan penyakit jantung. Variabel tersebut digunakan untuk melatih mesin yang bisa memprediksi kemungkinan penyakit jantung.
Deskripsi Variabel dari Dataset:
## age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
## 1 52 1 0 125 212 0 1 168 0 1.0 2 2 3
## 2 53 1 0 140 203 1 0 155 1 3.1 0 0 3
## 3 70 1 0 145 174 0 1 125 1 2.6 0 0 3
## 4 61 1 0 148 203 0 1 161 0 0.0 2 1 3
## 5 62 0 0 138 294 1 1 106 0 1.9 1 3 2
## 6 58 0 0 100 248 0 0 122 0 1.0 1 0 2
## target
## 1 0
## 2 0
## 3 0
## 4 0
## 5 0
## 6 1summary(heart)#ringkasan dataset (statistik deskriptif dari dataset)## age sex cp trestbps
## Min. :29.00 Min. :0.0000 Min. :0.0000 Min. : 94.0
## 1st Qu.:48.00 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:120.0
## Median :56.00 Median :1.0000 Median :1.0000 Median :130.0
## Mean :54.43 Mean :0.6956 Mean :0.9424 Mean :131.6
## 3rd Qu.:61.00 3rd Qu.:1.0000 3rd Qu.:2.0000 3rd Qu.:140.0
## Max. :77.00 Max. :1.0000 Max. :3.0000 Max. :200.0
## chol fbs restecg thalach
## Min. :126 Min. :0.0000 Min. :0.0000 Min. : 71.0
## 1st Qu.:211 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:132.0
## Median :240 Median :0.0000 Median :1.0000 Median :152.0
## Mean :246 Mean :0.1493 Mean :0.5298 Mean :149.1
## 3rd Qu.:275 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:166.0
## Max. :564 Max. :1.0000 Max. :2.0000 Max. :202.0
## exang oldpeak slope ca
## Min. :0.0000 Min. :0.000 Min. :0.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:1.000 1st Qu.:0.0000
## Median :0.0000 Median :0.800 Median :1.000 Median :0.0000
## Mean :0.3366 Mean :1.072 Mean :1.385 Mean :0.7541
## 3rd Qu.:1.0000 3rd Qu.:1.800 3rd Qu.:2.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :6.200 Max. :2.000 Max. :4.0000
## thal target
## Min. :0.000 Min. :0.0000
## 1st Qu.:2.000 1st Qu.:0.0000
## Median :2.000 Median :1.0000
## Mean :2.324 Mean :0.5132
## 3rd Qu.:3.000 3rd Qu.:1.0000
## Max. :3.000 Max. :1.0000Pada summary data, terlihat 2 variabel yang memiliki niali dengan deskripsi data, yaitu variabel ca (pembuluh darah utama) dan variabel thal (detak jantung maksimum tercapai). Untuk membuat model yang sesuai dengan pengukuran medis, maka nilai pada variabel tersebut akan di ubah.
Dalam artikel ini, nilai tersebut akan diubah ke dalam nilai NaN (missing value) terlebih dahulu, kemudian missing value akan diisi dengan niali median sesuai dengan nilai-nilai ada variabel tersebut. Berikut caranya:
#Mengubah niali variabel ca dan thal yang tidak seharusnya ada pada data
heart$ca[heart$ca==4] = NaN #nilai 4 seharusnya tidak ada pada variabel ca. Pengukuran variabel ini hanya dari 0-3
heart$thal[heart$thal==0] = NaN #nilai 0 seharusnya tidak ada pada variabel ca. Pengukuran variabel ini hanya dari 1-3
#niali yang sudah diubah ke nilai NaNm digati dengan median dari nilai-nilai pada variabel ca dan thal
heart$ca[is.na(heart$ca)]<-median(heart$ca,na.rm=TRUE)
heart$thal[is.na(heart$thal)]<-median(heart$thal,na.rm=TRUE)Untuk menjaga agar tidak terdapat duplikasi pada data seperti baris yang mempunyai nilai-nilai yang sama untuk setiap variabel, maka perlu untuk mmebersihkan data dengan menghapus baris yang sama dengan cara:
library(dplyr) #library yang bisa digunakan untuk membersihkan data duplikat##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionheart <- heart %>% distinct()Untuk memriksa lebih lanjut jika data belum sesuai, dengan pengukuran yang seharusnya, maka salah satu hal yang perlu dilakukan adalah mengecek tipe data dengan cara:
str(heart) #melihat data dan tipe datanya## 'data.frame': 302 obs. of 14 variables:
## $ age : int 52 53 70 61 62 58 58 55 46 54 ...
## $ sex : int 1 1 1 1 0 0 1 1 1 1 ...
## $ cp : int 0 0 0 0 0 0 0 0 0 0 ...
## $ trestbps: int 125 140 145 148 138 100 114 160 120 122 ...
## $ chol : int 212 203 174 203 294 248 318 289 249 286 ...
## $ fbs : int 0 1 0 0 1 0 0 0 0 0 ...
## $ restecg : int 1 0 1 1 1 0 2 0 0 0 ...
## $ thalach : int 168 155 125 161 106 122 140 145 144 116 ...
## $ exang : int 0 1 1 0 0 0 0 1 0 1 ...
## $ oldpeak : num 1 3.1 2.6 0 1.9 1 4.4 0.8 0.8 3.2 ...
## $ slope : int 2 0 0 2 1 1 0 1 2 1 ...
## $ ca : num 2 0 0 1 3 0 3 1 0 2 ...
## $ thal : num 3 3 3 3 2 2 1 3 3 2 ...
## $ target : int 0 0 0 0 0 1 0 0 0 0 ...Dari code tersebut, terlihat bahwa variabel ca dan thal memiliki tipe data yang tidak sesuai dengan isi setiap nilainnya yang harusnya integer. Maka perlu dilakukan konversi tipe data dari numeric ke integer (bilang bulat), dengan cara:
i <- c(12, 13) #memilih kolom ke 12 dan 13 (posisi variabel ca dan thal)
heart[ , i] <- apply(heart[ , i], 2,
function(x) as.integer(as.numeric(x))) #konversi tipe data variabel ca dan thal dari numeric ke integer
sapply(heart, class) #mengecek tipe data setiap kolom## age sex cp trestbps chol fbs restecg thalach
## "integer" "integer" "integer" "integer" "integer" "integer" "integer" "integer"
## exang oldpeak slope ca thal target
## "integer" "numeric" "integer" "integer" "integer" "integer"Setelah berhasil, membersihkan data. Langkah selanjutnya adalah mengubah nilai target dari 0 dan 1 menjadi no dan yes agar memudahkan untukmelihat data mana yang terklasifikasi berisiko penyakit jantung dan tidak, dengan cara:
heart$target <- ifelse(heart$target == 1, "yes", "no") #jika target memiliki nilai 1, maka akan diubah menjadi yes. Sebaliknya jika bernilai 0 makan diubah menjadi 0
heart$target <- as.factor(heart$target) #target yang sudah dibuah di konversi menjadi tipe data factor (nilai-niali dalam kategori)
sapply(heart, class) #melakukan pengecekan tipe data tiap variabel## age sex cp trestbps chol fbs restecg thalach
## "integer" "integer" "integer" "integer" "integer" "integer" "integer" "integer"
## exang oldpeak slope ca thal target
## "integer" "numeric" "integer" "integer" "integer" "factor"Setalah data selesai melewati tahap preprocessing, dataset yang ada dibagi menjadi data latih (training) dan data uji (testing). Data latih akan melaith model yang akan divalidasi dengan data uji untuk melihat keakuratan hasil klasifikasi.
Data latih yang diambil dari dataset sebesar 80% dan data uji sebesar 20%. Alasannya untuk membuat model lebih banyak melakukan pelatihan tetap tidak sedikit pengujian juga.
library(dplyr) #library untuk split data
#membuat seed untuk membuat data memiliki niali acak yang tetap setiap kali running
set.seed(1)
#buat id kolom yang dapat digunakan untuk mengambil data uji (test) yang beda dengan data latih (train)
heart$id <- 1:nrow(heart)
#use 80% of dataset as training set and 20% as test set
train <- heart %>% dplyr::sample_frac(0.8) #ambil data latih sebesar 80%
test <- dplyr::anti_join(heart, train, by = 'id') #membuat data uji#memilih semua variabel selain target sebagai variabel bebas (prediktor) dan variabel target sebagai variabel terikat (respons)
log_model <- glm(target ~ ., data = train, family = "binomial") #family yang digunakan pada model regresi logistik ini adalah binomial karena target yang dimiliki biner (1 dan 0 atau iya dan tidak)
summary(log_model) #ringkasan model regresi logistik yang dibuat##
## Call:
## glm(formula = target ~ ., family = "binomial", data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7568 -0.3455 0.2096 0.4866 2.9900
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.381701 2.921200 0.131 0.89604
## age 0.011864 0.027800 0.427 0.66957
## sex -1.233985 0.521682 -2.365 0.01801 *
## cp 0.683471 0.215658 3.169 0.00153 **
## trestbps -0.017080 0.011885 -1.437 0.15069
## chol -0.001485 0.004466 -0.332 0.73957
## fbs 0.816395 0.679639 1.201 0.22967
## restecg 0.223041 0.398194 0.560 0.57539
## thalach 0.028183 0.011735 2.402 0.01632 *
## exang -1.094016 0.474570 -2.305 0.02115 *
## oldpeak -0.434350 0.238931 -1.818 0.06908 .
## slope 0.503955 0.418865 1.203 0.22892
## ca -1.376192 0.295557 -4.656 3.22e-06 ***
## thal -1.044453 0.344197 -3.034 0.00241 **
## id 0.005822 0.002463 2.364 0.01806 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 332.24 on 241 degrees of freedom
## Residual deviance: 161.01 on 227 degrees of freedom
## AIC: 191.01
##
## Number of Fisher Scoring iterations: 6Sebagai contoh interpretasi sederhana, kita mecoba estimate dengan nilai estimate dari summary model pada variabel age (usia)
exp(0.011864) #menggunakan exp untuk melihat kenaikan## [1] 1.011935Dari hasil di atas bisa dilihat bahwa, jika ketambahan usia setahun, mempunyai risiko penyakit jantung sebesar 1 (dalam range 0 - 1)
Setelah model berhasil dilatih, selanjutnya adalah melakukan prediksi atau menguji model dengan data uji (test) untuk melihat sebarapa baik model yang sudah dibuat untuk digunakan sesuai kebutuhan prediksi kedepannya.
log.Risk <- predict(log_model, newdata = test, type = "response")
#menentukan kelas, jika hasil perhitungan prediksi pada data test lebih dari 0.5, maka akan diklasifikan sebagai yes (berisiko penyakit jantung), jika dibawah 0.5 maka tidak berisiko terkena penyakit jantung
log.Label <- ifelse(log.Risk > 0.5, "yes", "no")
#label diubah ke tipe factor (kategori) karena akan digunakan untuk evaluasi dengan confussion matrix
log.Label <- as.factor(log.Label)
head(log.Label)## 1 2 3 4 5 6
## no no no no yes yes
## Levels: no yeslibrary(caret) #library caret untuk membuat confussion matrix## Loading required package: ggplot2## Loading required package: lattice#membuat confussion matrix
confmat <- confusionMatrix(data = log.Label,
reference = test$target,
positive = "yes")
confmat## Confusion Matrix and Statistics
##
## Reference
## Prediction no yes
## no 25 1
## yes 6 28
##
## Accuracy : 0.8833
## 95% CI : (0.7743, 0.9518)
## No Information Rate : 0.5167
## P-Value [Acc > NIR] : 1.737e-09
##
## Kappa : 0.7677
##
## Mcnemar's Test P-Value : 0.1306
##
## Sensitivity : 0.9655
## Specificity : 0.8065
## Pos Pred Value : 0.8235
## Neg Pred Value : 0.9615
## Prevalence : 0.4833
## Detection Rate : 0.4667
## Detection Prevalence : 0.5667
## Balanced Accuracy : 0.8860
##
## 'Positive' Class : yes
## Hasil Confussion Matrix menunjukkan akurasi sebesar 0.88 (88.3%) dari data 60 data test (uji), dimana 25 dari 26 data yang dilabelkan “no” diklasifikasi dengan benar sebagai “no” (tidak berisiko penyakit jantung) dan 28 dari 34 data yang dilabelkan “yes” berhasil terklasfikasi dengan benar sebagai “yes” (berisiko memiliki penyakit jantung).
Hasil ini tidak bisa hanya dilihat dari akurasi saja. Kenyataannya sulit diterima bagi orang yang tidak memiliki risiko penyakit jantung tapi diklasifikasi berisiko penyakit jantung.
Dalam kasus ini, kita bisa memilih menggunakan recall (Sensitivity) yang merupakan rasio prediksi benar risiko dibandingkan dengan keseluruhan data yang benar risiko. Recall menjawab pertanyaan :
“Berapa persen orang yang diprediksi risiko dibandingkan keseluruhan orang yang sebenarnya memiliki risiko”
Dan dalam kasus ini, kita memilkiki recall (Sensitivity) sebesar 0.9655 (96.55%)