Analisis Regresi untuk Prediksi Kesehatan Jantung Dengan Regresi Linear & logistik
Yudhoro Kunto Wibisono
2025-04-16
Pembangkitan Data Simulasi
Dalam analisis ini, kita akan mensimulasikan data untuk memprediksi risiko penyakit jantung berdasarkan 5 variabel penting: Tekanan darah sistolik (mmHg) Kolesterol total (mg/dL) Indeks massa tubuh (kg/m²) Tingkat aktivitas fisik (skala 1-4) Riwayat keluarga (0/1)
dari variabel tersebut akan dilakukan simulasi dengan membangkitkan data dari 50 mahasiswa yang kemudian akan di analisis menggunakan regresi linear dan regresi logistik
n <- 50 # jumlah pasien
n## [1] 50# Simulasi data
set.seed(456) # Mengatur seed untuk reproduktifitas
# Variabel prediktor dengan distribusi realistis
x1 = round(rnorm(n, 130, 15)) # Tekanan darah sistolik, rata-rata 130 mmHg
x2 = round(rnorm(n, 200, 35)) # Kolesterol total, rata-rata 200 mg/dL
x3 = round(rnorm(n, 27, 4), 1) # Indeks massa tubuh, rata-rata 27 kg/m²
x4 = sample(1:4, n, replace = TRUE,
prob = c(0.3, 0.3, 0.25, 0.15)) # Tingkat aktivitas fisik (1=Sangat Rendah, 4=Tinggi)
x5 = sample(0:1, n, replace = TRUE,
prob = c(0.7, 0.3)) # Riwayat keluarga dengan penyakit jantung (0=Tidak, 1=Ya)# Membuat data frame dengan nama variabel yang lebih deskriptif
data <- data.frame(
TD_Sistolik = x1,
Kolesterol = x2,
IMT = x3,
Aktivitas_Fisik = factor(x4, levels = 1:4,
labels = c("Sangat Rendah", "Rendah", "Sedang", "Tinggi")),
Riwayat_Keluarga = factor(x5, levels = 0:1,
labels = c("Tidak", "Ya"))
)
# Menampilkan data simulasi dalam bentuk tabel
head(data, 10)## TD_Sistolik Kolesterol IMT Aktivitas_Fisik Riwayat_Keluarga
## 1 110 177 27.5 Tinggi Tidak
## 2 139 191 30.5 Sangat Rendah Ya
## 3 142 224 26.6 Rendah Tidak
## 4 109 231 27.3 Sedang Tidak
## 5 119 222 20.3 Rendah Tidak
## 6 125 226 31.5 Sedang Ya
## 7 140 186 21.6 Sangat Rendah Tidak
## 8 134 255 24.9 Sangat Rendah Tidak
## 9 145 219 25.5 Rendah Ya
## 10 139 220 28.4 Tinggi TidakPembangkitan Variabel Target
# Membuat skor kesehatan jantung (100 = sangat sehat, 0 = sangat berisiko)
# Menggunakan koefisien yang mencerminkan pengaruh klinis yang realistis
# Normalisasi variabel-variabel ke skala yang sama
td_norm <- scale(data$TD_Sistolik)
kol_norm <- scale(data$Kolesterol)
imt_norm <- scale(data$IMT)
# Membuat skor kesehatan jantung dengan hubungan yang realistis
data$Skor_Kesehatan <- 70 +
# Tekanan darah tinggi menurunkan skor, dengan efek non-linear
-8 * (td_norm) - 2 * (td_norm^2) +
# Kolesterol tinggi menurunkan skor
-7 * (kol_norm) +
# IMT memiliki efek parabola (terlalu rendah atau tinggi tidak baik)
-6 * (abs(imt_norm)) +
# Aktivitas fisik meningkatkan skor
ifelse(data$Aktivitas_Fisik == "Tinggi", 10,
ifelse(data$Aktivitas_Fisik == "Sedang", 6,
ifelse(data$Aktivitas_Fisik == "Rendah", 3, 0))) +
# Riwayat keluarga menurunkan skor
ifelse(data$Riwayat_Keluarga == "Ya", -8, 0) +
# Komponen acak
rnorm(n, 0, 3)
# Memastikan skor dalam rentang 0-100
data$Skor_Kesehatan <- pmin(pmax(data$Skor_Kesehatan, 0), 100)
data$Skor_Kesehatan <- round(data$Skor_Kesehatan, 1)
# Membuat variabel kategori risiko jantung
data$Kategori_Risiko <- cut(data$Skor_Kesehatan,
breaks = c(0, 40, 60, 80, 100),
labels = c("Sangat Tinggi", "Tinggi", "Sedang", "Rendah"),
include.lowest = TRUE)
# Membuat variabel biner (1 = risiko tinggi)
data$Risiko_Tinggi <- ifelse(data$Skor_Kesehatan < 60, 1, 0)
# Tampilkan data dengan skor dan kategori
head(data, 10)## TD_Sistolik Kolesterol IMT Aktivitas_Fisik Riwayat_Keluarga Skor_Kesehatan
## 1 110 177 27.5 Tinggi Tidak 92.1
## 2 139 191 30.5 Sangat Rendah Ya 57.6
## 3 142 224 26.6 Rendah Tidak 62.8
## 4 109 231 27.3 Sedang Tidak 75.1
## 5 119 222 20.3 Rendah Tidak 64.4
## 6 125 226 31.5 Sedang Ya 55.4
## 7 140 186 21.6 Sangat Rendah Tidak 59.8
## 8 134 255 24.9 Sangat Rendah Tidak 56.1
## 9 145 219 25.5 Rendah Ya 52.7
## 10 139 220 28.4 Tinggi Tidak 71.7
## Kategori_Risiko Risiko_Tinggi
## 1 Rendah 0
## 2 Tinggi 1
## 3 Sedang 0
## 4 Sedang 0
## 5 Sedang 0
## 6 Tinggi 1
## 7 Tinggi 1
## 8 Tinggi 1
## 9 Tinggi 1
## 10 Sedang 0# Menyimpan data ke file CSV
write.csv(data, "data_kesehatan_jantung.csv", row.names = FALSE)Analisis Deskriptif
# Instalasi dan muat package yang diperlukan
if(!require(ggplot2)) install.packages("ggplot2")## Loading required package: ggplot2if(!require(dplyr)) install.packages("dplyr")## Loading required package: 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, unionif(!require(corrplot)) install.packages("corrplot")## Loading required package: corrplot## corrplot 0.94 loadedlibrary(ggplot2)
library(dplyr)
library(corrplot)
# Ringkasan statistik
summary(data)## TD_Sistolik Kolesterol IMT Aktivitas_Fisik
## Min. :100.0 Min. :121.0 Min. :18.70 Sangat Rendah:18
## 1st Qu.:122.2 1st Qu.:181.5 1st Qu.:23.45 Rendah :13
## Median :132.0 Median :199.0 Median :26.30 Sedang :11
## Mean :132.2 Mean :203.3 Mean :26.49 Tinggi : 8
## 3rd Qu.:142.0 3rd Qu.:227.5 3rd Qu.:30.23
## Max. :164.0 Max. :271.0 Max. :33.10
## Riwayat_Keluarga Skor_Kesehatan.V1 Kategori_Risiko Risiko_Tinggi.V1
## Tidak:33 Min. :31.500 Sangat Tinggi: 3 Min. :0.00
## Ya :17 1st Qu.:56.275 Tinggi :16 1st Qu.:0.00
## Median :64.350 Sedang :28 Median :0.00
## Mean :64.410 Rendah : 3 Mean :0.38
## 3rd Qu.:73.025 3rd Qu.:1.00
## Max. :92.700 Max. :1.00# Melihat proporsi kategori risiko
table_risk <- table(data$Kategori_Risiko)
prop_risk <- prop.table(table_risk) * 100
# Tampilkan dalam diagram pie
pie(table_risk,
labels = paste(names(table_risk), "(", round(prop_risk, 1), "%)"),
main = "Distribusi Kategori Risiko Jantung",
col = c("red", "orange", "yellow", "green"))
# Visualisasi distribusi skor kesehatan
ggplot(data, aes(x = Skor_Kesehatan)) +
geom_histogram(bins = 10, fill = "steelblue", color = "black") +
labs(title = "Distribusi Skor Kesehatan Jantung", x = "Skor Kesehatan", y = "Frekuensi") +
theme_minimal()
# Korelasi antar variabel numerik
numeric_data <- data[, c("TD_Sistolik", "Kolesterol", "IMT", "Skor_Kesehatan")]
cor_matrix <- cor(numeric_data)
corrplot(cor_matrix, method = "circle", type = "upper",
tl.col = "black", tl.srt = 45, addCoef.col = "black")
# Hubungan variabel kategorik dengan skor kesehatan
ggplot(data, aes(x = Aktivitas_Fisik, y = Skor_Kesehatan, fill = Aktivitas_Fisik)) +
geom_boxplot() +
labs(title = "Skor Kesehatan Berdasarkan Tingkat Aktivitas Fisik",
x = "Tingkat Aktivitas Fisik", y = "Skor Kesehatan") +
theme_minimal() +
theme(legend.position = "none")
ggplot(data, aes(x = Riwayat_Keluarga, y = Skor_Kesehatan, fill = Riwayat_Keluarga)) +
geom_boxplot() +
labs(title = "Skor Kesehatan Berdasarkan Riwayat Keluarga",
x = "Riwayat Keluarga dengan Penyakit Jantung", y = "Skor Kesehatan") +
theme_minimal() +
theme(legend.position = "none")
Regresi Linear
# Konversi faktor menjadi variabel dummy untuk model regresi
data_model <- data
data_model$Aktivitas_Rendah <- ifelse(data$Aktivitas_Fisik == "Rendah", 1, 0)
data_model$Aktivitas_Sedang <- ifelse(data$Aktivitas_Fisik == "Sedang", 1, 0)
data_model$Aktivitas_Tinggi <- ifelse(data$Aktivitas_Fisik == "Tinggi", 1, 0)
data_model$Riwayat_Ya <- ifelse(data$Riwayat_Keluarga == "Ya", 1, 0)
# Model regresi linear dasar
model <- lm(Skor_Kesehatan ~ TD_Sistolik + Kolesterol + IMT +
Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
Riwayat_Ya, data = data_model)
summary(model)##
## Call:
## lm(formula = Skor_Kesehatan ~ TD_Sistolik + Kolesterol + IMT +
## Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
## Riwayat_Ya, data = data_model)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.1359 -2.9445 -0.0578 3.7037 9.0165
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 172.52553 9.24647 18.659 < 2e-16 ***
## TD_Sistolik -0.49796 0.04718 -10.554 2.19e-13 ***
## Kolesterol -0.21160 0.02326 -9.096 1.76e-11 ***
## IMT 0.02180 0.20456 0.107 0.9156
## Aktivitas_Rendah 2.89174 1.91308 1.512 0.1381
## Aktivitas_Sedang 5.17319 2.07067 2.498 0.0165 *
## Aktivitas_Tinggi 10.11221 2.25030 4.494 5.41e-05 ***
## Riwayat_Ya -9.86305 1.53540 -6.424 9.75e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.955 on 42 degrees of freedom
## Multiple R-squared: 0.8769, Adjusted R-squared: 0.8564
## F-statistic: 42.74 on 7 and 42 DF, p-value: < 2.2e-16# Menambahkan transformasi dan interaksi untuk model yang lebih baik
data_model$TD_squared <- data_model$TD_Sistolik^2
data_model$IMT_squared <- data_model$IMT^2
data_model$TD_IMT <- data_model$TD_Sistolik * data_model$IMT
# Model regresi linear yang disempurnakan
model_improved <- lm(Skor_Kesehatan ~ TD_Sistolik + TD_squared +
Kolesterol + IMT + IMT_squared +
Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
Riwayat_Ya + TD_IMT, data = data_model)
summary(model_improved)##
## Call:
## lm(formula = Skor_Kesehatan ~ TD_Sistolik + TD_squared + Kolesterol +
## IMT + IMT_squared + Aktivitas_Rendah + Aktivitas_Sedang +
## Aktivitas_Tinggi + Riwayat_Ya + TD_IMT, data = data_model)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.0729 -1.3719 0.3257 1.2878 5.6634
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -49.382742 47.179898 -1.047 0.30169
## TD_Sistolik 0.782116 0.470701 1.662 0.10461
## TD_squared -0.006866 0.001498 -4.584 4.61e-05 ***
## Kolesterol -0.219199 0.013149 -16.670 < 2e-16 ***
## IMT 10.830120 1.921202 5.637 1.65e-06 ***
## IMT_squared -0.255901 0.030204 -8.473 2.24e-10 ***
## Aktivitas_Rendah 3.213852 1.058882 3.035 0.00427 **
## Aktivitas_Sedang 6.663851 1.159766 5.746 1.17e-06 ***
## Aktivitas_Tinggi 10.976841 1.306712 8.400 2.79e-10 ***
## Riwayat_Ya -6.996468 0.904896 -7.732 2.17e-09 ***
## TD_IMT 0.020412 0.007516 2.716 0.00980 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.74 on 39 degrees of freedom
## Multiple R-squared: 0.965, Adjusted R-squared: 0.9561
## F-statistic: 107.7 on 10 and 39 DF, p-value: < 2.2e-16# Plot diagnostik model
par(mfrow = c(2, 2))
plot(model_improved)
# Memilih model terbaik dengan metode stepwise
model_final <- step(model_improved, direction = "both")## Start: AIC=110.39
## Skor_Kesehatan ~ TD_Sistolik + TD_squared + Kolesterol + IMT +
## IMT_squared + Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
## Riwayat_Ya + TD_IMT
##
## Df Sum of Sq RSS AIC
## <none> 292.89 110.39
## - TD_Sistolik 1 20.73 313.63 111.81
## - TD_IMT 1 55.39 348.29 117.05
## - Aktivitas_Rendah 1 69.18 362.08 118.99
## - TD_squared 1 157.83 450.72 129.94
## - IMT 1 238.65 531.55 138.19
## - Aktivitas_Sedang 1 247.94 540.84 139.06
## - Riwayat_Ya 1 448.96 741.85 154.86
## - Aktivitas_Tinggi 1 529.96 822.85 160.04
## - IMT_squared 1 539.10 832.00 160.59
## - Kolesterol 1 2086.93 2379.82 213.14summary(model_final)##
## Call:
## lm(formula = Skor_Kesehatan ~ TD_Sistolik + TD_squared + Kolesterol +
## IMT + IMT_squared + Aktivitas_Rendah + Aktivitas_Sedang +
## Aktivitas_Tinggi + Riwayat_Ya + TD_IMT, data = data_model)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.0729 -1.3719 0.3257 1.2878 5.6634
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -49.382742 47.179898 -1.047 0.30169
## TD_Sistolik 0.782116 0.470701 1.662 0.10461
## TD_squared -0.006866 0.001498 -4.584 4.61e-05 ***
## Kolesterol -0.219199 0.013149 -16.670 < 2e-16 ***
## IMT 10.830120 1.921202 5.637 1.65e-06 ***
## IMT_squared -0.255901 0.030204 -8.473 2.24e-10 ***
## Aktivitas_Rendah 3.213852 1.058882 3.035 0.00427 **
## Aktivitas_Sedang 6.663851 1.159766 5.746 1.17e-06 ***
## Aktivitas_Tinggi 10.976841 1.306712 8.400 2.79e-10 ***
## Riwayat_Ya -6.996468 0.904896 -7.732 2.17e-09 ***
## TD_IMT 0.020412 0.007516 2.716 0.00980 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.74 on 39 degrees of freedom
## Multiple R-squared: 0.965, Adjusted R-squared: 0.9561
## F-statistic: 107.7 on 10 and 39 DF, p-value: < 2.2e-16# Visualisasi prediksi vs aktual
data_model$predicted_score <- predict(model_final, data_model)
ggplot(data_model, aes(x = predicted_score, y = Skor_Kesehatan)) +
geom_point() +
geom_abline(intercept = 0, slope = 1, color = "red", linetype = "dashed") +
labs(title = "Skor Kesehatan: Aktual vs Prediksi",
x = "Skor Prediksi", y = "Skor Aktual") +
theme_minimal()
Regresi Logistik
# Model regresi logistik untuk memprediksi risiko tinggi
logm <- glm(Risiko_Tinggi ~ TD_Sistolik + Kolesterol + IMT +
Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
Riwayat_Ya, family = binomial(link = "logit"), data = data_model)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logm)##
## Call:
## glm(formula = Risiko_Tinggi ~ TD_Sistolik + Kolesterol + IMT +
## Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
## Riwayat_Ya, family = binomial(link = "logit"), data = data_model)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -266.5808 170.3032 -1.565 0.118
## TD_Sistolik 1.1799 0.7503 1.573 0.116
## Kolesterol 0.6202 0.4019 1.543 0.123
## IMT -0.4475 0.3833 -1.167 0.243
## Aktivitas_Rendah -27.2353 18.1275 -1.502 0.133
## Aktivitas_Sedang -17.4316 11.3053 -1.542 0.123
## Aktivitas_Tinggi -21.3338 13.7855 -1.548 0.122
## Riwayat_Ya 10.3174 6.5417 1.577 0.115
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 66.406 on 49 degrees of freedom
## Residual deviance: 13.702 on 42 degrees of freedom
## AIC: 29.702
##
## Number of Fisher Scoring iterations: 11# Model regresi logistik dengan transformasi
logm_improved <- glm(Risiko_Tinggi ~ TD_Sistolik + TD_squared +
Kolesterol + IMT + IMT_squared +
Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
Riwayat_Ya, family = binomial(link = "logit"), data = data_model)## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logm_improved)##
## Call:
## glm(formula = Risiko_Tinggi ~ TD_Sistolik + TD_squared + Kolesterol +
## IMT + IMT_squared + Aktivitas_Rendah + Aktivitas_Sedang +
## Aktivitas_Tinggi + Riwayat_Ya, family = binomial(link = "logit"),
## data = data_model)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.266e+03 3.643e+06 0.001 1.000
## TD_Sistolik -3.592e+01 2.826e+04 -0.001 0.999
## TD_squared 1.969e-01 1.116e+02 0.002 0.999
## Kolesterol 7.709e+00 2.053e+03 0.004 0.997
## IMT -1.934e+02 1.471e+05 -0.001 0.999
## IMT_squared 3.575e+00 2.674e+03 0.001 0.999
## Aktivitas_Rendah -2.990e+02 1.554e+05 -0.002 0.998
## Aktivitas_Sedang -2.484e+02 7.023e+04 -0.004 0.997
## Aktivitas_Tinggi -3.698e+02 1.198e+05 -0.003 0.998
## Riwayat_Ya 2.175e+02 6.516e+04 0.003 0.997
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 6.6406e+01 on 49 degrees of freedom
## Residual deviance: 2.7398e-08 on 40 degrees of freedom
## AIC: 20
##
## Number of Fisher Scoring iterations: 25# Memilih model logistik terbaik dengan metode stepwise
logm_final <- step(logm_improved, direction = "both")## Start: AIC=20
## Risiko_Tinggi ~ TD_Sistolik + TD_squared + Kolesterol + IMT +
## IMT_squared + Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
## Riwayat_Ya## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - TD_Sistolik 1 0.000 18.000
## - TD_squared 1 0.000 18.000
## - IMT_squared 1 0.000 18.000
## <none> 0.000 20.000
## - IMT 1 9.716 27.716
## - Riwayat_Ya 1 16.682 34.682
## - Aktivitas_Rendah 1 18.616 36.616
## - Aktivitas_Sedang 1 19.116 37.116
## - Aktivitas_Tinggi 1 20.477 38.477
## - Kolesterol 1 40.165 58.165## Warning: glm.fit: algorithm did not converge
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred##
## Step: AIC=18
## Risiko_Tinggi ~ TD_squared + Kolesterol + IMT + IMT_squared +
## Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
## Riwayat_Ya## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## <none> 0.000 18.000
## + TD_Sistolik 1 0.000 20.000
## - IMT_squared 1 9.709 25.709
## - IMT 1 10.531 26.531
## - Riwayat_Ya 1 17.756 33.756
## - Aktivitas_Rendah 1 19.367 35.367
## - Aktivitas_Sedang 1 19.953 35.953
## - Aktivitas_Tinggi 1 21.379 37.379
## - Kolesterol 1 40.446 56.446
## - TD_squared 1 43.231 59.231summary(logm_final)##
## Call:
## glm(formula = Risiko_Tinggi ~ TD_squared + Kolesterol + IMT +
## IMT_squared + Aktivitas_Rendah + Aktivitas_Sedang + Aktivitas_Tinggi +
## Riwayat_Ya, family = binomial(link = "logit"), data = data_model)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.087e+03 1.004e+06 -0.001 0.999
## TD_squared 8.277e-02 1.772e+01 0.005 0.996
## Kolesterol 1.088e+01 2.297e+03 0.005 0.996
## IMT -1.979e+02 8.430e+04 -0.002 0.998
## IMT_squared 3.721e+00 1.597e+03 0.002 0.998
## Aktivitas_Rendah -4.085e+02 9.040e+04 -0.005 0.996
## Aktivitas_Sedang -3.802e+02 8.723e+04 -0.004 0.997
## Aktivitas_Tinggi -3.635e+02 7.838e+04 -0.005 0.996
## Riwayat_Ya 2.769e+02 6.522e+04 0.004 0.997
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 6.6406e+01 on 49 degrees of freedom
## Residual deviance: 4.5455e-08 on 41 degrees of freedom
## AIC: 18
##
## Number of Fisher Scoring iterations: 25# Menghitung odds ratio
if(!require(broom)) install.packages("broom")## Loading required package: broomlibrary(broom)
# Mengekstrak koefisien dan menghitung odds ratio
coef_tidy <- tidy(logm_final)
coef_tidy$odds_ratio <- exp(coef_tidy$estimate)
coef_tidy$lower_ci <- exp(coef_tidy$estimate - 1.96 * coef_tidy$std.error)
coef_tidy$upper_ci <- exp(coef_tidy$estimate + 1.96 * coef_tidy$std.error)
# Tampilkan hasil
coef_tidy## # A tibble: 9 × 8
## term estimate std.error statistic p.value odds_ratio lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Intercept) -1.09e+3 1003972. -0.00108 0.999 0 0 Inf
## 2 TD_squared 8.28e-2 17.7 0.00467 0.996 1.09e+ 0 8.92e-16 1.32e15
## 3 Kolesterol 1.09e+1 2297. 0.00474 0.996 5.29e+ 4 0 Inf
## 4 IMT -1.98e+2 84297. -0.00235 0.998 1.11e- 86 0 Inf
## 5 IMT_squared 3.72e+0 1597. 0.00233 0.998 4.13e+ 1 0 Inf
## 6 Aktivitas_… -4.09e+2 90397. -0.00452 0.996 3.77e-178 0 Inf
## 7 Aktivitas_… -3.80e+2 87228. -0.00436 0.997 7.64e-166 0 Inf
## 8 Aktivitas_… -3.64e+2 78375. -0.00464 0.996 1.31e-158 0 Inf
## 9 Riwayat_Ya 2.77e+2 65217. 0.00425 0.997 1.81e+120 0 Inf# Visualisasi odds ratio
odds_ratio_plot <- coef_tidy[-1, ] # Menghapus intercept
odds_ratio_plot$term <- factor(odds_ratio_plot$term,
levels = odds_ratio_plot$term[order(odds_ratio_plot$odds_ratio)])
ggplot(odds_ratio_plot, aes(x = term, y = odds_ratio)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = lower_ci, ymax = upper_ci), width = 0.2) +
geom_hline(yintercept = 1, linetype = "dashed", color = "red") +
coord_flip() +
labs(title = "Odds Ratio untuk Risiko Jantung Tinggi (dengan 95% CI)",
x = "Variabel",
y = "Odds Ratio (skala log)") +
scale_y_log10() +
theme_minimal()## Warning in scale_y_log10(): log-10 transformation introduced infinite values.
# Mengevaluasi model logistik
if(!require(caret)) install.packages("caret")## Loading required package: caret## Loading required package: latticelibrary(caret)
# Prediksi probabilitas dan kelas
data_model$prob_risiko <- predict(logm_final, type = "response")
data_model$predicted_risiko <- ifelse(data_model$prob_risiko >= 0.5, 1, 0)
# Membuat confusion matrix
confusionMatrix(factor(data_model$predicted_risiko, levels = c(0, 1)),
factor(data_model$Risiko_Tinggi, levels = c(0, 1)))## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 31 0
## 1 0 19
##
## Accuracy : 1
## 95% CI : (0.9289, 1)
## No Information Rate : 0.62
## P-Value [Acc > NIR] : 4.165e-11
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Sensitivity : 1.00
## Specificity : 1.00
## Pos Pred Value : 1.00
## Neg Pred Value : 1.00
## Prevalence : 0.62
## Detection Rate : 0.62
## Detection Prevalence : 0.62
## Balanced Accuracy : 1.00
##
## 'Positive' Class : 0
## # Kurva ROC
if(!require(pROC)) install.packages("pROC")## Loading required package: pROC## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, varlibrary(pROC)
roc_obj <- roc(data_model$Risiko_Tinggi, data_model$prob_risiko)## Setting levels: control = 0, case = 1## Warning in roc.default(data_model$Risiko_Tinggi, data_model$prob_risiko):
## Deprecated use a matrix as response. Unexpected results may be produced, please
## pass a vector or factor.## Setting direction: controls < casesplot(roc_obj, main = "Kurva ROC untuk Prediksi Risiko Jantung Tinggi",
col = "blue", lwd = 2)
abline(a = 0, b = 1, lty = 2, col = "red")
text(0.6, 0.2, paste("AUC =", round(auc(roc_obj), 3)), col = "blue")
# Visualisasi hubungan tekanan darah dengan probabilitas risiko
ggplot(data_model, aes(x = TD_Sistolik, y = Risiko_Tinggi)) +
geom_point(aes(color = Kategori_Risiko), alpha = 0.7) +
geom_smooth(method = "glm", method.args = list(family = "binomial"), se = TRUE) +
labs(title = "Probabilitas Risiko Tinggi vs Tekanan Darah Sistolik",
x = "Tekanan Darah Sistolik (mmHg)",
y = "Probabilitas Risiko Tinggi") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Simulasi untuk Pengambilan Keputusan Medis
# Contoh pasien baru untuk prediksi
new_patients <- data.frame(
TD_Sistolik = c(120, 145, 160),
Kolesterol = c(180, 220, 260),
IMT = c(23.5, 28.7, 33.2),
Aktivitas_Fisik = factor(c("Sedang", "Rendah", "Sangat Rendah"),
levels = c("Sangat Rendah", "Rendah", "Sedang", "Tinggi")),
Riwayat_Keluarga = factor(c("Tidak", "Tidak", "Ya"), levels = c("Tidak", "Ya"))
)
# Membuat variabel dummy dan transformasi untuk prediksi
new_patients$Aktivitas_Rendah <- ifelse(new_patients$Aktivitas_Fisik == "Rendah", 1, 0)
new_patients$Aktivitas_Sedang <- ifelse(new_patients$Aktivitas_Fisik == "Sedang", 1, 0)
new_patients$Aktivitas_Tinggi <- ifelse(new_patients$Aktivitas_Fisik == "Tinggi", 1, 0)
new_patients$Riwayat_Ya <- ifelse(new_patients$Riwayat_Keluarga == "Ya", 1, 0)
new_patients$TD_squared <- new_patients$TD_Sistolik^2
new_patients$IMT_squared <- new_patients$IMT^2
new_patients$TD_IMT <- new_patients$TD_Sistolik * new_patients$IMT
# Prediksi skor kesehatan
new_patients$prediksi_skor <- predict(model_final, new_patients)
new_patients$prediksi_skor <- round(pmin(pmax(new_patients$prediksi_skor, 0), 100), 1)
# Prediksi kategori risiko
new_patients$kategori_prediksi <- cut(new_patients$prediksi_skor,
breaks = c(0, 40, 60, 80, 100),
labels = c("Sangat Tinggi", "Tinggi", "Sedang", "Rendah"),
include.lowest = TRUE)
# Prediksi probabilitas risiko tinggi
new_patients$prob_risiko <- predict(logm_final, new_patients, type = "response")
new_patients$status_risiko <- ifelse(new_patients$prob_risiko >= 0.5,
"Risiko Tinggi", "Risiko Rendah")
# Tampilkan hasil prediksi
result <- data.frame(
Profil = c("Pasien Ideal", "Pasien Tipikal", "Pasien Berisiko"),
TD_Sistolik = new_patients$TD_Sistolik,
Kolesterol = new_patients$Kolesterol,
IMT = new_patients$IMT,
Aktivitas_Fisik = as.character(new_patients$Aktivitas_Fisik),
Riwayat_Keluarga = as.character(new_patients$Riwayat_Keluarga),
Skor_Kesehatan = new_patients$prediksi_skor,
Kategori_Risiko = as.character(new_patients$kategori_prediksi),
Probabilitas_Risiko_Tinggi = round(new_patients$prob_risiko, 3),
Status = new_patients$status_risiko
)
result## Profil TD_Sistolik Kolesterol IMT Aktivitas_Fisik Riwayat_Keluarga
## 1 Pasien Ideal 120 180 23.5 Sedang Tidak
## 2 Pasien Tipikal 145 220 28.7 Rendah Tidak
## 3 Pasien Berisiko 160 260 33.2 Sangat Rendah Ya
## Skor_Kesehatan Kategori_Risiko Probabilitas_Risiko_Tinggi Status
## 1 83.6 Rendah 0 Risiko Rendah
## 2 59.7 Tinggi 1 Risiko Tinggi
## 3 21.9 Sangat Tinggi 1 Risiko TinggiRekomendasi Medis
Berdasarkan analisis faktor risiko penyakit jantung, berikut rekomendasi untuk kategori pasien yang berbeda:
Untuk Pasien Dengan Risiko Rendah (Skor ≥ 80)
- Pertahankan gaya hidup sehat dengan aktivitas fisik regular
- Lakukan pemeriksaan rutin setiap 2 tahun
- Jaga pola makan seimbang kaya serat dan rendah lemak jenuh
Untuk Pasien Dengan Risiko Sedang (Skor 60-80)
- Tingkatkan aktivitas fisik menjadi minimal 150 menit per minggu
- Kurangi konsumsi natrium (<2,300 mg per hari)
- Kontrol tekanan darah dan kolesterol setiap 6 bulan
- Pertimbangkan konsultasi nutrisi
Untuk Pasien Dengan Risiko Tinggi (Skor 40-60)
- Konsultasi dengan spesialis jantung
- Program penurunan berat badan jika IMT > 25
- Pemeriksaan EKG dan lipid lengkap
- Evaluasi untuk terapi obat jika tekanan darah > 140/90 mmHg
Untuk Pasien Dengan Risiko Sangat Tinggi (Skor < 40)
- Rujukan segera ke spesialis jantung
- Pemeriksaan jantung komprehensif (EKG, ekokardiogram, uji stres)
- Terapi obat untuk mengendalikan tekanan darah dan kolesterol
- Program rehabilitasi jantung terpadu
- Monitoring intensif setiap 3 bulan
Kesimpulan
Model regresi linear dan logistik yang dikembangkan dalam analisis ini memberikan wawasan berharga tentang faktor-faktor yang mempengaruhi kesehatan jantung. Beberapa kesimpulan utama:
Faktor risiko terkuat: Tekanan darah sistolik tinggi, kolesterol tinggi, dan kurangnya aktivitas fisik adalah prediktor terkuat untuk risiko jantung tinggi.
Pengaruh non-linear: Tekanan darah dan IMT menunjukkan efek non-linear, dengan pengaruh yang meningkat secara eksponensial pada level yang lebih tinggi.
Aktivitas fisik sebagai faktor protektif: Pasien dengan tingkat aktivitas fisik sedang dan tinggi memiliki penurunan risiko jantung yang signifikan.
Riwayat keluarga: Riwayat keluarga dengan penyakit jantung tetap menjadi faktor risiko penting yang tidak dapat dimodifikasi.
Akurasi prediktif tinggi: Model logistik final memiliki akurasi tinggi (AUC > 0.9) dalam memprediksi pasien dengan risiko jantung tinggi.
Model ini dapat digunakan oleh profesional kesehatan untuk stratifikasi risiko, perencanaan intervensi, dan pendidikan pasien. Namun, evaluasi klinis komprehensif tetap diperlukan untuk keputusan pengobatan individual