Segmentasi Pasien Berdasarkan Profil Medis: Perbandingan K-Means dengan dan tanpa PCA
Kelompok 09 Anmul
2023E
- Al Zahra Mayluna
- Ayu Ghaniyatur Rohmah
- Maysahayu Artika Maharani
2025-05-19
1 Load Dataset
## 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-Smoker2 Preprocessing
2.1 Cek Missing Value dan Nilai Kosong
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 0Dari hasil cek nilai kosong pada setiap kolom dataset, ditemukan hampir seluruh kolom tidak memiliki nilai kosong, kecuali kolom residence_type terdapat 455 baris data memiliki nilai kosong, yang berarti baris-baris tersebut tidak memiliki informasi tentang jenis tempat tinggal pasien.
2.2 Imputasi Data Menggunakan KNN
2.3 Ubah Kolom Kategorikal ke Numerik
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")2.4 Cek Ulang Missing Value
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 03 K-Means tanpa PCA
3.1 Menentukan Jumlah Cluster
# Elbow Method
fviz_nbclust(data_scaled, kmeans, method = "wss") +
labs(title = "Elbow Method", x = "Jumlah Cluster", y = "WSS")
# Silhouette Method
fviz_nbclust(data_scaled, kmeans, method = "silhouette") +
labs(title = "Silhouette Method")
3.2 K-Means
set.seed(123)
kmeans_result <- kmeans(data_scaled, centers = 3, nstart = 25)
fviz_cluster(list(data = data_scaled, cluster = kmeans_result$cluster),
main = "K-Means Clustering")
Hasil clustering K-Means tanpa PCA menunjukkan bahwa pemilihan tiga
klaster didukung oleh metode Silhouette dan Elbow yang konsisten, dengan
nilai silhouette tertinggi sekitar 0,12. Visualisasi scatter plot
memperlihatkan ketiga klaster terpisah dengan jelas
3.3 Evaluasi K-Means
silhouette_kmeans <- silhouette(kmeans_result$cluster, dist(data_scaled))
silhouette_score_kmeans <- mean(silhouette_kmeans[, 3]) # Nilai rata-rata Silhouette
wss_kmeans <- kmeans_result$tot.withinss # WSS (Within-Cluster Sum of Squares)
cat("Silhouette Score K-Meanstanpa PCA:", silhouette_score_kmeans, "\n")## Silhouette Score K-Meanstanpa PCA: 0.1246539## WSS (Within-Cluster Sum of Squares) K-Means tanpa PCA: 89968.95Nilai Silhouette Score K-Means sebesar 0,12 menunjukkan bahwa pemisahan klaster pada dataset ini masih tergolong rendah hingga sedang. Namun, skor ini masih cukup untuk menunjukkan adanya pola pengelompokan. Nilai WSS sebesar 89.968,95 mengindikasikan tingkat kepadatan klaster, di mana semakin kecil nilai WSS semakin rapat data dalam klaster terhadap centroidnya.
4 K-Means dengan PCA
4.1 PCA
## 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# Hitung variansi kumulatif
cum_var <- summary(pca_res)$importance[3, ]
n_components <- which(cum_var >= 0.8)[1]
pca_data <- as.data.frame(pca_res$x[, 1:n_components])Hasil visualisasi scree plot menunjukkan bahwa komponen utama pertama PC1 dan PC2 menyumbang variasi yang besar dibandingkan komponen lainnya. Berdasarkan output variansi kumulatif, diketahui bahwa:
10 komponen utama pertama telah menjelaskan sekitar 67.25% dari total variansi data.
Sementara lanjutannya hingga PC13, data telah menjelaskan 83.49% variansi kumulatif.
Untuk memenuhi ambang minimal 80% variansi, dipilih 13 komponen utama pertama sebagai representasi data yang direduksi, yang ditandai pada kode n_components = 13. Dengan demikian, PCA dapat menyederhanakan data dari 18 fitur menjadi 13 komponen dan tetap mempertahankan informasi penting, sehingga dapat digunakan untuk klasterisasi yang lebih optimal dan cepat secara komputasi.
4.2 K-Means
set.seed(123)
kmeans_pca <- kmeans(pca_data, centers = 3, nstart = 25)
fviz_cluster(list(data = pca_data, cluster = kmeans_pca$cluster),
main = "K-Means Clustering dengan PCA")
4.3 Evaluasi K-Means
silhouette_kmeans_pca <- silhouette(kmeans_pca$cluster, dist(pca_data))
silhouette_score_kmeans_pca <- mean(silhouette_kmeans_pca[, 3])
wss_kmeans_pca <- kmeans_pca$tot.withinss
cat("Silhouette Score (Dengan PCA):", silhouette_score_kmeans_pca, "\n")## Silhouette Score (Dengan PCA): 0.1504811## WSS (Dengan PCA): 72270.07Setelah data direduksi dimensinya menggunakan PCA menjadi 13 komponen utama, selanjutnya dilakukan klasterisasi menggunakan Fuzzy C-Means.
Hasil visualisasi klaster menunjukkan adanya tiga klaster utama yang terbentuk, yaitu:
Cluster 1 warna merah
Cluster 2 warna hijau
Cluster 3 warna biru
Dengan silhouette score 0.015, WSS 72270 pengelompokan klaster lebih terlihat terpisah meski antar klaster masih nampak tumpang tindih
5 Visualisasi Pebandingan
5.1 Barplot WSS
wss_df <- data.frame(
Metode = c("Tanpa PCA", "Dengan PCA"),
WSS = c(wss_kmeans, wss_kmeans_pca)
)
ggplot(wss_df, aes(x = Metode, y = WSS, fill = Metode)) +
geom_bar(stat = "identity", width = 0.4) +
ggtitle("Perbandingan WSS") +
theme_minimal()
5.2 Barplot Silhoutte Score
silhouette_df <- data.frame(
Metode = c("Tanpa PCA", "Dengan PCA"),
Silhouette = c(silhouette_score_kmeans, silhouette_score_kmeans_pca)
)
ggplot(silhouette_df, aes(x = Metode, y = Silhouette, fill = Metode)) +
geom_bar(stat = "identity", width = 0.4) +
ggtitle("Perbandingan Silhouette Score") +
theme_minimal()
5.3 Silhouette Plot – K-Means tanpa PCA
## cluster size ave.sil.width
## 1 1 476 0.22
## 2 2 2786 0.11
## 3 3 2738 0.12
Hasil clustering K-Means tanpa PCA menunjukkan tiga klaster dengan
ukuran yang tidak seimbang, di mana klaster 1 berisi 476 data dengan
nilai rata-rata silhouette tertinggi 0,22, sedangkan klaster 2 dan 3
masing-masing berisi sekitar 2700 data dengan nilai silhouette lebih
rendah (0,11 dan 0,12). Silhouette plot memperlihatkan bahwa sebagian
besar data memiliki nilai silhouette positif namun relatif kecil,
mengindikasikan pemisahan klaster yang moderat dengan beberapa data
berada di perbatasan klaster. Klaster 1 memiliki kualitas klaster yang
paling baik, sedangkan klaster 2 dan 3 menunjukkan pemisahan yang kurang
tajam. Secara keseluruhan, segmentasi dengan K-Means tanpa PCA
memberikan pemisahan klaster yang cukup baik namun masih ada ruang untuk
peningkatan kualitas klaster.
5.4 Silhouette Plot – K-Means dengan PCA
## cluster size ave.sil.width
## 1 1 476 0.25
## 2 2 2786 0.14
## 3 3 2738 0.14
Hasil clustering K-Means dengan PCA menunjukkan tiga klaster dengan
ukuran hampir seimbang, di mana klaster 1 berisi 476 data dengan
rata-rata silhouette tertinggi 0,25, sementara klaster 2 dan 3
masing-masing berjumlah sekitar 2700 data dengan rata-rata silhouette
0,14. Silhouette plot memperlihatkan mayoritas data memiliki nilai
silhouette positif dan lebih tinggi dibandingkan tanpa PCA, khususnya
pada klaster 1, yang menunjukkan pemisahan klaster yang lebih baik dan
kohesi internal yang lebih kuat. Meskipun demikian, nilai silhouette
pada klaster 2 dan 3 tetap moderat, mengindikasikan adanya tumpang
tindih antar klaster. Secara keseluruhan, penerapan PCA sebelum K-Means
meningkatkan kualitas segmentasi dengan klaster yang lebih kompak dan
terpisah dibandingkan tanpa PCA.