TPG LAT UAS
Ghonia Choirinnajdhatul Muna
2025-11-12
library(tidyverse) # untuk manipulasi data & ggplot2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.1 ✔ stringr 1.5.2
## ✔ ggplot2 4.0.0 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(cluster) # clustering (hierarchical, pam)
library(factoextra) # visualisasi cluster## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary(NbClust) # menentukan jumlah cluster optimal
library(dendextend) # manipulasi dendrogram##
## ---------------------
## Welcome to dendextend version 1.19.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
##
## Attaching package: 'dendextend'
##
## The following object is masked from 'package:stats':
##
## cutreelibrary(clusterCrit) # evaluasi internal clusterPersiapan Data
data_raw <- read.csv("~/Downloads/Mall_Customers.csv", stringsAsFactors = FALSE)
glimpse(data_raw)## Rows: 200
## Columns: 5
## $ CustomerID <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, …
## $ Genre <chr> "Male", "Male", "Female", "Female", "Female", "…
## $ Age <int> 19, 21, 20, 23, 31, 22, 35, 23, 64, 30, 67, 35,…
## $ Annual.Income..k.. <int> 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 19, 19,…
## $ Spending.Score..1.100. <int> 39, 81, 6, 77, 40, 76, 6, 94, 3, 72, 14, 99, 15…summary(data_raw)## CustomerID Genre Age Annual.Income..k..
## Min. : 1.00 Length:200 Min. :18.00 Min. : 15.00
## 1st Qu.: 50.75 Class :character 1st Qu.:28.75 1st Qu.: 41.50
## Median :100.50 Mode :character Median :36.00 Median : 61.50
## Mean :100.50 Mean :38.85 Mean : 60.56
## 3rd Qu.:150.25 3rd Qu.:49.00 3rd Qu.: 78.00
## Max. :200.00 Max. :70.00 Max. :137.00
## Spending.Score..1.100.
## Min. : 1.00
## 1st Qu.:34.75
## Median :50.00
## Mean :50.20
## 3rd Qu.:73.00
## Max. :99.00data_num <- data_raw %>%
select(Age, Annual.Income..k.., Spending.Score..1.100.) %>%
rename(
Income = Annual.Income..k..,
Spending = Spending.Score..1.100.
)
head(data_num)## Age Income Spending
## 1 19 15 39
## 2 21 15 81
## 3 20 16 6
## 4 23 16 77
## 5 31 17 40
## 6 22 17 76Standarisasi Data
data_scaled <- scale(data_num)
summary(data_scaled)## Age Income Spending
## Min. :-1.4926 Min. :-1.73465 Min. :-1.905240
## 1st Qu.:-0.7230 1st Qu.:-0.72569 1st Qu.:-0.598292
## Median :-0.2040 Median : 0.03579 Median :-0.007745
## Mean : 0.0000 Mean : 0.00000 Mean : 0.000000
## 3rd Qu.: 0.7266 3rd Qu.: 0.66401 3rd Qu.: 0.882916
## Max. : 2.2299 Max. : 2.91037 Max. : 1.889750##HIERARCHICAL CLUSTERING
# Matriks jarak Euclidean
dist_matrix <- dist(data_scaled, method = "euclidean")# Metode Ward
hc_ward <- hclust(dist_matrix, method = "ward.D2")Dendogram
plot(hc_ward, labels = FALSE, hang = -1,
main = "Dendrogram Hierarchical Clustering (Ward.D2)")
rect.hclust(hc_ward, k = 3, border = "red")
Analisis menunjukkan bahwa K-Means dengan \(k=8\) kluster adalah metode segmentasi yang
paling valid dan kuat, dibuktikan dengan skor metrik validitas tertinggi
(Silhouette \(0.41\) dan Calinski
Harabasz \(131.34\)), yang
mengonfirmasi bahwa segmen yang dihasilkan paling terpisah dan padat.
Meskipun dendrogram Hierarchical Clustering mengindikasikan adanya tiga
kelompok besar yang mendasari struktur data, visualisasi K-Means yang
diproyeksikan ke Dimensi 1 dan 2 (menjelaskan \(77.6\%\) variansi) menunjukkan pemisahan
visual yang jelas untuk 8 kluster. Kluster yang paling menonjol dan
berharga secara strategis adalah Kluster 6 (High Spenders), Kluster 7
(High Earners, Low Spenders), dan Kluster 8 (Young High Spenders &
Earners), yang semuanya terpisah secara ekstrem di ruang data,
menyiratkan keberadaan tiga segmen pasar yang sangat unik dan harus
menjadi fokus utama penargetan Anda.
Simpan Hasil Kluster
cluster_hc <- cutree(hc_ward, k = 3)
table(cluster_hc)## cluster_hc
## 1 2 3
## 95 66 39##**K-MEANS Clustering
set.seed(123)
k_opt <- 8
kmeans_res <- kmeans(data_scaled, centers = k_opt, nstart = 25)
print(kmeans_res)## K-means clustering with 8 clusters of sizes 33, 32, 20, 20, 20, 39, 14, 22
##
## Cluster means:
## Age Income Spending
## 1 -1.0218509 -0.2289971 -0.03942846
## 2 0.5901457 -0.1902742 -0.09245447
## 3 0.4688952 -1.3291594 -1.22562679
## 4 1.8612633 -0.2821275 -0.01355353
## 5 0.7266085 1.0580733 -1.20239216
## 6 -0.4408110 0.9891010 1.23640011
## 7 -0.5517316 1.0936996 -1.42671699
## 8 -0.9719569 -1.3262173 1.12934389
##
## Clustering vector:
## [1] 1 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3 8 3
## [38] 8 3 8 4 8 2 1 3 8 2 1 1 1 2 1 1 4 2 2 2 4 1 2 4 1 4 2 4 1 2 4 1 1 4 2 4 4
## [75] 4 1 2 2 1 2 4 2 4 2 1 2 2 1 1 2 4 1 2 2 1 1 2 1 2 1 1 2 4 1 2 1 4 2 4 4 4
## [112] 1 2 1 1 1 4 2 2 2 1 2 2 6 1 6 2 6 5 6 5 6 1 6 7 6 5 6 7 6 5 6 1 6 7 6 5 6
## [149] 7 6 5 6 5 6 5 6 7 6 7 6 5 6 7 6 5 6 5 6 7 6 7 6 7 6 5 6 5 6 5 6 7 6 5 6 5
## [186] 6 5 6 5 6 7 6 7 6 5 6 5 6 7 6
##
## Within cluster sum of squares by cluster:
## [1] 14.406726 9.645699 19.809395 4.461166 12.984588 22.362673 11.407191
## [8] 8.191823
## (between_SS / total_SS = 82.7 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"table(kmeans_res$cluster)##
## 1 2 3 4 5 6 7 8
## 33 32 20 20 20 39 14 22Interpretasi: Berdasarkan hasil analisis K-Means dengan 8 klaster, diperoleh delapan kelompok pelanggan yang memiliki karakteristik berbeda. Misalnya, Cluster 6 merupakan pelanggan muda dengan pendapatan dan tingkat pengeluaran yang tinggi, yang dapat dikategorikan sebagai segmen pelanggan bernilai tinggi (high-value customers). Sebaliknya, Cluster 3 berisi pelanggan dengan pendapatan dan pengeluaran rendah, mencerminkan segmen dengan kontribusi ekonomi kecil. Beberapa klaster lain seperti Cluster 5 dan 7 memiliki pendapatan tinggi namun pengeluaran rendah, yang dapat menjadi target promosi potensial. Secara umum, hasil ini menunjukkan adanya variasi perilaku konsumen di mall yang dapat dimanfaatkan untuk strategi pemasaran yang lebih terarah.
Visualisasi K-Means
fviz_cluster(kmeans_res, data = data_scaled, geom = "point",
palette = "jco", ellipse.type = "norm",
main = paste("Visualisasi K-Means (k =", k_opt, ")"))
Interpretasi: Kedua kluster 8 dan 6 mewakili profil pelanggan yang
sangat unik dan ekstrem dibandingkan dengan rata-rata populasi. (Dari
analisis sebelumnya, Kluster 8 adalah Young High Spenders & Earners;
Kluster 6 adalah High Spenders).
Kluster yang tumpang tindih ini menunjukkan bahwa, dalam hal kombinasi variabel Dim1 dan Dim2, anggota-anggota di area perbatasan ini memiliki karakteristik yang sangat mirip dan mungkin bisa saja diklasifikasikan ke kluster tetangga. Hal ini wajar dalam segmentasi pasar yang kompleks.
# Elbow Method
fviz_nbclust(data_scaled, kmeans, method = "wss") +
ggtitle("Metode Elbow untuk Menentukan k Optimal")
# Silhouette Method
fviz_nbclust(data_scaled, kmeans, method = "silhouette") +
ggtitle("Metode Silhouette untuk Menentukan k Optimal")
##Perbandingan Hasil Cluster
### CHUNK PAM CLUSTERING
set.seed(123)
pam_euc <- pam(data_scaled, k = 3)
# Lihat hasil cepat
print(pam_euc)## Medoids:
## ID Age Income Spending
## [1,] 59 -0.8483065 -0.55435578 0.03097951
## [2,] 99 0.6550215 0.01675251 -0.31753996
## [3,] 176 -0.6335454 1.04474743 1.38633299
## Clustering vector:
## [1] 1 1 1 1 1 1 1 1 2 1 2 1 2 1 1 1 1 1 2 1 1 1 2 1 2 1 2 1 1 1 2 1 2 1 2 1 2
## [38] 1 1 1 2 1 2 1 2 1 2 1 1 1 2 1 1 2 2 2 2 2 1 2 2 1 2 2 2 1 2 2 1 1 2 2 2 2
## [75] 2 1 2 2 1 2 2 1 2 2 1 2 2 1 1 2 2 1 2 2 1 1 2 1 2 1 1 2 2 1 2 1 2 2 2 2 2
## [112] 1 2 1 1 1 2 2 2 2 1 2 2 3 1 3 2 3 2 3 2 3 1 3 1 3 2 3 1 3 2 3 1 3 1 3 2 3
## [149] 2 3 2 3 2 3 2 3 2 3 2 3 2 3 1 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2 3 2
## [186] 3 2 3 2 3 2 3 2 3 2 3 2 3 3 3
## Objective function:
## build swap
## 1.196211 1.101123
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call" "data"table(pam_euc$clustering)##
## 1 2 3
## 68 92 40comparison <- data.frame(
Observasi = 1:nrow(data_scaled),
Hierarchical = cluster_hc,
KMeans = kmeans_res$cluster,
PAM = pam_euc$clustering
)
head(comparison)## Observasi Hierarchical KMeans PAM
## 1 1 1 1 1
## 2 2 2 8 1
## 3 3 1 3 1
## 4 4 2 8 1
## 5 5 1 3 1
## 6 6 2 8 1##RINGKASAN KARAKTERISTIK KLASTER
data_clustered <- data.frame(data_num, cluster = factor(kmeans_res$cluster))
cluster_summary <- data_clustered %>%
group_by(cluster) %>%
summarise(across(where(is.numeric), mean, .names = "{.col}"))
cluster_summary## # A tibble: 8 × 4
## cluster Age Income Spending
## <fct> <dbl> <dbl> <dbl>
## 1 1 24.6 54.5 49.2
## 2 2 47.1 55.6 47.8
## 3 3 45.4 25.6 18.6
## 4 4 64.8 53.2 49.8
## 5 5 49 88.4 19.2
## 6 6 32.7 86.5 82.1
## 7 7 31.1 89.3 13.4
## 8 8 25.3 25.7 79.4# Visualisasi ringkasan rata-rata
cluster_summary %>%
tidyr::pivot_longer(-cluster, names_to = "Variabel", values_to = "Rata2") %>%
ggplot(aes(x = Variabel, y = Rata2, fill = cluster)) +
geom_col(position = "dodge") +
theme_minimal() +
ggtitle("Rata-rata Variabel per Cluster (K-Means)") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Hasil ini sangat baik karena menunjukkan pemisahan yang jelas antara segmen-segmen:
Segmen Prioritas (Target Utama): Kluster 6 dan 8 (Tinggi Spending).
Segmen Potensial (Pemasaran Berbasis Nilai): Kluster 7 (Tinggi Income, bisa diyakinkan untuk Spending).
Segmen Value (Stabil): Kluster 2 & 3 (Dewasa, Income Stabil).
Penting: Selisih antara rata-rata variabel pada kluster-kluster tersebut menunjukkan bahwa algoritma K-Means berhasil dalam membagi data menjadi segmen-segmen yang homogen di dalam kluster dan heterogen antar kluster.
##Evaluasi Clustering
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_hc <- eval_cluster(data_scaled, cluster_hc, dist_matrix)
eval_km <- eval_cluster(data_scaled, kmeans_res$cluster, dist_matrix)
eval_pam <- eval_cluster(data_scaled, pam_euc$clustering, dist_matrix)
eval_all <- rbind(
cbind(Metode = "Hierarchical", eval_hc),
cbind(Metode = "K-Means", eval_km),
cbind(Metode = "PAM", eval_pam)
)
eval_all## Metode Silhouette Calinski_Harabasz Dunn
## 1 Hierarchical 0.3214887 88.10174 0.06719828
## 2 K-Means 0.4100894 131.13611 0.09137426
## 3 PAM 0.3588098 101.66237 0.06831917Metode K-Means adalah pilihan terbaik untuk segmentasi data Anda karena secara konsisten menghasilkan skor tertinggi pada ketiga metrik evaluasi yang sangat penting (Silhouette, Calinski Harabasz, dan Dunn).
Implikasi: Analisis kluster dan interpretasi yang Anda lakukan pada grafik sebelumnya (rata-rata variabel per kluster) adalah valid karena didukung oleh hasil evaluasi ini. Kluster K-Means (Kluster 1-8) adalah segmentasi yang paling kuat secara statistik.