Tugas TPG Clustering
Nyoman Kiranasassi Anara
2025-11-04
Persiapan
Data Preparation
# Data bawaan R
data("USArrests")
# Gunakan hanya variabel numerik & lakukan standardisasi
data_scaled <- scale(USArrests)Data yang digunakan adalah data bawaan R studio yang berisi Jenis Kejahatan berserta jumlahnya di Amerika Serikat. Data kemudian dilakukan standardisasi
Penentuan Jumlah Cluster Optimal
Metode Elbow
# ============================================================
# 2. MENENTUKAN JUMLAH CLUSTER OPTIMAL
# ============================================================
# Metode Elbow
fviz_nbclust(data_scaled, kmeans, method = "wss") +
labs(title = "Elbow Method - USArrests")
Metode Elbow digunakan untuk memilih jumlah kluster optimal dengan melihat titik di mana penurunan nilai Within-Cluster Sum of Squares (WCSS) mulai melambat, menyerupai bentuk “siku” pada grafik.
Pada grafik, terlihat garis mulai menurun secara lambat setelah angka ke-2. Terlihat garis sebelum angka dua menurun drastis dan terlihat patahan. Maka penentuan banyaknya cluster yang akan dibentuk adalah 2 cluster.
Metode Shillouette
# Metode Silhouette
fviz_nbclust(data_scaled, kmeans, method = "silhouette") +
labs(title = "Silhouette Method - USArrests")
# Berdasarkan literatur & hasil umum, gunakan k = 3
k_opt <- 2Metode Silhouette menilai kualitas klaster dengan membandingkan kedekatan antar titik di dalam klaster dan antar klaster. Jumlah klaster optimal adalah nilai k yang memberikan rata-rata Silhouette tertinggi, menunjukkan bahwa klaster sudah terpisah dengan baik dan tidak terlalu tumpang tindih.
Untuk menentukan jumlah klaster dari grafik metode Silhouette, lihat nilai rata-rata Silhouette Score tertinggi pada grafik k vs score. Nilai k pada titik tertinggi tersebut adalah jumlah klaster optimal. Dari grafik di atas, didapatkan banyaknya cluster yang optimal adalah 2.
Namun, nilai Silhouette terlalu tinggi untuk k kecil (misal k=2) bisa berarti data belum memiliki struktur klaster yang jelas.
Clustering tak Berhierarki
Metode tak berhierarki adalah metode klasterisasi yang langsung membagi data ke dalam sejumlah klaster tertentu (k) berdasarkan kemiripan antar data, tanpa membentuk struktur bertingkat seperti dendrogram.
Metode K-Means
K-Means adalah metode klasterisasi berbasis jarak yang membagi data menjadi k kelompok dengan cara meminimalkan jarak antar data dalam klaster dan memaksimalkan jarak antar klaster.
# ============================================================
# 3. K-MEANS CLUSTERING
# ============================================================
set.seed(123)
kmeans_result <- kmeans(data_scaled, centers = k_opt, nstart = 25)
# Ringkasan hasil
kmeans_result## K-means clustering with 2 clusters of sizes 20, 30
##
## Cluster means:
## Murder Assault UrbanPop Rape
## 1 1.004934 1.0138274 0.1975853 0.8469650
## 2 -0.669956 -0.6758849 -0.1317235 -0.5646433
##
## Clustering vector:
## Alabama Alaska Arizona Arkansas California
## 1 1 1 2 1
## Colorado Connecticut Delaware Florida Georgia
## 1 2 2 1 1
## Hawaii Idaho Illinois Indiana Iowa
## 2 2 1 2 2
## Kansas Kentucky Louisiana Maine Maryland
## 2 2 1 2 1
## Massachusetts Michigan Minnesota Mississippi Missouri
## 2 1 2 1 1
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 1 2 2
## New Mexico New York North Carolina North Dakota Ohio
## 1 1 1 2 2
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 2 2 2 2 1
## South Dakota Tennessee Texas Utah Vermont
## 2 1 1 2 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 2 2 2 2 2
##
## Within cluster sum of squares by cluster:
## [1] 46.74796 56.11445
## (between_SS / total_SS = 47.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"table(kmeans_result$cluster)##
## 1 2
## 20 30# Visualisasi
fviz_cluster(kmeans_result, data = data_scaled,
palette = "jco", geom = "point",
main = "Visualisasi Hasil K-Means Clustering (USArrests)")
Cluster 1 terdiri dari 20 amatan dan cluster 2 terdiri dari 30
amatan
Komponen K-Means
kmeans_result$cluster## Alabama Alaska Arizona Arkansas California
## 1 1 1 2 1
## Colorado Connecticut Delaware Florida Georgia
## 1 2 2 1 1
## Hawaii Idaho Illinois Indiana Iowa
## 2 2 1 2 2
## Kansas Kentucky Louisiana Maine Maryland
## 2 2 1 2 1
## Massachusetts Michigan Minnesota Mississippi Missouri
## 2 1 2 1 1
## Montana Nebraska Nevada New Hampshire New Jersey
## 2 2 1 2 2
## New Mexico New York North Carolina North Dakota Ohio
## 1 1 1 2 2
## Oklahoma Oregon Pennsylvania Rhode Island South Carolina
## 2 2 2 2 1
## South Dakota Tennessee Texas Utah Vermont
## 2 1 1 2 2
## Virginia Washington West Virginia Wisconsin Wyoming
## 2 2 2 2 2kmeans_result$withinss## [1] 46.74796 56.11445kmeans_result$centers## Murder Assault UrbanPop Rape
## 1 1.004934 1.0138274 0.1975853 0.8469650
## 2 -0.669956 -0.6758849 -0.1317235 -0.5646433Evaluasi Model
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.408489 43.46199 0.2214287data_clustered <- data.frame(data_scaled, cluster = factor(cluster_km))
cluster_summary <- data_clustered %>%
group_by(cluster) %>%
summarise(across(where(is.numeric), mean, .names = "{.col}"))
cluster_summary## # A tibble: 2 × 5
## cluster Murder Assault UrbanPop Rape
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 1 1.00 1.01 0.198 0.847
## 2 2 -0.670 -0.676 -0.132 -0.565Hasil evaluasi model K-Means menunjukkan bahwa nilai Silhouette sebesar 0,408 menandakan kualitas klasterisasi berada pada kategori cukup baik, artinya sebagian besar data sudah tergolong ke dalam klaster yang sesuai, meskipun masih ada beberapa titik yang berada di batas antar klaster.
Nilai Calinski–Harabasz sebesar 43,46 mengindikasikan bahwa tingkat pemisahan antar klaster relatif baik, namun belum maksimal karena nilai ini sebaiknya dibandingkan dengan hasil untuk jumlah klaster lain untuk memastikan kinerja terbaik.
Sementara itu, Dunn Index sebesar 0,221 menunjukkan bahwa jarak antar klaster belum terlalu besar dan masih terdapat tumpang tindih antar kelompok data. Secara keseluruhan, hasil ini menunjukkan bahwa model K-Means telah berhasil membentuk klaster yang cukup jelas, namun masih ada ruang untuk perbaikan, misalnya dengan mengubah jumlah klaster, melakukan standarisasi data, atau mengurangi pengaruh outlier agar pemisahan antar klaster menjadi lebih optimal.
heat_data <- cluster_summary %>%
pivot_longer(-cluster, names_to = "Variabel", values_to = "Rata2")
heat_data## # A tibble: 8 × 3
## cluster Variabel Rata2
## <fct> <chr> <dbl>
## 1 1 Murder 1.00
## 2 1 Assault 1.01
## 3 1 UrbanPop 0.198
## 4 1 Rape 0.847
## 5 2 Murder -0.670
## 6 2 Assault -0.676
## 7 2 UrbanPop -0.132
## 8 2 Rape -0.565ggplot(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))
Metode K-Medoids
K-Medoids adalah metode klasterisasi tak berhierarki yang menggunakan objek nyata (medoid) sebagai pusat klaster untuk meminimalkan total jarak antar data dalam klaster. Metode ini lebih robust terhadap outlier dibanding K-Means dan cocok digunakan jika data memiliki nilai ekstrim atau tidak berbentuk bulat sempurna.
# ============================================================
# 2. EKSPERIMEN DENGAN BERBAGAI JARAK
# ============================================================
# Hitung jarak antar observasi dengan 3 metode
dist_euc <- dist(data_scaled, method = "euclidean")
dist_man <- dist(data_scaled, method = "manhattan")
dist_can <- dist(data_scaled, method = "canberra")
# Jalankan metode K-Medoids (PAM) dengan k = 2
pam_euc <- pam(dist_euc, k = 2)
pam_man <- pam(dist_man, k = 2)
pam_can <- pam(dist_can, k = 2)# ============================================================
# 3. MELIHAT KOMPONEN HASIL PAM
# ============================================================
names(pam_euc)## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call"# Beberapa komponen penting
head(pam_euc$clustering)## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1pam_euc$medoids## [1] "New Mexico" "Nebraska"pam_euc$id.med## [1] 31 27pam_euc$objective## build swap
## 1.441358 1.368969head(pam_euc$clusinfo, 10)## size max_diss av_diss diameter separation
## [1,] 20 2.655735 1.492192 4.420074 0.978731
## [2,] 30 2.295229 1.286821 4.400542 0.978731pam_euc$silinfo## $widths
## cluster neighbor sil_width
## New Mexico 1 2 0.5222275
## Michigan 1 2 0.5165960
## Florida 1 2 0.5035739
## Maryland 1 2 0.4890198
## Louisiana 1 2 0.4387476
## Nevada 1 2 0.4299099
## Georgia 1 2 0.4044931
## Arizona 1 2 0.3911248
## New York 1 2 0.3865530
## California 1 2 0.3774168
## South Carolina 1 2 0.3650274
## Texas 1 2 0.3471312
## Illinois 1 2 0.3354701
## Alabama 1 2 0.3354254
## Alaska 1 2 0.3254396
## Tennessee 1 2 0.3175580
## Colorado 1 2 0.2972633
## Mississippi 1 2 0.2620747
## North Carolina 1 2 0.2596933
## Missouri 1 2 0.1134541
## Minnesota 2 1 0.5986325
## Iowa 2 1 0.5945178
## Nebraska 2 1 0.5926288
## Wisconsin 2 1 0.5891363
## New Hampshire 2 1 0.5870108
## Idaho 2 1 0.5680837
## Maine 2 1 0.5625723
## Kansas 2 1 0.5362530
## South Dakota 2 1 0.5325247
## Connecticut 2 1 0.5306315
## Pennsylvania 2 1 0.5253841
## Montana 2 1 0.5240161
## North Dakota 2 1 0.5143664
## West Virginia 2 1 0.4592799
## Indiana 2 1 0.4428995
## Vermont 2 1 0.4408083
## Wyoming 2 1 0.4400334
## Hawaii 2 1 0.4194608
## Utah 2 1 0.4078063
## Oklahoma 2 1 0.4064074
## Massachusetts 2 1 0.3837284
## Rhode Island 2 1 0.3635329
## Ohio 2 1 0.3618181
## Kentucky 2 1 0.3496924
## Washington 2 1 0.3313743
## Virginia 2 1 0.2622062
## Oregon 2 1 0.1942476
## New Jersey 2 1 0.1782450
## Delaware 2 1 0.1743774
## Arkansas 2 1 0.1345762
##
## $clus.avg.widths
## [1] 0.3709100 0.4335417
##
## $avg.width
## [1] 0.408489pam_euc$call## pam(x = dist_euc, k = 2)Evaluasi K-Medoids
# ============================================================
# 4. EVALUASI CLUSTERING
# ============================================================
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))
}
# Bandingkan hasil untuk ketiga jarak
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)
)
# Tampilkan hasil evaluasi
eval_result## Silhouette CH Dunn
## Euclidean 0.4084890 43.46199 0.2214287
## Manhattan 0.4387159 43.46199 0.2214287
## Canberra 0.3584003 42.29334 0.2214287Berdasarkan ketiga indeks evaluasi, jarak Manhattan memberikan hasil klasterisasi terbaik pada metode K-Medoids karena menghasilkan nilai Silhouette tertinggi (0.439), menandakan pemisahan antar klaster paling jelas dan struktur klaster paling stabil. Jarak Euclidean menghasilkan hasil yang cukup baik namun sedikit di bawah Manhattan, sedangkan Canberra kurang efektif untuk dataset ini karena memberikan skor evaluasi terendah.
# ============================================================
# 5. VISUALISASI PERBANDINGAN METRIK EVALUASI
# ============================================================
eval_long <- eval_result %>%
mutate(Jarak = rownames(eval_result)) %>%
pivot_longer(cols = c(Silhouette, CH, Dunn),
names_to = "Metrik", values_to = "Nilai")
# Plot gabungan
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 K-Medoids (USArrests)",
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"))
# Plot per metrik
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))
Perbandingan Kedua Metode
# Data & standardisasi ulang
data <- USArrests %>% select(where(is.numeric)) %>% na.omit()
data_scaled <- scale(data)
# ============================================================
# 2. ANALISIS K-MEANS
# ============================================================
set.seed(123)
kmeans_result <- kmeans(data_scaled, centers = 2, nstart = 25)
# Ringkasan hasil
kmeans_result$size## [1] 20 30kmeans_result$centers## Murder Assault UrbanPop Rape
## 1 1.004934 1.0138274 0.1975853 0.8469650
## 2 -0.669956 -0.6758849 -0.1317235 -0.5646433head(kmeans_result$cluster, 10)## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1
## Connecticut Delaware Florida Georgia
## 2 2 1 1# Visualisasi hasil K-Means
fviz_cluster(kmeans_result, data = data_scaled,
palette = "jco", geom = "point",
main = "Visualisasi Hasil K-Means (USArrests)")
# ============================================================
# 3. ANALISIS K-MEDOIDS (PAM)
# ============================================================
pam_result <- pam(data_scaled, k = 2)
pam_result$clusinfo## size max_diss av_diss diameter separation
## [1,] 20 2.655735 1.492192 4.420074 0.978731
## [2,] 30 2.295229 1.286821 4.400542 0.978731head(pam_result$clustering, 10)## Alabama Alaska Arizona Arkansas California Colorado
## 1 1 1 2 1 1
## Connecticut Delaware Florida Georgia
## 2 2 1 1# Visualisasi hasil K-Medoids
fviz_cluster(pam_result, data = data_scaled,
palette = "Dark2", geom = "point",
main = "Visualisasi Hasil K-Medoids (PAM) (USArrests)")
# ============================================================
# 4. EVALUASI PERFORMA CLUSTERING
# ============================================================
# Fungsi evaluasi gabungan
eval_model <- function(data_scaled, model, dist_matrix, method_name) {
if ("clustering" %in% names(model)) {
cl <- model$clustering # PAM
} else {
cl <- model$cluster # K-Means
}
sil <- mean(silhouette(cl, dist_matrix)[, 3])
ch <- intCriteria(as.matrix(data_scaled), cl, "Calinski_Harabasz")$calinski_harabasz
dunn <- intCriteria(as.matrix(data_scaled), cl, "Dunn")$dunn
data.frame(
Metode = method_name,
Silhouette = sil,
CH = ch,
Dunn = dunn
)
}
# Matriks jarak Euclidean untuk evaluasi
dist_man <- dist(data_scaled, method = "manhattan")
# Hasil evaluasi kedua metode
eval_kmeans <- eval_model(data_scaled, kmeans_result, dist_man, "K-Means")
eval_pam <- eval_model(data_scaled, pam_result, dist_man, "K-Medoids (Manhattan)")
eval_compare <- rbind(eval_kmeans, eval_pam)
print(eval_compare)## Metode Silhouette CH Dunn
## 1 K-Means 0.4387159 43.46199 0.2214287
## 2 K-Medoids (Manhattan) 0.4387159 43.46199 0.2214287# ============================================================
# 5. VISUALISASI PERBANDINGAN PERFORMA
# ============================================================
eval_long <- eval_compare %>%
pivot_longer(cols = c(Silhouette, CH, Dunn),
names_to = "Metrik", values_to = "Nilai")
ggplot(eval_long, aes(x = Metode, y = Nilai, fill = Metrik)) +
geom_bar(stat = "identity", position = "dodge", width = 0.7) +
scale_fill_brewer(palette = "Set2") +
labs(title = "Perbandingan Evaluasi K-Means vs K-Medoids (USArrests)",
x = "Metode Clustering", y = "Nilai", fill = "Metrik") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(face = "bold", hjust = 0.5),
axis.text.x = element_text(face = "bold"))
# ============================================================
# 6. RINGKASAN HASIL CLUSTERING
# ============================================================
cat("\nUkuran cluster K-Means:\n")##
## Ukuran cluster K-Means:print(kmeans_result$size)## [1] 20 30cat("\nUkuran cluster K-Medoids (PAM):\n")##
## Ukuran cluster K-Medoids (PAM):print(pam_result$clusinfo[, "size"])## [1] 20 30# Perbandingan anggota cluster untuk 10 observasi pertama
comparison_table <- data.frame(
Observasi = rownames(data),
KMeans = kmeans_result$cluster,
KMedoids = pam_result$clustering
)
head(comparison_table, 10)## Observasi KMeans KMedoids
## Alabama Alabama 1 1
## Alaska Alaska 1 1
## Arizona Arizona 1 1
## Arkansas Arkansas 2 2
## California California 1 1
## Colorado Colorado 1 1
## Connecticut Connecticut 2 2
## Delaware Delaware 2 2
## Florida Florida 1 1
## Georgia Georgia 1 1Kedua metode menghasilkan jumlah tiap klaster yang sama yaitu 20 amatan untuk cluster 1 dan 30 amatan untuk kluster 2. Secara angka, kinerja K-Means dan K-Medoids sama baiknya, ditunjukkan oleh nilai Silhouette, CH, dan Dunn yang identik. Namun, mengingat karakteristik data USArrests yang memiliki kemungkinan outlier, K-Medoids (PAM) lebih stabil dan lebih aman digunakan, sehingga lebih layak dijadikan metode clustering utama untuk data ini.