Dosen Pengampu: Ike Fitriyaningsih, M.Si
## age gender chest_pain_type blood_pressure cholesterol max_heart_rate
## 1 24 1 4 250 139 212
## 2 29 0 4 132 187 147
## 3 46 0 3 271 185 193
## 4 73 NA 2 102 200 125
## 5 49 1 3 91 163 192
## 6 63 1 3 18 154 107
## 7 48 0 3 143 275 165
## 8 37 1 4 263 201 201
## 9 20 0 3 113 127 139
## 10 77 1 1 138 217 201
## exercise_angina plasma_glucose skin_thickness insulin bmi
## 1 0 108 33 109 37.99930
## 2 0 202 42 NA 25.58835
## 3 0 149 43 102 37.89203
## 4 0 105 77 165 18.66024
## 5 0 162 31 170 12.76798
## 6 0 103 67 102 22.37385
## 7 0 248 NA 136 27.90071
## 8 0 186 21 180 35.66340
## 9 1 123 NA 120 26.52915
## 10 0 199 100 132 18.39360
## diabetes_pedigree hypertension heart_disease residence_type smoking_status
## 1 0.4802775 1 1 Urban Smoker
## 2 0.2839864 1 1 Urban Unknown
## 3 2.4723086 1 0 Rural Non-Smoker
## 4 1.4720523 0 1 Rural Smoker
## 5 0.5376265 1 1 Rural Smoker
## 6 1.0624109 0 0 Rural Non-Smoker
## 7 1.0737608 1 1 Rural Non-Smoker
## 8 0.1512359 0 0 Urban Smoker
## 9 1.9102780 1 0 Urban Non-Smoker
## 10 1.8253058 1 0 Rural Non-Smoker
data %>%
summarise(across(everything(), ~sum(is.na(.)))) %>%
pivot_longer(everything(), names_to = "Kolom", values_to = "Jumlah_NA") %>%
mutate(Persen_NA = round((Jumlah_NA / nrow(data)) * 100, 2))## # A tibble: 16 × 3
## Kolom Jumlah_NA Persen_NA
## <chr> <int> <dbl>
## 1 age 0 0
## 2 gender 472 7.87
## 3 chest_pain_type 0 0
## 4 blood_pressure 0 0
## 5 cholesterol 0 0
## 6 max_heart_rate 0 0
## 7 exercise_angina 0 0
## 8 plasma_glucose 609 10.2
## 9 skin_thickness 614 10.2
## 10 insulin 568 9.47
## 11 bmi 0 0
## 12 diabetes_pedigree 0 0
## 13 hypertension 0 0
## 14 heart_disease 0 0
## 15 residence_type 0 0
## 16 smoking_status 0 0
# Cek nilai kosong " " atau spasi pada kolom karakter
sapply(data, function(x) {
if (is.character(x) || is.factor(x)) sum(trimws(x) == "") else 0
})## age gender chest_pain_type blood_pressure
## 0 0 0 0
## cholesterol max_heart_rate exercise_angina plasma_glucose
## 0 0 0 0
## skin_thickness insulin bmi diabetes_pedigree
## 0 0 0 0
## hypertension heart_disease residence_type smoking_status
## 0 0 455 0
Dari hasil cek nilai kosong pada setiap kolom dataset, ditemukan kolom gender, plasma_glucose, skin_thickness, dan insulin memiliki nilai kosong (NA). Selain itu, terdapat 455 baris nilai dengan kolom kosong (” “) pada kolom residence_type, yang berarti baris-baris tersebut tidak memiliki informasi tentang jenis tempat tinggal pasien.
ohe_encode <- function(df, column) {
dummies <- dummyVars(as.formula(paste("~", column)), data = df)
ohe <- predict(dummies, newdata = df)
colnames(ohe) <- gsub("\\.", "_", colnames(ohe))
ohe_df <- as.data.frame(ohe)
df <- cbind(df, ohe_df)
df <- df[, !(names(df) %in% column)]
return(df)
}
data <- ohe_encode(data, "residence_type")
data <- ohe_encode(data, "gender")
data <- ohe_encode(data, "smoking_status")data %>%
summarise(across(everything(), ~sum(is.na(.)))) %>%
pivot_longer(everything(), names_to = "Kolom", values_to = "Jumlah_NA") %>%
mutate(Persen_NA = round((Jumlah_NA / nrow(data)) * 100, 2))## # A tibble: 18 × 3
## Kolom Jumlah_NA Persen_NA
## <chr> <int> <dbl>
## 1 age 0 0
## 2 chest_pain_type 0 0
## 3 blood_pressure 0 0
## 4 cholesterol 0 0
## 5 max_heart_rate 0 0
## 6 exercise_angina 0 0
## 7 plasma_glucose 0 0
## 8 skin_thickness 0 0
## 9 insulin 0 0
## 10 bmi 0 0
## 11 diabetes_pedigree 0 0
## 12 hypertension 0 0
## 13 heart_disease 0 0
## 14 residence_typeRural 0 0
## 15 residence_typeUrban 0 0
## 16 smoking_statusNon-Smoker 0 0
## 17 smoking_statusSmoker 0 0
## 18 smoking_statusUnknown 0 0
Dari grafik kNN distance plot (dengan k = 4, artinya minPts = 4), kita
bisa menentukan parameter eps dan minPts berdasarkan titik “elbow” atau
perubahan kemiringan yang signifikan. Terlihat bahwa titik siku mulai
naik tajam sekitar jarak 3.0, sehingga dapat disimpulkan bahwa titik ini
adalah estimasi eps yang baik. Namun, jika terlalu banyak noise, coba
naikkan eps sedikit, sedangkan jika terlalu sedikit cluster yang
terbentuk, atau semua titik masuk 1 cluster, coba kurangi eps.
db_result <- dbscan(data_scaled, eps = 3.6, minPts = 4)
fviz_cluster(list(data = data_scaled, cluster = db_result$cluster),
main = "DBSCAN Clustering")
Parameter ε (epsilon) pada DBSCAN ditentukan menggunakan kNN distance
plot dengan k = 4 sehingga minPts = 4. Untuk grafiknya menunjukkan elbow
atau tekukan di nilai 3 dan garis merah putus-putus pada grafik menandai
ambang epsilon yang digunakan dalam algoritma, sehingga ditetapkan eps =
3.6 untuk meminimalisir noise.
Setelah parameter ditentukan, dilanjutkan klasterisasi menggunakan DBSCAN. Hasil visualisasi menunjukkan bahwa algoritma berhasil mengidentifikasi beberapa klaster yang terpisah, namun masih cukup banyak data yang diklasifikasikan sebagai noise yang ditandai dengan label 0 dan simbol merah. Hal ini mengindikasikan bahwa data asli masih cukup kompleks dan tumpang tindih antar grup pasien.
silhouette_dbscan <- silhouette(db_result$cluster, dist(data_scaled))
silhouette_score_dbscan <- mean(silhouette_dbscan[, 3]) # Nilai rata-rata Silhouette
# Hitung jumlah noise points dengan label 0
noise_points_dbscan <- sum(db_result$cluster == 0)
cat("Silhouette Score DBSCAN tanpa PCA:", silhouette_score_dbscan, "\n")## Silhouette Score DBSCAN tanpa PCA: 0.1592547
## Number of Noise Points DBSCAN tanpa PCA: 10
Pada bagian ini, algoritma DBSCAN tanpa reduksi dimensi PCA menghasilkan Silhouette Score sebesar 0.159, yang menandakan bahwa kualitas klaster masih tergolong rendah. Nilai ini menunjukkan bahwa pemisahan antar klaster belum optimal dan terjadi tumpang tindih (overlap) antar kelompok data, yang mengakibatkan jarak antar titik menjadi kurang representatif dan menghambat pembentukan klaster yang jelas oleh DBSCAN.
Sebanyak 10 data atau sekitar 0.17% dari total 6000 observasi diklasifikasikan sebagai noise karena tidak masuk ke dalam klaster manapun.
## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 PC9 PC10
## 0.10366 0.20654 0.27089 0.33078 0.38998 0.44797 0.50503 0.56139 0.61739 0.67246
## PC11 PC12 PC13 PC14 PC15 PC16 PC17 PC18
## 0.72705 0.78132 0.83493 0.88817 0.94046 0.99219 1.00000 1.00000
# Ambil variansi kumulatif
cum_var <- summary(pca_res)$importance[3, ]
n_components_80 <- which(cum_var >= 0.8)[1] # Komponen pertama yang mencapai ≥80%
cat("Jumlah komponen untuk ≥80% variansi:", n_components_80, "\n")## Jumlah komponen untuk ≥80% variansi: 13
# Opsi 1: PCA dengan variansi kumulatif ≥80%
pca_data_80 <- as.data.frame(pca_res$x[, 1:n_components_80])
# Opsi 2: PCA dengan 10 komponen
pca_data_10 <- as.data.frame(pca_res$x[, 1:10])
# Opsi 3 : PCA dengan 5 komponen
pca_data_5 <- as.data.frame(pca_res$x[, 1:5])
# Opsi 4 : PCA dengan 3 komponen
pca_data_3 <- as.data.frame(pca_res$x[, 1:3])Hasil visualisasi scree plot menunjukkan bahwa komponen utama pertama (PC1) hingga PC2 menyumbang variasi yang cukup besar dibandingkan komponen lainnya. Grafik menunjukkan pola “elbow” yang menandakan penurunan kontribusi variansi mulai terjadi setelah beberapa komponen pertama.
Namun, perlu ditekankan bahwa dalam konteks klasterisasi, tujuan utama bukan sekadar mempertahankan variansi data sebanyak mungkin, melainkan mewakili struktur spasial yang optimal agar kelompok lebih kompak dan terpisah jelas.
Karena itu, digunakan empat opsi jumlah komponen utama:
Opsi 1: 13 komponen utama (pca_data_80) untuk mempertahankan ≥80% variansi total. Cocok jika ingin menjaga informasi sebanyak mungkin.
Opsi 2: 10 komponen utama (pca_data_10) yang menjelaskan ~67.25% variansi. Digunakan jika hasil klaster cukup baik dan komputasi lebih ringan.
Opsi 3: 5 komponen utama (pca_data_5), hanya mencakup ~38.99% variansi, namun bisa memberikan representasi struktur spasial yang lebih jelas untuk clustering.
Opsi 4: 3 komponen utama (pca_data_3), hanya ~27.09% variansi, tetapi sering kali cukup untuk menghasilkan separasi kelompok yang lebih optimal.
Perlu diingat, variansi tinggi belum tentu berguna dalam clustering jika informasi tersebut tidak berkaitan dengan jarak antar titik. Oleh karena itu, jumlah komponen dipilih berdasarkan kualitas hasil clustering (misalnya dari Silhouette Score), bukan semata-mata dari nilai variansi kumulatif.
# Hasil tuning terbaik
best_eps <- 2
best_minPts <- 4
# DBSCAN pada data PCA dengan ≥80% variansi (13 PC)
db_80 <- dbscan(pca_data_80, eps = best_eps, minPts = best_minPts)
# DBSCAN pada data PCA dengan 10 komponen utama
db_10 <- dbscan(pca_data_10, eps = best_eps, minPts = best_minPts)
# DBSCAN pada data PCA dengan 5 komponen utama
db_5 <- dbscan(pca_data_5, eps = best_eps, minPts = best_minPts)
# DBSCAN pada data PCA dengan 3 komponen utama
db_3 <- dbscan(pca_data_3, eps = best_eps, minPts = best_minPts)
# Evaluasi menggunakan Silhouette Score
sil_80 <- silhouette(db_80$cluster, dist(pca_data_80))
sil_10 <- silhouette(db_10$cluster, dist(pca_data_10))
sil_5 <- silhouette(db_5$cluster, dist(pca_data_5))
sil_3 <- silhouette(db_3$cluster, dist(pca_data_3))
# Tampilkan hasil evaluasi
cat("Silhouette Score (80% var):", mean(sil_80[, 3]), "\n")## Silhouette Score (80% var): -0.2711639
## Silhouette Score (10 PC): 0.1809241
## Silhouette Score (5 PC): 0.3453177
## Silhouette Score (3 PC): 0.5484953
Dikarenakan hasil scree plot menunjukkan bahwa dua komponen utama pertama (PC1 dan PC2) menyumbang proporsi variansi terbesar dibandingkan komponen lainnya, maka digunakanlah parameter eps = 2 dan minPts = 4 yang telah ditentukan melalui analisis kNN distance plot. Tujuannya adalah untuk mengevaluasi performa DBSCAN terhadap data hasil reduksi PCA dengan empat opsi berbeda.
Dari hasil yang ada, terlihat bahwa nilai Silhouette Score tertinggi diperoleh pada konfigurasi PCA dengan 3 komponen utama, yaitu sebesar 0.548. Hal ini menunjukkan bahwa struktur klaster paling kompak dan terpisah dengan baik justru terbentuk saat hanya menggunakan sebagian kecil komponen, bukan saat mempertahankan variansi maksimal.
db_result <- dbscan(pca_data_3, eps = 2, minPts = 4)
fviz_cluster(list(data = pca_data_3, cluster = db_result$cluster),
main = "DBSCAN Clustering")
Setelah data direduksi dimensinya menggunakan PCA menjadi 3 komponen
utama, selanjutnya dilakukan klasterisasi menggunakan DBSCAN.
Hasil visualisasi klaster menunjukkan adanya 3 klaster utama yang terbentuk dengan jelas, yaitu:
Cluster 1 warna merah
Cluster 2 warna hijau
Cluster 3 warna biru
silhouette_dbscan_pca <- silhouette(db_result$cluster, dist(pca_data_3))
silhouette_score_dbscan_pca <- mean(silhouette_dbscan_pca[, 3])
noise_points_dbscan <- sum(db_result$cluster == 0)
cat("Silhouette Score DBSCAN dengan PCA:", silhouette_score_dbscan_pca, "\n")## Silhouette Score DBSCAN dengan PCA: 0.5484953
## Number of Noise Points DBSCAN dengan PCA: 0
Hasil klasterisasi menunjukkan adanya peningkatan yang signifikan dibandingkan hasil klaster tanpa PCA. Tidak ada data yang dikategorikan sebagai noise, jauh lebih sempurna klasterisasinya dibandingkan dengan hasil tanpa PCA.
Selain itu, nilai Silhouette Score meningkat menjadi 0,548, yang menunjukkan bahwa pembentukan klaster menjadi lebih baik, dengan pemisahan antar klaster yang lebih jelas serta kohesi yang lebih kuat di dalam klaster
silhouette_df <- data.frame(
Metode = c("Tanpa PCA", "Dengan PCA"),
Silhouette = c(silhouette_score_dbscan, silhouette_score_dbscan_pca)
)
ggplot(silhouette_df, aes(x = Metode, y = Silhouette, fill = Metode)) +
geom_bar(stat = "identity", width = 0.4) +
ggtitle("Perbandingan Silhouette Score") +
theme_minimal()## cluster size ave.sil.width
## 0 0 10 -0.15
## 1 1 5520 0.16
## 2 2 470 0.19
Secara keseluruhan, average silhouette score yang rendah dan bahkan
negatif pada klaster 0 mengindikasikan bahwa pemisahan antar klaster
masih belum optimal. Hal ini disebabkan oleh dimensi data yang tinggi
dan overlap antar fitur, yang menyebabkan DBSCAN kesulitan menemukan
struktur klaster yang jelas. Maka, diperlukan reduksi dimensi seperti
PCA untuk meningkatkan performa klasterisasi.
## cluster size ave.sil.width
## 1 1 2786 0.54
## 2 2 476 0.65
## 3 3 2738 0.54
Setelah reduksi dimensi dengan PCA, terutama dengan hanya menggunakan 3
komponen utama, struktur spasial antar data menjadi lebih terdefinisi.
Nilai average silhouette width pada seluruh klaster meningkat secara
drastis dibandingkan kondisi tanpa PCA. Ini membuktikan bahwa reduksi
dimensi tidak hanya menyederhanakan data, tetapi juga membantu algoritma
DBSCAN dalam mengidentifikasi klaster yang lebih jelas dan kohesif,
tanpa perlu mempertahankan seluruh variansi awal. Selain itu, tidak
ditemukan noise atau misclustered point secara eksplisit dari output
ini, yang menandakan bahwa semua data berhasil dikelompokkan dengan
baik.
data$Cluster <- db_result$cluster
# statistik deskriptif
cluster_summary <- data %>%
group_by(Cluster) %>%
summarise(across(everything(), list(mean = ~mean(. , na.rm = TRUE), sd = ~sd(. , na.rm = TRUE)), .names = "{col}_{fn}"))
cluster_summary## # A tibble: 3 × 37
## Cluster age_mean age_sd chest_pain_type_mean chest_pain_type_sd
## <int> <dbl> <dbl> <dbl> <dbl>
## 1 1 53.6 21.0 2.53 1.13
## 2 2 53.9 21.5 2.51 1.12
## 3 3 53.7 21.0 2.51 1.12
## # ℹ 32 more variables: blood_pressure_mean <dbl>, blood_pressure_sd <dbl>,
## # cholesterol_mean <dbl>, cholesterol_sd <dbl>, max_heart_rate_mean <dbl>,
## # max_heart_rate_sd <dbl>, exercise_angina_mean <dbl>,
## # exercise_angina_sd <dbl>, plasma_glucose_mean <dbl>,
## # plasma_glucose_sd <dbl>, skin_thickness_mean <dbl>,
## # skin_thickness_sd <dbl>, insulin_mean <dbl>, insulin_sd <dbl>,
## # bmi_mean <dbl>, bmi_sd <dbl>, diabetes_pedigree_mean <dbl>, …