# install.packages("skimr")
#install.packages("caret")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ 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 errors
library(lubridate)
library(psych)
##
## Attaching package: 'psych'
##
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
library(skimr)
## Warning: package 'skimr' was built under R version 4.5.3
library(corrplot)
## corrplot 0.95 loaded
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cluster)
library(caret)
## Warning: package 'caret' was built under R version 4.5.3
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(dbscan)
## Warning: package 'dbscan' was built under R version 4.5.3
##
## Attaching package: 'dbscan'
##
## The following object is masked from 'package:stats':
##
## as.dendrogram
library(LPCM)
## Warning: package 'LPCM' was built under R version 4.5.3
##
## Attaching package: 'LPCM'
##
## The following object is masked from 'package:lubridate':
##
## ms
library(meanShiftR)
# Baca data
data <- read.csv("marketing_campaign.csv", sep = "\t")
# Lihat struktur
str(data)
## 'data.frame': 2240 obs. of 29 variables:
## $ ID : int 5524 2174 4141 6182 5324 7446 965 6177 4855 5899 ...
## $ Year_Birth : int 1957 1954 1965 1984 1981 1967 1971 1985 1974 1950 ...
## $ Education : chr "Graduation" "Graduation" "Graduation" "Graduation" ...
## $ Marital_Status : chr "Single" "Single" "Together" "Together" ...
## $ Income : int 58138 46344 71613 26646 58293 62513 55635 33454 30351 5648 ...
## $ Kidhome : int 0 1 0 1 1 0 0 1 1 1 ...
## $ Teenhome : int 0 1 0 0 0 1 1 0 0 1 ...
## $ Dt_Customer : chr "04-09-2012" "08-03-2014" "21-08-2013" "10-02-2014" ...
## $ Recency : int 58 38 26 26 94 16 34 32 19 68 ...
## $ MntWines : int 635 11 426 11 173 520 235 76 14 28 ...
## $ MntFruits : int 88 1 49 4 43 42 65 10 0 0 ...
## $ MntMeatProducts : int 546 6 127 20 118 98 164 56 24 6 ...
## $ MntFishProducts : int 172 2 111 10 46 0 50 3 3 1 ...
## $ MntSweetProducts : int 88 1 21 3 27 42 49 1 3 1 ...
## $ MntGoldProds : int 88 6 42 5 15 14 27 23 2 13 ...
## $ NumDealsPurchases : int 3 2 1 2 5 2 4 2 1 1 ...
## $ NumWebPurchases : int 8 1 8 2 5 6 7 4 3 1 ...
## $ NumCatalogPurchases: int 10 1 2 0 3 4 3 0 0 0 ...
## $ NumStorePurchases : int 4 2 10 4 6 10 7 4 2 0 ...
## $ NumWebVisitsMonth : int 7 5 4 6 5 6 6 8 9 20 ...
## $ AcceptedCmp3 : int 0 0 0 0 0 0 0 0 0 1 ...
## $ AcceptedCmp4 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ AcceptedCmp5 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ AcceptedCmp1 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ AcceptedCmp2 : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Complain : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Z_CostContact : int 3 3 3 3 3 3 3 3 3 3 ...
## $ Z_Revenue : int 11 11 11 11 11 11 11 11 11 11 ...
## $ Response : int 1 0 0 0 0 0 0 0 1 0 ...
# Lihat 6 data awal
head(data)
## 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 0
Untuk mengetahui ukuran dataset, yaitu jumlah baris (observasi) dan kolom (variabel). Informasi ini penting untuk memahami skala data yang akan dianalisis.
dim(data) # jumlah baris & kolom
## [1] 2240 29
Melihat tipe data masing-masing variabel. Hal ini bertujuan untuk mengelompokkan variabel ke dalam kategori numerik dan non-numerik, karena metode clustering nantinya hanya menggunakan data numerik.
sapply(data, class)
## ID Year_Birth Education Marital_Status
## "integer" "integer" "character" "character"
## Income Kidhome Teenhome Dt_Customer
## "integer" "integer" "integer" "character"
## Recency MntWines MntFruits MntMeatProducts
## "integer" "integer" "integer" "integer"
## MntFishProducts MntSweetProducts MntGoldProds NumDealsPurchases
## "integer" "integer" "integer" "integer"
## NumWebPurchases NumCatalogPurchases NumStorePurchases NumWebVisitsMonth
## "integer" "integer" "integer" "integer"
## AcceptedCmp3 AcceptedCmp4 AcceptedCmp5 AcceptedCmp1
## "integer" "integer" "integer" "integer"
## AcceptedCmp2 Complain Z_CostContact Z_Revenue
## "integer" "integer" "integer" "integer"
## Response
## "integer"
describe(data)
## vars n mean sd median trimmed mad min
## ID 1 2240 5592.16 3246.66 5458.5 5582.43 4137.94 0
## Year_Birth 2 2240 1968.81 11.98 1970.0 1968.94 13.34 1893
## Education* 3 2240 3.39 1.12 3.0 3.48 0.00 1
## Marital_Status* 4 2240 4.73 1.08 5.0 4.75 1.48 1
## Income 5 2216 52247.25 25173.08 51381.5 51763.99 24548.15 1730
## Kidhome 6 2240 0.44 0.54 0.0 0.40 0.00 0
## Teenhome 7 2240 0.51 0.54 0.0 0.48 0.00 0
## Dt_Customer* 8 2240 328.88 190.17 327.0 327.94 238.70 1
## Recency 9 2240 49.11 28.96 49.0 49.11 37.06 0
## MntWines 10 2240 303.94 336.60 173.5 248.99 243.89 0
## MntFruits 11 2240 26.30 39.77 8.0 16.98 11.86 0
## MntMeatProducts 12 2240 166.95 225.72 67.0 119.33 87.47 0
## MntFishProducts 13 2240 37.53 54.63 12.0 25.08 17.79 0
## MntSweetProducts 14 2240 27.06 41.28 8.0 17.35 11.86 0
## MntGoldProds 15 2240 44.02 52.17 24.0 33.41 26.69 0
## NumDealsPurchases 16 2240 2.33 1.93 2.0 1.96 1.48 0
## NumWebPurchases 17 2240 4.08 2.78 4.0 3.81 2.97 0
## NumCatalogPurchases 18 2240 2.66 2.92 2.0 2.21 2.97 0
## NumStorePurchases 19 2240 5.79 3.25 5.0 5.48 2.97 0
## NumWebVisitsMonth 20 2240 5.32 2.43 6.0 5.40 2.97 0
## AcceptedCmp3 21 2240 0.07 0.26 0.0 0.00 0.00 0
## AcceptedCmp4 22 2240 0.07 0.26 0.0 0.00 0.00 0
## AcceptedCmp5 23 2240 0.07 0.26 0.0 0.00 0.00 0
## AcceptedCmp1 24 2240 0.06 0.25 0.0 0.00 0.00 0
## AcceptedCmp2 25 2240 0.01 0.11 0.0 0.00 0.00 0
## Complain 26 2240 0.01 0.10 0.0 0.00 0.00 0
## Z_CostContact 27 2240 3.00 0.00 3.0 3.00 0.00 3
## Z_Revenue 28 2240 11.00 0.00 11.0 11.00 0.00 11
## Response 29 2240 0.15 0.36 0.0 0.06 0.00 0
## max range skew kurtosis se
## ID 11191 11191 0.04 -1.19 68.60
## Year_Birth 1996 103 -0.35 0.71 0.25
## Education* 5 4 -0.28 -0.16 0.02
## Marital_Status* 8 7 0.17 -0.78 0.02
## Income 666666 664936 6.75 159.13 534.75
## Kidhome 2 2 0.63 -0.78 0.01
## Teenhome 2 2 0.41 -0.99 0.01
## Dt_Customer* 663 662 0.03 -1.16 4.02
## Recency 99 99 0.00 -1.20 0.61
## MntWines 1493 1493 1.17 0.59 7.11
## MntFruits 199 199 2.10 4.03 0.84
## MntMeatProducts 1725 1725 2.08 5.49 4.77
## MntFishProducts 259 259 1.92 3.08 1.15
## MntSweetProducts 263 263 2.13 4.36 0.87
## MntGoldProds 362 362 1.88 3.54 1.10
## NumDealsPurchases 15 15 2.42 8.90 0.04
## NumWebPurchases 27 27 1.38 5.68 0.06
## NumCatalogPurchases 28 28 1.88 8.02 0.06
## NumStorePurchases 13 13 0.70 -0.63 0.07
## NumWebVisitsMonth 20 20 0.21 1.81 0.05
## AcceptedCmp3 1 1 3.29 8.81 0.01
## AcceptedCmp4 1 1 3.24 8.48 0.01
## AcceptedCmp5 1 1 3.29 8.81 0.01
## AcceptedCmp1 1 1 3.55 10.61 0.01
## AcceptedCmp2 1 1 8.46 69.62 0.00
## Complain 1 1 10.18 101.58 0.00
## Z_CostContact 3 0 NaN NaN 0.00
## Z_Revenue 11 0 NaN NaN 0.00
## Response 1 1 1.97 1.88 0.01
Mendeteksi apakah terdapat data yang hilang pada setiap variabel. Sehingga dapat diketahui jumlah nilai kosong di tiap kolom sehingga dapat ditentukan langkah penanganannya pada tahap preprocessing.
colSums(is.na(data))
## 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
Berdasarkan hasil pengecekan, hampir seluruh variabel tidak memiliki missing values. Hanya variabel Income yang memiliki 24 data kosong. Secara umum, data sudah cukup baik, namun missing values pada Income perlu ditangani agar tidak mempengaruhi analisis selanjutnya.
data_num <- data[, sapply(data, is.numeric)]
data_log <- log1p(data_num) # log(1 + x), aman untuk nilai 0
boxplot(data_log,
col = "lightblue",
las = 2, # bikin label jadi vertikal
cex.axis = 0.5, # kecilin font
main = "Boxplot Deteksi Outlier")
num_data <- data[sapply(data, is.numeric)]
detect_outlier <- function(x){
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
x < (Q1 - 1.5*IQR) | x > (Q3 + 1.5*IQR)
}
sapply(num_data, function(x) sum(detect_outlier(x), na.rm = TRUE))
## ID Year_Birth Income Kidhome
## 0 3 8 0
## Teenhome Recency MntWines MntFruits
## 0 0 35 227
## MntMeatProducts MntFishProducts MntSweetProducts MntGoldProds
## 175 223 248 207
## NumDealsPurchases NumWebPurchases NumCatalogPurchases NumStorePurchases
## 86 4 23 0
## NumWebVisitsMonth AcceptedCmp3 AcceptedCmp4 AcceptedCmp5
## 8 163 167 163
## AcceptedCmp1 AcceptedCmp2 Complain Z_CostContact
## 144 30 21 0
## Z_Revenue Response
## 0 334
Tahap preprocessing dilakukan untuk mempersiapkan data agar siap digunakan dalam proses clustering. Proses ini meliputi pembersihan data, transformasi variabel, serta penyesuaian format data agar sesuai dengan kebutuhan analisis.
# Hapus ID karena tidak berpengaruh ke clustering
data <- data %>% select(-ID)
Variabel ID dihapus karena hanya berfungsi sebagai identitas dan tidak memiliki pengaruh terhadap proses clustering. Penghapusan ini dilakukan agar analisis lebih fokus pada variabel yang relevan.
# Cek missing value
colSums(is.na(data))
## Year_Birth Education Marital_Status Income
## 0 0 0 24
## Kidhome Teenhome Dt_Customer Recency
## 0 0 0 0
## MntWines MntFruits MntMeatProducts MntFishProducts
## 0 0 0 0
## MntSweetProducts MntGoldProds NumDealsPurchases NumWebPurchases
## 0 0 0 0
## NumCatalogPurchases NumStorePurchases NumWebVisitsMonth AcceptedCmp3
## 0 0 0 0
## AcceptedCmp4 AcceptedCmp5 AcceptedCmp1 AcceptedCmp2
## 0 0 0 0
## Complain Z_CostContact Z_Revenue Response
## 0 0 0 0
# Imputasi median pada Income
data$Income[is.na(data$Income)] <- median(data$Income, na.rm = TRUE)
colSums(is.na(data))
## Year_Birth Education Marital_Status Income
## 0 0 0 0
## Kidhome Teenhome Dt_Customer Recency
## 0 0 0 0
## MntWines MntFruits MntMeatProducts MntFishProducts
## 0 0 0 0
## MntSweetProducts MntGoldProds NumDealsPurchases NumWebPurchases
## 0 0 0 0
## NumCatalogPurchases NumStorePurchases NumWebVisitsMonth AcceptedCmp3
## 0 0 0 0
## AcceptedCmp4 AcceptedCmp5 AcceptedCmp1 AcceptedCmp2
## 0 0 0 0
## Complain Z_CostContact Z_Revenue Response
## 0 0 0 0
Penanganan missing value dilakukan dengan mengganti nilai kosong pada variabel Income menggunakan median. Median dipilih karena lebih robust terhadap outlier dibandingkan mean.
head(data$Dt_Customer)
## [1] "04-09-2012" "08-03-2014" "21-08-2013" "10-02-2014" "19-01-2014"
## [6] "09-09-2013"
# Pastikan character + bersih
data$Dt_Customer <- as.character(data$Dt_Customer)
data$Dt_Customer <- trimws(data$Dt_Customer)
# Convert (karena format kamu dmy)
data$Dt_Customer <- dmy(data$Dt_Customer)
# Cek hasil
head(data$Dt_Customer)
## [1] "2012-09-04" "2014-03-08" "2013-08-21" "2014-02-10" "2014-01-19"
## [6] "2013-09-09"
Variabel Dt_Customer diubah ke tipe character dan dibersihkan dari spasi, lalu dikonversi ke format tanggal menggunakan dmy(). Hasilnya menjadi format standar (YYYY-MM-DD).
data$Customer_Duration <- as.numeric(Sys.Date() - data$Dt_Customer)
head(data$Customer_Duration)
## [1] 4970 4420 4619 4446 4468 4600
Selanjutnya dibuat variabel baru Customer_Duration, yaitu selisih antara tanggal saat ini dengan tanggal pelanggan terdaftar. Nilai ini menunjukkan lama menjadi pelanggan (dalam hari) dan dapat digunakan untuk analisis selanjutnya.
head(data)
## Year_Birth Education Marital_Status Income Kidhome Teenhome Dt_Customer
## 1 1957 Graduation Single 58138 0 0 2012-09-04
## 2 1954 Graduation Single 46344 1 1 2014-03-08
## 3 1965 Graduation Together 71613 0 0 2013-08-21
## 4 1984 Graduation Together 26646 1 0 2014-02-10
## 5 1981 PhD Married 58293 1 0 2014-01-19
## 6 1967 Master Together 62513 0 1 2013-09-09
## 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 0
## Customer_Duration
## 1 4970
## 2 4420
## 3 4619
## 4 4446
## 5 4468
## 6 4600
Feature engineering dilakukan untuk meningkatkan kualitas data dengan membentuk variabel baru yang lebih representatif. Variabel seperti Age, Customer_Duration, Total_Spending, dan Total_Purchases dibuat untuk menyederhanakan informasi serta mengurangi kompleksitas data. Selain itu, beberapa variabel digabungkan untuk menghindari redundansi dan multikolinearitas, sehingga data lebih optimal untuk proses clustering. ### 3.4.1 Age Dibuat variabel Age dengan cara mengurangi tahun saat ini dengan variabel Year_Birth. Variabel ini digunakan untuk menggambarkan usia pelanggan secara langsung sehingga lebih relevan dibandingkan hanya menggunakan tahun lahir.
data$Age <- year(Sys.Date()) - data$Year_Birth
head(data$Age)
## [1] 69 72 61 42 45 59
Dibentuk variabel Total_Spending dengan menjumlahkan seluruh pengeluaran pelanggan pada berbagai kategori produk seperti wine, fruits, meat, fish, sweet, dan gold products. Penggabungan ini dilakukan untuk menyederhanakan informasi pengeluaran menjadi satu indikator utama.
data$Total_Spending <- rowSums(data[, c(
"MntWines","MntFruits","MntMeatProducts",
"MntFishProducts","MntSweetProducts","MntGoldProds"
)])
head(data$Total_Spending)
## [1] 1617 27 776 53 422 716
Dibentuk variabel Total_Purchases yang merupakan total dari pembelian melalui web, katalog, dan toko. Variabel ini digunakan untuk menggambarkan intensitas perilaku pembelian pelanggan secara keseluruhan.
data$Total_Purchases <- rowSums(data[, c(
"NumWebPurchases","NumCatalogPurchases","NumStorePurchases"
)])
head(data$Total_Purchases)
## [1] 22 4 20 6 14 20
Variabel Total_Children dibuat dengan menjumlahkan jumlah anak di rumah (Kidhome) dan remaja (Teenhome), sehingga lebih ringkas dibandingkan memisahkan keduanya.
data$Total_Children <- data$Kidhome + data$Teenhome
head(data$Total_Children)
## [1] 0 2 0 1 1 1
Dibuat variabel Total_Campaign yang merupakan total respons pelanggan terhadap seluruh kampanye pemasaran. Variabel ini membantu melihat seberapa responsif pelanggan terhadap promosi yang diberikan.
data$Total_Campaign <- rowSums(data[, c(
"AcceptedCmp1","AcceptedCmp2","AcceptedCmp3",
"AcceptedCmp4","AcceptedCmp5","Response"
)])
head(data$Total_Campaign)
## [1] 1 0 0 0 0 0
Menghapus variabel yang tidak diperlukan setelah melakukan feature engineering
data <- data %>% select(
-Year_Birth,
-Dt_Customer,
-Kidhome, -Teenhome,
-MntWines, -MntFruits, -MntMeatProducts,
-MntFishProducts, -MntSweetProducts, -MntGoldProds,
-NumWebPurchases, -NumCatalogPurchases, ... = -NumStorePurchases,
-AcceptedCmp1, -AcceptedCmp2, -AcceptedCmp3,
-AcceptedCmp4, -AcceptedCmp5, -Response
)
head(data)
## Education Marital_Status Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 Graduation Single 58138 58 3 7
## 2 Graduation Single 46344 38 2 5
## 3 Graduation Together 71613 26 1 4
## 4 Graduation Together 26646 26 2 6
## 5 PhD Married 58293 94 5 5
## 6 Master Together 62513 16 2 6
## Complain Z_CostContact Z_Revenue Customer_Duration Age Total_Spending
## 1 0 3 11 4970 69 1617
## 2 0 3 11 4420 72 27
## 3 0 3 11 4619 61 776
## 4 0 3 11 4446 42 53
## 5 0 3 11 4468 45 422
## 6 0 3 11 4600 59 716
## Total_Purchases Total_Children Total_Campaign
## 1 22 0 1
## 2 4 2 0
## 3 20 0 0
## 4 6 1 0
## 5 14 1 0
## 6 20 1 0
Variabel kategorikal seperti Education dan Marital_Status diubah menjadi bentuk numerik menggunakan teknik one-hot encoding. Hal ini dilakukan karena metode clustering hanya dapat mengolah data numerik.
# One-hot encoding
data_dummy <- model.matrix(~ Education + Marital_Status -1, data = data)
# Gabungkan
data <- cbind(data, data_dummy)
# Hapus variabel asli
data <- data %>% select(-Education, -Marital_Status)
head(data)
## Income Recency NumDealsPurchases NumWebVisitsMonth Complain Z_CostContact
## 1 58138 58 3 7 0 3
## 2 46344 38 2 5 0 3
## 3 71613 26 1 4 0 3
## 4 26646 26 2 6 0 3
## 5 58293 94 5 5 0 3
## 6 62513 16 2 6 0 3
## Z_Revenue Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 11 4970 69 1617 22 0
## 2 11 4420 72 27 4 2
## 3 11 4619 61 776 20 0
## 4 11 4446 42 53 6 1
## 5 11 4468 45 422 14 1
## 6 11 4600 59 716 20 1
## Total_Campaign Education2n Cycle EducationBasic EducationGraduation
## 1 1 0 0 1
## 2 0 0 0 1
## 3 0 0 0 1
## 4 0 0 0 1
## 5 0 0 0 0
## 6 0 0 0 0
## EducationMaster EducationPhD Marital_StatusAlone Marital_StatusDivorced
## 1 0 0 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 1 0 0
## 6 1 0 0 0
## Marital_StatusMarried Marital_StatusSingle Marital_StatusTogether
## 1 0 1 0
## 2 0 1 0
## 3 0 0 1
## 4 0 0 1
## 5 1 0 0
## 6 0 0 1
## Marital_StatusWidow Marital_StatusYOLO
## 1 0 0
## 2 0 0
## 3 0 0
## 4 0 0
## 5 0 0
## 6 0 0
Seleksi dilakukan untuk mengambil hanya variabel numerik yang akan digunakan dalam proses clustering, karena metode berbasis jarak tidak dapat mengolah data kategorikal secara langsung.
data_num <- data %>% select(where(is.numeric))
rm(var)
## Warning in rm(var): object 'var' not found
var_check <- sapply(data_num, var, na.rm = TRUE)
names(var_check[var_check == 0])
## [1] "Z_CostContact" "Z_Revenue"
Langkah tersebut dilakukan dengan terlebih dahulu menghapus objek bernama var agar tidak terjadi konflik dengan fungsi bawaan R. Kemudian dihitung varians untuk setiap kolom numerik dengan mengabaikan nilai yang kosong. Dari hasil tersebut, diidentifikasi kolom-kolom yang memiliki varians nol, yang berarti nilainya konstan dan tidak memberikan informasi penting dalam analisis.
data_num <- data_num[, var_check > 1e-6]
Langkah ini bertujuan untuk menyaring data dengan hanya mempertahankan kolom yang memiliki varians tidak sama dengan nol. Artinya, kolom-kolom yang nilainya konstan akan dihapus, sehingga data yang digunakan selanjutnya hanya berisi fitur yang memiliki variasi dan lebih informatif untuk analisis.
Penanganan outlier dilakukan untuk mengurangi pengaruh nilai ekstrem terhadap hasil clustering, khususnya pada metode berbasis jarak seperti K-Means dan K-Median. Outlier tidak dihapus, tetapi dapat ditangani menggunakan metode capping agar tetap mempertahankan informasi tanpa mengganggu distribusi data secara keseluruhan.
cap_outlier <- function(x){
Q1 <- quantile(x, 0.25)
Q3 <- quantile(x, 0.75)
IQR <- Q3 - Q1
lower <- Q1 - 1.5*IQR
upper <- Q3 + 1.5*IQR
x[x < lower] <- lower
x[x > upper] <- upper
return(x)
}
data_num <- as.data.frame(lapply(data_num, cap_outlier))
sapply(data_num, function(x) sum(detect_outlier(x)))
## Income Recency NumDealsPurchases
## 0 0 0
## NumWebVisitsMonth Complain Customer_Duration
## 0 0 0
## Age Total_Spending Total_Purchases
## 0 0 0
## Total_Children Total_Campaign Education2n.Cycle
## 0 0 0
## EducationBasic EducationGraduation EducationMaster
## 0 0 0
## EducationPhD Marital_StatusAlone Marital_StatusDivorced
## 0 0 0
## Marital_StatusMarried Marital_StatusSingle Marital_StatusTogether
## 0 0 0
## Marital_StatusWidow Marital_StatusYOLO
## 0 0
Normalisasi dilakukan menggunakan fungsi scale() untuk menyamakan skala antar variabel. Hal ini penting karena metode clustering berbasis jarak sangat sensitif terhadap perbedaan skala.
data_scaled <- scale(data_num)
colSums(is.nan(data_scaled))
## Income Recency NumDealsPurchases
## 0 0 0
## NumWebVisitsMonth Complain Customer_Duration
## 0 2240 0
## Age Total_Spending Total_Purchases
## 0 0 0
## Total_Children Total_Campaign Education2n.Cycle
## 0 0 2240
## EducationBasic EducationGraduation EducationMaster
## 2240 0 2240
## EducationPhD Marital_StatusAlone Marital_StatusDivorced
## 2240 2240 2240
## Marital_StatusMarried Marital_StatusSingle Marital_StatusTogether
## 0 2240 0
## Marital_StatusWidow Marital_StatusYOLO
## 2240 2240
data_scaled <- data_scaled[, colSums(is.nan(data_scaled)) == 0]
final_data <- data_scaled
head(final_data)
## Income Recency NumDealsPurchases NumWebVisitsMonth
## [1,] 0.2995842 0.3069707 0.5097743 0.7242905
## [2,] -0.2637489 -0.3835785 -0.1401371 -0.1273687
## [3,] 0.9432091 -0.7979081 -0.7900486 -0.5531982
## [4,] -1.2046116 -0.7979081 -0.1401371 0.2984609
## [5,] 0.3069876 1.5499594 1.8095971 -0.1273687
## [6,] 0.5085533 -1.1431827 -0.1401371 0.2984609
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## [1,] 1.5308431 1.0068390 1.6792397 1.3132510 -1.29854625
## [2,] -1.1902788 1.2616870 -0.9611249 -1.1847572 1.46839177
## [3,] -0.2057274 0.3272445 0.2826695 1.0356946 -1.29854625
## [4,] -1.0616440 -1.2867925 -0.9179492 -0.9072008 0.08492276
## [5,] -0.9527991 -1.0319446 -0.3051853 0.2030251 0.08492276
## [6,] -0.2997298 0.1573459 0.1830330 1.0356946 0.08492276
## Total_Campaign EducationGraduation Marital_StatusMarried
## [1,] 0.8242806 0.9935476 -0.7922289
## [2,] -0.5500317 0.9935476 -0.7922289
## [3,] -0.5500317 0.9935476 -0.7922289
## [4,] -0.5500317 0.9935476 -0.7922289
## [5,] -0.5500317 -1.0060450 1.2616979
## [6,] -0.5500317 -1.0060450 -0.7922289
## Marital_StatusTogether
## [1,] -0.5909667
## [2,] -0.5909667
## [3,] 1.6913874
## [4,] 1.6913874
## [5,] -0.5909667
## [6,] 1.6913874
Tahap ini bertujuan untuk memastikan bahwa data yang telah diproses memenuhi kondisi yang baik untuk dilakukan analisis clustering, khususnya metode berbasis jarak seperti K-Means dan K-Median. ## 4.1 Uji Multikolinearitas (Korelasi Antar Variabel)
# Matriks korelasi
corr_matrix <- cor(final_data)
# Visualisasi
corrplot(corr_matrix, method = "color", tl.cex = 0.7)
Berdasarkan hasil uji multikolinearitas menggunakan matriks korelasi, tidak ditemukan korelasi yang sangat tinggi antar variabel (>|0.9|). Hal ini menunjukkan bahwa tidak terjadi multikolinearitas yang serius, sehingga seluruh variabel dapat digunakan dalam proses clustering.
# Cari pasangan variabel dengan korelasi tinggi
high_corr <- findCorrelation(corr_matrix, cutoff = 0.9)
# Lihat variabel yang perlu dihapus
colnames(final_data)[high_corr]
## character(0)
Berdasarkan hasil analisis korelasi dengan cutoff 0.9, tidak ditemukan pasangan variabel dengan korelasi tinggi. Hal ini menunjukkan bahwa tidak terdapat multikolinearitas yang signifikan antar variabel, sehingga seluruh variabel dapat digunakan dalam analisis clustering.
KMO(final_data)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = final_data)
## Overall MSA = 0.71
## MSA for each item =
## Income Recency NumDealsPurchases
## 0.77 0.38 0.51
## NumWebVisitsMonth Customer_Duration Age
## 0.77 0.54 0.73
## Total_Spending Total_Purchases Total_Children
## 0.78 0.75 0.67
## Total_Campaign EducationGraduation Marital_StatusMarried
## 0.74 0.50 0.50
## Marital_StatusTogether
## 0.50
Berdasarkan hasil uji Kaiser-Meyer-Olkin (KMO), diperoleh nilai Overall MSA sebesar 0.71 yang menunjukkan bahwa data memiliki tingkat kecukupan yang baik untuk analisis multivariat. Meskipun terdapat beberapa variabel dengan nilai MSA di bawah 0.5 seperti Recency, secara keseluruhan data masih layak digunakan untuk proses clustering. Oleh karena itu, analisis dapat dilanjutkan ke tahap clustering.
cortest.bartlett(cor(final_data), n = nrow(final_data))
## $chisq
## [1] 10657.64
##
## $p.value
## [1] 0
##
## $df
## [1] 78
Berdasarkan hasil uji Bartlett, diperoleh nilai Chi-square sebesar 10657.64 dengan p-value < 0.05. Hal ini menunjukkan bahwa variabel saling berkorelasi secara signifikan, sehingga data layak digunakan untuk analisis clustering.
Berdasarkan seluruh tahapan preprocessing dan uji asumsi yang telah dilakukan, data telah memenuhi syarat untuk analisis clustering. Data telah bersih, bebas dari missing value, tidak mengandung multikolinearitas yang tinggi, serta memiliki struktur korelasi yang signifikan berdasarkan uji Bartlett dan nilai KMO yang memadai. Oleh karena itu, analisis dapat dilanjutkan ke tahap clustering.
Metode Elbow dan Silhouette digunakan untuk menentukan jumlah cluster optimal pada metode berbasis centroid seperti K-Means, K-Median, dan Fuzzy C-Means. Sementara itu, metode DBSCAN dan Mean Shift tidak memerlukan jumlah cluster di awal karena jumlah cluster terbentuk secara otomatis berdasarkan parameter tertentu. ## 5.1 Elbow Method
fviz_nbclust(final_data, kmeans, method = "wss") +
labs(title = "Elbow Method")
## 5.2 Silhouette Method
fviz_nbclust(final_data, kmeans, method = "silhouette") +
labs(title = "Silhouette Method")
Berdasarkan metode Elbow, nilai k = 3 sebenarnya menunjukkan titik
penurunan variasi yang mulai melandai. Namun, hasil evaluasi menggunakan
metode Silhouette menunjukkan bahwa nilai terbaik diperoleh pada k = 2,
yang menandakan bahwa pemisahan antar cluster pada k = 2 lebih optimal.
Oleh karena itu, dalam penelitian ini dipilih k = 2 sebagai jumlah
cluster yang digunakan.
Pemilihan k = 2 dianggap lebih tepat karena mampu menghasilkan pengelompokan yang lebih jelas dengan tingkat overlap yang lebih rendah dibandingkan k = 3. Meskipun jumlah cluster lebih sedikit, hasil segmentasi tetap mampu membedakan karakteristik utama pelanggan secara efektif, sehingga interpretasi yang dihasilkan menjadi lebih sederhana dan mudah dipahami.
# Set seed biar hasil konsisten
set.seed(123)
# Jalankan K-Means
kmeans_result <- kmeans(final_data, centers = 2, nstart = 25)
# Lihat hasil cluster
kmeans_result
## K-means clustering with 2 clusters of sizes 1328, 912
##
## Cluster means:
## Income Recency NumDealsPurchases NumWebVisitsMonth Customer_Duration
## 1 -0.6511394 -0.007520383 0.1867761 0.4972669 -0.03918537
## 2 0.9481503 0.010950733 -0.2719722 -0.7240903 0.05705940
## Age Total_Spending Total_Purchases Total_Children Total_Campaign
## 1 -0.1220658 -0.6889743 -0.6597408 0.4333944 -0.2690635
## 2 0.1777449 1.0032432 0.9606752 -0.6310831 0.3917942
## EducationGraduation Marital_StatusMarried Marital_StatusTogether
## 1 -0.02883449 0.02284596 -0.00834768
## 2 0.04198706 -0.03326692 0.01215539
##
## Clustering vector:
## [1] 2 1 2 1 1 2 1 1 1 1 1 1 2 1 1 2 1 1 2 1 1 2 2 2 1 1 1 2 1 2 1 1 1 1 2 1 2
## [38] 1 1 2 2 1 1 1 1 2 1 1 1 1 2 2 1 2 1 2 2 1 1 1 2 2 2 2 2 1 1 2 2 1 2 1 2 1
## [75] 1 1 2 2 1 2 1 1 1 1 2 1 1 1 2 1 1 1 2 1 1 1 1 1 2 1 1 1 2 2 2 1 1 1 1 2 2
## [112] 2 2 2 1 1 2 1 1 1 2 1 1 1 2 2 2 1 1 2 1 1 2 2 1 2 1 1 1 1 2 2 2 2 1 1 1 1
## [149] 1 1 1 1 1 1 2 2 1 1 1 2 1 2 1 2 2 1 2 2 2 1 1 1 1 1 1 2 2 1 1 2 1 1 2 1 1
## [186] 1 1 2 2 1 1 2 1 1 1 1 2 2 2 1 2 2 2 2 1 1 1 1 1 2 1 2 1 1 2 1 1 2 1 2 1 2
## [223] 2 1 2 1 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 2 1 2 2 1 2 2 2 2 1 1 2 1 2 1 2 1 1
## [260] 1 1 2 1 1 1 1 2 1 2 1 2 1 1 1 1 2 2 2 2 2 1 1 1 2 1 1 2 1 2 1 1 1 2 1 1 2
## [297] 1 1 2 2 1 2 1 1 1 2 1 2 2 1 1 1 2 2 1 1 1 2 1 1 2 1 1 2 1 2 1 1 1 1 1 1 2
## [334] 1 1 2 2 1 2 2 2 1 2 2 1 2 1 2 1 1 2 2 2 2 2 1 1 2 2 1 2 2 1 1 1 2 2 1 2 1
## [371] 1 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1 2 1 2 2 1 2 1 2 2 1 1 1 1 1 2 1 1 1 1 1
## [408] 1 1 1 1 1 2 1 2 2 1 2 2 1 1 1 1 2 2 1 2 2 1 2 2 1 2 2 1 1 2 1 1 1 1 1 1 1
## [445] 1 1 1 2 1 2 2 2 1 1 2 1 2 1 1 2 2 2 1 2 1 2 2 1 1 2 2 1 2 1 1 2 1 1 1 1 1
## [482] 1 1 1 2 2 2 2 1 1 2 1 2 1 2 2 1 2 2 2 1 1 1 2 1 2 2 2 1 2 1 2 1 2 1 2 1 1
## [519] 2 2 1 2 1 2 1 1 2 2 2 1 1 2 1 1 1 1 1 2 1 1 1 1 1 2 2 1 2 1 1 1 1 1 1 1 2
## [556] 1 2 2 1 2 1 2 2 2 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 2
## [593] 2 1 2 1 1 1 1 1 1 2 2 1 1 1 1 1 1 2 1 2 1 1 2 1 1 2 1 1 1 1 2 1 2 1 2 2 1
## [630] 1 2 2 2 1 2 1 2 1 2 2 2 2 2 1 2 1 2 1 2 2 2 1 2 1 1 2 1 1 2 1 1 1 2 1 1 1
## [667] 1 1 1 1 2 1 2 2 1 1 2 2 1 2 2 2 1 1 2 2 2 2 2 2 1 2 1 1 1 1 1 1 2 2 2 2 2
## [704] 2 1 2 1 1 2 1 1 2 1 2 1 2 2 1 2 1 2 2 1 2 1 1 2 2 1 2 1 1 1 1 2 2 2 2 1 2
## [741] 2 1 1 1 2 2 1 2 1 2 2 2 2 2 2 2 2 1 1 1 1 1 2 1 2 1 2 2 1 1 2 2 1 1 1 1 1
## [778] 2 1 2 2 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 2 2 2 1 2 1 1 2 2 1 1 1 1 2 1 1 2 2
## [815] 2 2 1 1 2 1 2 1 2 1 2 2 2 1 2 1 1 2 1 1 1 2 1 2 1 2 1 1 1 1 2 2 2 2 1 1 1
## [852] 2 2 1 1 2 1 1 1 2 1 1 1 1 1 1 1 1 1 1 2 2 1 1 2 2 1 1 2 1 1 1 1 1 2 2 1 1
## [889] 1 2 1 1 2 1 2 2 2 2 1 1 2 1 2 2 1 2 2 1 1 1 2 2 2 1 2 2 2 2 1 2 1 2 1 1 2
## [926] 1 2 2 2 2 2 1 2 1 2 1 2 2 2 2 1 2 2 2 1 2 2 1 1 1 1 1 1 1 1 1 1 2 1 1 2 1
## [963] 1 1 1 2 2 1 1 1 2 1 1 1 2 2 2 1 1 2 1 1 1 2 2 1 2 2 2 1 2 1 1 2 1 1 2 1 2
## [1000] 1 2 2 1 1 1 1 2 2 1 1 2 1 1 1 1 2 2 2 1 1 1 1 1 1 1 2 1 1 1 2 2 2 2 1 2 1
## [1037] 1 1 1 1 2 1 1 2 1 1 1 2 1 1 2 1 2 1 1 2 1 1 2 2 1 2 2 1 2 1 2 2 1 2 1 2 2
## [1074] 1 1 2 2 1 1 1 2 1 2 1 2 1 1 2 1 2 2 1 2 1 1 1 2 2 1 2 2 1 1 1 1 2 1 1 2 1
## [1111] 2 2 1 2 1 2 1 1 1 1 2 1 1 1 1 1 2 1 1 2 2 1 1 2 2 1 1 2 1 1 2 1 1 1 2 1 1
## [1148] 1 1 1 2 2 1 2 1 1 1 2 2 2 1 1 2 2 1 2 1 1 2 2 1 1 2 1 1 1 1 1 1 2 1 1 2 1
## [1185] 1 1 1 2 1 1 2 2 1 1 1 2 1 2 2 2 1 2 1 1 2 1 2 1 1 1 1 2 2 2 1 1 2 1 2 1 1
## [1222] 1 2 1 1 2 2 1 1 1 1 1 1 1 1 2 1 2 1 1 1 1 2 2 1 1 1 1 1 2 2 2 2 2 2 1 2 2
## [1259] 1 2 1 2 2 1 1 2 1 1 1 2 2 2 1 1 1 2 1 1 2 1 2 2 1 1 1 1 2 1 2 2 1 1 1 1 1
## [1296] 1 1 2 2 1 2 2 1 1 2 2 1 2 2 2 2 2 1 2 1 1 1 1 1 1 2 1 2 1 1 2 1 1 1 2 1 1
## [1333] 2 2 2 1 2 1 1 1 1 1 2 1 1 1 1 1 2 2 2 2 1 1 2 2 1 2 2 1 1 1 1 2 1 2 1 1 1
## [1370] 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 2 1 1 1 2 1 1 1 1 1 2 1 1 2 1 1 2 1 1 1 1
## [1407] 1 2 2 1 2 2 1 2 1 1 1 2 1 1 1 2 2 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1
## [1444] 2 2 2 2 2 2 2 1 2 2 1 1 2 1 1 2 1 2 2 1 1 1 2 1 2 1 2 1 1 1 2 2 1 2 1 1 2
## [1481] 2 2 1 1 2 2 2 1 2 1 1 1 2 1 1 2 1 1 2 2 1 1 1 1 2 2 1 2 2 2 2 1 2 2 1 1 1
## [1518] 1 1 1 2 2 1 1 1 1 2 1 2 1 2 1 2 1 1 1 1 2 2 2 1 2 2 1 2 1 1 1 2 1 1 2 2 2
## [1555] 2 1 1 1 1 2 1 1 1 2 1 1 2 2 1 1 2 1 2 1 1 1 1 2 1 1 1 2 2 1 2 1 1 2 1 2 1
## [1592] 2 1 1 1 1 1 1 2 1 1 2 2 1 1 1 2 1 1 2 2 1 2 1 1 2 1 1 1 2 1 1 2 1 1 1 1 2
## [1629] 1 1 2 1 1 1 1 1 1 2 1 1 1 2 1 1 2 1 1 2 2 1 1 2 1 2 1 1 1 2 1 2 1 1 2 1 1
## [1666] 1 2 1 2 2 1 2 2 2 2 1 1 1 1 1 2 1 1 1 1 1 2 2 2 2 1 2 1 1 1 2 1 2 1 2 2 1
## [1703] 1 1 1 1 2 1 2 1 2 2 1 2 1 1 2 1 1 2 1 2 2 2 1 1 1 1 2 2 1 1 1 2 2 2 1 2 1
## [1740] 1 1 1 1 2 2 2 1 2 2 2 2 1 1 1 1 1 1 1 1 2 2 1 2 2 1 2 1 2 1 1 1 1 2 2 1 1
## [1777] 1 1 1 2 1 1 2 2 1 1 1 1 1 2 1 1 2 1 1 1 2 1 2 2 2 2 1 1 1 2 1 1 2 2 1 1 2
## [1814] 2 2 1 2 2 1 1 2 1 1 2 2 1 1 2 2 1 1 1 2 1 1 1 2 1 1 2 1 2 1 2 1 2 1 1 1 1
## [1851] 2 1 2 2 2 2 1 1 2 1 2 1 1 2 2 1 1 1 1 2 1 2 1 1 1 1 1 2 2 2 2 1 1 2 1 1 1
## [1888] 2 2 1 2 2 1 2 2 1 1 2 2 2 1 1 2 1 1 2 2 1 1 1 2 2 2 2 2 1 1 1 1 1 1 2 2 2
## [1925] 2 1 2 2 2 1 1 2 1 1 2 1 1 2 1 1 2 1 1 2 1 2 2 2 1 1 1 2 2 2 2 2 1 1 2 1 2
## [1962] 2 1 1 1 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 2 2 1 2 2 1 2 2 1
## [1999] 1 1 1 1 1 1 1 1 2 1 2 2 2 1 2 1 2 1 1 1 1 1 1 1 1 2 2 1 1 1 2 1 2 2 1 2 1
## [2036] 2 2 2 1 2 2 2 1 1 1 1 1 2 2 2 1 1 2 1 1 1 2 2 2 1 1 1 2 1 2 2 1 2 1 1 1 2
## [2073] 1 2 2 2 1 1 1 1 1 1 1 2 2 2 2 2 1 1 1 1 2 2 2 1 2 1 2 2 1 2 1 2 1 1 1 2 1
## [2110] 2 1 2 1 1 1 2 1 2 2 1 1 1 1 2 1 2 2 2 2 1 1 2 2 1 2 1 1 1 1 1 1 1 1 1 2 2
## [2147] 1 1 1 1 1 2 1 1 1 1 1 1 2 1 2 1 1 2 1 1 2 2 2 1 2 2 2 2 2 2 2 1 1 1 1 1 1
## [2184] 1 1 2 2 2 2 1 2 1 1 2 2 1 1 1 1 1 1 2 1 2 1 1 1 1 1 1 1 2 1 2 1 1 1 2 1 1
## [2221] 1 2 1 1 2 1 1 1 2 1 1 2 1 1 1 2 1 2 2 1
##
## Within cluster sum of squares by cluster:
## [1] 12866.73 10061.76
## (between_SS / total_SS = 21.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
Hasil K-Means clustering dengan dua cluster menunjukkan bahwa data terbagi menjadi dua kelompok utama dengan karakteristik yang cukup berbeda. Cluster 1 yang berjumlah 1328 pelanggan cenderung memiliki pendapatan, total pembelian, dan total pengeluaran di bawah rata-rata, namun memiliki frekuensi kunjungan web yang lebih tinggi serta jumlah anak yang lebih banyak, sehingga dapat diinterpretasikan sebagai pelanggan dengan nilai rendah (low value customers). Sebaliknya, Cluster 2 yang berjumlah 912 pelanggan memiliki pendapatan, jumlah pembelian, dan pengeluaran yang tinggi, tetapi lebih jarang mengunjungi website dan memiliki jumlah anak lebih sedikit, sehingga termasuk pelanggan bernilai tinggi (high value customers). Secara keseluruhan, model mampu menjelaskan sekitar 21,2% variasi data, yang menunjukkan bahwa pemisahan cluster sudah cukup baik meskipun masih dapat ditingkatkan.
# Tambahkan label cluster ke data
cluster_kmeans <- kmeans_result$cluster
# Tampilkan jumlah anggota tiap cluster
table(cluster_kmeans)
## cluster_kmeans
## 1 2
## 1328 912
fviz_cluster(kmeans_result, data = final_data,
geom = "point",
ellipse.type = "norm",
palette = "Set2",
ggtheme = theme_minimal(),
main = "Clustering K-Means (k = 2)",
pointsize = 2,
alpha = 0.7)
Visualisasi K-Means (k = 2) menunjukkan bahwa data terbagi menjadi beberapa kelompok, namun pada plot ini terlihat dua cluster utama yang cukup jelas terpisah sepanjang sumbu Dim1 (27.6%), yang merupakan komponen dengan kontribusi variasi terbesar. Cluster di sebelah kanan (warna hijau) berisi data dengan nilai Dim1 positif, sedangkan cluster di sebelah kiri (warna oranye) memiliki nilai Dim1 negatif. Meskipun demikian, terdapat area tumpang tindih di bagian tengah, yang menandakan bahwa beberapa data memiliki karakteristik yang mirip antar cluster sehingga pemisahannya tidak sepenuhnya tegas. Secara keseluruhan, model sudah mampu membedakan kelompok utama dalam data, tetapi masih terdapat overlap yang menunjukkan bahwa struktur cluster belum sepenuhnya kuat atau mungkin memerlukan eksplorasi jumlah cluster atau fitur tambahan.
sil <- silhouette(kmeans_result$cluster, dist(final_data))
# Rata-rata silhouette
mean(sil[, 3])
## [1] 0.2004047
Nilai rata-rata silhouette sebesar 0.2004 menunjukkan bahwa kualitas clustering masih tergolong lemah hingga sedang. Secara umum, nilai silhouette berada pada rentang -1 hingga 1, di mana nilai mendekati 1 menandakan pemisahan cluster yang sangat baik, sedangkan nilai mendekati 0 menunjukkan adanya tumpang tindih antar cluster. Dengan nilai sekitar 0.20, dapat diartikan bahwa sebagian besar data belum terkelompok dengan jelas dan masih berada di batas antar cluster. Hal ini sejalan dengan visualisasi sebelumnya yang menunjukkan adanya overlap antar kelompok. Oleh karena itu, model clustering ini masih bisa ditingkatkan, misalnya dengan mencoba jumlah cluster yang berbeda, melakukan pemilihan fitur yang lebih relevan, atau menggunakan metode clustering lain.
data_cluster <- as.data.frame(final_data)
colnames(data_cluster) <- make.names(colnames(data_cluster))
data_cluster$cluster <- as.factor(cluster_kmeans)
aggregate(. ~ cluster, data = data_cluster, mean)
## cluster Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 1 -0.6511394 -0.007520383 0.1867761 0.4972669
## 2 2 0.9481503 0.010950733 -0.2719722 -0.7240903
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 -0.03918537 -0.1220658 -0.6889743 -0.6597408 0.4333944
## 2 0.05705940 0.1777449 1.0032432 0.9606752 -0.6310831
## Total_Campaign EducationGraduation Marital_StatusMarried
## 1 -0.2690635 -0.02883449 0.02284596
## 2 0.3917942 0.04198706 -0.03326692
## Marital_StatusTogether
## 1 -0.00834768
## 2 0.01215539
Hasil profiling cluster menunjukkan perbedaan karakteristik yang cukup jelas antara kedua kelompok. Cluster 1 didominasi oleh pelanggan dengan nilai Income, Total Spending, dan Total Purchases di bawah rata-rata, yang menunjukkan daya beli rendah dan aktivitas pembelian yang relatif sedikit, meskipun mereka cenderung lebih sering mengunjungi website serta memiliki jumlah anak lebih banyak. Selain itu, pelanggan pada cluster ini juga sedikit lebih muda dan kurang responsif terhadap campaign. Sebaliknya, Cluster 2 memiliki Income, Total Spending, dan Total Purchases di atas rata-rata, yang menandakan pelanggan dengan nilai tinggi dan kontribusi besar terhadap penjualan, meskipun mereka lebih jarang mengunjungi website. Mereka juga cenderung lebih tua, memiliki lebih sedikit anak, dan lebih responsif terhadap campaign. Secara umum, cluster yang terbentuk merepresentasikan dua segmen utama, yaitu pelanggan bernilai rendah dan pelanggan bernilai tinggi.
library(cluster)
set.seed(123)
kmedians_model <- pam(data_scaled, k = 2, metric = "manhattan")
kmedians_cluster <- kmedians_model$clustering
kmedians_model$medoids
## Income Recency NumDealsPurchases NumWebVisitsMonth Customer_Duration
## [1,] 0.8966389 0.6867728 -0.7900486 -0.9790278 0.1950196
## [2,] 0.1084789 -0.1073588 -0.1401371 0.2984609 -0.1809899
## Age Total_Spending Total_Purchases Total_Children Total_Campaign
## [1,] 1.1767377 1.2092880 0.8969163 -1.29854625 0.8242806
## [2,] -0.0975021 -0.6688582 -0.4908661 0.08492276 -0.5500317
## EducationGraduation Marital_StatusMarried Marital_StatusTogether
## [1,] -1.0060450 -0.7922289 -0.5909667
## [2,] 0.9935476 -0.7922289 -0.5909667
Berdasarkan hasil clustering menggunakan metode K-Medians dengan k = 2, terlihat bahwa Cluster 1 memiliki karakteristik pelanggan dengan income, recency, age, total spending, dan total purchases yang tinggi. Selain itu, pelanggan pada cluster ini memiliki frekuensi kunjungan website yang rendah serta jumlah anak yang lebih sedikit. Hal ini menunjukkan bahwa pelanggan dalam cluster ini cenderung merupakan pelanggan bernilai tinggi yang aktif bertransaksi dan responsif terhadap kampanye pemasaran.
Sebaliknya, Cluster 2 menunjukkan nilai yang lebih rendah pada income, total spending, dan total purchases, namun memiliki frekuensi kunjungan website yang lebih tinggi. Pelanggan dalam cluster ini juga cenderung memiliki jumlah anak lebih banyak dan kurang responsif terhadap kampanye. Hal ini mengindikasikan bahwa Cluster 2 merupakan kelompok pelanggan dengan aktivitas pembelian yang lebih rendah.
Secara keseluruhan, hasil K-Medians menunjukkan perbedaan yang cukup jelas antara pelanggan bernilai tinggi dan pelanggan dengan aktivitas rendah, sehingga segmentasi ini dapat digunakan untuk membantu perusahaan dalam menentukan strategi pemasaran yang lebih tepat sasaran.
library(factoextra)
library(ggplot2)
fviz_cluster(
kmedians_model,
data = data_scaled,
geom = "point",
ellipse.type = "norm",
palette = "lancet",
pointsize = 2,
alpha = 0.6,
repel = TRUE,
labelsize = 0
)
Visualisasi K-Medians dengan k = 2 menunjukkan bahwa data pelanggan terbagi menjadi dua cluster yang cukup jelas, ditandai dengan perbedaan warna pada setiap titik. Setiap titik merepresentasikan satu pelanggan, sedangkan ellipse menggambarkan area penyebaran masing-masing cluster sehingga pola pengelompokan lebih mudah terlihat.
Meskipun masih terdapat sedikit tumpang tindih pada beberapa titik, secara umum kedua cluster sudah terpisah dengan cukup baik. Hal ini menunjukkan bahwa metode K-Medians mampu menghasilkan segmentasi yang cukup efektif dalam membedakan karakteristik pelanggan.
library(cluster)
sil <- silhouette(kmedians_cluster, dist(data_scaled, method = "manhattan"))
mean(sil[, 3])
## [1] 0.2465486
Berdasarkan hasil evaluasi clustering menggunakan metode K-Medians, diperoleh nilai sebesar 0.2465486. Nilai ini menunjukkan bahwa kualitas pengelompokan sudah cukup baik, di mana antar cluster memiliki pemisahan yang cukup jelas meskipun belum sepenuhnya optimal. Hal ini sejalan dengan hasil profil cluster yang menunjukkan adanya perbedaan karakteristik antara pelanggan bernilai tinggi dan pelanggan dengan aktivitas rendah.
Secara keseluruhan, metode K-Medians dengan k = 2 mampu membentuk segmentasi yang cukup baik dibandingkan metode lain, namun masih terdapat kemungkinan untuk meningkatkan kualitas clustering dengan mengeksplorasi jumlah cluster yang berbeda.
aggregate(data_scaled, by = list(Cluster = kmedians_cluster), FUN = median)
## Cluster Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 1 1.0712177 0.2379158 -0.7900486 -0.9790278
## 2 2 -0.4631652 -0.0383039 -0.1401371 0.2984609
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 0.20986211 0.4121938 1.1345607 0.8969163 -1.29854625
## 2 -0.05235509 -0.1824514 -0.7817794 -0.7684225 0.08492276
## Total_Campaign EducationGraduation Marital_StatusMarried
## 1 0.8242806 -1.0060450 -0.7922289
## 2 -0.5500317 0.9935476 -0.7922289
## Marital_StatusTogether
## 1 -0.5909667
## 2 -0.5909667
Berdasarkan hasil K-Medians dengan k = 2, terlihat bahwa Cluster 1 memiliki karakteristik pelanggan dengan income, total spending, dan total purchases yang tinggi, serta frekuensi kunjungan website yang rendah. Selain itu, pelanggan pada cluster ini cenderung lebih lama menjadi pelanggan (customer duration lebih tinggi), berusia lebih tua, memiliki jumlah anak lebih sedikit, dan lebih responsif terhadap kampanye pemasaran. Hal ini menunjukkan bahwa Cluster 1 merupakan kelompok pelanggan bernilai tinggi yang aktif bertransaksi.
Sebaliknya, Cluster 2 menunjukkan nilai yang lebih rendah pada income, total spending, dan total purchases, namun memiliki frekuensi kunjungan website yang lebih tinggi. Pelanggan dalam cluster ini juga cenderung memiliki durasi sebagai pelanggan yang lebih pendek, usia lebih muda, serta kurang responsif terhadap kampanye. Hal ini mengindikasikan bahwa Cluster 2 merupakan kelompok pelanggan dengan aktivitas pembelian yang lebih rendah.
Secara keseluruhan, hasil ini menunjukkan perbedaan yang cukup jelas antara pelanggan bernilai tinggi dan pelanggan dengan aktivitas rendah, sehingga segmentasi yang dihasilkan dapat membantu dalam penentuan strategi pemasaran yang lebih efektif dan tepat sasaran.
library(e1071)
## Warning: package 'e1071' was built under R version 4.5.3
##
## Attaching package: 'e1071'
## The following object is masked from 'package:ggplot2':
##
## element
set.seed(123)
# Jalankan FCM
fcm_model <- cmeans(final_data, centers = 2, m = 2, method = "cmeans")
# Lihat pusat cluster
fcm_model$centers
## Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 0.03228688 0.0003543468 -0.006254521 -0.02511204
## 2 -0.03204528 -0.0003337638 0.006017669 0.02486355
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 0.002106019 0.008856248 0.03295102 0.03272077 -0.02129988
## 2 -0.002126057 -0.008848030 -0.03265219 -0.03250747 0.02106828
## Total_Campaign EducationGraduation Marital_StatusMarried
## 1 0.01324547 0.001277913 -0.001395808
## 2 -0.01317265 -0.001246308 0.001381573
## Marital_StatusTogether
## 1 0.001246714
## 2 -0.001340304
# Membership (derajat keanggotaan)
head(fcm_model$membership)
## 1 2
## [1,] 0.5104933 0.4895067
## [2,] 0.4897280 0.5102720
## [3,] 0.5116379 0.4883621
## [4,] 0.4892009 0.5107991
## [5,] 0.4977672 0.5022328
## [6,] 0.5055569 0.4944431
# Tentukan cluster (ambil nilai membership terbesar)
fcm_cluster <- apply(fcm_model$membership, 1, which.max)
# Jumlah anggota tiap cluster
table(fcm_cluster)
## fcm_cluster
## 1 2
## 1007 1233
Berdasarkan hasil Fuzzy C-Means dengan k = 2, data pelanggan terbagi menjadi dua cluster dengan karakteristik yang relatif mirip, terlihat dari nilai rata-rata variabel yang mendekati nol. Cluster 1 cenderung memiliki income, total spending, dan total purchases sedikit lebih tinggi serta frekuensi kunjungan website yang lebih rendah. Hal ini menunjukkan bahwa pelanggan pada cluster ini lebih berorientasi pada pembelian.
Sebaliknya, Cluster 2 memiliki income, total spending, dan total purchases yang sedikit lebih rendah, namun frekuensi kunjungan website lebih tinggi, yang mengindikasikan pelanggan lebih sering melakukan penelusuran dibandingkan transaksi. Selain itu, nilai membership yang mendekati 0.5 pada banyak data menunjukkan adanya overlap antar cluster, sehingga batas antar kelompok tidak terlalu jelas. Secara keseluruhan, penggunaan dua cluster masih kurang optimal dalam memisahkan karakteristik pelanggan secara tegas.
library(factoextra)
fviz_cluster(
list(data = final_data, cluster = fcm_cluster),
geom = "point",
ellipse.type = "norm",
palette = "Set2",
ggtheme = theme_minimal(),
main = "Clustering Fuzzy C-Means (k = 2)",
pointsize = 2,
alpha = 0.7
)
Berdasarkan visualisasi hasil Fuzzy C-Means dengan k = 2, terlihat bahwa data terbagi menjadi dua kelompok utama yang cukup jelas meskipun masih terdapat sedikit tumpang tindih antar cluster. Cluster 1 dan Cluster 2 menunjukkan pola pemisahan yang relatif baik, namun karena sifat metode Fuzzy C-Means yang memungkinkan satu data memiliki keanggotaan pada lebih dari satu cluster, batas antar cluster tidak sepenuhnya tegas. Hal ini mencerminkan kondisi data pelanggan yang memiliki karakteristik yang saling beririsan. Secara keseluruhan, visualisasi menunjukkan bahwa metode ini mampu menggambarkan struktur data dengan lebih fleksibel dibandingkan metode clustering berbasis keras seperti K-Means.
library(cluster)
sil_fcm <- silhouette(fcm_cluster, dist(final_data))
mean(sil_fcm[, 3])
## [1] 0.1946251
Berdasarkan hasil evaluasi clustering menggunakan metode Fuzzy C-Means, diperoleh nilai evaluasi yang relatif kecil, yang menunjukkan bahwa kualitas pemisahan antar cluster masih kurang baik. Hal ini sejalan dengan hasil sebelumnya, di mana nilai rata-rata antar cluster yang hampir sama serta derajat keanggotaan yang mendekati 0.5 mengindikasikan adanya overlap antar cluster. Dengan demikian, model dengan jumlah cluster sebanyak 2 belum mampu membentuk segmentasi yang jelas, sehingga diperlukan eksplorasi jumlah cluster lain agar diperoleh hasil clustering yang lebih optimal.
aggregate(data_scaled, by = list(Cluster = fcm_cluster), FUN = mean)
## Cluster Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 1 0.8759884 0.005069721 -0.1788608 -0.6639900
## 2 2 -0.7154261 -0.004140478 0.1460769 0.5422854
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 0.06961759 0.1978381 0.9047619 0.9021532 -0.5532315
## 2 -0.05685719 -0.1615758 -0.7389255 -0.7367951 0.4518282
## Total_Campaign EducationGraduation Marital_StatusMarried
## 1 0.3479797 0.03842936 -0.02532079
## 2 -0.2841976 -0.03138554 0.02067967
## Marital_StatusTogether
## 1 0.0005868587
## 2 -0.0004792917
Berdasarkan hasil Fuzzy C-Means dengan k = 2, terlihat bahwa Cluster 1 memiliki karakteristik pelanggan dengan income, total spending, dan total purchases yang tinggi, serta frekuensi kunjungan website yang rendah. Selain itu, pelanggan pada cluster ini cenderung memiliki lebih sedikit jumlah anak dan lebih aktif dalam melakukan pembelian, sehingga dapat dikategorikan sebagai pelanggan bernilai tinggi.
Sebaliknya, Cluster 2 menunjukkan karakteristik dengan income, total spending, dan total purchases yang lebih rendah, namun memiliki frekuensi kunjungan website yang lebih tinggi. Hal ini mengindikasikan bahwa pelanggan dalam cluster ini lebih sering melakukan penelusuran tetapi tidak diikuti dengan tingkat pembelian yang tinggi, sehingga termasuk dalam kelompok pelanggan bernilai lebih rendah.
Secara keseluruhan, kedua cluster menunjukkan perbedaan yang cukup jelas antara pelanggan aktif dengan daya beli tinggi dan pelanggan yang lebih pasif dalam bertransaksi, sehingga hasil segmentasi ini dapat digunakan untuk mendukung strategi pemasaran yang lebih tepat sasaran.
# k-distance plot
kNNdistplot(final_data, k = 5)
abline(h = 2, lty = 2)
Berdasarkan visualisasi k-distance plot, titik kelengkungan tajam mulai
terlihat pada nilai jarak sekitar 2. Oleh karena itu, nilai eps = 2
dipilih sebagai ambang batas jarak maksimum antar dua titik untuk
dianggap sebagai tetangga. Untuk parameter minPts, dipilih nilai 5
sebagai standar minimum anggota untuk membentuk sebuah cluster
padat.
set.seed(123)
dbscan_result <- dbscan(final_data, eps = 2.1, minPts = 5)
# Lihat hasil
dbscan_result
## DBSCAN clustering for 2240 objects.
## Parameters: eps = 2.1, minPts = 5
## Using euclidean distances and borderpoints = TRUE
## The clustering contains 4 cluster(s) and 198 noise points.
##
## 0 1 2 3 4
## 198 1513 517 7 5
##
## Available fields: cluster, eps, minPts, metric, borderPoints
# Jumlah anggota cluster
table(dbscan_result$cluster)
##
## 0 1 2 3 4
## 198 1513 517 7 5
Berdasarkan implementasi DBSCAN dengan parameter \(eps = 2.1\) dan \(minPts = 5\), diperoleh sebanyak 4 cluster utama dan 198 data yang dikategorikan sebagai noise (cluster 0). Munculnya noise sebesar kurang lebih 8,8% menunjukkan bahwa terdapat sebagian kecil pelanggan dengan karakteristik unik yang tidak mengikuti pola kelompok besar. Algoritma ini berhasil membagi populasi menjadi dua kelompok dominan (Cluster 1 dan 2) serta dua kelompok kecil yang sangat spesifik (Cluster 3 dan 4), memberikan gambaran segmentasi yang lebih mendalam dibandingkan hanya membagi data secara rata.
fviz_cluster(
list(data = final_data, cluster = dbscan_result$cluster),
geom = "point",
ellipse = TRUE,
ggtheme = theme_minimal(),
main = "Clustering DBSCAN (Optimized)")
Visualisasi DBSCAN menunjukkan pembentukan cluster yang terstruktur.
Cluster 1 dan 2 membentuk basis massa pelanggan terbesar yang saling
berdekatan namun memiliki kepadatan yang berbeda. Sementara itu, Cluster
3 dan 4 terlihat sebagai kelompok kecil yang letaknya cukup terpisah
dari pusat massa utama. Titik-titik noise (warna merah) yang tersebar di
area pinggiran mengonfirmasi adanya pelanggan dengan profil pengeluaran
atau pendapatan yang sangat ekstrem, yang tidak dapat disatukan ke dalam
segmen standar manapun.
valid_idx <- dbscan_result$cluster != 0
if(length(unique(dbscan_result$cluster[valid_idx])) > 1) {
sil_db <- silhouette(
dbscan_result$cluster[valid_idx],
dist(final_data[valid_idx, ])
)
# Menampilkan rata-rata silhouette
print(mean(sil_db[, 3]))
} else {
print("Cluster tidak cukup untuk evaluasi")
}
## [1] 0.05821199
Hasil evaluasi menggunakan Silhouette Score menunjukkan nilai sebesar 0.0582. Nilai positif ini mengonfirmasi bahwa struktur cluster yang terbentuk sudah cukup stabil, meskipun batas antar kelompok tetap tipis. Hal ini sangat wajar dalam data perilaku konsumen, di mana preferensi pelanggan seringkali bersinggungan satu sama lain dan tidak memiliki sekat pemisah yang benar-benar kaku. ## 9.5 Profil Cluster
db_cluster <- as.data.frame(final_data)
db_cluster$cluster <- as.factor(dbscan_result$cluster)
aggregate(. ~ cluster, data = db_cluster, mean)
## cluster Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 0 0.53013630 -0.143281340 0.178253795 0.128559203
## 2 1 -0.05546641 0.002909974 -0.009123942 0.003785716
## 3 2 -0.07727899 0.060536801 -0.020714355 -0.035119319
## 4 3 1.84563516 -0.067898871 -0.882893044 -1.222358950
## 5 4 1.19749713 -1.371063952 -0.920030839 -0.893861864
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 0.19634396 0.16206526 0.73656022 0.57310043 -0.26094449
## 2 -0.01973695 -0.04573523 -0.07067511 -0.05958035 0.02731632
## 3 -0.01706233 0.08061214 -0.09965031 -0.07372606 0.05013534
## 4 0.73712366 -1.18970760 1.04678575 1.68993481 -1.29854625
## 5 -1.07054944 0.75199107 1.05684428 0.59160419 -1.29854625
## Total_Campaign EducationGraduation Marital_StatusMarried
## 1 1.2789143 -0.208227775 -0.08683991
## 2 -0.1153929 0.018201017 0.28835651
## 3 -0.2124347 0.003420483 -0.79222892
## 4 2.7875840 0.993547561 -0.79222892
## 5 2.3360242 0.993547561 -0.79222892
## Marital_StatusTogether
## 1 0.1352369
## 2 -0.5909667
## 3 1.6913874
## 4 -0.5909667
## 5 -0.5909667
Berdasarkan hasil profiling terhadap empat cluster yang terbentuk, terlihat perbedaan kontras antara kelompok mayoritas dan kelompok spesifik. Cluster 1 dan 2 mendominasi basis data sebagai segmen Mass Market, di mana keduanya mewakili kelompok pelanggan terbesar dengan profil yang cenderung stabil. Perbedaan tipis terlihat pada Cluster 2 yang memiliki tingkat Recency dan jumlah anak (Total Children) sedikit lebih tinggi dibandingkan Cluster 1, menunjukkan kelompok ini sebagai pelanggan umum yang lebih sering bertransaksi namun memiliki beban tanggungan keluarga yang lebih besar.
Di sisi lain, DBSCAN berhasil mengisolasi kelompok kecil dengan karakteristik yang sangat kuat, yaitu Cluster 3 danM Cluster 4. Cluster 3 diidentifikasi sebagai segmen “Sultan” atau pelanggan bernilai tinggi yang memiliki pendapatan (Income) dan frekuensi pembelian (Total Purchases) tertinggi di antara seluruh kelompok. Kelompok ini sangat responsif terhadap kampanye pemasaran dan umumnya tidak memiliki tanggungan anak. Sementara itu, Cluster 4 muncul sebagai segmen Mature High Spenders, yang diisi oleh pelanggan dengan profil usia (Age) lebih senior dan tingkat pengeluaran tinggi, meskipun masa keanggotaan mereka tergolong baru. Terakhir, Cluster 0 (Noise) menampung pelanggan dengan pola belanja yang terlalu acak untuk dikelompokkan, meskipun mereka tercatat sangat aktif di website dan responsif terhadap promosi perusahaan.
##10.1 Mean Shift Clustering
# jalankan mean shift
set.seed(123)
# Jalankan mean shift menggunakan library meanShiftR
ms_result <- meanShiftR::meanShift(
final_data,
trainData = final_data,
nNeighbor = 10
)
# Ambil hasil cluster
ms_clusters <- ms_result$assignment
# Tampilkan tabel jumlah anggota tiap cluster
table(ms_clusters)
## ms_clusters
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14
## 213 278 319 162 144 186 418 389 123 2 3 1 1 1
Berdasarkan implementasi Mean Shift dengan parameter \(nNeighbor = 10\), algoritma secara otomatis mengidentifikasi 14 cluster yang berbeda. Berbeda dengan metode sebelumnya yang cenderung menyederhanakan data, Mean Shift mengungkapkan bahwa dataset marketing campaign ini memiliki struktur yang sangat kompleks dengan banyak pusat kepadatan kecil. Terdapat 9 cluster utama dengan anggota yang signifikan, serta beberapa “micro-cluster” (Cluster 10 hingga 14) yang hanya berisi sedikit pelanggan namun memiliki profil yang sangat spesifik.
fviz_cluster(
list(data = final_data, cluster = ms_clusters),
geom = "point",
palette = "Set1",
ggtheme = theme_minimal(),
main = "Visualisasi Clustering Mean Shift"
)
## Warning in RColorBrewer::brewer.pal(n, pal): n too large, allowed maximum for palette Set1 is 9
## Returning the palette you asked for with that many colors
## Warning in RColorBrewer::brewer.pal(n, pal): n too large, allowed maximum for palette Set1 is 9
## Returning the palette you asked for with that many colors
## Warning: Removed 8 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 5 rows containing missing values or values outside the scale range
## (`geom_point()`).
Visualisasi Mean Shift menunjukkan adanya kepadatan data yang sangat
rapat di bagian tengah, di mana banyak cluster saling beririsan
(overlap). Hal ini mengonfirmasi bahwa sebagian besar pelanggan memiliki
perilaku yang mirip, namun Mean Shift berhasil menangkap perbedaan halus
yang memisahkan mereka ke dalam pusat-pusat kepadatan yang berbeda.
Munculnya banyak poligon yang tumpang tindih merupakan indikasi bahwa
segmentasi pelanggan dalam bisnis ini tidak bisa hanya dipandang secara
kaku, melainkan sebagai sebuah kontinum perilaku.
# Menghitung Silhouette Score untuk Mean Shift
sil_ms <- silhouette(ms_clusters, dist(final_data))
avg_sil_ms <- mean(sil_ms[, 3])
print(round(avg_sil_ms, 4))
## [1] -0.032
Hasil evaluasi menunjukkan nilai Silhouette Score sebesar -0.032. Nilai negatif ini secara statistik mengindikasikan bahwa jarak antar cluster sangatlah dekat atau terjadi tumpang tindih yang signifikan. Namun, dalam konteks market discovery, hasil ini tidak serta merta buruk; ini menunjukkan bahwa data pelanggan sangat heterogen di tingkat mikro. Mean Shift bekerja dengan sangat sensitif dalam mendeteksi variasi kecil pada profil pelanggan, meskipun hal tersebut membuat batas-batas antar kelompok menjadi tidak tegas secara spasial.
ms_cluster <- as.data.frame(final_data)
ms_cluster$cluster <- as.factor(ms_result$assignment)
aggregate(. ~ cluster, data = ms_cluster, mean)
## cluster Income Recency NumDealsPurchases NumWebVisitsMonth
## 1 1 1.0673348532 0.32074929 -0.4391574 -0.38526544
## 2 2 -0.4814230174 0.13582380 -0.1541640 0.05644266
## 3 3 1.1506117230 -0.11958956 -0.7472644 -1.35146178
## 4 4 -0.9195989016 0.05717945 -0.2444439 0.37206106
## 5 5 0.2173139217 0.90304899 0.7850840 -0.16285446
## 6 6 0.4475389429 -0.36111711 0.2232542 -0.14568391
## 7 7 0.1479518926 -0.09777704 0.9233542 0.29336724
## 8 8 -0.9194796885 -0.17091066 -0.2270148 0.65642044
## 9 9 -1.0587184093 -0.28448752 -0.2669491 0.89392987
## 10 10 -2.1792198187 0.79035519 -1.1150043 3.27926779
## 11 11 0.7422007220 0.03075102 -0.1401371 -0.97902777
## 12 12 0.5309070403 -0.97054539 -0.7900486 -0.97902777
## 13 13 1.5442282947 0.23791580 -0.7900486 -0.97902777
## 14 14 0.0004836356 1.34279459 -0.7900486 -1.83068689
## Customer_Duration Age Total_Spending Total_Purchases Total_Children
## 1 0.69847945 0.36433504 1.56887266 1.07674164 -0.88610361
## 2 -0.73062454 0.63740117 -0.80860599 -0.86576698 0.95332328
## 3 -0.41429765 0.13657455 1.04637803 0.81947893 -1.12507051
## 4 -0.47060161 -0.67222093 -0.87353307 -0.97487658 0.23864154
## 5 -0.50209608 -0.16947304 -0.05044364 0.33120225 0.31069722
## 6 -0.16641346 0.42954904 0.24907341 0.62309044 0.09607977
## 7 0.72307589 0.05654475 0.16895365 0.48124561 0.33315285
## 8 0.07758977 -0.62510505 -0.79194798 -0.86331974 0.07603157
## 9 0.26171024 -0.21491172 -0.85949042 -0.98730854 0.11866591
## 10 -0.07709256 1.30416163 -0.85152491 -1.60109196 0.77665727
## 11 0.41600771 -0.72046375 0.70999890 0.48058160 -0.37623357
## 12 0.57102920 0.15734586 1.45505776 1.31325103 -1.29854625
## 13 0.18512464 -0.52224868 1.04820913 0.89691631 0.08492276
## 14 -0.47783961 0.92188971 -0.49117326 -0.07453135 -1.29854625
## Total_Campaign EducationGraduation Marital_StatusMarried
## 1 1.5404716 -0.01094261 0.01777039
## 2 -0.3844221 0.25269132 -0.17161794
## 3 0.2534456 0.32910614 -0.31576940
## 4 -0.4227806 0.63559580 -0.77955036
## 5 -0.2684885 -0.54780505 1.09053734
## 6 -0.1584266 -0.86628854 -0.53824872
## 7 -0.1538484 0.48647385 -0.03060533
## 8 -0.3133249 -0.36350241 0.84457652
## 9 0.1818176 -0.79470596 -0.79222892
## 10 0.1371245 -1.00604502 -0.79222892
## 11 -0.5500317 0.32701670 -0.79222892
## 12 0.8242806 -1.00604502 -0.79222892
## 13 -0.5500317 0.99354756 -0.79222892
## 14 -0.5500317 0.99354756 1.26169791
## Marital_StatusTogether
## 1 -0.4302375
## 2 -0.3692992
## 3 0.4750858
## 4 1.0292229
## 5 -0.5751170
## 6 0.9674149
## 7 -0.3343383
## 8 -0.5909667
## 9 1.1532714
## 10 1.6913874
## 11 0.9306027
## 12 1.6913874
## 13 -0.5909667
## 14 -0.5909667
Berdasarkan analisis profil dari 14 cluster yang terbentuk, terdapat kontras yang jelas antara segmen pelanggan Premium dan Mass Market. Cluster 1 dan 3 mewakili kelompok “Sultan” dengan tingkat pendapatan dan pengeluaran tertinggi, yang didominasi oleh pelanggan tanpa anak sehingga daya beli mereka sangat terfokus. Sebaliknya, Cluster 7 muncul sebagai basis massa terbesar dengan karakteristik yang sangat identik dengan rata-rata populasi, menjadikannya segmen paling stabil bagi perusahaan. Sementara itu, kelompok seperti Cluster 2 dan 8 mencerminkan pelanggan menengah ke bawah dengan jumlah anak yang lebih banyak, yang cenderung lebih selektif dan sensitif terhadap program diskon.
Selain kelompok utama tersebut, Mean Shift berhasil menangkap niche market yang unik seperti pada Cluster 10 dan 14. Cluster 10 menunjukkan adanya kelompok pelanggan yang sangat aktif melakukan riset di website meskipun memiliki pendapatan rendah (window shoppers), sedangkan Cluster 14 dihuni oleh pelanggan senior yang sudah cukup lama tidak bertransaksi sehingga memerlukan strategi retensi khusus. Keberagaman segmen mikro ini membuktikan bahwa meskipun secara spasial data terlihat tumpang tindih, sebenarnya terdapat pusat-pusat kepadatan perilaku yang berbeda, yang memungkinkan perusahaan untuk merancang strategi pemasaran yang lebih personal dan tepat sasaran.
perbandingan_model <- data.frame(
Metode = c("K-Means", "K-Medians", "Fuzzy C-Means", "DBSCAN", "Mean Shift"),
Jumlah_Cluster = c(2, 2, 2, 4, 14),
Silhouette_Score = c(0.2004, 0.2465, 0.1946, 0.0582, -0.0320),
Karakteristik = c("Segmentasi Umum", "Robust Outlier", "Segmentasi Luwes",
"Berbasis Kepadatan", "Segmentasi Mikro")
)
knitr::kable(perbandingan_model, digits = 4, caption = "Summary Perbandingan Performa Clustering")
| Metode | Jumlah_Cluster | Silhouette_Score | Karakteristik |
|---|---|---|---|
| K-Means | 2 | 0.2004 | Segmentasi Umum |
| K-Medians | 2 | 0.2465 | Robust Outlier |
| Fuzzy C-Means | 2 | 0.1946 | Segmentasi Luwes |
| DBSCAN | 4 | 0.0582 | Berbasis Kepadatan |
| Mean Shift | 14 | -0.0320 | Segmentasi Mikro |