Regresi Logistik adalah metode statistik yang digunakan untuk memodelkan hubungan antara variabel dependen kategorikal dengan satu atau lebih variabel independen. Berbeda dengan regresi linear yang memprediksi nilai kontinu, regresi logistik memprediksi probabilitas suatu kejadian.
Karakteristik Utama:
- Variabel dependen bersifat kategorikal (biner, ordinal, atau multinomial)
- Menggunakan fungsi logit untuk transformasi
- Hasil prediksi berupa probabilitas (0–1)
- Berdasarkan konsep Maximum Likelihood Estimation (MLE)
Regresi logistik dikembangkan karena keterbatasan regresi linear untuk data kategorikal:
- Asumsi normalitas tidak terpenuhi
- Prediksi dapat di luar rentang 0–1
- Variance tidak konstan
Fungsi Logit
Fungsi logit merupakan transformasi yang menghubungkan variabel prediktor dengan probabilitas:
\[ \text{logit}(p) = \ln\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1X_1 + \beta_2X_2 + \dots + \beta_nX_n \]
Fungsi Logistik (Inverse Logit):
\[ p = \frac{1}{1 + e^{-(\beta_0 + \beta_1X_1 + \dots + \beta_nX_n)}} \]
Odds dan Log Odds
\[ \text{Odds} = \frac{p}{1-p} \]
\[ \log(\text{Odds}) = \ln\left(\frac{p}{1-p}\right) \]
Maximum Likelihood Estimation (MLE)
Regresi logistik menggunakan MLE untuk mengestimasi parameter: -
Mencari parameter yang memaksimalkan fungsi likelihood
- Fungsi likelihood: produk dari probabilitas setiap observasi
- Iterative process (biasanya Newton-Raphson)
Fungsi Likelihood:
\[ L(\beta) = \prod_{i=1}^{n} [p_i^{y_i} (1-p_i)^{(1-y_i)}] \]
Asumsi Utama
Asumsi yang Tidak Diperlukan
Regresi Logistik Biner digunakan ketika variabel dependen memiliki dua kategori (0/1, Ya/Tidak, Sukses/Gagal).
Model:
\[ \ln\left(\frac{p}{1-p}\right) = \beta_0 + \beta_1X_1 + \beta_2X_2 + \dots + \beta_nX_n \]
Interpretasi Koefisien
Odds Ratio (OR)
\[ \text{OR} = e^{\beta} \]
Interpretasi:
- OR > 1: Peningkatan variabel independen meningkatkan odds
outcome
- OR < 1: Peningkatan variabel independen menurunkan odds
outcome
- OR = 1: Tidak ada pengaruh
Koefisien Regresi (β)
Classification Table
- Sensitivity, Specificity
- Accuracy, Precision, Recall
- F1-Score
Studi kasus ini menggunakan data penyakit jantung Cleveland dari UCI Machine Learning Repository yang telah diproses dan dibersihkan. Dataset awal terdiri dari 14 variabel klinis pasien seperti usia, jenis kelamin, tipe nyeri dada, tekanan darah istirahat, kolesterol, denyut jantung maksimum, dan hasil tes lainnya. Setelah proses pembersihan data yang menghilangkan observasi dengan nilai missing, diperoleh 297 observasi yang valid untuk analisis. Variabel target dikonversi menjadi bentuk biner di mana nilai 0 menunjukkan tidak adanya penyakit jantung dan nilai 1 menunjukkan adanya penyakit jantung.
## Warning: package 'tidyverse' was built under R version 4.5.1
## Warning: package 'ggplot2' was built under R version 4.5.2
## Warning: package 'tibble' was built under R version 4.5.1
## Warning: package 'tidyr' was built under R version 4.5.2
## Warning: package 'readr' was built under R version 4.5.1
## Warning: package 'purrr' was built under R version 4.5.1
## Warning: package 'dplyr' was built under R version 4.5.1
## Warning: package 'forcats' was built under R version 4.5.1
## Warning: package 'lubridate' was built under R version 4.5.1
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.2
## ✔ ggplot2 4.0.0 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Warning: package 'car' was built under R version 4.5.1
## Loading required package: carData
## Warning: package 'carData' was built under R version 4.5.1
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some
## Warning: package 'ResourceSelection' was built under R version 4.5.2
## ResourceSelection 0.3-6 2023-06-27
## Warning: package 'pROC' was built under R version 4.5.1
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
##
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
## Warning: package 'caret' was built under R version 4.5.1
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
## Warning: package 'broom' was built under R version 4.5.1
url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/heart-disease/processed.cleveland.data"
heart_data <- read.csv(url, header = FALSE)
# Beri nama kolom sesuai dokumentasi UCI
colnames(heart_data) <- c("age", "sex", "cp", "trestbps", "chol", "fbs",
"restecg", "thalach", "exang", "oldpeak", "slope",
"ca", "thal", "target")
# Bersihkan data (dataset memiliki beberapa missing values berupa "?")
heart_data <- heart_data %>%
mutate(across(everything(), ~ ifelse(. == "?", NA, .))) %>%
mutate(across(c(age, trestbps, chol, thalach, oldpeak), as.numeric),
across(c(sex, cp, fbs, restecg, exang, slope, ca, thal, target), as.factor)) %>%
na.omit()
# Ubah target menjadi biner (0 = no disease, 1 = disease)
heart_data <- heart_data %>%
mutate(heart_disease = ifelse(as.numeric(as.character(target)) > 0, 1, 0),
heart_disease = as.factor(heart_disease))
cat("\n=== STUDI KASUS: PREDIKSI PENYAKIT JANTUNG ===\n")##
## === STUDI KASUS: PREDIKSI PENYAKIT JANTUNG ===
## Jumlah observasi: 297
## Distribusi penyakit jantung:
##
## 0 1
## 160 137
##
## 0 1
## 0.5387205 0.4612795
Dari 297 observasi yang dianalisis, terdapat 160 kasus (53,87%) pasien tanpa penyakit jantung dan 137 kasus (46,13%) pasien dengan penyakit jantung. Proporsi ini menunjukkan distribusi yang relatif seimbang antara kedua kelas target, dengan persentase kasus tanpa penyakit jantung sedikit lebih tinggi dibandingkan kasus dengan penyakit jantung. Keseimbangan data ini menguntungkan untuk pembangunan model klasifikasi karena mencegah bias yang ekstrem terhadap salah satu kelas.
library(tidyverse)
library(car)
library(ResourceSelection)
library(pROC)
library(caret)
library(broom)
library(brglm2)## Warning: package 'brglm2' was built under R version 4.5.2
ggplot(heart_data, aes(x = age, fill = heart_disease)) +
geom_histogram(alpha = 0.7, position = "identity", bins = 20) +
labs(title = "Distribusi Usia berdasarkan Status Penyakit Jantung",
x = "Usia", y = "Frekuensi", fill = "Penyakit Jantung") +
scale_fill_manual(values = c("0" = "skyblue", "1" = "salmon"),
labels = c("0" = "Tidak Sakit", "1" = "Sakit")) +
theme_minimal()ggplot(heart_data, aes(x = heart_disease, y = age, fill = heart_disease)) +
geom_boxplot(alpha = 0.7) +
labs(title = "Perbandingan Usia berdasarkan Status Penyakit Jantung",
x = "Status Penyakit Jantung",
y = "Usia",
fill = "Penyakit Jantung") +
scale_fill_manual(values = c("0" = "lightgreen", "1" = "orange"),
labels = c("0" = "Tidak Sakit", "1" = "Sakit")) +
theme_minimal()Berdasarkan plot distribusi usia terhadap status penyakit jantung, tampak bahwa kelompok usia yang lebih tinggi cenderung memiliki frekuensi penyakit jantung lebih besar dibandingkan kelompok usia yang lebih muda. Distribusi usia untuk pasien tanpa penyakit jantung (0) terpusat pada rentang yang lebih rendah, sementara pasien dengan penyakit jantung (1) menunjukkan konsentrasi yang lebih tinggi pada rentang usia menengah hingga lanjut. Pola ini mengindikasikan bahwa usia merupakan faktor risiko yang signifikan dalam kejadian penyakit jantung, di mana peningkatan usia berkorelasi dengan kemungkinan yang lebih tinggi untuk menderita kondisi jantung. Visualisasi ini secara jelas merepresentasikan hubungan epidemiologis yang telah lama diakui antara penuaan dan peningkatan risiko penyakit kardiovaskular.
numeric_vars <- heart_data %>%
dplyr::select(age, trestbps, chol, thalach, oldpeak) %>%
mutate(across(everything(), as.numeric))
numeric_vars <- heart_data[, c("age", "trestbps", "chol", "thalach", "oldpeak")]
numeric_vars <- as.data.frame(lapply(numeric_vars, as.numeric))
# Hitung matriks korelasi
cor_matrix <- cor(numeric_vars, use = "complete.obs")
cat("Matriks Korelasi:\n")## Matriks Korelasi:
## age trestbps chol thalach oldpeak
## age 1.00 0.29 0.20 -0.39 0.20
## trestbps 0.29 1.00 0.13 -0.05 0.19
## chol 0.20 0.13 1.00 0.00 0.04
## thalach -0.39 -0.05 0.00 1.00 -0.35
## oldpeak 0.20 0.19 0.04 -0.35 1.00
## Warning: package 'ggcorrplot' was built under R version 4.5.2
ggcorrplot(cor_matrix,
method = "circle",
type = "lower",
lab = TRUE,
title = "Matriks Korelasi Variabel Numerik",
colors = c("blue", "white", "red"))## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the ggcorrplot package.
## Please report the issue at <https://github.com/kassambara/ggcorrplot/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Berdasarkan matriks korelasi antar variabel numerik, terlihat bahwa
hubungan yang paling kuat adalah antara usia (age) dengan
denyut jantung maksimal (thalach) yang memiliki korelasi
negatif sebesar -0.39, menunjukkan bahwa semakin tinggi usia seseorang,
semakin rendah denyut jantung maksimal yang dapat dicapai. Selain itu,
usia juga menunjukkan korelasi positif moderat dengan tekanan darah
istirahat (trestbps) sebesar 0.29 dan dengan depresi ST
(oldpeak) sebesar 0.20, mengindikasikan bahwa faktor usia
berkaitan dengan peningkatan kedua parameter klinis tersebut. Sementara
itu, korelasi antara variabel lainnya relatif lemah (di bawah 0.20),
seperti antara kolesterol (chol) dengan tekanan darah
(0.13) dan dengan depresi ST (0.04), yang menunjukkan bahwa dalam
dataset ini hubungan langsung antar sebagian besar faktor risiko klinis
tidak terlalu kuat, sehingga masing-masing variabel mungkin memberikan
kontribusi informasi yang unik dalam memprediksi penyakit jantung.
##
## === DISTRIBUSI VARIABEL KATEGORIKAL ===
# Buat tabel untuk variabel kategorikal penting
categorical_vars <- c("sex", "cp", "fbs", "exang", "slope", "thal")
for(var in categorical_vars) {
cat(paste0("\nDistribusi ", var, ":\n"))
tbl <- table(heart_data[[var]], heart_data$heart_disease)
print(tbl)
# Hitung persentase
prop_tbl <- prop.table(tbl, margin = 1) * 100
cat("Persentase (%):\n")
print(round(prop_tbl, 1))
}##
## Distribusi sex:
##
## 0 1
## 0 71 25
## 1 89 112
## Persentase (%):
##
## 0 1
## 0 74.0 26.0
## 1 44.3 55.7
##
## Distribusi cp:
##
## 0 1
## 1 16 7
## 2 40 9
## 3 65 18
## 4 39 103
## Persentase (%):
##
## 0 1
## 1 69.6 30.4
## 2 81.6 18.4
## 3 78.3 21.7
## 4 27.5 72.5
##
## Distribusi fbs:
##
## 0 1
## 0 137 117
## 1 23 20
## Persentase (%):
##
## 0 1
## 0 53.9 46.1
## 1 53.5 46.5
##
## Distribusi exang:
##
## 0 1
## 0 137 63
## 1 23 74
## Persentase (%):
##
## 0 1
## 0 68.5 31.5
## 1 23.7 76.3
##
## Distribusi slope:
##
## 0 1
## 1 103 36
## 2 48 89
## 3 9 12
## Persentase (%):
##
## 0 1
## 1 74.1 25.9
## 2 35.0 65.0
## 3 42.9 57.1
##
## Distribusi thal:
##
## 0 1
## 3.0 127 37
## 6.0 6 12
## 7.0 27 88
## Persentase (%):
##
## 0 1
## 3.0 77.4 22.6
## 6.0 33.3 66.7
## 7.0 23.5 76.5
# 4. Visualisasi hubungan antar variabel penting
# Hubungan antara age, chol, dan heart_disease
ggplot(heart_data, aes(x = age, y = chol, color = heart_disease, size = oldpeak)) +
geom_point(alpha = 0.7) +
scale_color_manual(values = c("0" = "blue", "1" = "red"),
labels = c("0" = "Tidak Sakit", "1" = "Sakit")) +
labs(title = "Hubungan Usia, Kolesterol, dan Penyakit Jantung",
x = "Usia",
y = "Kolesterol (mg/dl)",
color = "Penyakit Jantung",
size = "Depresi ST (oldpeak)") +
theme_minimal()##
## === ANALISIS MISSING VALUES ===
missing_summary <- sapply(heart_data, function(x) sum(is.na(x)))
cat("Jumlah missing values per variabel:\n")## Jumlah missing values per variabel:
## age sex cp trestbps chol
## 0 0 0 0 0
## fbs restecg thalach exang oldpeak
## 0 0 0 0 0
## slope ca thal target heart_disease
## 0 0 0 0 0
##
## === STATISTIK DESKRIPTIF ===
##
## Variabel Numerik:
## age trestbps chol thalach
## Min. :29.00 Min. : 94.0 Min. :126.0 Min. : 71.0
## 1st Qu.:48.00 1st Qu.:120.0 1st Qu.:211.0 1st Qu.:133.0
## Median :56.00 Median :130.0 Median :243.0 Median :153.0
## Mean :54.54 Mean :131.7 Mean :247.4 Mean :149.6
## 3rd Qu.:61.00 3rd Qu.:140.0 3rd Qu.:276.0 3rd Qu.:166.0
## Max. :77.00 Max. :200.0 Max. :564.0 Max. :202.0
## oldpeak
## Min. :0.000
## 1st Qu.:0.000
## Median :0.800
## Mean :1.056
## 3rd Qu.:1.600
## Max. :6.200
##
##
## Variabel Kategorikal:
##
## sex:
## 0 1
## 96 201
##
## cp:
## 1 2 3 4
## 23 49 83 142
##
## fbs:
## 0 1
## 254 43
##
## exang:
## 0 1
## 200 97
##
## slope:
## 1 2 3
## 139 137 21
##
## thal:
## 3.0 6.0 7.0
## 164 18 115
# SPLIT DATA TRAINING DAN TESTING
set.seed(123)
train_index <- createDataPartition(heart_data$heart_disease, p = 0.7, list = FALSE)
train_data <- heart_data[train_index, ]
test_data <- heart_data[-train_index, ]
cat("=== PEMBAGIAN DATA ===\n")## === PEMBAGIAN DATA ===
## Jumlah data training: 208
## Jumlah data testing: 89
## Proporsi penyakit jantung (training):
##
## 0 1
## 0.5384615 0.4615385
## Proporsi penyakit jantung (testing):
##
## 0 1
## 0.5393258 0.4606742
# MODEL KOMPLEKS PENYAKIT JANTUNG
model_heart <- glm(heart_disease ~ age + sex + cp + trestbps + chol +
fbs + thalach + exang + oldpeak + slope + ca,
data = train_data, family = binomial)
cat("\n=== MODEL REGRESI LOGISTIK UNTUK PENYAKIT JANTUNG ===\n")##
## === MODEL REGRESI LOGISTIK UNTUK PENYAKIT JANTUNG ===
##
## Call:
## glm(formula = heart_disease ~ age + sex + cp + trestbps + chol +
## fbs + thalach + exang + oldpeak + slope + ca, family = binomial,
## data = train_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.188780 3.213053 -2.549 0.010816 *
## age -0.032590 0.028158 -1.157 0.247119
## sex1 1.921765 0.558330 3.442 0.000577 ***
## cp2 1.494414 1.040870 1.436 0.151078
## cp3 1.005018 0.874266 1.150 0.250327
## cp4 3.133798 0.895616 3.499 0.000467 ***
## trestbps 0.031266 0.013441 2.326 0.020007 *
## chol 0.002716 0.005058 0.537 0.591204
## fbs1 -0.705654 0.659552 -1.070 0.284665
## thalach -0.004998 0.012789 -0.391 0.695956
## exang1 0.654140 0.515449 1.269 0.204417
## oldpeak 0.509473 0.273786 1.861 0.062766 .
## slope2 1.474033 0.549229 2.684 0.007279 **
## slope3 0.903148 1.051351 0.859 0.390321
## ca1.0 2.209455 0.599946 3.683 0.000231 ***
## ca2.0 2.617788 0.829723 3.155 0.001605 **
## ca3.0 2.561231 0.989085 2.589 0.009612 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 287.12 on 207 degrees of freedom
## Residual deviance: 139.01 on 191 degrees of freedom
## AIC: 173.01
##
## Number of Fisher Scoring iterations: 6
##
## === ODDS RATIO ===
## Waiting for profiling to be done...
## OR 2.5 % 97.5 %
## (Intercept) 0.000 0.000 0.124
## age 0.968 0.915 1.022
## sex1 6.833 2.397 21.746
## cp2 4.457 0.599 38.062
## cp3 2.732 0.527 17.474
## cp4 22.961 4.445 158.281
## trestbps 1.032 1.006 1.061
## chol 1.003 0.993 1.013
## fbs1 0.494 0.130 1.768
## thalach 0.995 0.970 1.020
## exang1 1.923 0.694 5.314
## oldpeak 1.664 0.996 2.930
## slope2 4.367 1.529 13.402
## slope3 2.467 0.294 19.296
## ca1.0 9.111 2.946 31.584
## ca2.0 13.705 2.924 77.402
## ca3.0 12.952 2.189 118.570
Hasil model regresi logistik menunjukkan bahwa beberapa variabel
memiliki pengaruh signifikan terhadap prediksi penyakit jantung setelah
pembagian data menjadi 208 sampel training dan 89 sampel testing dengan
proporsi penyakit jantung yang relatif seimbang pada kedua subset.
Variabel jenis kelamin pria (sex1) memiliki koefisien
positif tinggi (1.922) dan signifikan secara statistik (p=0.000577),
menunjukkan bahwa pria memiliki risiko lebih besar. Jenis nyeri dada
atipikal (cp4) juga menjadi prediktor kuat dengan koefisien
3.134 (p=0.000467). Tekanan darah sistolik (trestbps) dan
depresi ST (oldpeak) memberikan kontribusi positif
signifikan, sementara usia (age) dan kolesterol
(chol) ternyata tidak signifikan dalam model ini. Model
secara keseluruhan menunjukkan perbaikan yang baik dari null deviance
(287.12) menjadi residual deviance (139.01) dengan penurunan 148.11
poin.
Interpretasi Odds Ratio dalam Tabel
Odds Ratio (OR) mengukur besarnya pengaruh setiap variabel terhadap kemungkinan terkena penyakit jantung:
Faktor Risiko Terkuat: Jenis nyeri dada atipikal
(cp4) memiliki OR=22.96, artinya pasien dengan gejala ini
memiliki kemungkinan 23 kali lebih tinggi menderita
penyakit jantung dibandingkan dengan nyeri dada tipe biasa. Jumlah
pembuluh darah utama yang terblokir (ca) menunjukkan
peningkatan risiko bertahap: ca2.0 (OR=13.71) dan
ca3.0 (OR=12.95) mengindikasikan risiko 13-14 kali
lebih tinggi.
Faktor Demografi Signifikan: Jenis kelamin pria
(sex1) memiliki OR=6.83, menunjukkan pria memiliki risiko
hampir 7 kali lebih besar daripada wanita.
Faktor Klinis Moderat: Peningkatan setiap unit
tekanan darah (trestbps) meningkatkan risiko sebesar 3.2%
(OR=1.032). Kelainan kemiringan segmen ST (slope2)
meningkatkan risiko 4.4 kali (OR=4.367).
Variabel Non-Signifikan: Usia, kolesterol, gula darah puasa, dan denyut jantung maksimal memiliki interval kepercayaan OR yang mencakup nilai 1 (ditunjukkan oleh rentang 2.5%-97.5% yang melintasi 1), mengonfirmasi ketidaksignifikanan statistiknya dalam model ini.
Hasil ini mengonfirmasi bahwa gejala spesifik (jenis nyeri dada, jumlah pembuluh tersumbat) dan faktor demografi (jenis kelamin) merupakan prediktor penyakit jantung yang lebih kuat dibandingkan parameter klinis umum seperti usia atau kolesterol dalam dataset ini
##
## === 1. UJI LIKELIHOOD RATIO ===
null_model_heart <- glm(heart_disease ~ 1, data = train_data, family = binomial)
lr_test_heart <- anova(null_model_heart, model_heart, test = "Chisq")
print(lr_test_heart)## Analysis of Deviance Table
##
## Model 1: heart_disease ~ 1
## Model 2: heart_disease ~ age + sex + cp + trestbps + chol + fbs + thalach +
## exang + oldpeak + slope + ca
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 207 287.12
## 2 191 139.01 16 148.11 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Interpretasi:
## Chi-square: 148.11
## Derajat kebebasan: 16
## p-value: 1.84347e-23
if(lr_test_heart$`Pr(>Chi)`[2] < 0.05) {
cat("Kesimpulan: Model signifikan secara statistik (p < 0.05)\n")
cat(" Model dengan prediktor lebih baik dari model null\n")
} else {
cat("Kesimpulan: Model tidak signifikan secara statistik\n")
cat(" Model dengan prediktor tidak lebih baik dari model null\n")
}## Kesimpulan: Model signifikan secara statistik (p < 0.05)
## Model dengan prediktor lebih baik dari model null
##
## === 2. UJI HOSMER-LEMESHOW ===
# Convert factor to numeric untuk Hosmer-Lemeshow
heart_numeric <- as.numeric(as.character(train_data$heart_disease))
hoslem_result_heart <- hoslem.test(heart_numeric, fitted(model_heart), g = 10)
cat("Hosmer-Lemeshow Goodness of Fit Test:\n")## Hosmer-Lemeshow Goodness of Fit Test:
## Chi-square: 3.558
## Derajat kebebasan: 8
## p-value: 0.8946
if(hoslem_result_heart$p.value > 0.05) {
cat("Kesimpulan: Tidak ada bukti lack of fit (p > 0.05)\n")
cat(" Model sesuai dengan data\n")
} else {
cat("Kesimpulan: Terdapat bukti lack of fit (p < 0.05)\n")
cat(" Model tidak sesuai dengan data\n")
}## Kesimpulan: Tidak ada bukti lack of fit (p > 0.05)
## Model sesuai dengan data
# Visualisasi Hosmer-Lemeshow
hoslem_visual <- function(actual, predicted, g = 10) {
# Group by predicted probabilities
groups <- cut(predicted,
breaks = quantile(predicted, probs = seq(0, 1, 1/g)),
include.lowest = TRUE)
# Calculate observed vs expected
results <- data.frame(
group = levels(groups),
observed = tapply(actual, groups, mean),
expected = tapply(predicted, groups, mean),
n = table(groups)
)
# Plot
library(ggplot2)
p <- ggplot(results, aes(x = expected, y = observed)) +
geom_point(size = 3, color = "blue") +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
geom_segment(aes(x = expected, xend = expected, y = expected, yend = observed),
color = "gray") +
labs(title = "Hosmer-Lemeshow Goodness of Fit",
subtitle = paste("Observed vs Expected (g =", g, "groups)"),
x = "Expected Proportion",
y = "Observed Proportion") +
theme_minimal()
print(p)
return(results)
}
hoslem_visual(heart_numeric, fitted(model_heart), g = 10)## group observed expected n.groups n.Freq
## [0.00282,0.0257] [0.00282,0.0257] 0.00000000 0.01306190 [0.00282,0.0257] 21
## (0.0257,0.0566] (0.0257,0.0566] 0.09523810 0.03915677 (0.0257,0.0566] 21
## (0.0566,0.106] (0.0566,0.106] 0.04761905 0.07921999 (0.0566,0.106] 21
## (0.106,0.221] (0.106,0.221] 0.15000000 0.15330032 (0.106,0.221] 20
## (0.221,0.38] (0.221,0.38] 0.23809524 0.28174875 (0.221,0.38] 21
## (0.38,0.611] (0.38,0.611] 0.47619048 0.50010118 (0.38,0.611] 21
## (0.611,0.814] (0.611,0.814] 0.80000000 0.71675971 (0.611,0.814] 20
## (0.814,0.926] (0.814,0.926] 0.85714286 0.87354813 (0.814,0.926] 21
## (0.926,0.985] (0.926,0.985] 0.95238095 0.96411525 (0.926,0.985] 21
## (0.985,0.999] (0.985,0.999] 1.00000000 0.99184801 (0.985,0.999] 21
##
## === 3. PSEUDO R-SQUARED ===
# Fungsi untuk menghitung berbagai pseudo R-squared
calculate_pseudo_r2 <- function(model) {
# McFadden's R-squared
mcfadden <- 1 - (model$deviance / model$null.deviance)
# Cox & Snell R-squared
cox_snell <- 1 - exp((model$null.deviance - model$deviance) / nrow(model$data))
# Nagelkerke R-squared
nagelkerke <- cox_snell / (1 - exp(-model$null.deviance / nrow(model$data)))
return(list(
McFadden = mcfadden,
Cox_Snell = cox_snell,
Nagelkerke = nagelkerke
))
}
pseudo_r2_results <- calculate_pseudo_r2(model_heart)
cat("McFadden's R-squared:", round(pseudo_r2_results$McFadden, 4), "\n")## McFadden's R-squared: 0.5158
## Cox & Snell R-squared: -1.0382
## Nagelkerke R-squared: -1.387
##
## Interpretasi Pseudo R-squared:
## 0.2 - 0.4: Excellent fit
## 0.15 - 0.2: Good fit
## 0.1 - 0.15: Acceptable fit
## < 0.1: Poor fit
##
## === 4. UJI MULTIKOLINEARITAS (VIF) ===
## GVIF Df GVIF^(1/(2*Df))
## age 1.434526 1 1.197717
## sex 1.374584 1 1.172427
## cp 1.989720 3 1.121498
## trestbps 1.287861 1 1.134839
## chol 1.218415 1 1.103818
## fbs 1.220658 1 1.104834
## thalach 1.605384 1 1.267037
## exang 1.283649 1 1.132982
## oldpeak 1.507172 1 1.227669
## slope 1.754833 2 1.150957
## ca 1.822017 3 1.105161
##
## Interpretasi VIF:
## VIF < 5: Multikolinearitas rendah
## 5 ≤ VIF < 10: Multikolinearitas sedang
## VIF ≥ 10: Multikolinearitas tinggi (perlu tindakan)
## Variabel dengan VIF tinggi:
high_vif <- names(vif_values_heart[vif_values_heart >= 5])
if(length(high_vif) > 0) {
for(var in high_vif) {
cat(paste("-", var, ": VIF =", round(vif_values_heart[var], 2), "\n"))
}
cat("\nRekomendasi: Pertimbangkan untuk menghapus atau menggabungkan variabel ini\n")
} else {
cat("Tidak ada variabel dengan multikolinearitas tinggi (semua VIF < 5)\n")
}## Tidak ada variabel dengan multikolinearitas tinggi (semua VIF < 5)
Berdasarkan rangkaian uji statistik yang dilakukan, model regresi logistik untuk prediksi penyakit jantung ini menunjukkan performa yang sangat baik secara keseluruhan. Uji Likelihood Ratio menghasilkan nilai chi-square sebesar 148.11 dengan p-value sangat signifikan (< 2.2e-16), yang mengkonfirmasi bahwa model dengan prediktor secara statistik jauh lebih baik dibandingkan model null (tanpa prediktor), sehingga variabel-variabel yang dimasukkan memang berkontribusi signifikan dalam memprediksi penyakit jantung.
Uji Hosmer-Lemeshow yang mengukur kecocokan model dengan data observasi menunjukkan hasil yang sangat baik dengan nilai p-value sebesar 0.8946. Nilai ini jauh di atas ambang batas 0.05, yang berarti tidak terdapat bukti bahwa model tidak sesuai (lack of fit) dengan data, atau dengan kata lain, model mampu memprediksi proporsi kejadian penyakit jantung dengan akurat di berbagai kelompok risiko.
Nilai Pseudo R-squared McFadden sebesar 0.5158 termasuk dalam kategori “excellent fit” berdasarkan kriteria interpretasi yang umum digunakan (nilai > 0.2 dianggap excellent). Meskipun dua ukuran pseudo R-squared lainnya (Cox & Snell dan Nagelkerke) menunjukkan nilai negatif yang tidak biasa—kemungkinan akibat karakteristik data tertentu atau kompleksitas model—nilai McFadden yang tinggi tetap mengindikasikan bahwa model menjelaskan variasi data dengan sangat baik.
Terakhir, uji multikolinearitas dengan VIF menunjukkan bahwa semua variabel prediktor memiliki nilai VIF di bawah 2, jauh dari ambang batas kekhawatiran (VIF ≥ 5), yang mengindikasikan tidak adanya masalah multikolinearitas serius antar variabel independen. Hal ini berarti setiap prediktor memberikan kontribusi informasi yang unik dan tidak saling tumpang-tindih dalam menjelaskan variasi penyakit jantung, sehingga koefisien regresi yang diperoleh dapat diinterpretasikan dengan lebih andal.
# Prediksi pada data testing
test_predictions <- predict(model_heart, newdata = test_data, type = "response")
test_class <- ifelse(test_predictions > 0.5, 1, 0)
# Confusion Matrix
conf_matrix_heart <- confusionMatrix(as.factor(test_class),
test_data$heart_disease)
cat("\n=== PERFORMANCE MODEL PADA DATA TESTING ===\n")##
## === PERFORMANCE MODEL PADA DATA TESTING ===
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 42 8
## 1 6 33
##
## Accuracy : 0.8427
## 95% CI : (0.7502, 0.9112)
## No Information Rate : 0.5393
## P-Value [Acc > NIR] : 1.452e-09
##
## Kappa : 0.6823
##
## Mcnemar's Test P-Value : 0.7893
##
## Sensitivity : 0.8750
## Specificity : 0.8049
## Pos Pred Value : 0.8400
## Neg Pred Value : 0.8462
## Prevalence : 0.5393
## Detection Rate : 0.4719
## Detection Prevalence : 0.5618
## Balanced Accuracy : 0.8399
##
## 'Positive' Class : 0
##
# ROC Curve dan AUC
roc_heart <- roc(as.numeric(as.character(test_data$heart_disease)), test_predictions)## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(roc_heart, main = "ROC Curve: Prediksi Penyakit Jantung",
col = "red", lwd = 2, print.auc = TRUE)##
## Nilai AUC: 0.908
Berdasarkan evaluasi performa model pada data testing, model regresi logistik untuk prediksi penyakit jantung ini menunjukkan hasil yang sangat baik dengan akurasi keseluruhan sebesar 84.27%. Nilai akurasi ini secara statistik signifikan lebih tinggi daripada baseline model (No Information Rate sebesar 53.93%) dengan p-value yang sangat kecil (1.452e-09), menunjukkan bahwa model benar-benar memberikan nilai prediktif yang unggul. Dari 89 sampel testing, model berhasil mengklasifikasikan dengan benar 42 dari 48 pasien tanpa penyakit jantung (true negatives) dan 33 dari 41 pasien dengan penyakit jantung (true positives), dengan hanya menghasilkan 14 kesalahan klasifikasi (8 false positives dan 6 false negatives).
Lebih lanjut, model ini mencapai sensitivitas 87.50% yang berarti mampu mendeteksi 87.5% pasien tanpa penyakit jantung dengan benar, dan spesifisitas 80.49% yang menunjukkan kemampuannya mengidentifikasi 80.5% pasien dengan penyakit jantung secara akurat. Nilai Kappa sebesar 0.6823 mengindikasikan tingkat kesepakatan yang substansial antara prediksi model dan kondisi aktual, melampaui kesepakatan yang diharapkan secara kebetulan. Yang paling mengesankan adalah nilai AUC (Area Under Curve) sebesar 0.908, yang termasuk dalam kategori excellent (AUC > 0.9), menandakan bahwa model memiliki kemampuan diskriminasi yang sangat kuat dalam membedakan antara pasien dengan dan tanpa penyakit jantung. Dengan Precision (Positive Predictive Value) 84% dan Recall (Sensitivity) 87.5%, model ini menawarkan keseimbangan yang baik antara mengurangi false alarm dan mendeteksi kasus aktual, menjadikannya alat prediksi yang andal untuk skrining penyakit jantung.