Tp clustering
Rihab FOUNOUN
22/01/2022
Introduction
Dans ce Tp nous avons appliqué les méthodes de clustering sur le jeu de données decathlon2
Lecture des données
Tout d’abord nous avons téléchargé les packages necessaires pour l’analyse:
library(stats)
library(factoextra) Pour avoir un aperçu sur les données,nous avons utilisé les fonctions suivantes:
str(): pour afficher un listing de toutes les variables et de leurs types. head() : pour afficher les 6 premières lignes.
tail(): pour afficher les 6 dernières lignes.
rownames(): pour afficher les noms des lignes. colnames(): pour afficher les noms des colonnes.
summary() : pour calculer les statistiques élémentaire.
data(decathlon2)
str(decathlon2)## 'data.frame': 27 obs. of 13 variables:
## $ X100m : num 11 10.8 11 11.3 11.1 ...
## $ Long.jump : num 7.58 7.4 7.23 7.09 7.3 7.31 6.81 7.56 6.97 7.27 ...
## $ Shot.put : num 14.8 14.3 14.2 15.2 13.5 ...
## $ High.jump : num 2.07 1.86 1.92 2.1 2.01 2.13 1.95 1.86 1.95 1.98 ...
## $ X400m : num 49.8 49.4 48.9 50.4 48.6 ...
## $ X110m.hurdle: num 14.7 14.1 15 15.3 14.2 ...
## $ Discus : num 43.8 50.7 40.9 46.3 45.7 ...
## $ Pole.vault : num 5.02 4.92 5.32 4.72 4.42 4.42 4.92 4.82 4.72 4.62 ...
## $ Javeline : num 63.2 60.1 62.8 63.4 55.4 ...
## $ X1500m : num 292 302 280 276 268 ...
## $ Rank : int 1 2 4 5 7 8 9 10 11 12 ...
## $ Points : int 8217 8122 8067 8036 8004 7995 7802 7733 7708 7651 ...
## $ Competition : Factor w/ 2 levels "Decastar","OlympicG": 1 1 1 1 1 1 1 1 1 1 ...Remarque: On remarque que le jeu de données decathlon2 contient une variable qualitatif (la variable “compétition” ) donc pour pouvoir appliquer les méthodes k-means et clustering hiérarchique on doit travailler avec les 12 premiers variables quantitatifes.
head(decathlon2[1:12])tail(decathlon2[1:12])rownames(decathlon2[1:12])## [1] "SEBRLE" "CLAY" "BERNARD" "YURKOV" "ZSIVOCZKY"
## [6] "McMULLEN" "MARTINEAU" "HERNU" "BARRAS" "NOOL"
## [11] "BOURGUIGNON" "Sebrle" "Clay" "Karpov" "Macey"
## [16] "Warners" "Zsivoczky" "Hernu" "Bernard" "Schwarzl"
## [21] "Pogorelov" "Schoenbeck" "Barras" "KARPOV" "WARNERS"
## [26] "Nool" "Drews"colnames(decathlon2[1:12])## [1] "X100m" "Long.jump" "Shot.put" "High.jump" "X400m"
## [6] "X110m.hurdle" "Discus" "Pole.vault" "Javeline" "X1500m"
## [11] "Rank" "Points"summary(decathlon2[1:12])## X100m Long.jump Shot.put High.jump
## Min. :10.44 Min. :6.800 Min. :12.68 Min. :1.860
## 1st Qu.:10.84 1st Qu.:7.210 1st Qu.:14.17 1st Qu.:1.930
## Median :10.97 Median :7.310 Median :14.57 Median :1.980
## Mean :10.99 Mean :7.365 Mean :14.54 Mean :1.998
## 3rd Qu.:11.13 3rd Qu.:7.545 3rd Qu.:15.01 3rd Qu.:2.080
## Max. :11.64 Max. :7.960 Max. :16.36 Max. :2.150
## X400m X110m.hurdle Discus Pole.vault
## Min. :46.81 Min. :13.97 Min. :37.92 Min. :4.400
## 1st Qu.:48.70 1st Qu.:14.15 1st Qu.:42.27 1st Qu.:4.660
## Median :49.20 Median :14.34 Median :44.72 Median :4.900
## Mean :49.31 Mean :14.50 Mean :44.85 Mean :4.836
## 3rd Qu.:49.86 3rd Qu.:14.87 3rd Qu.:46.93 3rd Qu.:5.000
## Max. :51.16 Max. :15.67 Max. :51.65 Max. :5.400
## Javeline X1500m Rank Points
## Min. :50.31 Min. :262.1 Min. : 1.000 Min. :7313
## 1st Qu.:55.32 1st Qu.:271.6 1st Qu.: 4.000 1st Qu.:8000
## Median :57.19 Median :278.1 Median : 7.000 Median :8084
## Mean :58.32 Mean :278.5 Mean : 7.444 Mean :8119
## 3rd Qu.:62.05 3rd Qu.:283.6 3rd Qu.:10.500 3rd Qu.:8236
## Max. :70.52 Max. :301.5 Max. :19.000 Max. :8893K-means
Avant d’utiliser la méthode K-means pour faire le clustering ,nous avons standarisé les variables en utilisant la fonction R scale().
Et pour faire le clustering par la méthode k-means nous avons utlisé la fonction kmeans()
Estimation du nombre optimal de clusters
Le clustering k-means nécessite de spécifier apriori le nombre de clusters à générer.
library(factoextra)
data(decathlon2) # Loading the data set
df <- scale(decathlon2[1:12]) # Scaling the data
fviz_nbclust(df, kmeans, method = "wss") +
geom_vline(xintercept = 4, linetype = 2)
Le graphique ci-dessus représente la variance intra-clusters. Elle diminue à mesure que k augmente, mais on peut voir un “coude” à k = 4. Ce “coude” indique que des clusters supplémentaires au-delà du quatrième ont peu de valeur,donc le nombre optimal de clusters à générer est 4 .
Calcul du clustering k-means
Nous avons donné la valeur 123 à la fonction set.seed() comme référence pour le générateur de nombres aléatoires de R,et la valeur 50 au paramètre nstart comme nombre fixe de différentes affectations aléatoires de départ, afin d’avoir un résultat plus stable.
set.seed(123)
df <- scale(decathlon2[1:12])
km.res <- kmeans(df, 4, nstart = 50)
print(km.res) ## K-means clustering with 4 clusters of sizes 8, 11, 3, 5
##
## Cluster means:
## X100m Long.jump Shot.put High.jump X400m X110m.hurdle
## 1 -0.01676477 -0.4027678 0.2216799 0.8039166 0.01558585 0.04962638
## 2 -0.27253952 0.2615825 -0.2028858 -0.4751297 -0.10174084 -0.34674019
## 3 -1.40429576 1.7161275 1.5502646 0.9608257 -1.21617001 -0.94999079
## 4 1.46898803 -0.9607294 -0.8384979 -0.8174767 0.92859451 1.25342068
## Discus Pole.vault Javeline X1500m Rank Points
## 1 0.2116043 -1.067180040 0.1942150 -0.68523610 -0.01579371 0.114375161
## 2 -0.2807930 0.805594451 -0.2501708 0.50313724 -0.01837813 -0.001750371
## 3 1.5464099 -0.008528911 1.3264499 0.14897127 -1.23822680 2.026004737
## 4 -0.6486684 -0.059702380 -0.5562381 -0.09990692 0.80863791 -1.394752284
##
## Clustering vector:
## SEBRLE CLAY BERNARD YURKOV ZSIVOCZKY McMULLEN
## 2 2 2 1 1 1
## MARTINEAU HERNU BARRAS NOOL BOURGUIGNON Sebrle
## 4 4 4 4 4 3
## Clay Karpov Macey Warners Zsivoczky Hernu
## 3 3 1 2 1 1
## Bernard Schwarzl Pogorelov Schoenbeck Barras KARPOV
## 1 2 2 2 1 2
## WARNERS Nool Drews
## 2 2 2
##
## Within cluster sum of squares by cluster:
## [1] 39.51914 76.93079 12.74734 32.40713
## (between_SS / total_SS = 48.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"à ce niveau nous avons examiné les variables originales (decathlon[1 :12] au lieu de df) au sein des clusters.
Nous avons utilisé la fonction cbind pour joindre la colonne des clusters as.factor(km.res$cluster) au jeu de données decathlon2[1 :12],et la fonction ggplot pour visualiser la distribution des 4 premières variables dans chaque cluster.
aggregate(decathlon2[1:12], by=list(cluster=km.res$cluster), mean) aggregate(decathlon2[1:12], by=list(cluster=km.res$cluster), sd) decathlon2_C=cbind(decathlon2[1:12], cluster=as.factor(km.res$cluster))
for(i in c(1:4)){
var=colnames(decathlon2_C)[i]
print(ggplot(decathlon2_C, aes(y=decathlon2_C[[i]], fill=cluster)) +
geom_boxplot()+ ylab(var))
}## Warning: Use of `decathlon2_C[[i]]` is discouraged. Use `.data[[i]]` instead.
## Warning: Use of `decathlon2_C[[i]]` is discouraged. Use `.data[[i]]` instead.
## Warning: Use of `decathlon2_C[[i]]` is discouraged. Use `.data[[i]]` instead.
## Warning: Use of `decathlon2_C[[i]]` is discouraged. Use `.data[[i]]` instead.
Interpretation:
La premiere boite à moustache représente la distribution de la variable x 100m dans chaque cluster ,on peut constater qu’il y a un chevauchement entre le cluster 1 et 2 alors que les clusters 3 et 4 sont bien séparés.
Dans la deuxième et la troixieme boite à moustache on remarque qu’il y a un chevauchement faible entre les clusters 1,2 et 4.
Concernant la quatrième boite à moustache on constate qu’on a un fort degré de chevauchement entre les clusters 1 et 3,et faible degré entre les clusters 2 et 4.
Accès aux résultats de la fonction kmeans()
kmeans() retourne une liste de composants, qui comprend:
• cluster: vecteur d’entiers indiquant le cluster auquel chaque point est attribué
• centres: Une matrice de centres de clusters (moyennes dans les clusters)
• totss : La somme totale des carrés (TSS), mesure la variance totale
• withinss : Vecteur de la somme des carrés intra-clusters, une valeur par cluster
• tot.withinss : Totale des carrés intra-clusters, c.-à-d. somme(withinss)
• betweenss : la somme des carrés inter-clusters, c.-à-d. totss - tot.withinss
• size : Nombre d’observations dans chaque cluster
km.res$cluster## SEBRLE CLAY BERNARD YURKOV ZSIVOCZKY McMULLEN
## 2 2 2 1 1 1
## MARTINEAU HERNU BARRAS NOOL BOURGUIGNON Sebrle
## 4 4 4 4 4 3
## Clay Karpov Macey Warners Zsivoczky Hernu
## 3 3 1 2 1 1
## Bernard Schwarzl Pogorelov Schoenbeck Barras KARPOV
## 1 2 2 2 1 2
## WARNERS Nool Drews
## 2 2 2km.res$centers## X100m Long.jump Shot.put High.jump X400m X110m.hurdle
## 1 -0.01676477 -0.4027678 0.2216799 0.8039166 0.01558585 0.04962638
## 2 -0.27253952 0.2615825 -0.2028858 -0.4751297 -0.10174084 -0.34674019
## 3 -1.40429576 1.7161275 1.5502646 0.9608257 -1.21617001 -0.94999079
## 4 1.46898803 -0.9607294 -0.8384979 -0.8174767 0.92859451 1.25342068
## Discus Pole.vault Javeline X1500m Rank Points
## 1 0.2116043 -1.067180040 0.1942150 -0.68523610 -0.01579371 0.114375161
## 2 -0.2807930 0.805594451 -0.2501708 0.50313724 -0.01837813 -0.001750371
## 3 1.5464099 -0.008528911 1.3264499 0.14897127 -1.23822680 2.026004737
## 4 -0.6486684 -0.059702380 -0.5562381 -0.09990692 0.80863791 -1.394752284km.res$totss## [1] 312km.res$withinss## [1] 39.51914 76.93079 12.74734 32.40713km.res$tot.withinss## [1] 161.6044km.res$betweenss## [1] 150.3956km.res$size## [1] 8 11 3 5Le cluster 1 contient 8 observations (individus) et sa variance intra égal à 39 .51
Le cluster 2 contient 11 observations et sa variance intra égal à 76 .93 Le cluster 3 contient 3 observations et sa variance intra égal à 12 .74 Le cluster 4 contient 5 observations et sa variance intra égal à 32 .40
Visualisation des clusters produits par kmeans()
Nous avons utilisé la fonction fviz_cluster( ) pour visualiser les données en nuage de points avec la coloration de chaque point de données en fonction de son affectation aux clusters. Et grâce à l’ACP nous avons pu réduire le nombre de dimensions en 2 dimensions pour faire la représentation graphique.
fviz_cluster(km.res, data = df,
palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
ellipse.type = "euclid", # Concentration ellipse
star.plot = TRUE, # Add segments from centroids to items
repel = TRUE, # Avoid label overplotting (slow)
ggtheme = theme_minimal()
) ## Too few points to calculate an ellipse
interpretation:
Apres avoir appliquer l’algorithme k-means nous avons pu diviser les athlètes en 4 groupes qui sont séparés (un degré faible de chevauchement entre les clusters) comme montre le graphe ci-dessus .
Clustering hiérarchique
Nous avons utilisé la fonction dist() pour calculer la distance entre chaque paire d’observation dans le jeu de donnée decathlon2
set.seed(123)
df <- scale(decathlon2[1:12])
km.res <- kmeans(df, 4, nstart = 50)
res.dist <- dist(df, method = "euclidean") La fonction hclust() permet de créer l’arbre hiérarchique à partir de la matrice de distance “res.dist” et la méthode de couplage « ward.D2 »:
res.hc <- hclust(d = res.dist, method = "ward.D2") Dendrogramme
set.seed(123)
df <- scale(decathlon2[1:12])
km.res <- kmeans(df, 4, nstart = 50)
res.dist <- dist(df, method = "euclidean")
res.hc <- hclust(d = res.dist, method = "ward.D2")
grp <- cutree(res.hc, k = 4)la fonction fviz_dend()nous a permet de produire le dendrogramme :
fviz_dend(res.hc, cex = 0.5) ## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
Dans le dendrogramme ci-dessus, chaque noeud final correspond à un objet. En remontant l’arbre, les objets qui se ressemblent se combinent en branches, qui sont elles-mêmes fusionnées à une hauteur plus élevée.
Afin d’identifier les clusters, nous pouvons couper le dendrogramme à une certaine hauteur que nous jugeons appropriée. Par exemple si on découpe le dendrogramme à la hauteur 8 on obtient 3 clusters avec les Tailles (3,8,16)..
Vérification de l’arborescence du clustering
La fonction cophenetic() est utilisée pour calculer les distances cophenetic pour la classification hiérarchique.
# Compute cophentic distance
res.coph <- cophenetic(res.hc)
# Correlation between cophenetic distance and the original distance
cor(res.dist, res.coph)## [1] 0.6123268on a éxécute à nouveau la fonction hclust() en utilisant la méthode de liaison “average”.
res.hc2 <- hclust(res.dist, method = "average")
cor(res.dist, cophenetic(res.hc2)) ## [1] 0.7250826Le coefficient de corrélation montre que l’utilisation d’une méthode de liaison différente crée un arbre qui représente légèrement mieux les distances initiales.
découpage du dendrogramme en clusters
pour découper le dendrogramme en 4 clusters nous avons utilisé la fonction cutree() :
# Cut tree into 4 groups
grp <- cutree(res.hc, k = 4)
head(grp, n = 10) ## SEBRLE CLAY BERNARD YURKOV ZSIVOCZKY McMULLEN MARTINEAU HERNU
## 1 1 1 2 3 1 3 1
## BARRAS NOOL
## 3 3# Number of members in each cluster
table(grp) ## grp
## 1 2 3 4
## 13 3 8 3# Get the names for the members of cluster 1
rownames(df)[grp == 1]## [1] "SEBRLE" "CLAY" "BERNARD" "McMULLEN" "HERNU"
## [6] "Warners" "Bernard" "Schwarzl" "Pogorelov" "Schoenbeck"
## [11] "KARPOV" "WARNERS" "Nool"Nous avons découpé le dendrogramme en 4 clusters (1 2 3 4) qui contient respectivement (13 3 8 3 ) observations .puis nous avons utilisé la fonction fviz_dend() pour visualiser les groupes en couleur :
# Cut in 4 groups and color by groups
fviz_dend(res.hc, k = 4, # Cut in four groups
cex = 0.5, # label size
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
color_labels_by_k = TRUE, # color labels by groups
rect = TRUE # Add rectangle around groups
)## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
En utilisant la fonction fviz_cluster(), nous avons pu visualiser le résultat dans un diagramme de dispersion:
fviz_cluster(list(data = df, cluster = grp),
palette = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07"),
ellipse.type = "convex", # Concentration ellipse
repel = TRUE, # Avoid label overplotting (slow)
show.clust.cent = FALSE, ggtheme = theme_minimal())
Interpretation :
Apres l’utilisation de la méthode clustering hiérarchique, nous avons regroupé les athlètes en 4 groupes (1 2 3 4 ) qui ont respectivement les tailles (13 3 8 3). On peut constater d’après le graphe ci-dessus qu’il y a un peu de chevauchement entre le cluster 1 et 3 ,les autres sont séparés. Pour améliorer ce résultat nous avons utilisé la méthode (hkmeans) :
Hierarchical K-Means Clustering
L’algorithme hkmeans procède comme suit:
- Calculer le clustering hiérarchique et découper l’arbre en k-clusters
- Calculer le centre (c.-à-d. la moyenne) de chaque cluster
- Calculer k-means en utilisant les centres de clusters (définis à l’étape 2) comme point de départ
# Compute hierarchical k-means clustering
res.hk <-hkmeans(df, 4)
# Elements returned by hkmeans()
names(res.hk) ## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault" "data"
## [11] "hclust"# Print the results
res.hk## Hierarchical K-means clustering with 4 clusters of sizes 11, 8, 5, 3
##
## Cluster means:
## X100m Long.jump Shot.put High.jump X400m X110m.hurdle
## 1 -0.27253952 0.2615825 -0.2028858 -0.4751297 -0.10174084 -0.34674019
## 2 -0.01676477 -0.4027678 0.2216799 0.8039166 0.01558585 0.04962638
## 3 1.46898803 -0.9607294 -0.8384979 -0.8174767 0.92859451 1.25342068
## 4 -1.40429576 1.7161275 1.5502646 0.9608257 -1.21617001 -0.94999079
## Discus Pole.vault Javeline X1500m Rank Points
## 1 -0.2807930 0.805594451 -0.2501708 0.50313724 -0.01837813 -0.001750371
## 2 0.2116043 -1.067180040 0.1942150 -0.68523610 -0.01579371 0.114375161
## 3 -0.6486684 -0.059702380 -0.5562381 -0.09990692 0.80863791 -1.394752284
## 4 1.5464099 -0.008528911 1.3264499 0.14897127 -1.23822680 2.026004737
##
## Clustering vector:
## SEBRLE CLAY BERNARD YURKOV ZSIVOCZKY McMULLEN
## 1 1 1 2 2 2
## MARTINEAU HERNU BARRAS NOOL BOURGUIGNON Sebrle
## 3 3 3 3 3 4
## Clay Karpov Macey Warners Zsivoczky Hernu
## 4 4 2 1 2 2
## Bernard Schwarzl Pogorelov Schoenbeck Barras KARPOV
## 2 1 1 1 2 1
## WARNERS Nool Drews
## 1 1 1
##
## Within cluster sum of squares by cluster:
## [1] 76.93079 39.51914 32.40713 12.74734
## (between_SS / total_SS = 48.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault" "data"
## [11] "hclust"Visualisation des résultats de hkmeans
set.seed(123)
df <- scale(decathlon2[1:12])
km.res <- kmeans(df, 4, nstart = 50)
res.dist <- dist(df, method = "euclidean")
res.hk <-hkmeans(df, 4) # Visualize the tree
fviz_dend(res.hk, cex = 0.6, palette = "jco",rect = TRUE,
rect_border = "jco", rect_fill = TRUE)
# Visualize the hkmeans final clusters
fviz_cluster(res.hk, palette = "jco", repel = TRUE,
ggtheme = theme_classic())
interpretation
Apres avoir utiliser la méthode hkmeans nous avons obtenu les résultats suivants :
Le cluster 1 contient 11 observations (Nool ,SEBRE ,Drews , …) ,sa variance intra est égal à 79 .93 (le groupe est un peu homogène). Le cluster 2 contient 8 observations (Hernu ,Barras,Bernard , …) ,sa variance intra est égal à «39 .52 (ce groupe est plus homogène par rapport au premier ). De même pour le cluster 3 qui contient 5 observations et sa variance intra est égal a 32 .40. Le cluster 4 contient seulement 3 observations (Clay, Karpov et Sebrle)sa variance intra est égal a 12 .74 (ce groupe et très homogène ). En plus on remarque que les groupes sont distincts (le degré de chevauchement est très faible).
La méthode hkmeans nous a permet de faire le clustering sur jeu de données decathlon2 et nous avons obtenu un bon résultat (4 clusters homogènes et sans chevauchement ).