library(tidyr)
library(MASS)
library(brant)
library(dplyr)
library(ggplot2)
library(caret)
library(DT)
library(knitr)
library(kableExtra)
library(corrplot)
library(car)
if (!require("heplots")) install.packages("heplots")
library(heplots)
# 1. Persiapan Data
df <- read.csv("HeartDiseaseTrain-Test.csv", stringsAsFactors = TRUE)
# Cek Missing Value
na_check <- data.frame(Nilai_Kosong = colSums(is.na(df)))
kable(na_check, caption = "Identifikasi Nilai Kosong pada Dataset") %>%
kable_styling(bootstrap_options = "condensed", full_width = F)
Identifikasi Nilai Kosong pada Dataset
|
|
Nilai_Kosong
|
|
age
|
0
|
|
sex
|
0
|
|
chest_pain_type
|
0
|
|
resting_blood_pressure
|
0
|
|
cholestoral
|
0
|
|
fasting_blood_sugar
|
0
|
|
rest_ecg
|
0
|
|
Max_heart_rate
|
0
|
|
exercise_induced_angina
|
0
|
|
oldpeak
|
0
|
|
slope
|
0
|
|
vessels_colored_by_flourosopy
|
0
|
|
thalassemia
|
0
|
|
target
|
0
|
# Deteksi Outlier (Variabel Numerik)
df_numeric <- df %>% select_if(is.numeric) %>% select(-target)
df_long <- df_numeric %>% pivot_longer(cols = everything(), names_to = "Var", values_to = "Val")
ggplot(df_long, aes(x = "", y = Val, fill = Var)) +
geom_boxplot(outlier.color = "red", alpha = 0.7) +
facet_wrap(~Var, scales = "free", ncol = 3) +
theme_bw() +
labs(title = "Boxplot untuk Deteksi Outlier", y = "Nilai", x = "") +
theme(legend.position = "none")
# Rekayasa Variabel Ordinal
df_final <- df %>%
mutate(target_ordinal = case_when(
target == 0 ~ "Sehat",
target == 1 & (vessels_colored_by_flourosopy == "Zero") ~ "Risiko Rendah",
target == 1 & (vessels_colored_by_flourosopy != "Zero") ~ "Risiko Tinggi"
)) %>%
mutate(target_ordinal = factor(target_ordinal,
levels = c("Sehat", "Risiko Rendah", "Risiko Tinggi"),
ordered = TRUE)) %>%
select(-target)
datatable(head(df_final, 50), options = list(pageLength = 5), caption = "Dataset Setelah Transformasi")
# 2. Eksplorasi Hubungan Variabel
cor_mat <- cor(df %>% select_if(is.numeric))
corrplot(cor_mat, method = "color", type = "upper", tl.cex = 0.7,
addCoef.col = "black", number.cex = 0.6,
col = colorRampPalette(c("#E41A1C", "white", "#377EB8"))(200))
# 3. Pengujian Multikolinearitas
vif_model <- lm(as.numeric(target_ordinal) ~ ., data = df_final)
vif_values <- vif(vif_model)
if(is.matrix(vif_values) || is.array(vif_values)){
vif_df <- as.data.frame(vif_values)
} else {
vif_df <- data.frame(Variabel = names(vif_values), Nilai_VIF = as.numeric(vif_values))
}
kable(vif_df, caption = "Hasil Uji VIF") %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = F)
Hasil Uji VIF
|
|
GVIF
|
Df
|
GVIF^(1/(2*Df))
|
|
age
|
1.551126
|
1
|
1.245442
|
|
sex
|
1.355486
|
1
|
1.164253
|
|
chest_pain_type
|
1.806342
|
3
|
1.103570
|
|
resting_blood_pressure
|
1.232774
|
1
|
1.110303
|
|
cholestoral
|
1.170485
|
1
|
1.081889
|
|
fasting_blood_sugar
|
1.138739
|
1
|
1.067117
|
|
rest_ecg
|
1.217927
|
2
|
1.050523
|
|
Max_heart_rate
|
1.771458
|
1
|
1.330961
|
|
exercise_induced_angina
|
1.517459
|
1
|
1.231852
|
|
oldpeak
|
1.937646
|
1
|
1.391993
|
|
slope
|
1.971660
|
2
|
1.184972
|
|
vessels_colored_by_flourosopy
|
1.790937
|
4
|
1.075561
|
|
thalassemia
|
1.692594
|
3
|
1.091672
|
# 4. Implementasi Regresi Logistik Ordinal
fit_awal <- polr(target_ordinal ~ ., data = df_final, Hess = TRUE)
model_ordinal <- step(fit_awal, direction = "both", trace = 0)
sum_mod <- coef(summary(model_ordinal))
p_values <- pnorm(abs(sum_mod[, "t value"]), lower.tail = FALSE) * 2
res_table <- cbind(sum_mod, "p_value" = round(p_values, 5))
kable(res_table, caption = "Estimasi Koefisien Model Ordinal") %>%
kable_styling(bootstrap_options = c("striped", "bordered")) %>%
row_spec(which(res_table[,4] < 0.05), bold = T, color = "#2C3E50")
Estimasi Koefisien Model Ordinal
|
|
Value
|
Std. Error
|
t value
|
p_value
|
|
age
|
0.0274092
|
0.0101949
|
2.6885082
|
0.00718
|
|
sexMale
|
-1.1089123
|
0.1840103
|
-6.0263591
|
0.00000
|
|
chest_pain_typeAtypical angina
|
-1.0582080
|
0.3178129
|
-3.3296574
|
0.00087
|
|
chest_pain_typeNon-anginal pain
|
-0.4853027
|
0.2949815
|
-1.6451969
|
0.09993
|
|
chest_pain_typeTypical angina
|
-2.0715989
|
0.3036428
|
-6.8224855
|
0.00000
|
|
resting_blood_pressure
|
-0.0119050
|
0.0047933
|
-2.4836937
|
0.01300
|
|
rest_ecgNormal
|
0.7032483
|
0.8870178
|
0.7928232
|
0.42788
|
|
rest_ecgST-T wave abnormality
|
1.1087715
|
0.8892887
|
1.2468071
|
0.21247
|
|
Max_heart_rate
|
0.0132807
|
0.0045748
|
2.9030271
|
0.00370
|
|
exercise_induced_anginaYes
|
-0.5884262
|
0.2006744
|
-2.9322435
|
0.00337
|
|
oldpeak
|
-0.4104217
|
0.1011837
|
-4.0562060
|
0.00005
|
|
slopeFlat
|
-0.9230723
|
0.1912663
|
-4.8261115
|
0.00000
|
|
slopeUpsloping
|
-0.1381025
|
0.3640716
|
-0.3793279
|
0.70444
|
|
vessels_colored_by_flourosopyOne
|
-3.9665686
|
0.7437438
|
-5.3332457
|
0.00000
|
|
vessels_colored_by_flourosopyThree
|
-4.9114073
|
0.8420629
|
-5.8325893
|
0.00000
|
|
vessels_colored_by_flourosopyTwo
|
-5.1864755
|
0.8026195
|
-6.4619355
|
0.00000
|
|
vessels_colored_by_flourosopyZero
|
-4.1854375
|
0.7295177
|
-5.7372669
|
0.00000
|
|
thalassemiaNo
|
-1.2745430
|
0.9821584
|
-1.2976960
|
0.19439
|
|
thalassemiaNormal
|
-0.1657682
|
0.3517070
|
-0.4713248
|
0.63741
|
|
thalassemiaReversable Defect
|
-1.2553513
|
0.1936385
|
-6.4829623
|
0.00000
|
|
Sehat|Risiko Rendah
|
-5.0917332
|
1.6597825
|
-3.0677111
|
0.00216
|
|
Risiko Rendah|Risiko Tinggi
|
-1.6014438
|
1.6466242
|
-0.9725618
|
0.33077
|
# Validasi Asumsi Parallel Odds (Uji Brant)
brant_res <- as.matrix(brant(model_ordinal))
## --------------------------------------------------------------------
## Test for X2 df probability
## --------------------------------------------------------------------
## Omnibus 2023.53 20 0
## age 0 1 0.97
## sexMale 2.95 1 0.09
## chest_pain_typeAtypical angina 4.65 1 0.03
## chest_pain_typeNon-anginal pain 0.44 1 0.51
## chest_pain_typeTypical angina 6.2 1 0.01
## resting_blood_pressure 4.59 1 0.03
## rest_ecgNormal 0 1 1
## rest_ecgST-T wave abnormality 0 1 1
## Max_heart_rate 4.9 1 0.03
## exercise_induced_anginaYes 8.04 1 0
## oldpeak 5.16 1 0.02
## slopeFlat 0.76 1 0.38
## slopeUpsloping 5.1 1 0.02
## vessels_colored_by_flourosopyOne 1.19 1 0.28
## vessels_colored_by_flourosopyThree 0 1 0.98
## vessels_colored_by_flourosopyTwo 1.1 1 0.29
## vessels_colored_by_flourosopyZero 0 1 0.98
## thalassemiaNo 0 1 1
## thalassemiaNormal 0 1 0.99
## thalassemiaReversable Defect 0.34 1 0.56
## --------------------------------------------------------------------
##
## H0: Parallel Regression Assumption holds
brant_df <- data.frame(
Variabel = rownames(brant_res),
Chi_Square = as.numeric(brant_res[,1]),
df = as.numeric(brant_res[,2]),
p_value = as.numeric(brant_res[,3])
)
kable(brant_df, row.names = FALSE, caption = "Uji Brant untuk Asumsi Proportional Odds") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F) %>%
row_spec(which(brant_df$p_value < 0.05), bold = T, color = "white", background = "#e74c3c") %>%
row_spec(1, bold = T, background = "#f1c40f")
Uji Brant untuk Asumsi Proportional Odds
|
Variabel
|
Chi_Square
|
df
|
p_value
|
|
Omnibus
|
2023.5337140
|
20
|
0.0000000
|
|
age
|
0.0015954
|
1
|
0.9681389
|
|
sexMale
|
2.9517585
|
1
|
0.0857842
|
|
chest_pain_typeAtypical angina
|
4.6489829
|
1
|
0.0310720
|
|
chest_pain_typeNon-anginal pain
|
0.4391236
|
1
|
0.5075458
|
|
chest_pain_typeTypical angina
|
6.1978738
|
1
|
0.0127904
|
|
resting_blood_pressure
|
4.5856680
|
1
|
0.0322404
|
|
rest_ecgNormal
|
0.0000050
|
1
|
0.9982159
|
|
rest_ecgST-T wave abnormality
|
0.0000069
|
1
|
0.9979116
|
|
Max_heart_rate
|
4.9020855
|
1
|
0.0268243
|
|
exercise_induced_anginaYes
|
8.0375075
|
1
|
0.0045819
|
|
oldpeak
|
5.1624878
|
1
|
0.0230798
|
|
slopeFlat
|
0.7567318
|
1
|
0.3843532
|
|
slopeUpsloping
|
5.0983879
|
1
|
0.0239481
|
|
vessels_colored_by_flourosopyOne
|
1.1902295
|
1
|
0.2752833
|
|
vessels_colored_by_flourosopyThree
|
0.0004677
|
1
|
0.9827455
|
|
vessels_colored_by_flourosopyTwo
|
1.1021589
|
1
|
0.2937928
|
|
vessels_colored_by_flourosopyZero
|
0.0008365
|
1
|
0.9769264
|
|
thalassemiaNo
|
0.0000001
|
1
|
0.9997668
|
|
thalassemiaNormal
|
0.0000571
|
1
|
0.9939713
|
|
thalassemiaReversable Defect
|
0.3436397
|
1
|
0.5577358
|
# 5. Implementasi Linear Discriminant Analysis (LDA)
box_m_test <- boxM(df_final[, sapply(df_final, is.numeric)], df_final$target_ordinal)
kable(data.frame(Statistic = box_m_test$statistic, P_Value = box_m_test$p.value),
caption = "Hasil Uji Box's M") %>%
kable_styling(full_width = F)
Hasil Uji Box’s M
|
|
Statistic
|
P_Value
|
|
Chi-Sq (approx.)
|
318.8451
|
0
|
model_lda <- lda(target_ordinal ~ ., data = df_final)
pred_lda <- predict(model_lda, df_final)
# Evaluasi Klasifikasi LDA
cm_lda_data <- as.data.frame(confusionMatrix(pred_lda$class, df_final$target_ordinal)$table)
ggplot(data = cm_lda_data, aes(x = Reference, y = Prediction, fill = Freq)) +
geom_tile(color = "white") +
scale_fill_gradient(low = "#f1f8e9", high = "#388e3c") +
geom_text(aes(label = Freq), fontface = "bold") +
theme_minimal() +
labs(title = "Confusion Matrix: Model LDA", x = "Data Aktual", y = "Prediksi Model")
# Koefisien Fungsi Diskriminan (Melihat kontribusi variabel)
lda_scaling <- as.data.frame(model_lda$scaling)
kable(lda_scaling, caption = "Koefisien Fungsi Diskriminan (Linear Discriminants)") %>%
kable_styling(bootstrap_options = c("striped", "condensed"), full_width = F)
Koefisien Fungsi Diskriminan (Linear Discriminants)
|
|
LD1
|
LD2
|
|
age
|
0.0090255
|
0.0048709
|
|
sexMale
|
-0.3476777
|
-0.8099128
|
|
chest_pain_typeAtypical angina
|
0.1538642
|
-0.7897268
|
|
chest_pain_typeNon-anginal pain
|
0.1151671
|
-0.3524452
|
|
chest_pain_typeTypical angina
|
-0.2964904
|
-1.4309526
|
|
resting_blood_pressure
|
-0.0077142
|
-0.0044810
|
|
cholestoral
|
-0.0024808
|
0.0006058
|
|
fasting_blood_sugarLower than 120 mg/ml
|
-0.0362299
|
-0.1414234
|
|
rest_ecgNormal
|
0.2672660
|
0.3142513
|
|
rest_ecgST-T wave abnormality
|
0.2057570
|
0.7020759
|
|
Max_heart_rate
|
0.0097357
|
-0.0005049
|
|
exercise_induced_anginaYes
|
-0.3436930
|
-0.1388443
|
|
oldpeak
|
-0.0740067
|
-0.1949089
|
|
slopeFlat
|
-0.1793058
|
-0.7163466
|
|
slopeUpsloping
|
-0.4526484
|
0.0363464
|
|
vessels_colored_by_flourosopyOne
|
0.3057767
|
-3.0225967
|
|
vessels_colored_by_flourosopyThree
|
0.5870854
|
-3.5983201
|
|
vessels_colored_by_flourosopyTwo
|
0.3827396
|
-3.6742838
|
|
vessels_colored_by_flourosopyZero
|
2.9022841
|
-4.8250407
|
|
thalassemiaNo
|
-1.3160314
|
-0.3524283
|
|
thalassemiaNormal
|
0.0533317
|
-0.4321205
|
|
thalassemiaReversable Defect
|
-0.6713137
|
-0.5126318
|
# Visualisasi Plot Skor LD1 vs LD2
# Mengambil skor LD untuk tiap observasi
lda_scores <- predict(model_lda)$x
lda_plot_df <- cbind(df_final, lda_scores)
ggplot(lda_plot_df, aes(x = LD1, y = LD2, color = target_ordinal)) +
geom_point(alpha = 0.6, size = 2) +
stat_ellipse(aes(fill = target_ordinal), geom = "polygon", alpha = 0.1) +
theme_minimal() +
scale_color_brewer(palette = "Set1") +
scale_fill_brewer(palette = "Set1") +
labs(title = "Pemisahan Kelompok Berdasarkan Skor LD1 dan LD2",
subtitle = "Lingkaran menunjukkan cakupan area tiap kategori risiko",
x = "Linear Discriminant 1 (LD1)",
y = "Linear Discriminant 2 (LD2)",
color = "Status Risiko",
fill = "Status Risiko")
# 6. Kesimpulan dan Perbandingan Model
acc_ord <- confusionMatrix(predict(model_ordinal, df_final), df_final$target_ordinal)$overall['Accuracy']
acc_lda <- confusionMatrix(pred_lda$class, df_final$target_ordinal)$overall['Accuracy']
perbandingan <- data.frame(
Metode = c("Regresi Logistik Ordinal", "Linear Discriminant Analysis (LDA)"),
Akurasi = c(paste(round(acc_ord*100, 2), "%"), paste(round(acc_lda*100, 2), "%"))
)
kable(perbandingan, caption = "Perbandingan Akurasi Klasifikasi") %>%
kable_styling(bootstrap_options = c("striped", "inverse"), full_width = F)
Perbandingan Akurasi Klasifikasi
|
Metode
|
Akurasi
|
|
Regresi Logistik Ordinal
|
73.95 %
|
|
Linear Discriminant Analysis (LDA)
|
87.71 %
|