Penyakit menular seperti Malaria, Tuberkulosis (TB) Paru, Pneumonia, Kusta, dan Demam Berdarah Dengue (DBD) masih menjadi permasalahan kesehatan masyarakat di Indonesia. Meskipun tersebar di seluruh wilayah, tingkat keparahan dan pola sebaran penyakit ini sangat bervariasi antarprovinsi. Oleh karena itu, diperlukan pendekatan analisis yang mampu mengelompokkan provinsi-provinsi berdasarkan kesamaan karakteristik kasus penyakit. Proses analisis menggunakan analisis gerombol (clustering) dengan tiga pendekatan berbeda — Hierarchical Clustering, K-Means, dan K-Medoids (PAM) — untuk menemukan pola kesamaan antarprovinsi dalam hal jumlah kasus penyakit. Data bersumber dari Badan Pusat Statistik (BPS) tahun 2018, mencakup lima variabel numerik penyakit utama.
library(cluster)
## Warning: package 'cluster' was built under R version 4.4.3
library(factoextra)
## Warning: package 'factoextra' was built under R version 4.4.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.4.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(clusterCrit)
## Warning: package 'clusterCrit' was built under R version 4.4.3
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.4.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.4.2
library(scales)
## Warning: package 'scales' was built under R version 4.4.3
library(RColorBrewer)
library(readxl)
## Warning: package 'readxl' was built under R version 4.4.3
df_sick <- read_excel("C:\\Users\\FAQIH\\Downloads\\Jumlah Kasus Penyakit Menurut Provinsi dan Jenis Penyakit, 2018.xlsx")
df_sick <- df_sick %>% select(where(is.numeric)) %>% na.omit()
data_scaled <- scale(df_sick)
# Matriks jarak Euclidean
dist_matrix <- dist(data_scaled, method = "euclidean")#"euclidean", "maximum", "manhattan", "canberra", "binary" or "minkowski"
# Hierarchical clustering dengan metode Ward
hc_ward <- hclust(dist_matrix, method = "ward.D2") #"single", "complete", "average" (= UPGMA), "mcquitty" "median" or "centroid"
hc_ward
##
## Call:
## hclust(d = dist_matrix, method = "ward.D2")
##
## Cluster method : ward.D2
## Distance : euclidean
## Number of objects: 34
fviz_dend(hc_ward, k = 3, rect = TRUE, palette = "jco",
main = "Dendrogram Hierarchical Clustering (Ward.D2)")
## 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 factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
cluster_hc <- cutree(hc_ward, k = 3)
table(cluster_hc)
## cluster_hc
## 1 2 3
## 30 2 2
Proses pengelompokan hierarkis dengan metode Ward menghasilkan struktur klaster yang kuat dengan tiga kelompok utama. Berdasarkan dendrogram yang terbentuk, terlihat bahwa sebagian besar provinsi memiliki pola penyakit yang sangat berdekatan dan tergabung dalam satu kelompok besar, sementara empat provinsi lainnya membentuk dua kelompok kecil yang terpisah cukup jauh dari kelompok utama. Jarak penggabungan (height) antarcluster meningkat tajam pada tahap akhir dengan nilai maksimum sebesar 12.22, menandakan adanya perbedaan yang nyata antara cluster yang terbentuk.
Pemotongan dendrogram pada tingkat tiga menghasilkan distribusi cluster sebesar Cluster 1 = 30 provinsi, Cluster 2 = 2 provinsi, dan Cluster 3 = 2 provinsi. Struktur ini menunjukkan bahwa mayoritas provinsi memiliki kemiripan tingkat kasus penyakit yang tinggi, sementara beberapa provinsi memiliki karakteristik ekstrem terhadap satu atau dua jenis penyakit tertentu.
head(data.frame(Observasi = 1:length(cluster_hc),
Cluster = cluster_hc),10)
## Observasi Cluster
## 1 1 1
## 2 2 1
## 3 3 1
## 4 4 1
## 5 5 1
## 6 6 1
## 7 7 1
## 8 8 1
## 9 9 1
## 10 10 1
names(hc_ward)
## [1] "merge" "height" "order" "labels" "method"
## [6] "call" "dist.method"
head(hc_ward$merge, 10)
## [,1] [,2]
## [1,] -4 -5
## [2,] -17 -29
## [3,] -28 -30
## [4,] -1 -25
## [5,] -9 1
## [6,] -10 2
## [7,] -6 -8
## [8,] -26 3
## [9,] -7 6
## [10,] -3 -21
hc_ward$height
## [1] 0.1690442 0.1804403 0.1941351 0.2309455 0.2506506 0.2984490
## [7] 0.3067994 0.3615419 0.3844469 0.4391191 0.4790739 0.5899865
## [13] 0.6395679 0.6533429 0.7285358 0.7454685 0.8156765 0.8501094
## [19] 1.0723260 1.1126533 1.1482573 1.5293110 1.7217081 1.8184431
## [25] 2.1901786 2.2332191 2.2986210 2.5303582 2.7528773 3.8495067
## [31] 7.2689705 8.1754084 12.2222545
hc_ward$order
## [1] 12 15 19 34 6 8 20 23 22 3 21 9 4 5 24 7 10 17 29 1 25 26 28 30 16
## [26] 18 27 32 31 33 14 2 11 13
eval_cluster <- function(data_scaled, cluster, dist_matrix) {
sil <- mean(silhouette(cluster, dist_matrix)[, 3])
ch <- intCriteria(traj = as.matrix(data_scaled),
part = cluster, crit = "Calinski_Harabasz")$calinski_harabasz
dunn <- intCriteria(traj = as.matrix(data_scaled),
part = cluster, crit = "Dunn")$dunn
return(data.frame(Silhouette = sil,
Calinski_Harabasz = ch,
Dunn = dunn))
}
eval_cluster(data_scaled, cluster_hc, dist_matrix)
## Silhouette Calinski_Harabasz Dunn
## 1 0.651027 29.4555 0.5819343
Kualitas hasil pengelompokan dinilai melalui tiga metrik evaluasi, yaitu Silhouette = 0.651, Calinski–Harabasz = 29.455, dan Dunn Index = 0.582. Nilai Silhouette di atas 0.6 mengindikasikan bahwa observasi dalam satu cluster memiliki jarak rata-rata antaranggota yang lebih kecil dibandingkan jaraknya terhadap cluster lain, sehingga pengelompokan yang dihasilkan dapat dianggap baik. Nilai Calinski–Harabasz yang cukup tinggi menegaskan bahwa variasi antarcluster lebih besar dibandingkan variasi di dalam cluster. Sementara itu, Dunn Index mendekati 0.6 menandakan jarak antarcluster jauh lebih besar daripada diameter dalam cluster, yang memperkuat bukti adanya pemisahan yang tajam antarprovinsi.
data_clustered <- data.frame(df_sick, cluster = factor(cluster_hc))
cluster_summary <- data_clustered %>%
group_by(cluster) %>%
summarise(across(where(is.numeric), mean, .names = "{.col}"))
cluster_summary
## # A tibble: 3 × 6
## cluster Malaria..Suspek. TB.Paru Pneumonia Kusta Demam.Berdarah.Dengue..DBD.
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 17508. 5571. 8577. 260. 1563.
## 2 2 14791 14592. 108694 2402. 8590.
## 3 3 381906. 4046. 1684. 898 763
Dari hasil penghitungan rata-rata tiap variabel penyakit pada masing-masing cluster diperoleh pola sebagai berikut: Cluster 1 memiliki rata-rata Malaria sebesar 17.508 kasus, TB Paru sebesar 5.571, Pneumonia sebesar 8.577, Kusta 260, dan DBD 1.563. Nilai-nilai ini jauh lebih kecil dibandingkan dua cluster lainnya, sehingga dapat dikatakan bahwa kelompok ini merepresentasikan provinsi dengan tingkat penyakit menular yang relatif rendah. Cluster 2 ditandai oleh rata-rata Pneumonia sebesar 108.694 kasus dan DBD sebesar 8.590 kasus, keduanya merupakan nilai ekstrem yang menunjukkan beban penyakit pernapasan dan demam berdarah yang sangat tinggi. Sementara itu, Cluster 3 didominasi oleh rata-rata kasus Malaria sebesar 381.906, jauh melampaui cluster lain, sementara penyakit lain pada kelompok ini relatif kecil. Artinya, cluster ketiga terdiri atas provinsi dengan karakteristik endemik Malaria yang jelas berbeda dari pola nasional.
Data untuk visualisasi
heat_data <- cluster_summary %>%
pivot_longer(-cluster, names_to = "Variabel", values_to = "Rata2")
heat_data
## # A tibble: 15 × 3
## cluster Variabel Rata2
## <fct> <chr> <dbl>
## 1 1 Malaria..Suspek. 17508.
## 2 1 TB.Paru 5571.
## 3 1 Pneumonia 8577.
## 4 1 Kusta 260.
## 5 1 Demam.Berdarah.Dengue..DBD. 1563.
## 6 2 Malaria..Suspek. 14791
## 7 2 TB.Paru 14592.
## 8 2 Pneumonia 108694
## 9 2 Kusta 2402.
## 10 2 Demam.Berdarah.Dengue..DBD. 8590.
## 11 3 Malaria..Suspek. 381906.
## 12 3 TB.Paru 4046.
## 13 3 Pneumonia 1684.
## 14 3 Kusta 898
## 15 3 Demam.Berdarah.Dengue..DBD. 763
Heatmap
ggplot(heat_data, aes(x = Variabel, y = cluster, fill = Rata2)) +
geom_tile(color = "white") +
scale_fill_gradientn(colors = c("#56B1F7", "white", "#FF6B6B")) +
labs(title = "Heatmap Karakteristik Cluster",
x = "Variabel", y = "Cluster") +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Hasil visualisasi melalui heatmap memperkuat temuan numerik tersebut. Warna pada Cluster 3 menunjukkan intensitas tertinggi hanya pada variabel Malaria, sedangkan Cluster 2 memperlihatkan intensitas warna tinggi pada Pneumonia dan DBD. Cluster 1 tampak lebih netral dan seragam di seluruh variabel. Dengan demikian, heatmap secara visual menegaskan adanya pemisahan pola yang jelas antarcluster, di mana setiap cluster memiliki penyakit dominan yang berbeda secara statistik.
Bar Plot
ggplot(heat_data, aes(x = Variabel, y = Rata2, fill = cluster)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_brewer(palette = "Set2") +
labs(title = "Bar Plot Karakteristik Cluster",
x = "Variabel", y = "Rata-rata Nilai") +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Visualisasi bar plot juga menunjukkan pola yang sejalan. Perbedaan tinggi batang antarcluster pada variabel tertentu menggambarkan perbedaan mean yang signifikan secara praktis antarcluster. Misalnya, batang Malaria pada cluster 3 yang sangat tinggi dibandingkan dua cluster lainnya menegaskan adanya nilai ekstrem di cluster tersebut. Bar plot ini memperlihatkan bahwa variabilitas antarcluster jauh lebih besar dibandingkan dalam cluster, mendukung hasil evaluasi dengan nilai Dunn dan Calinski–Harabasz yang tinggi.
fviz_nbclust(data_scaled, kmeans, method = "wss") +
labs(title = "Elbow Method")
fviz_nbclust(data_scaled, kmeans, method = "silhouette") +
labs(title = "Silhouette Method")
Langkah pertama dalam metode K-Means adalah menentukan jumlah cluster optimal. Hasil metode Elbow menunjukkan titik siku pada k = 3, di mana penurunan total within-cluster sum of squares (WSS) mulai melandai. Hal ini berarti penambahan cluster di atas tiga tidak lagi memberikan pengurangan variasi internal yang signifikan. Hasil metode Silhouette juga mencapai nilai maksimum pada k = 3, memperkuat kesimpulan bahwa struktur data secara alami terbagi menjadi tiga kelompok.
Setelah jumlah cluster optimal dipilih (misal k = 3), dilakukan
proses clustering menggunakan fungsi kmeans().
Parameter nstart = 25 digunakan untuk memastikan
stabilitas hasil dengan mencoba 25 inisialisasi acak.
set.seed(123)
kmeans_result <- kmeans(data_scaled, centers = 3, nstart = 25)
kmeans_result
## K-means clustering with 3 clusters of sizes 30, 2, 2
##
## Cluster means:
## Malaria (Suspek) TB Paru Pneumonia Kusta Demam Berdarah Dengue (DBD)
## 1 -0.2364448 -0.0573700 -0.2024189 -0.2770143 -0.1773366
## 2 -0.2666406 1.1163267 3.4931345 3.3512192 3.2247664
## 3 3.8133124 -0.2557766 -0.4568517 0.8039956 -0.5647168
##
## Clustering vector:
## [1] 1 1 1 1 1 1 1 1 1 1 1 2 1 1 2 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3
##
## Within cluster sum of squares by cluster:
## [1] 51.849326 2.398441 2.641829
## (between_SS / total_SS = 65.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
Centroid yang dihasilkan memberikan arah dominasi variabel pada setiap cluster. Cluster pertama memiliki nilai centroid negatif pada seluruh variabel, menandakan rata-rata kasus lebih rendah dibandingkan keseluruhan data. Cluster kedua memiliki centroid positif tinggi pada Pneumonia (3.49), Kusta (3.35), dan DBD (3.22), sedangkan cluster ketiga memiliki centroid ekstrem positif pada Malaria (3.81). Pola ini sepenuhnya konsisten dengan hasil hierarchical.
table(kmeans_result$cluster)
##
## 1 2 3
## 30 2 2
Penerapan algoritme K-Means dengan centers = 3 menghasilkan pembagian yang identik dengan hasil hierarchical, yaitu 30, 2, dan 2 provinsi dalam tiga cluster. Dari output withinss diperoleh total variasi dalam cluster sebesar 56.89, sedangkan variasi antarcluster (betweenss) sebesar 108.11, dengan proporsi 65.5% variasi total dijelaskan oleh perbedaan antarcluster. Ini menunjukkan kemampuan model yang tinggi dalam memisahkan kelompok.
head(data.frame(Observasi = 1:length(kmeans_result$cluster),
Cluster = kmeans_result$cluster),10)
## Observasi Cluster
## 1 1 1
## 2 2 1
## 3 3 1
## 4 4 1
## 5 5 1
## 6 6 1
## 7 7 1
## 8 8 1
## 9 9 1
## 10 10 1
names(kmeans_result)
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
kmeans_result$cluster
## [1] 1 1 1 1 1 1 1 1 1 1 1 2 1 1 2 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3
kmeans_result$totss
## [1] 165
kmeans_result$withinss
## [1] 51.849326 2.398441 2.641829
kmeans_result$tot.withinss
## [1] 56.8896
kmeans_result$betweenss
## [1] 108.1104
kmeans_result$iter
## [1] 1
cluster_km <- kmeans_result$cluster
dist_matrix <- dist(data_scaled, method = "euclidean")
sil <- mean(silhouette(cluster_km, dist_matrix)[, 3])
ch <- intCriteria(traj = as.matrix(data_scaled),
part = cluster_km,
crit = "Calinski_Harabasz")$calinski_harabasz
dunn <- intCriteria(traj = as.matrix(data_scaled),
part = cluster_km,
crit = "Dunn")$dunn
data.frame(Silhouette = sil,
Calinski_Harabasz = ch,
Dunn = dunn)
## Silhouette Calinski_Harabasz Dunn
## 1 0.651027 29.4555 0.5819343
Evaluasi kualitas K-Means menghasilkan nilai Silhouette = 0.651, CH = 29.455, dan Dunn = 0.582, sama persis dengan Hierarchical Clustering. Kesamaan ini menunjukkan bahwa struktur tiga cluster yang terbentuk memang stabil dan independen dari algoritme yang digunakan. Secara statistik, hal ini menandakan bahwa struktur internal data memiliki kecenderungan alami untuk membentuk tiga kelompok yang jelas.
data_clustered <- data.frame(df_sick, cluster = factor(cluster_km))
cluster_summary <- data_clustered %>%
group_by(cluster) %>%
summarise(across(where(is.numeric), mean, .names = "{.col}"))
cluster_summary
## # A tibble: 3 × 6
## cluster Malaria..Suspek. TB.Paru Pneumonia Kusta Demam.Berdarah.Dengue..DBD.
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 17508. 5571. 8577. 260. 1563.
## 2 2 14791 14592. 108694 2402. 8590.
## 3 3 381906. 4046. 1684. 898 763
fviz_cluster(kmeans_result, data = data_scaled,
palette = "jco", geom = "point",
main = "Visualisasi Hasil K-Means Clustering (3 Cluster)")
Visualisasi hasil K-Means menunjukkan tiga kelompok data yang terpisah jelas tanpa tumpang tindih besar. Dua titik ekstrem berada jauh dari kelompok utama, yang secara visual mempertegas keberadaan cluster ekstrem (kemungkinan besar Papua dan Papua Barat). Kombinasi hasil numerik dan grafik ini menunjukkan konsistensi tinggi antar-metode, sehingga hasil K-Means dapat dianggap valid secara empiris.
heat_data <- cluster_summary %>%
pivot_longer(-cluster, names_to = "Variabel", values_to = "Rata2")
heat_data
## # A tibble: 15 × 3
## cluster Variabel Rata2
## <fct> <chr> <dbl>
## 1 1 Malaria..Suspek. 17508.
## 2 1 TB.Paru 5571.
## 3 1 Pneumonia 8577.
## 4 1 Kusta 260.
## 5 1 Demam.Berdarah.Dengue..DBD. 1563.
## 6 2 Malaria..Suspek. 14791
## 7 2 TB.Paru 14592.
## 8 2 Pneumonia 108694
## 9 2 Kusta 2402.
## 10 2 Demam.Berdarah.Dengue..DBD. 8590.
## 11 3 Malaria..Suspek. 381906.
## 12 3 TB.Paru 4046.
## 13 3 Pneumonia 1684.
## 14 3 Kusta 898
## 15 3 Demam.Berdarah.Dengue..DBD. 763
ggplot(heat_data, aes(x = Variabel, y = cluster, fill = Rata2)) +
geom_tile(color = "white") +
scale_fill_gradientn(colors = c("#56B1F7", "white", "#FF6B6B")) +
labs(title = "Heatmap Karakteristik Cluster",
x = "Variabel", y = "Cluster") +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Hasil visualisasi melalui heatmap memperkuat temuan numerik tersebut. Warna pada Cluster 3 menunjukkan intensitas tertinggi hanya pada variabel Malaria, sedangkan Cluster 2 memperlihatkan intensitas warna tinggi pada Pneumonia dan DBD. Cluster 1 tampak lebih netral dan seragam di seluruh variabel. Dengan demikian, heatmap secara visual menegaskan adanya pemisahan pola yang jelas antarcluster, di mana setiap cluster memiliki penyakit dominan yang berbeda secara statistik.
ggplot(heat_data, aes(x = Variabel, y = Rata2, fill = cluster)) +
geom_bar(stat = "identity", position = "dodge") +
scale_fill_brewer(palette = "Set2") +
labs(title = "Heatmap Karakteristik Cluster",
x = "Variabel", y = "Rata-rata Nilai") +
theme_minimal(base_size = 12) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
visualisasi bar plot menunjukkan pola yang sejalan. Perbedaan tinggi batang antarcluster pada variabel tertentu menggambarkan perbedaan mean yang signifikan secara praktis antarcluster. Misalnya, batang Malaria pada cluster 3 yang sangat tinggi dibandingkan dua cluster lainnya menegaskan adanya nilai ekstrem di cluster tersebut. Bar plot ini memperlihatkan bahwa variabilitas antarcluster jauh lebih besar dibandingkan dalam cluster, mendukung hasil evaluasi dengan nilai Dunn dan Calinski–Harabasz yang tinggi.
dist_euc <- dist(data_scaled, method = "euclidean")
dist_man <- dist(data_scaled, method = "manhattan")
dist_can <- dist(data_scaled, method = "canberra")
pam_euc <- pam(dist_euc, k = 3)
pam_man <- pam(dist_man, k = 3)
pam_can <- pam(dist_can, k = 3)
names(pam_euc)
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call"
head(pam_euc$clustering)
## [1] 1 1 1 1 1 1
pam_euc$medoids
## [1] 26 15 34
pam_euc$id.med
## [1] 26 15 34
pam_euc$objective
## build swap
## 1.021374 1.021374
head(pam_euc$clusinfo,10)
## size max_diss av_diss diameter separation
## [1,] 30 4.259704 1.007931 4.817280 2.803340
## [2,] 2 2.190179 1.095089 2.190179 4.400351
## [3,] 2 2.298621 1.149311 2.298621 2.803340
pam_euc$silinfo
## $widths
## cluster neighbor sil_width
## 17 1 3 0.7563307
## 26 1 3 0.7551292
## 4 1 3 0.7524880
## 29 1 3 0.7470451
## 7 1 3 0.7466326
## 28 1 3 0.7440173
## 3 1 3 0.7424194
## 10 1 3 0.7414867
## 5 1 3 0.7384106
## 1 1 3 0.7371555
## 21 1 3 0.7341213
## 30 1 3 0.7333087
## 25 1 3 0.7314696
## 9 1 3 0.7254919
## 6 1 3 0.7254579
## 22 1 3 0.7141456
## 8 1 3 0.7042064
## 24 1 3 0.7026316
## 23 1 3 0.6982112
## 20 1 3 0.6756576
## 16 1 3 0.6541587
## 18 1 3 0.6523152
## 32 1 3 0.6431677
## 31 1 3 0.6331767
## 27 1 3 0.6071929
## 33 1 3 0.4891821
## 2 1 3 0.4720572
## 11 1 2 0.4064911
## 13 1 2 0.3944847
## 14 1 3 0.3079298
## 15 2 1 0.6662317
## 12 2 1 0.6605516
## 34 3 1 0.5618790
## 19 3 1 0.3802844
##
## $clus.avg.widths
## [1] 0.6621991 0.6633916 0.4710817
##
## $avg.width
## [1] 0.651027
pam_euc$call
## pam(x = dist_euc, k = 3)
Dari komponen output, medoid yang terpilih adalah observasi ke-26, ke-15, dan ke-34. Cluster pertama beranggotakan 30 provinsi dengan diameter 4.81 dan separation 2.80, menunjukkan kepadatan internal yang tinggi dan jarak antarcluster yang cukup besar. Cluster kedua dan ketiga masing-masing hanya terdiri dari dua provinsi dengan diameter kecil namun separation besar, menandakan bahwa anggota dalam cluster sangat mirip, tetapi berbeda jauh dari cluster lain. Nilai rata-rata silhouette per cluster masing-masing 0.662, 0.663, dan 0.471, dengan rata-rata keseluruhan 0.651. Angka ini memperkuat bukti bahwa pemisahan antarcluster sangat baik secara statistik.
eval_pam <- function(data_scaled, pam_model, dist_matrix) {
cl <- pam_model$clustering
sil <- mean(silhouette(cl, dist_matrix)[, 3])
ch <- intCriteria(traj = as.matrix(data_scaled),
part = cl, crit = "Calinski_Harabasz")$calinski_harabasz
dunn <- intCriteria(traj = as.matrix(data_scaled),
part = cl, crit = "Dunn")$dunn
return(data.frame(Silhouette = sil, CH = ch, Dunn = dunn))
}
eval_result <- rbind(
Euclidean = eval_pam(data_scaled, pam_euc, dist_euc),
Manhattan = eval_pam(data_scaled, pam_man, dist_man),
Canberra = eval_pam(data_scaled, pam_can, dist_can)
)
eval_result
## Silhouette CH Dunn
## Euclidean 0.6510270 29.45550 0.5819343
## Manhattan 0.5405460 23.44867 0.3597861
## Canberra 0.2468235 12.43677 0.0599120
Untuk meningkatkan ketahanan terhadap outlier, analisis dilanjutkan dengan metode Partitioning Around Medoids (PAM) menggunakan tiga jenis jarak: Euclidean, Manhattan, dan Canberra. Berdasarkan hasil evaluasi, jarak Euclidean memberikan performa terbaik dengan Silhouette = 0.651, Calinski–Harabasz = 29.455, dan Dunn = 0.582. Nilai-nilai ini identik dengan hasil dua metode sebelumnya. Sebaliknya, jarak Manhattan dan Canberra menghasilkan nilai metrik yang jauh lebih rendah, masing-masing dengan Silhouette 0.541 dan 0.247. Penurunan ini menunjukkan bahwa kedua jarak tersebut kurang efektif menangkap variasi alami dalam data, karena sensitivitasnya terhadap perbedaan kecil antarvariabel.
eval_long <- eval_result %>%
mutate(Jarak = rownames(eval_result)) %>%
pivot_longer(cols = c(Silhouette, CH, Dunn),
names_to = "Metrik", values_to = "Nilai")
eval_long
## # A tibble: 9 × 3
## Jarak Metrik Nilai
## <chr> <chr> <dbl>
## 1 Euclidean Silhouette 0.651
## 2 Euclidean CH 29.5
## 3 Euclidean Dunn 0.582
## 4 Manhattan Silhouette 0.541
## 5 Manhattan CH 23.4
## 6 Manhattan Dunn 0.360
## 7 Canberra Silhouette 0.247
## 8 Canberra CH 12.4
## 9 Canberra Dunn 0.0599
ggplot(eval_long, aes(x = Jarak, y = Nilai, fill = Metrik)) +
geom_bar(stat = "identity", position = "dodge", width = 0.7) +
scale_fill_brewer(palette = "Set2") +
labs(title = "Perbandingan Metrik Evaluasi",
x = "Jenis Jarak",
y = "Nilai Metrik",
fill = "Metrik") +
theme_minimal(base_size = 12) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
axis.text.x = element_text(face = "bold")
)
ggplot(filter(eval_long, Metrik == "Silhouette"),
aes(x = Jarak, y = Nilai, fill = Jarak)) +
geom_bar(stat = "identity", width = 0.6, show.legend = FALSE) +
scale_fill_brewer(palette = "Set2") +
labs(title = "Perbandingan Nilai Silhouette",
x = "Jenis Jarak", y = "Nilai") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
ggplot(filter(eval_long, Metrik == "CH"),
aes(x = Jarak, y = Nilai, fill = Jarak)) +
geom_bar(stat = "identity", width = 0.6, show.legend = FALSE) +
scale_fill_brewer(palette = "Set3") +
labs(title = "Perbandingan Nilai Calinski-Harabasz",
x = "Jenis Jarak", y = "Nilai") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
ggplot(filter(eval_long, Metrik == "Dunn"),
aes(x = Jarak, y = Nilai, fill = Jarak)) +
geom_bar(stat = "identity", width = 0.6, show.legend = FALSE) +
scale_fill_brewer(palette = "Pastel1") +
labs(title = "Perbandingan Nilai Dunn Index",
x = "Jenis Jarak", y = "Nilai") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold", hjust = 0.5))
Visualisasi perbandingan metrik antarjarak memperlihatkan perbedaan mencolok. Grafik batang menunjukkan nilai Silhouette, Calinski–Harabasz, dan Dunn paling tinggi untuk Euclidean, turun sedang untuk Manhattan, dan paling rendah untuk Canberra. Hal ini mempertegas bahwa jarak Euclidean paling sesuai dengan distribusi data penyakit menular ini, karena pola penyebaran penyakit antarprovinsi cenderung linier dan tidak terlalu ekstrem.
Jarak terbaik euclidean
table(pam_euc$cluster)
##
## 1 2 3
## 30 2 2
Ketiga metode menghasilkan pola pengelompokan dan nilai evaluasi yang identik, yakni tiga cluster dengan Silhouette = 0.651, Calinski–Harabasz = 29.455, dan Dunn = 0.582. Kesamaan ini menunjukkan bahwa struktur tiga cluster yang terbentuk bukan hasil kebetulan algoritmik, melainkan mencerminkan struktur alami data. Secara statistik, hal ini berarti varians antarprovinsi terhadap lima penyakit tersebut memang membentuk tiga kelompok yang berbeda signifikan.
head(data.frame(Observasi = 1:length(pam_euc$cluster),
Cluster = pam_euc$cluster),10)
## Observasi Cluster
## 1 1 1
## 2 2 1
## 3 3 1
## 4 4 1
## 5 5 1
## 6 6 1
## 7 7 1
## 8 8 1
## 9 9 1
## 10 10 1
# Membandingkan hasil berbagai metode
comparison <- data.frame(
Observasi = 1:nrow(df_sick),
Hierarchical = cluster_hc,
KMeans = kmeans_result$cluster,
PAM = pam_euc$clustering
)
print(head(comparison, 10))
## Observasi Hierarchical KMeans PAM
## 1 1 1 1 1
## 2 2 1 1 1
## 3 3 1 1 1
## 4 4 1 1 1
## 5 5 1 1 1
## 6 6 1 1 1
## 7 7 1 1 1
## 8 8 1 1 1
## 9 9 1 1 1
## 10 10 1 1 1
Dari ketiga pendekatan clustering yang diterapkan, struktur data menunjukkan tiga kelompok provinsi dengan karakteristik penyakit menular yang sangat berbeda secara signifikan.
Cluster pertama memiliki tingkat kasus rendah pada semua penyakit dan mencakup sekitar 88% provinsi, mencerminkan daerah dengan kondisi kesehatan relatif stabil.
Cluster kedua memiliki nilai rata-rata Pneumonia dan DBD yang jauh lebih tinggi dibandingkan variabel lain, menggambarkan provinsi dengan beban penyakit pernapasan dan demam berdarah yang berat.
Cluster ketiga sangat ekstrem pada variabel Malaria, menunjukkan wilayah endemik dengan karakteristik epidemiologis yang unik.
Secara statistik, nilai Silhouette di atas 0.65 dan Dunn Index mendekati 0.6 menunjukkan bahwa jarak antarcluster cukup besar dan variasi dalam cluster kecil. Nilai Calinski–Harabasz yang tinggi mengindikasikan bahwa pemisahan kelompok signifikan dan struktur pengelompokan sangat kuat. Dengan demikian, hasil ini menegaskan bahwa model clustering mampu menggambarkan perbedaan nyata antarprovinsi dalam pola penyebaran penyakit menular di Indonesia.