Στην εργασία αυτή εφαρμόζεται συσταδοποίηση σε δεδομένα πελατών τηλεπικοινωνιακής εταιρείας. Η συσταδοποίηση είναι μέθοδος μη εποπτευόμενης μάθησης, δηλαδή δεν προσπαθούμε να προβλέψουμε μια γνωστή κατηγορία, αλλά να ανακαλύψουμε ομάδες πελατών που μοιάζουν μεταξύ τους.
Το βασικό ερώτημα της ανάλυσης είναι: μπορούμε να χωρίσουμε τους πελάτες σε ομάδες με παρόμοια χαρακτηριστικά υπηρεσιών, συμβολαίων και χρεώσεων;
Η μεταβλητή Churn, δηλαδή αν ο πελάτης αποχώρησε από την
εταιρεία, δεν χρησιμοποιείται για να δημιουργηθούν τα clusters.
Χρησιμοποιείται μόνο στο τέλος, ώστε να ερμηνεύσουμε αν κάποια ομάδα
πελατών εμφανίζει μεγαλύτερο ποσοστό αποχώρησης.
if (!requireNamespace("ggplot2", quietly = TRUE)) {
install.packages("ggplot2")
}
library(ggplot2)
Το dataset που χρησιμοποιείται είναι το Telco Customer Churn. Κάθε γραμμή αντιστοιχεί σε έναν πελάτη και κάθε στήλη περιγράφει ένα χαρακτηριστικό του.
Οι βασικές μεταβλητές που μας ενδιαφέρουν είναι:
tenure: πόσους μήνες είναι πελάτης στην εταιρεία,Contract: τι είδος συμβολαίου έχει,InternetService: τι υπηρεσία internet
χρησιμοποιεί,PaymentMethod: πώς πληρώνει,MonthlyCharges: πόσο πληρώνει κάθε μήνα,TotalCharges: πόσα έχει πληρώσει συνολικά,Churn: αν αποχώρησε ή όχι από την εταιρεία.Το dataset είναι κατάλληλο για business case study, επειδή μπορεί να βοηθήσει μια εταιρεία να κατανοήσει καλύτερα διαφορετικά προφίλ πελατών.
# Φόρτωση του dataset
# Το CSV πρέπει να βρίσκεται στον ίδιο φάκελο με το Rmd αρχείο
telco_raw <- read.csv("WA_Fn-UseC_-Telco-Customer-Churn.csv",
stringsAsFactors = FALSE)
head(telco_raw)
## customerID gender SeniorCitizen Partner Dependents tenure PhoneService
## 1 7590-VHVEG Female 0 Yes No 1 No
## 2 5575-GNVDE Male 0 No No 34 Yes
## 3 3668-QPYBK Male 0 No No 2 Yes
## 4 7795-CFOCW Male 0 No No 45 No
## 5 9237-HQITU Female 0 No No 2 Yes
## 6 9305-CDSKC Female 0 No No 8 Yes
## MultipleLines InternetService OnlineSecurity OnlineBackup DeviceProtection
## 1 No phone service DSL No Yes No
## 2 No DSL Yes No Yes
## 3 No DSL Yes Yes No
## 4 No phone service DSL Yes No Yes
## 5 No Fiber optic No No No
## 6 Yes Fiber optic No No Yes
## TechSupport StreamingTV StreamingMovies Contract PaperlessBilling
## 1 No No No Month-to-month Yes
## 2 No No No One year No
## 3 No No No Month-to-month Yes
## 4 Yes No No One year No
## 5 No No No Month-to-month Yes
## 6 No Yes Yes Month-to-month Yes
## PaymentMethod MonthlyCharges TotalCharges Churn
## 1 Electronic check 29.85 29.85 No
## 2 Mailed check 56.95 1889.50 No
## 3 Mailed check 53.85 108.15 Yes
## 4 Bank transfer (automatic) 42.30 1840.75 No
## 5 Electronic check 70.70 151.65 Yes
## 6 Electronic check 99.65 820.50 Yes
# Διαστάσεις: αριθμός πελατών και αριθμός μεταβλητών
dim(telco_raw)
## [1] 7043 21
# Δομή των μεταβλητών
str(telco_raw)
## 'data.frame': 7043 obs. of 21 variables:
## $ customerID : chr "7590-VHVEG" "5575-GNVDE" "3668-QPYBK" "7795-CFOCW" ...
## $ gender : chr "Female" "Male" "Male" "Male" ...
## $ SeniorCitizen : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Partner : chr "Yes" "No" "No" "No" ...
## $ Dependents : chr "No" "No" "No" "No" ...
## $ tenure : int 1 34 2 45 2 8 22 10 28 62 ...
## $ PhoneService : chr "No" "Yes" "Yes" "No" ...
## $ MultipleLines : chr "No phone service" "No" "No" "No phone service" ...
## $ InternetService : chr "DSL" "DSL" "DSL" "DSL" ...
## $ OnlineSecurity : chr "No" "Yes" "Yes" "Yes" ...
## $ OnlineBackup : chr "Yes" "No" "Yes" "No" ...
## $ DeviceProtection: chr "No" "Yes" "No" "Yes" ...
## $ TechSupport : chr "No" "No" "No" "Yes" ...
## $ StreamingTV : chr "No" "No" "No" "No" ...
## $ StreamingMovies : chr "No" "No" "No" "No" ...
## $ Contract : chr "Month-to-month" "One year" "Month-to-month" "One year" ...
## $ PaperlessBilling: chr "Yes" "No" "Yes" "No" ...
## $ PaymentMethod : chr "Electronic check" "Mailed check" "Mailed check" "Bank transfer (automatic)" ...
## $ MonthlyCharges : num 29.9 57 53.9 42.3 70.7 ...
## $ TotalCharges : num 29.9 1889.5 108.2 1840.8 151.7 ...
## $ Churn : chr "No" "No" "Yes" "No" ...
# Κατανομή της μεταβλητής Churn
# Δεν χρησιμοποιείται στο clustering, μόνο στην ερμηνεία.
table(telco_raw$Churn)
##
## No Yes
## 5174 1869
Πριν τη συσταδοποίηση έγινε ένας απλός καθαρισμός των δεδομένων. Η
μεταβλητή TotalCharges διαβάστηκε αρχικά ως κείμενο, επειδή
περιείχε κάποιες κενές τιμές. Για αυτό μετατράπηκε σε αριθμητική
μεταβλητή και οι κενές τιμές αντικαταστάθηκαν με τη διάμεσο.
Επίσης, για να είναι πιο γρήγορη και καθαρή η ιεραρχική συσταδοποίηση, χρησιμοποιήθηκε τυχαίο δείγμα 1000 πελατών. Αυτό είναι αρκετό για να παρουσιαστεί η μέθοδος χωρίς να γίνει πολύ βαρύ το dendrogram.
telco <- telco_raw
# Μετατροπή TotalCharges σε αριθμητική μεταβλητή
telco$TotalCharges <- as.numeric(trimws(telco$TotalCharges))
# Αντικατάσταση ελλιπών τιμών με τη διάμεσο
telco$TotalCharges[is.na(telco$TotalCharges)] <- median(telco$TotalCharges, na.rm = TRUE)
# Μετατροπή SeniorCitizen σε κατηγορική μεταβλητή
telco$SeniorCitizen <- ifelse(telco$SeniorCitizen == 1, "Yes", "No")
# Έλεγχος ελλιπών τιμών
colSums(is.na(telco))
## customerID gender SeniorCitizen Partner
## 0 0 0 0
## Dependents tenure PhoneService MultipleLines
## 0 0 0 0
## InternetService OnlineSecurity OnlineBackup DeviceProtection
## 0 0 0 0
## TechSupport StreamingTV StreamingMovies Contract
## 0 0 0 0
## PaperlessBilling PaymentMethod MonthlyCharges TotalCharges
## 0 0 0 0
## Churn
## 0
# Επιλογή τυχαίου δείγματος 1000 πελατών
set.seed(123)
sample_size <- min(1000, nrow(telco))
sample_index <- sample(1:nrow(telco), sample_size)
telco_sample <- telco[sample_index, ]
dim(telco_sample)
## [1] 1000 21
Επειδή θα χρησιμοποιηθεί binary distance, τα δεδομένα πρέπει να έχουν μορφή 0 και 1.
Οι κατηγορικές μεταβλητές μετατρέπονται σε dummy variables. Για
παράδειγμα, μια μεταβλητή όπως το Contract μετατρέπεται σε
ξεχωριστές στήλες, όπως Month-to-month,
One year και Two year, με τιμές 0 ή 1.
Οι αριθμητικές μεταβλητές tenure,
MonthlyCharges και TotalCharges πρώτα
χωρίζονται σε τρεις κατηγορίες: Low, Medium
και High. Μετά μετατρέπονται και αυτές σε binary μορφή.
# Συνάρτηση για διαχωρισμό αριθμητικών μεταβλητών σε Low / Medium / High
create_groups <- function(x) {
cut(x,
breaks = quantile(x, probs = c(0, 1/3, 2/3, 1), na.rm = TRUE),
include.lowest = TRUE,
labels = c("Low", "Medium", "High"))
}
# Δημιουργία κατηγοριών για τις αριθμητικές μεταβλητές
telco_sample$tenure_group <- create_groups(telco_sample$tenure)
telco_sample$MonthlyCharges_group <- create_groups(telco_sample$MonthlyCharges)
telco_sample$TotalCharges_group <- create_groups(telco_sample$TotalCharges)
# Επιλογή μεταβλητών για clustering
# Δεν χρησιμοποιούνται customerID και Churn.
cluster_data <- telco_sample[, c(
"gender",
"SeniorCitizen",
"Partner",
"Dependents",
"PhoneService",
"MultipleLines",
"InternetService",
"OnlineSecurity",
"OnlineBackup",
"DeviceProtection",
"TechSupport",
"StreamingTV",
"StreamingMovies",
"Contract",
"PaperlessBilling",
"PaymentMethod",
"tenure_group",
"MonthlyCharges_group",
"TotalCharges_group"
)]
cluster_data[] <- lapply(cluster_data, as.factor)
# Μετατροπή σε binary/dummy variables
binary_matrix <- model.matrix(~ . - 1, data = cluster_data)
telco_binary <- as.data.frame(binary_matrix)
# Ενδεικτική εμφάνιση των πρώτων 10 binary μεταβλητών
head(telco_binary[, 1:10])
## genderFemale genderMale SeniorCitizenYes PartnerYes DependentsYes
## 2463 0 1 0 0 1
## 2511 0 1 0 0 0
## 2227 1 0 0 1 1
## 526 0 1 0 0 0
## 4291 1 0 0 1 1
## 2986 1 0 0 0 0
## PhoneServiceYes MultipleLinesNo phone service MultipleLinesYes
## 2463 1 0 0
## 2511 1 0 1
## 2227 0 1 0
## 526 1 0 0
## 4291 0 1 0
## 2986 1 0 1
## InternetServiceFiber optic InternetServiceNo
## 2463 0 0
## 2511 1 0
## 2227 0 0
## 526 1 0
## 4291 0 0
## 2986 1 0
# Διαστάσεις του binary dataset
dim(telco_binary)
## [1] 1000 34
# Έλεγχος ότι υπάρχουν μόνο τιμές 0 και 1
table(as.matrix(telco_binary))
##
## 0 1
## 22806 11194
Σε αυτό το στάδιο υπολογίζεται η απόσταση μεταξύ των πελατών. Επειδή
τα δεδομένα έχουν γίνει binary, χρησιμοποιείται η μέθοδος
binary.
Η ερμηνεία είναι απλή: όσο πιο μικρή είναι η απόσταση μεταξύ δύο πελατών, τόσο πιο παρόμοιο είναι το προφίλ τους. Όσο πιο μεγάλη είναι η απόσταση, τόσο περισσότερο διαφέρουν.
# Υπολογισμός binary απόστασης
distance_matrix <- dist(telco_binary, method = "binary")
# Μικρό ενδεικτικό μέρος του πίνακα αποστάσεων
as.matrix(distance_matrix)[1:5, 1:5]
## 2463 2511 2227 526 4291
## 2463 0.0000000 0.6666667 0.8125000 0.8235294 0.8571429
## 2511 0.6666667 0.0000000 0.9375000 0.8000000 1.0000000
## 2227 0.8125000 0.9375000 0.0000000 0.9500000 0.5833333
## 526 0.8235294 0.8000000 0.9500000 0.0000000 0.8750000
## 4291 0.8571429 1.0000000 0.5833333 0.8750000 0.0000000
Στη συνέχεια εφαρμόζεται ιεραρχική συσταδοποίηση με τη μέθοδο
average linkage. Η μέθοδος αυτή ενώνει σταδιακά πελάτες ή
ομάδες πελατών με βάση τη μέση απόσταση μεταξύ τους.
# Ιεραρχική συσταδοποίηση
hc_model <- hclust(distance_matrix, method = "average")
hc_model
##
## Call:
## hclust(d = distance_matrix, method = "average")
##
## Cluster method : average
## Distance : binary
## Number of objects: 1000
Το δενδρόγραμμα δείχνει πώς σχηματίζονται οι ομάδες. Στην αρχή κάθε πελάτης είναι μόνος του και στη συνέχεια ενώνονται σταδιακά οι πιο παρόμοιοι πελάτες ή ομάδες.
Στο συγκεκριμένο γράφημα δεν εμφανίζονται τα ονόματα των πελατών, επειδή υπάρχουν πολλές παρατηρήσεις και το διάγραμμα θα γινόταν δυσανάγνωστο.
plot(hc_model,
labels = FALSE,
main = "Δενδρόγραμμα Ιεραρχικής Συσταδοποίησης",
xlab = "",
sub = "",
ylab = "Height")
# Επιλογή 4 clusters
rect.hclust(hc_model, k = 4, border = 2:5)
Το dendrogram κόβεται σε 4 clusters. Με αυτόν τον τρόπο κάθε πελάτης ταξινομείται σε μία από τις τέσσερις ομάδες.
Η επιλογή των 4 clusters δίνει μια πρακτική τμηματοποίηση των πελατών, χωρίς να κάνει την ανάλυση υπερβολικά πολύπλοκη.
# Δημιουργία 4 clusters
hc_clusters <- cutree(hc_model, k = 4)
# Προσθήκη των clusters στο αρχικό δείγμα
telco_hc <- telco_sample
telco_hc$Cluster <- as.factor(hc_clusters)
# Ενδεικτική εμφάνιση βασικών μεταβλητών
telco_hc_preview <- head(telco_hc[, c("customerID", "Contract", "InternetService",
"MonthlyCharges", "TotalCharges", "Churn", "Cluster")])
telco_hc_preview
## customerID Contract InternetService MonthlyCharges TotalCharges
## 2463 2585-KTFRE Month-to-month DSL 70.45 70.45
## 2511 3707-GNWHM Month-to-month Fiber optic 74.25 74.25
## 2227 3298-QEICA Two year DSL 34.60 813.45
## 526 0750-EBAIU One year Fiber optic 91.25 4738.30
## 4291 7734-DBOAI Month-to-month DSL 40.10 40.10
## 2986 9786-IJYDL Two year Fiber optic 113.20 3914.05
## Churn Cluster
## 2463 No 1
## 2511 Yes 2
## 2227 No 3
## 526 No 1
## 4291 Yes 3
## 2986 No 1
# Πλήθος πελατών ανά cluster
table(telco_hc$Cluster)
##
## 1 2 3 4
## 661 41 86 212
Για να καταλάβουμε τι σημαίνει κάθε cluster, εξετάζουμε βασικά χαρακτηριστικά των πελατών κάθε ομάδας.
Οι μέσοι όροι δείχνουν αν ένα cluster έχει, για παράδειγμα, πελάτες με μεγαλύτερη διάρκεια συνεργασίας ή υψηλότερες μηνιαίες χρεώσεις.
# Μέσοι όροι αριθμητικών μεταβλητών ανά cluster
aggregate(telco_hc[, c("tenure", "MonthlyCharges", "TotalCharges")],
by = list(Cluster = telco_hc$Cluster),
FUN = mean)
## Cluster tenure MonthlyCharges TotalCharges
## 1 1 35.53707 82.87799 3082.4688
## 2 2 9.97561 54.24878 535.6183
## 3 3 26.82558 39.93953 1136.8142
## 4 4 29.09434 21.19009 652.9587
# Πίνακας Churn ανά cluster
churn_table <- table(Cluster = telco_hc$Cluster, Churn = telco_hc$Churn)
churn_table
## Churn
## Cluster No Yes
## 1 444 217
## 2 22 19
## 3 66 20
## 4 196 16
# Ποσοστά Churn ανά cluster
round(prop.table(churn_table, margin = 1) * 100, 2)
## Churn
## Cluster No Yes
## 1 67.17 32.83
## 2 53.66 46.34
## 3 76.74 23.26
## 4 92.45 7.55
# Ποσοστά τύπου συμβολαίου ανά cluster
contract_table <- table(Cluster = telco_hc$Cluster, Contract = telco_hc$Contract)
round(prop.table(contract_table, margin = 1) * 100, 2)
## Contract
## Cluster Month-to-month One year Two year
## 1 58.40 20.73 20.88
## 2 87.80 7.32 4.88
## 3 65.12 22.09 12.79
## 4 37.26 19.34 43.40
Το παρακάτω γράφημα δείχνει το ποσοστό πελατών που αποχώρησαν ή παρέμειναν στην εταιρεία μέσα σε κάθε cluster.
Το γράφημα αυτό είναι χρήσιμο γιατί συνδέει το τεχνικό αποτέλεσμα της συσταδοποίησης με ένα επιχειρηματικό ερώτημα: ποια ομάδα πελατών φαίνεται να έχει μεγαλύτερο ποσοστό αποχώρησης;
ggplot(telco_hc, aes(x = Cluster, fill = Churn)) +
geom_bar(position = "fill") +
labs(title = "Ποσοστό Churn ανά Cluster",
x = "Cluster",
y = "Ποσοστό",
fill = "Churn") +
theme_minimal()
Συμπληρωματικά εφαρμόζεται και ο αλγόριθμος K-means με 4 clusters. Το K-means δεν είναι το βασικό ζητούμενο της εργασίας, αλλά χρησιμοποιείται για μια σύντομη σύγκριση με την ιεραρχική συσταδοποίηση.
set.seed(123)
kmeans_model <- kmeans(telco_binary, centers = 4, nstart = 25)
telco_kmeans <- telco_sample
telco_kmeans$Cluster <- as.factor(kmeans_model$cluster)
# Πλήθος πελατών ανά K-means cluster
table(telco_kmeans$Cluster)
##
## 1 2 3 4
## 212 214 364 210
# Σύγκριση ιεραρχικής συσταδοποίησης και K-means
table(Hierarchical = telco_hc$Cluster,
Kmeans = telco_kmeans$Cluster)
## Kmeans
## Hierarchical 1 2 3 4
## 1 0 212 239 210
## 2 0 0 41 0
## 3 0 2 84 0
## 4 212 0 0 0
Οι δύο μέθοδοι δεν είναι απαραίτητο να δώσουν ακριβώς τα ίδια clusters. Η ιεραρχική συσταδοποίηση βασίζεται στη σταδιακή ένωση παρατηρήσεων, ενώ το K-means βασίζεται σε κέντρα συστάδων.
Από την ανάλυση δημιουργήθηκαν τέσσερα clusters πελατών. Τα clusters
αυτά δεν βασίζονται στη μεταβλητή Churn, αλλά στα
χαρακτηριστικά των πελατών, όπως οι υπηρεσίες που χρησιμοποιούν, το
είδος συμβολαίου και οι χρεώσεις.
Η ανάλυση του Churn ανά cluster βοηθά στην ερμηνεία των
αποτελεσμάτων. Αν ένα cluster έχει υψηλότερο ποσοστό αποχώρησης, τότε
μπορεί να θεωρηθεί ομάδα υψηλότερου επιχειρηματικού ενδιαφέροντος.
Για παράδειγμα, πελάτες με μηνιαία συμβόλαια, υψηλότερες μηνιαίες χρεώσεις ή μικρότερη διάρκεια συνεργασίας μπορεί να εμφανίζονται σε clusters με μεγαλύτερο churn. Αυτό δεν αποδεικνύει αιτιότητα, αλλά δείχνει χρήσιμα μοτίβα για περαιτέρω διερεύνηση.
Η εργασία έδειξε πώς μπορεί να εφαρμοστεί η συσταδοποίηση σε ένα πραγματικό επιχειρηματικό dataset. Μέσα από τη μετατροπή των δεδομένων σε binary μορφή και τη χρήση binary distance, έγινε ομαδοποίηση πελατών με βάση κοινά χαρακτηριστικά.
Η ιεραρχική συσταδοποίηση και το dendrogram έδειξαν τη διαδικασία σχηματισμού των ομάδων. Στη συνέχεια, η ανάλυση του churn ανά cluster βοήθησε να δοθεί επιχειρηματική ερμηνεία στα αποτελέσματα.
Συνολικά, η συσταδοποίηση δεν προβλέπει αν ένας πελάτης θα φύγει, αλλά βοηθά να εντοπιστούν ομάδες πελατών με παρόμοιο προφίλ. Αυτό μπορεί να βοηθήσει μια εταιρεία να κατανοήσει καλύτερα τη βάση πελατών της και να σχεδιάσει πιο στοχευμένες στρατηγικές διατήρησης.