Το dataset το οποίο επιλέκτηκε για την εργασία αφορά την χρήση μεταβλητών όπως η ηλικία, το ετήσιο εισόδημα, το φύλλο και το σκορ κατανάλωσης πελάτη για την εύρεση του καλύτερου μεγέθους στόχου. Τα δεδομένα αυτά είναι δεδομένα που έχουν συλλεκτεί από το ίδιο το εμπορικό κέντρο μέσω της κάρτας μέλους. Το παρόν dataset έχει σχεδιαστεί για το KMeans, ωστόσο θα χρησιμοποιηθεί και για την ιεραρχική συσταδοποιήση.
Αποτελείται από ένα αρχείο με το όνομα Mall_Customers.csv
Link Dataset: https://www.kaggle.com/datasets/vjchoudhary7/customer-segmentation-tutorial-in-python
print(summary(df))
## CustomerID Gender 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.00
print(str(df))
## spc_tbl_ [200 × 5] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ CustomerID : num [1:200] 1 2 3 4 5 6 7 8 9 10 ...
## $ Gender : chr [1:200] "Male" "Male" "Female" "Female" ...
## $ Age : num [1:200] 19 21 20 23 31 22 35 23 64 30 ...
## $ Annual Income (k$) : num [1:200] 15 15 16 16 17 17 18 18 19 19 ...
## $ Spending Score (1-100): num [1:200] 39 81 6 77 40 76 6 94 3 72 ...
## - attr(*, "spec")=
## .. cols(
## .. CustomerID = col_double(),
## .. Gender = col_character(),
## .. Age = col_double(),
## .. `Annual Income (k$)` = col_double(),
## .. `Spending Score (1-100)` = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
## NULL
cat("Το αρχικό dataset έχει", nrow(df),"εγγραφές")
## Το αρχικό dataset έχει 200 εγγραφές
df2 <- unique(df)
cat("Το αρχικό dataset έχει", nrow(df2),"εγγραφές")
## Το αρχικό dataset έχει 200 εγγραφές
Αρα δεν υπάρχουν διπλότυπα και μπορούμε να προχωρήσουμε κανονικά με το αρχικό dataset.
Επειδή το Gender είναι αλφαριθμητικό, οι ευκλείδια απόσταση δεν θα λειτουργήσει σωστά και επομένως την αλλάζουμε σε δυαδικό (0 ή 1).
df$Gender_num = ifelse(df$Gender == "Male", 1, 0)
df$Gender <- df$Gender_num
df$Gender_num = NULL
distances = dist(df[2:5], method = "euclidean")
clusterCustomers = hclust(distances, method = "ward.D2")
plot(clusterCustomers)
Για να βρω τον καλύτερο αριθμό συστάδων χρησιμοποιώ το Silhouette Score που δείχνει σε κλίμακα [-1, +1], και δείχνει την ποιότητα των συστάδων. Όσο το σκορ συγκλίνει προς το +1 τότε η συστάδα έχει καλή συνοχή εσωτερικά και μεγάλη απόσταση από τις άλλες συστάδες, κάτι που δείχνει καλή συσταδοποιήση. Όταν τίνει προς το -1 τότε έχουμε κακή συσταδοποιήση και έχει μπει το σημείο σε λάθος συστάδα. Αν η τιμή είναι κοντά στο 0 τότε το σημείο αυτό είναι στις παρυφές της συστάδας ή υπάρχει συγκάλυψη.
Αρχικά δοκιμάζω για 10 συστάδες
clusterGroups = cutree(clusterCustomers, k = 10)
#Χρησιμοποιώ το silhouette score για να βρω τον καλύτερο αριθμό clusters
sil_score = silhouette(clusterGroups, distances)
summary(sil_score)
## Silhouette of 200 units in 10 clusters from silhouette.default(x = clusterGroups, dist = distances) :
## Cluster sizes and average silhouette widths:
## 23 20 10 33 18 22 36 25
## 0.2848470 0.4919827 0.4088666 0.1859973 0.4380582 0.3615423 0.4435320 0.3394928
## 10 3
## 0.3233108 0.7027740
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.3875 0.2490 0.4186 0.3613 0.5213 0.7475
plot(clusterGroups)
Από την στιγμή που για 10 κανένα δεν συγκλίνει προς το 1 (τέλειες συστάδες) τότε πρέπει να μειώσω τον αριθμό συστάδων.
Δοκιμάζω για 9 συστάδες
clusterGroups = cutree(clusterCustomers, k = 9)
#Χρησιμοποιώ το silhouette score για να βρω τον καλύτερο αριθμό clusters
sil_score = silhouette(clusterGroups, distances)
summary(sil_score)
## Silhouette of 200 units in 9 clusters from silhouette.default(x = clusterGroups, dist = distances) :
## Cluster sizes and average silhouette widths:
## 23 20 32 33 18 36 25 10
## 0.3579901 0.6134932 0.3003031 0.2136776 0.4380582 0.4610115 0.3423536 0.3233108
## 3
## 0.7027740
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.3875 0.2575 0.4221 0.3777 0.5272 0.7475
plot(clusterGroups)
Υπάρχει βελτίωση στις τιμές των σκορ άρα κινούμε σωστά. Ωστόσο καμία δεν είναι κοντά στο 1 και πολλά είναι κοντά στο 0,5 άρα μειώνω και άλλο.
Δοκιμάζω για 8 συστάδες
clusterGroups = cutree(clusterCustomers, k = 8)
#Χρησιμοποιώ το silhouette score για να βρω τον καλύτερο αριθμό clusters
sil_score = silhouette(clusterGroups, distances)
summary(sil_score)
## Silhouette of 200 units in 8 clusters from silhouette.default(x = clusterGroups, dist = distances) :
## Cluster sizes and average silhouette widths:
## 23 20 32 51 36 25 10 3
## 0.3785166 0.6134932 0.3845741 0.3983097 0.4660461 0.3500377 0.3233108 0.7027740
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.3875 0.3474 0.4690 0.4223 0.5592 0.7475
plot(clusterGroups)
Έχουμε μικρή βελτίωση, και μηδενική πτώση τιμών, συνεπώς είμαστε στο σωστό μονοπάτι. Μειώνουμε και άλλο εφόσον έχουμε τιμές κάτω του 0,5.
Δοκιμάζω για 7 συστάδες
clusterGroups = cutree(clusterCustomers, k = 7)
#Χρησιμοποιώ το silhouette score για να βρω τον καλύτερο αριθμό clusters
sil_score = silhouette(clusterGroups, distances)
summary(sil_score)
## Silhouette of 200 units in 7 clusters from silhouette.default(x = clusterGroups, dist = distances) :
## Cluster sizes and average silhouette widths:
## 23 20 32 51 39 25 10
## 0.3785166 0.6134932 0.3845741 0.3983097 0.5027640 0.3500377 0.3233108
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.2819 0.3541 0.4689 0.4259 0.5491 0.7146
plot(clusterGroups)
Με 8 συστάδες είχαμε παρόμοια σκορ και μια συστάδα με 0,7 σκορ, ενώ με 7 την συστάδα μς 0,7 την χάσαμε. Συνεπώς κόβουμε το δέντρο στις 8 συστάδες.
Από τα παραπάνω βλέπουμε πως παρότι έχουμε επικάλυψη μεταξύ των συστάδων αλλά με το Κ = 8 έχουμε το καλύτερο δυνατό μέσο.
Για την χρήση του KMeans θα χρειαστεί να κάνουμε κανονικοποιήση (scaling) στα δεδομένα [0,1]. Για να το κάνουμε αυτό θα πρέπει να έχουμε στο σετ δεδομένων μας μόνο αριθμητικές τιμές, κάτι το οποίο το λύσαμε πιο πάνω.
df_scaled = scale(df)
fviz_nbclust(df_scaled, kmeans, method = "wss") +
labs(subtitle = "Elbow method")
Από το παραπάνω διάγραμμα βλέπουμε πως το το σημείο που το διάγραμμα γίνεται πιο παράλληλο με τον άξονα Χ είναι γύρω στις 8 συστάδες, όμως για 9 ξανά ανεβαίνει, άρα μετά το 8 έχουμε θόρυβο. Επίσης έχουμε παρόμοιο φαινόμενο γύρω στις 3 ή 4 συστάδες. Συνεπώς αξίζει να δοκιμάσουμε για Κ = 3, 4 και 8 και να κρίνουμε ποιο δουλέυει καλύτερα.
Elbow method είναι η απεικόνιση του αθροίσματος των τετραγώνων των εντός συστάδων αποστάσεων σε διάγραμμα διασποράς με άξονα χ τον αριθμό συστάδων και άξονα y το άθροισμα των τετραγώνων των εντός συστάδων αποστάσεων. Θέλουμε να βρούμε το σημείο καμπής όπου κάνει κοιλιά το διάγραμμα πριν ξεκίνησει να πλατίαζει, σαν έναν έναν αγκώνα χεριού. Το σημείο αυτό είναι ο βέλτιστος αιρθμός συστάδων.
Για επαλύθευση θα κάνουμε απεικόνιση των συστάδων σε χρωματισμένα 2D σχήματα μέσω PCA (Principal Component Analysis), δηλαδή dimensionality reduction.
Για Κ = 8
set.seed(901)
km_result = kmeans(df_scaled, centers = 8, nstart = 25)
print(km_result)
## K-means clustering with 8 clusters of sizes 37, 19, 24, 25, 34, 20, 19, 22
##
## Cluster means:
## CustomerID Gender Age Annual Income (k$) Spending Score (1-100)
## 1 -0.5652501 -0.8841865 0.86397828 -0.5090787 -0.3656838
## 2 1.0716515 -0.8841865 0.16898311 1.0407397 -0.9921595
## 3 -0.8437115 1.1253282 -0.94375592 -0.8097681 0.3456151
## 4 -0.5380173 1.1253282 1.43102509 -0.4858228 -0.3562643
## 5 -0.8328708 -0.8841865 -0.91989357 -0.8007162 0.3601368
## 6 1.0193647 1.1253282 0.04653158 0.9362369 -1.3998865
## 7 0.9998140 1.1253282 -0.42255197 0.9706035 1.2029017
## 8 1.0539195 -0.8841865 -0.45132380 0.9409096 1.1768693
##
## Clustering vector:
## [1] 3 3 5 5 5 5 1 5 4 5 4 5 1 5 3 3 5 3 4 5 3 3 1 3 1 3 1 3 1 5 4 5 4 3 1 5 1
## [38] 5 1 5 1 3 4 5 1 5 1 5 5 5 1 3 5 4 1 4 1 4 5 4 4 3 1 1 4 3 1 1 3 5 4 1 1 1
## [75] 4 3 1 3 5 1 4 3 4 1 5 4 1 5 5 1 1 3 4 1 5 3 1 5 4 3 5 1 4 3 4 5 1 4 4 4 4
## [112] 5 1 3 5 5 1 1 1 1 7 2 8 7 2 8 6 7 6 7 6 7 2 8 6 8 2 7 6 8 2 7 2 8 6 7 6 8
## [149] 2 7 6 7 2 8 2 8 6 8 6 8 2 8 6 8 6 8 6 8 2 7 6 7 6 7 2 8 6 7 6 7 2 8 6 8 2
## [186] 7 2 7 2 8 2 8 6 8 2 8 2 7 6 7
##
## Within cluster sum of squares by cluster:
## [1] 48.63799 23.04719 36.04404 33.05283 52.36593 27.59065 19.08458 13.22610
## (between_SS / total_SS = 74.6 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
fviz_cluster(km_result, data = df_scaled,
palette = "jco",
geom = "point",
ellipse.type = "convex",
ggtheme = theme_minimal())
Από το παραπάπω έχουμε πάρα πολύ υψηλή επικάλυψη. Συνεπώς παρότι που βάσει το elbow method και των αποστάσεων εντός και μεταξύ συστάδων μπορούμε να απορρίψουμε τις 8 συστάδες.
Για Κ = 4
set.seed(901)
km_result = kmeans(df_scaled, centers = 4, nstart = 25)
print(km_result)
## K-means clustering with 4 clusters of sizes 39, 60, 60, 41
##
## Cluster means:
## CustomerID Gender Age Annual Income (k$) Spending Score (1-100)
## 1 1.0448378 0.14633389 0.1061875 0.9871485 -1.2012503
## 2 -0.8681878 -0.11387250 -0.9067693 -0.8354680 0.2872059
## 3 -0.5140017 -0.01339676 1.1370409 -0.4585365 -0.3188308
## 4 1.0288462 0.04705205 -0.4379905 0.9546702 1.1889331
##
## Clustering vector:
## [1] 2 2 2 2 2 2 2 2 3 2 3 2 3 2 2 2 2 2 3 2 2 2 3 2 3 2 3 2 2 2 3 2 3 2 3 2 3
## [38] 2 2 2 3 2 3 2 3 2 3 2 2 2 3 2 2 3 3 3 3 3 2 3 3 2 3 3 3 2 3 3 2 2 3 3 3 3
## [75] 3 2 3 3 2 3 3 2 3 3 2 3 3 2 2 3 3 2 3 3 2 2 3 2 3 2 2 3 3 2 3 2 3 3 3 3 3
## [112] 2 3 2 2 2 3 3 3 3 4 1 4 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4
## [149] 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4 1
## [186] 4 1 4 1 4 1 4 1 4 1 4 1 4 1 4
##
## Within cluster sum of squares by cluster:
## [1] 91.88284 154.32174 136.13523 73.53429
## (between_SS / total_SS = 54.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
fviz_cluster(km_result, data = df_scaled,
palette = "jco",
geom = "point",
ellipse.type = "convex",
ggtheme = theme_minimal())
Εδώ έχουμε μερική επικάλυψη και σχετικά οκ διαχωρισμός (between_SS / total_SS = 54.2 %). Δεν το απορρίπτουμε ακόμα.
Για Κ = 3
set.seed(901)
km_result = kmeans(df_scaled, centers = 3, nstart = 25)
print(km_result)
## K-means clustering with 3 clusters of sizes 56, 64, 80
##
## Cluster means:
## CustomerID Gender Age Annual Income (k$) Spending Score (1-100)
## 1 -0.9033596 -0.20238684 -0.9262853 -0.8664257 0.32971048
## 2 -0.4864659 0.05777355 1.1158631 -0.4389443 -0.38954311
## 3 1.0215244 0.09545195 -0.2442908 0.9576534 0.08083715
##
## Clustering vector:
## [1] 1 1 1 1 1 1 1 1 2 1 2 1 2 1 2 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 2 2 2 1 2 2 1 1 2 2 1 2 2 1 1 2 1 2 1 1 2 2 3 2 1 2 2 2 2 2
## [112] 1 3 3 1 1 2 2 2 2 3 3 3 3 3 3 3 3 2 3 2 3 3 3 3 3 3 3 3 3 2 3 3 3 3 3 3 3
## [149] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## [186] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
##
## Within cluster sum of squares by cluster:
## [1] 137.3878 156.6031 276.8750
## (between_SS / total_SS = 42.6 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
fviz_cluster(km_result, data = df_scaled,
palette = "jco",
geom = "point",
ellipse.type = "convex",
ggtheme = theme_minimal())
Εδώ για Κ = 3 έχουμε χαμηλότερη επικάλυψη αλλά between_SS / total_SS = 42.6 %… σημαντικά χειρότερος διαχωρισμός. Επίσης οι αποστάσεις εντός συστάδων είναι υψηλότερες. Κρατάμε συνεπώς το K = 4.