Unsupervised Learning: Mall Customer Segmentation

Introduction

Mall adalah jenis dari pusat perbelanjaan yang secara arsitektur berupa bangunan tertutup dengan suhu yang diatur dan memiliki jalur untuk berjalan jalan yang teratur sehingga berada di antara antar toko-toko kecil yang saling berhadapan. Seorang pemilik mall melalui kartu keanggotaan, memiliki beberapa data dasar tentang pelanggan mereka seperti ID Pelanggan, usia, jenis kelamin, pendapatan tahunan, dan skor pengeluaran. Skor Pengeluaran adalah sesuatu yang ditetapkan kepada pelanggan berdasarkan parameter yang ada seperti perilaku pelanggan dan data pembelian.

Sebagai pemilik mall tentu ingin memahami karakter pelanggan seperti apa yang melakukan pembelian di mall mereka sehingga tim pemasaran dapat merencanakan strategi marketing terhadap customer mereka sesuai segmentasi customernya.

Data yang digunakan dalam proses analisis ini diambil dari kaggle.com tentang mall customer segmenattion. Data ini memiliki beberapa variabel diantaranya adalah:

customerid: ID Pelanggan
gender: Jenis kelamin
age: usia
annual_income: Pendapatan tahunan
spending_score: Skor pengeluaran

Tujuan utama dari proyek ini adalah memahami karakteristik pelanggan dan melakukan clustering menggunakan K-means untuk mengelompokkan customer ke dalam kelompok yang berbeda dengan pola yang sama. Setelah dilakukan analisis ini, informasi dapat diberikan kepada tim pemasaran untuk merencanakan kampanye pemasaran yang tepat atau meningkatkan kepuasan pelanggan.

Analisis

Import Library

library(dplyr)
library(tidyr)
library(GGally)
library(gridExtra)
library(factoextra)
library(FactoMineR)
library(plotly)
library(cowplot)
library(caret)

Read data

Read data mall customer yang tersimpan pada file Mall_Customers.csv dan simpan kedalam objek cust, kemudian cek struktur datanya.

cust <- read.csv("Mall_Customers.csv")
glimpse(cust)

## Rows: 200
## Columns: 5
## $ CustomerID             <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ~
## $ Gender                 <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~

Dari struktur yang terlihat, data tersebut memiliki variabel yakni:

CustomerID : ID Pelanggan
Gender: Jenis kelamin
Age: usia
Annual.Income..k..: Pendapatan tahunan dalam dollar $
Spending.Score..1.100.: Skor pengeluaran yang diberikan oleh pihak mall ke customer

Data Wrangling

anyNA(cust)

## [1] FALSE

Karena data ini tidak mengandung missing value maka tidak perlu melakukan handling misiing value. Sementara itu terdapat tipe data yang belum sesuai dan nama kolom akan sedikit diubah agar memudahkan penulisan code dan mudah dipahami.

names(cust) <- c("customerid","gender","age","annual_income","spending_score")
cust$gender <- as.factor(cust$gender)
glimpse(cust)

## Rows: 200
## Columns: 5
## $ customerid     <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, ~
## $ gender         <fct> Male, Male, Female, Female, Female, Female, Female, Fem~
## $ age            <int> 19, 21, 20, 23, 31, 22, 35, 23, 64, 30, 67, 35, 58, 24,~
## $ annual_income  <int> 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 19, 19, 20, 20,~
## $ spending_score <int> 39, 81, 6, 77, 40, 76, 6, 94, 3, 72, 14, 99, 15, 77, 13~

Exploratory Data Analysis

Visualisasi data berdasarkan gender

data_gender <- cust %>% 
  group_by(gender) %>% 
  summarise(jml = n(), prop = jml/nrow(cust))

p_gender <- data_gender %>% plot_ly(labels=~gender, values=~jml,
                                    type = 'pie',textposition = 'inside', 
                                    textinfo = 'label+percent') %>% 
  layout(title = "Gender")
p_gender

Dari pie chart diatas dapat diketahui bahwa jumlah customer wanita lebih tinggi daripada customer pria dengan persentase 56% customer wanita dan 44% customer pria.

Distribusi variabel age

density1 <- density(cust$age)
p_age <- cust %>% plot_ly(x=~age) %>% 
  add_histogram(color=I("mediumaquamarine"), name = "Histogram") %>% 
  add_lines(x = density1$x, y = density1$y, fill = "tozeroy", 
            color = I("skyblue"), yaxis = "y2", name = "Density") %>% 
  layout(title = "Distribution of Age ", xaxis = list (title = "Age"), 
         yaxis2 = list(overlaying = "y", side = "right"), showlegend = FALSE)
p_age

Dari grafik tersebut diketahui bahwa customer mall tersebut memiliki usia diantara 15 - 74 tahun. dengan usia yang paling banyak adalah antara 30 - 34 tahun. Dengan grafik density diatas juga diketahui bahwa lebih banyak customer dengan usia diatas rata rata yaitu 38.85.

Distribusi variabel annual_income

density2 <- density(cust$annual_income)
p_income <- cust %>% plot_ly(x=~annual_income) %>% 
  add_histogram(color=I("lightcoral"), name = "Histogram") %>% 
  add_lines(x = density2$x, y = density2$y, fill = "tozeroy",
            color = I("powderblue"), 
            yaxis = "y2", name="Density") %>%
  layout(title = "Distribution of Income ",
         xaxis = list (title = "Annual Income (k$)"), 
         yaxis2 = list(overlaying = "y", side = "right"), showlegend = FALSE)
p_income

Dari grafik di atas, kita dapat menyimpulkan bahwa pendapatan tahunan minimum adalah 15.000 dolar, pendapatan maksimum adalah 137.000 dolar dan pendapatan rata-rata adalah 60.560 dolar. Selain itu, orang yang berpenghasilan tahunan 70.000 hingga 80.000 memiliki frekuensi tertinggi.

Distribusi variabel spending_score

density3<- density(cust$spending_score)
p_score <- cust %>% plot_ly(x=~spending_score) %>% 
  add_histogram(color=I("mediumpurple"), name="Histogram") %>% 
  add_lines(x = density3$x, y = density3$y, fill = "tozeroy",
            color = I("lavender"), yaxis = "y2", name="Density") %>% 
  layout(title = "Distribution of Spending score ",
         xaxis = list (title = "Spending Score"), 
         yaxis2 = list(overlaying = "y", side = "right"), showlegend = FALSE)
p_score

Spending score berkisar dari 1 hingga 99 dan 50% pelanggan menengah memiliki spending_score antara 35 dan 75. Dari histogram, kita dapat mengatakan bahwa skor yang paling sering adalah antara 40 hingga 50. Selain itu, tidak ada kemiringan yang jelas dalam grafik density sehingga distribusi spending_score simetris.

Selanjutnya kita akan melihat korelasi antara variabel gender dan variabel numerik lainnya.

cust %>% plot_ly(x=~gender, y=~age, color = ~gender) %>% 
  add_boxplot(colors = c("cornflowerblue", "lawngreen"))

cust %>% plot_ly(x=~gender, y=~annual_income, color = ~gender) %>% 
  add_boxplot(colors = c("cornflowerblue", "lawngreen")) %>% 
  layout(yaxis = list(title ="Annual Income (k$)"))

cust %>% plot_ly(x=~gender, y=~spending_score, color = ~gender) %>% 
  add_boxplot(colors = c("cornflowerblue", "lawngreen")) %>% 
  layout(yaxis = list(title ="Spending Score"))

Selanjutnya akan dilihat korelasi antar variabel pada data.

ggpairs(cust[,-c(1,2)], showStrips = F) + 
  theme(axis.text = element_text(colour = "black", size = 11),
        strip.background = element_rect(fill = "#2F5187"),
        strip.text = element_text(colour = "white", size = 12,
                                  face = "bold"))

Dari grafik diatas terlihat bahwa data tidak memiliki multikolinearity dikarenakan setiap variabel tidak memiliki korelasi yang kuat, sehingga data ini cukup baik untuk digunakan pada kasus klasifikasi.

Data pre-processing

dummy <- dummyVars(" ~ .", data = cust)
mall_cust <- data.frame(predict(dummy, newdata = cust))
mall_cust

summary(mall_cust)

##    customerid     gender.Female   gender.Male        age       
##  Min.   :  1.00   Min.   :0.00   Min.   :0.00   Min.   :18.00  
##  1st Qu.: 50.75   1st Qu.:0.00   1st Qu.:0.00   1st Qu.:28.75  
##  Median :100.50   Median :1.00   Median :0.00   Median :36.00  
##  Mean   :100.50   Mean   :0.56   Mean   :0.44   Mean   :38.85  
##  3rd Qu.:150.25   3rd Qu.:1.00   3rd Qu.:1.00   3rd Qu.:49.00  
##  Max.   :200.00   Max.   :1.00   Max.   :1.00   Max.   :70.00  
##  annual_income    spending_score 
##  Min.   : 15.00   Min.   : 1.00  
##  1st Qu.: 41.50   1st Qu.:34.75  
##  Median : 61.50   Median :50.00  
##  Mean   : 60.56   Mean   :50.20  
##  3rd Qu.: 78.00   3rd Qu.:73.00  
##  Max.   :137.00   Max.   :99.00

cust_scale <- mall_cust %>% 
  mutate(gender.Female = scale(gender.Female),
         gender.Male = scale(gender.Male),
         age = scale(age),
         annual_income = scale(annual_income),
         spending_score = scale(spending_score))

cust_scale

K-Means Clustering

Menentukan k optimum

fviz_nbclust(cust_scale, kmeans, method = "wss", k.max = 10) + labs(subtitle = "Elbow method")

fviz_nbclust(cust_scale, kmeans, "silhouette", k.max = 10) + labs(subtitle = "Silhouette method")

fviz_nbclust(cust_scale, kmeans, "gap_stat", k.max = 10) + labs(subtitle = "Gap Statistic method")

Dari plot, kita dapat melihat bahwa 4 adalah jumlah K yang optimal. Setelah k=4, peningkatan jumlah K tidak mengakibatkan penurunan yang cukup besar dari total sum of square.

# k-means clustering
set.seed(123)
cust_km <- kmeans(cust_scale, 4)

# result analysis
cust_km

## K-means clustering with 4 clusters of sizes 50, 50, 50, 50
## 
## Cluster means:
##   customerid gender.Female gender.Male        age annual_income spending_score
## 1       75.5   -0.04019029  0.04019029  0.3844224    -0.3365732    0.006970389
## 2      125.5   -0.08038059  0.08038059 -0.0193285     0.3289584    0.030205020
## 3       25.5    0.16076118 -0.16076118 -0.2555658    -1.2625301   -0.027881557
## 4      175.5   -0.04019029  0.04019029 -0.1095282     1.2701448   -0.009293852
## 
## Clustering vector:
##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
##   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3 
##  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40 
##   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3 
##  41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  59  60 
##   3   3   3   3   3   3   3   3   3   3   1   1   1   1   1   1   1   1   1   1 
##  61  62  63  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79  80 
##   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1 
##  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95  96  97  98  99 100 
##   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1 
## 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 
##   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2 
## 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 
##   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2 
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 
##   2   2   2   2   2   2   2   2   2   2   4   4   4   4   4   4   4   4   4   4 
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 
##   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4 
## 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 
##   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4 
## 
## Within cluster sum of squares by cluster:
## [1] 10584.05 10616.92 10625.09 10632.58
##  (between_SS / total_SS =  93.6 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Bebearapa informasi yang dapat diakses dari objek cust_km

cust_km$cluster

##   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
##   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3 
##  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40 
##   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3   3 
##  41  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  59  60 
##   3   3   3   3   3   3   3   3   3   3   1   1   1   1   1   1   1   1   1   1 
##  61  62  63  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79  80 
##   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1 
##  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95  96  97  98  99 100 
##   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1   1 
## 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 
##   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2 
## 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 
##   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2   2 
## 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 
##   2   2   2   2   2   2   2   2   2   2   4   4   4   4   4   4   4   4   4   4 
## 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 
##   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4 
## 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 
##   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4

cust_km$tot.withinss

## [1] 42458.64

cust_km$betweenss

## [1] 625186.4

cust_km$totss

## [1] 667645

cust_km$iter

## [1] 3

cust_km$centers

##   customerid gender.Female gender.Male        age annual_income spending_score
## 1       75.5   -0.04019029  0.04019029  0.3844224    -0.3365732    0.006970389
## 2      125.5   -0.08038059  0.08038059 -0.0193285     0.3289584    0.030205020
## 3       25.5    0.16076118 -0.16076118 -0.2555658    -1.2625301   -0.027881557
## 4      175.5   -0.04019029  0.04019029 -0.1095282     1.2701448   -0.009293852

Dari hasil klustering mengggunakan k-means data tersebut masih dapat dilakukan klsutering menggunakan PCA.

mall_cust$cluster <- as.factor(cust_km$cluster)
cust$cluster <- as.factor(cust_km$cluster)
head(cust)

fviz_cluster(object = cust_km, 
             data = mall_cust %>% 
               select(customerid,age, annual_income, spending_score))

mall_cust %>% group_by(cluster) %>% 
  summarise(gender.Female = sum(gender.Female),
            gender.Male = sum(gender.Male),
            age = mean(age),
            annual_income = mean(annual_income),
            spending_score = mean(spending_score))

Profiling:

Cluster 1: cluster dengan customer didominasi wanita dengan spending score terendah.
Cluster 2: cluster dengan customer didominasi wanita dengan umur rata-rata 38.58 dan spending_score paling tinggi.
Cluster 3: cluster dengan customer didominasi wanita dengan annual income terendah dan spending_score terendah.
Cluster 4: cluster dengan customer didominasi wanita dengan umur rata-rata 37.32 dengan annual income tertinggi.

PCA

Ide dasar dari PCA adalah untuk membuat sumbu (axis) baru yang dapat menangkap informasi sebesar mungkin. Sumbu baru ini adalah yang dinamakan sebagai Principal Component (PC). Untuk melakukan dimensionality reduction, kita akan memilih beberapa PC untuk dapat merangkum informasi yang dibutuhkan.

# nama kolom numerik
quanti <- cust %>% 
  select_if(is.numeric) %>% 
  colnames()

# indeks kolom numerik
quantivar <- which(colnames(cust) %in% quanti)

# nama kolom kategorik
quali <- cust %>% 
  select_if(is.factor) %>% 
  colnames()

qualivar <- which(colnames(cust) %in% quali)

quantivar

## [1] 1 3 4 5

qualivar

## [1] 2 6

cust_pca <- PCA(X = cust, scale.unit = T,
                quali.sup = qualivar, graph = F, ncp = 4)
head(cust_pca$ind$coord)

##       Dim.1      Dim.2       Dim.3        Dim.4
## 1 -2.403924 -0.8164234 -1.32939625 -0.004787476
## 2 -2.348416 -1.8667632 -0.07523035  0.010148273
## 3 -2.393558  0.1420082 -2.18400060 -0.007423860
## 4 -2.307126 -1.6532138 -0.08317962  0.009076587
## 5 -2.332853 -0.2309333 -0.69226728 -0.000578146
## 6 -2.254118 -1.6739433 -0.16105294  0.005798875

Dipilih ncp = 4 karena jumlah variabel numeric pada cust adalah 4 (jumlah quantivar), tujuannya adalah kita bisa akses seluruh hasil PC

plot.PCA(x = cust_pca, 
         choix = "ind", 
         select = "contrib 5", 
         habillage = "cluster", 
         invisible = "quali")

plot.PCA(x = cust_pca, choix = "var")

Insight:

Data memiliki outlier yaitu data ke 9, 11, 199, 198, 200.
PC1 banyak merangkum variabel annual_income, customerid.
PC2 banyak merangkum variabel age dan spending_score.
Variabel age kemungkinan memiliki korelasi negatif dengan variabel spending_score.
Variabel annual_income memiliki korelasi positif dengan customerid.

Kesimpulan

Dari analisis clustering menggunakan K-Means dan PCA ada beberapa informasi yang diperoleh:

Kita dapat mengelompokkan data menjadi 4 kluster.
Cluster 1: cluster dengan customer didominasi wanita dengan spending score terendah.
Cluster 2: cluster dengan customer didominasi wanita dengan umur rata-rata 38.58 dan spending_score paling tinggi.
Cluster 3: cluster dengan customer didominasi wanita dengan annual income terendah dan spending_score terendah.
Cluster 4: cluster dengan customer didominasi wanita dengan umur rata-rata 37.32 dengan annual income tertinggi.

3D plot

x <- data.frame(cust_pca$ind$coord[,1:4])
mc_x <- cbind(x, cluster = cust$cluster)
plot_ly(mc_x, x = ~Dim.1, y = ~Dim.2, 
        z = ~Dim.3, color = ~cluster, colors = c("black", 
    "red", "green", "blue")) %>% 
  add_markers() %>% 
  layout(scene = list(xaxis = list(title = "Dim.1"), 
    yaxis = list(title = "Dim.2"), zaxis = list(title = "Dim.3")))