Modul 3 - Clustering
Ananda Keissa Az Zahra and Fajar Syihabuddin
2026-04-13
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.5.3## Warning: package 'ggplot2' was built under R version 4.5.3## Warning: package 'tidyr' was built under R version 4.5.3## Warning: package 'purrr' was built under R version 4.5.3## Warning: package 'dplyr' was built under R version 4.5.3## Warning: package 'forcats' was built under R version 4.5.3## Warning: package 'lubridate' was built under R version 4.5.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.1.6
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── 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)## Warning: package 'cluster' was built under R version 4.5.3library(factoextra)## Warning: package 'factoextra' was built under R version 4.5.3## Welcome to factoextra!
## Want to learn more? See two factoextra-related books at https://www.datanovia.com/en/product/practical-guide-to-principal-component-methods-in-r/library(e1071) ## Warning: package 'e1071' was built under R version 4.5.3##
## Attaching package: 'e1071'
##
## The following object is masked from 'package:ggplot2':
##
## elementlibrary(readr)
df <- read.delim("C:/Users/ASUS/Downloads/marketing_campaign.csv", sep = "\t", stringsAsFactors = FALSE)
head(df)## ID Year_Birth Education Marital_Status Income Kidhome Teenhome Dt_Customer
## 1 5524 1957 Graduation Single 58138 0 0 04-09-2012
## 2 2174 1954 Graduation Single 46344 1 1 08-03-2014
## 3 4141 1965 Graduation Together 71613 0 0 21-08-2013
## 4 6182 1984 Graduation Together 26646 1 0 10-02-2014
## 5 5324 1981 PhD Married 58293 1 0 19-01-2014
## 6 7446 1967 Master Together 62513 0 1 09-09-2013
## Recency MntWines MntFruits MntMeatProducts MntFishProducts MntSweetProducts
## 1 58 635 88 546 172 88
## 2 38 11 1 6 2 1
## 3 26 426 49 127 111 21
## 4 26 11 4 20 10 3
## 5 94 173 43 118 46 27
## 6 16 520 42 98 0 42
## MntGoldProds NumDealsPurchases NumWebPurchases NumCatalogPurchases
## 1 88 3 8 10
## 2 6 2 1 1
## 3 42 1 8 2
## 4 5 2 2 0
## 5 15 5 5 3
## 6 14 2 6 4
## NumStorePurchases NumWebVisitsMonth AcceptedCmp3 AcceptedCmp4 AcceptedCmp5
## 1 4 7 0 0 0
## 2 2 5 0 0 0
## 3 10 4 0 0 0
## 4 4 6 0 0 0
## 5 6 5 0 0 0
## 6 10 6 0 0 0
## AcceptedCmp1 AcceptedCmp2 Complain Z_CostContact Z_Revenue Response
## 1 0 0 0 3 11 1
## 2 0 0 0 3 11 0
## 3 0 0 0 3 11 0
## 4 0 0 0 3 11 0
## 5 0 0 0 3 11 0
## 6 0 0 0 3 11 0colnames(df)## [1] "ID" "Year_Birth" "Education"
## [4] "Marital_Status" "Income" "Kidhome"
## [7] "Teenhome" "Dt_Customer" "Recency"
## [10] "MntWines" "MntFruits" "MntMeatProducts"
## [13] "MntFishProducts" "MntSweetProducts" "MntGoldProds"
## [16] "NumDealsPurchases" "NumWebPurchases" "NumCatalogPurchases"
## [19] "NumStorePurchases" "NumWebVisitsMonth" "AcceptedCmp3"
## [22] "AcceptedCmp4" "AcceptedCmp5" "AcceptedCmp1"
## [25] "AcceptedCmp2" "Complain" "Z_CostContact"
## [28] "Z_Revenue" "Response"df$Income <- as.numeric(df$Income)
summary(df)## ID Year_Birth Education Marital_Status
## Min. : 0 Min. :1893 Length:2240 Length:2240
## 1st Qu.: 2828 1st Qu.:1959 Class :character Class :character
## Median : 5458 Median :1970 Mode :character Mode :character
## Mean : 5592 Mean :1969
## 3rd Qu.: 8428 3rd Qu.:1977
## Max. :11191 Max. :1996
##
## Income Kidhome Teenhome Dt_Customer
## Min. : 1730 Min. :0.0000 Min. :0.0000 Length:2240
## 1st Qu.: 35303 1st Qu.:0.0000 1st Qu.:0.0000 Class :character
## Median : 51382 Median :0.0000 Median :0.0000 Mode :character
## Mean : 52247 Mean :0.4442 Mean :0.5062
## 3rd Qu.: 68522 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :666666 Max. :2.0000 Max. :2.0000
## NA's :24
## Recency MntWines MntFruits MntMeatProducts
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.0
## 1st Qu.:24.00 1st Qu.: 23.75 1st Qu.: 1.0 1st Qu.: 16.0
## Median :49.00 Median : 173.50 Median : 8.0 Median : 67.0
## Mean :49.11 Mean : 303.94 Mean : 26.3 Mean : 166.9
## 3rd Qu.:74.00 3rd Qu.: 504.25 3rd Qu.: 33.0 3rd Qu.: 232.0
## Max. :99.00 Max. :1493.00 Max. :199.0 Max. :1725.0
##
## MntFishProducts MntSweetProducts MntGoldProds NumDealsPurchases
## Min. : 0.00 Min. : 0.00 Min. : 0.00 Min. : 0.000
## 1st Qu.: 3.00 1st Qu.: 1.00 1st Qu.: 9.00 1st Qu.: 1.000
## Median : 12.00 Median : 8.00 Median : 24.00 Median : 2.000
## Mean : 37.53 Mean : 27.06 Mean : 44.02 Mean : 2.325
## 3rd Qu.: 50.00 3rd Qu.: 33.00 3rd Qu.: 56.00 3rd Qu.: 3.000
## Max. :259.00 Max. :263.00 Max. :362.00 Max. :15.000
##
## NumWebPurchases NumCatalogPurchases NumStorePurchases NumWebVisitsMonth
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 2.000 1st Qu.: 0.000 1st Qu.: 3.00 1st Qu.: 3.000
## Median : 4.000 Median : 2.000 Median : 5.00 Median : 6.000
## Mean : 4.085 Mean : 2.662 Mean : 5.79 Mean : 5.317
## 3rd Qu.: 6.000 3rd Qu.: 4.000 3rd Qu.: 8.00 3rd Qu.: 7.000
## Max. :27.000 Max. :28.000 Max. :13.00 Max. :20.000
##
## AcceptedCmp3 AcceptedCmp4 AcceptedCmp5 AcceptedCmp1
## Min. :0.00000 Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
## Median :0.00000 Median :0.00000 Median :0.00000 Median :0.00000
## Mean :0.07277 Mean :0.07455 Mean :0.07277 Mean :0.06429
## 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
## Max. :1.00000 Max. :1.00000 Max. :1.00000 Max. :1.00000
##
## AcceptedCmp2 Complain Z_CostContact Z_Revenue
## Min. :0.00000 Min. :0.000000 Min. :3 Min. :11
## 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:3 1st Qu.:11
## Median :0.00000 Median :0.000000 Median :3 Median :11
## Mean :0.01339 Mean :0.009375 Mean :3 Mean :11
## 3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:3 3rd Qu.:11
## Max. :1.00000 Max. :1.000000 Max. :3 Max. :11
##
## Response
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.1491
## 3rd Qu.:0.0000
## Max. :1.0000
## Preprocessing
# handling missing value
colSums(is.na(df))## ID Year_Birth Education Marital_Status
## 0 0 0 0
## Income Kidhome Teenhome Dt_Customer
## 24 0 0 0
## Recency MntWines MntFruits MntMeatProducts
## 0 0 0 0
## MntFishProducts MntSweetProducts MntGoldProds NumDealsPurchases
## 0 0 0 0
## NumWebPurchases NumCatalogPurchases NumStorePurchases NumWebVisitsMonth
## 0 0 0 0
## AcceptedCmp3 AcceptedCmp4 AcceptedCmp5 AcceptedCmp1
## 0 0 0 0
## AcceptedCmp2 Complain Z_CostContact Z_Revenue
## 0 0 0 0
## Response
## 0# hapus NA
df <- na.omit(df)
# hapus kolom yang tidak dipakai
df_clean <- df %>%
select(-ID, -Dt_Customer, -Z_CostContact, -Z_Revenue)
# ubah kategori ke numeric
df_clean$Education <- as.numeric(as.factor(df_clean$Education))
df_clean$Marital_Status <- as.numeric(as.factor(df_clean$Marital_Status))
# ambil numerik saja
df_num <- df_clean %>% select(where(is.numeric))
# duplikat
sum(duplicated(df_num))## [1] 182# cek outlier
boxplot(df_num, main = "Boxplot Data", col = "lightblue")
# scaling
df_scaled <- scale(df_num)Disini, variabel Income memiliki outlier dan rentang yang masif sehingga harus dilakukan scaling (standarisasi). Dan karena algoritma K-Means dan Fuzzy C-Means sangat sensitif terhadap nilai rata-rata (yang mudah rusak oleh outlier), maka titik anomali ekstrem pada variabel Income tersebut harus dihapus (filtering) pada tahap preprocessing
Menentukan K-optimal menggunakan elbow dan silhouette methods
fviz_nbclust(df_scaled, kmeans, method = "wss")
fviz_nbclust(df_scaled, kmeans, method = "silhouette")
Evaluasi Elbow Method (WSS): Penurunan nilai error paling tajam terjadi
pada k=2, dan garis mulai melandai (membentuk siku) secara bertahap pada
k=3. Jadi bisa dilakukan clustering untuk k=2 atau k=3. Evaluasi
Silhouette Method: Nilai Average Silhouette Width mencapai puncak
tertingginya secara mutlak pada k=2, menunjukkan bahwa batas pemisahan
data paling tegas berada pada 2 kelompok. Meskipun evaluasi silhouette
menunjuk ke k = 2, kami memilih menetapkan k = 3 berdasarkan domain
expertise di bidang pemasaran. Kalau 2 kelompok saja akan menghasilkan
pembagian yang ekstrem seperti segmentasi atas dan segmentasi bawah.
K-means
set.seed(123)
kmeans_res <- kmeans(df_scaled, centers = 3, nstart = 25)
# visualisasi
fviz_cluster(kmeans_res, data = df_scaled,
geom = "point",
palette = "jco",
ggtheme = theme_minimal())
# evaluasi
sil_km <- silhouette(kmeans_res$cluster, dist(df_scaled))
mean(sil_km[,3])## [1] 0.1659226Batas antar poligon terlihat lebih menyebar. Setiap titik pelanggan dipaksa masuk ke dalam satu kelompok secara mutlak 1 atau 2 atau 3. Akibatnya, pelanggan yang sebenarnya berada di area “abu-abu” (perbatasan antar selera) akan ditarik ke centroid terdekat secara paksa, sehingga area tumpang tindih terlihat lebih lebar.
Fuzzy c-means
set.seed(123)
fcm_res <- cmeans(df_scaled, centers = 3, m = 2)
# visualisasi
fviz_cluster(list(data = df_scaled, cluster = fcm_res$cluster),
geom = "point",
palette = "jco",
ggtheme = theme_minimal())
# evaluasi
sil_fcm <- silhouette(fcm_res$cluster, dist(df_scaled))
mean(sil_fcm[,3])## [1] 0.1296239FCM mendeteksi sekumpulan besar pelanggan yang memiliki selera “campuran” (probabilitas terbagi) dan mengelompokkan mereka secara spesifik ke dalam area transisi di tengah-tengah ruang dimensi.