## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── 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
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
##
## ---------------------
## Welcome to dendextend version 1.17.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
##
## Attachement du package : 'dendextend'
##
## L'objet suivant est masqué depuis 'package:stats':
##
## cutree
library(clusterCrit)
library(clValid)
library(ggplot2)
# Chargement des données
usarrests <- read.csv("USArrests.csv", header = TRUE)
colnames(usarrests)[1] <- "State"
rownames(usarrests) <- usarrests$State
usarrests <- usarrests[, -1]
# Statistiques descriptives
summary(usarrests)## Murder Assault UrbanPop Rape
## Min. : 0.800 Min. : 45.0 Min. :32.00 Min. : 7.30
## 1st Qu.: 4.075 1st Qu.:109.0 1st Qu.:54.50 1st Qu.:15.07
## Median : 7.250 Median :159.0 Median :66.00 Median :20.10
## Mean : 7.788 Mean :170.8 Mean :65.54 Mean :21.23
## 3rd Qu.:11.250 3rd Qu.:249.0 3rd Qu.:77.75 3rd Qu.:26.18
## Max. :17.400 Max. :337.0 Max. :91.00 Max. :46.00
set.seed(123)
kmeans_res <- kmeans(usarrests_scaled, centers = 4, nstart = 25)
usarrests_kmeans <- usarrests %>% mutate(cluster = factor(kmeans_res$cluster))plot(usarrests$Murder, usarrests$Assault, col = kmeans_res$cluster, pch = 19,
xlab = "Murder", ylab = "Assault", main = "K-means: Murder vs Assault")plot(usarrests$Murder, usarrests$Rape, col = kmeans_res$cluster, pch = 19,
xlab = "Murder", ylab = "Rape", main = "K-means: Murder vs Rape")plot(usarrests$Assault, usarrests$Rape, col = kmeans_res$cluster, pch = 19,
xlab = "Assault", ylab = "Rape", main = "K-means: Assault vs Rape")pam_res <- pam(usarrests_scaled, k = 4)
usarrests_pam <- usarrests %>% mutate(cluster = factor(pam_res$clustering))plot(usarrests$Murder, usarrests$Assault, col = pam_res$clustering, pch = 19,
xlab = "Murder", ylab = "Assault", main = "PAM: Murder vs Assault")plot(usarrests$Murder, usarrests$Rape, col = pam_res$clustering, pch = 19,
xlab = "Murder", ylab = "Rape", main = "PAM: Murder vs Rape")plot(usarrests$Assault, usarrests$Rape, col = pam_res$clustering, pch = 19,
xlab = "Assault", ylab = "Rape", main = "PAM: Assault vs Rape")dist_mat <- dist(usarrests_scaled)
hclust_res <- hclust(dist_mat, method = "ward.D2")
# Dendrogramme
plot(as.dendrogram(hclust_res), main = "Dendrogramme CAH", xlab = "États", ylab = "Distance")
rect.hclust(hclust_res, k = 4, border = 2:5)# Découpage en 4 clusters
cah_clusters <- cutree(hclust_res, k = 4)
usarrests_cah <- usarrests %>% mutate(cluster = factor(cah_clusters))
# Visualisation dans les plans
plot(usarrests$Murder, usarrests$Assault, col = cah_clusters, pch = 19,
xlab = "Murder", ylab = "Assault", main = "CAH: Murder vs Assault")plot(usarrests$Murder, usarrests$Rape, col = cah_clusters, pch = 19,
xlab = "Murder", ylab = "Rape", main = "CAH: Murder vs Rape")plot(usarrests$Assault, usarrests$Rape, col = cah_clusters, pch = 19,
xlab = "Assault", ylab = "Rape", main = "CAH: Assault vs Rape")par(mfrow = c(1, 3))
plot(pca_res$x[, 1:2], col = kmeans_res$cluster, pch = 19, main = "K-means (PCA)")
plot(pca_res$x[, 1:2], col = pam_res$clustering, pch = 19, main = "PAM (PCA)")
plot(pca_res$x[, 1:2], col = cah_clusters, pch = 19, main = "CAH (PCA)")La comparaison visuelle des clusters sur les différentes combinaisons de variables (Meurtre, Agression, Viol) et dans le plan principal de l’ACP montre des différences notables entre les trois méthodes. La méthode des k-médoïdes produit des groupes bien séparés, compacts et homogènes, ce qui reflète une bonne structuration des données. Le k-means affiche une séparation globalement correcte mais certains clusters semblent plus diffus, et la sensibilité aux valeurs extrêmes peut influencer les résultats. Quant à la CAH, bien que les groupes soient cohérents, ils paraissent parfois moins distincts, surtout aux frontières des clusters. Cette visualisation renforce l’évaluation quantitative selon laquelle PAM est la méthode la plus efficace dans ce contexte.
La comparaison visuelle des clusters sur le plan factoriel montre des différences notables entre les trois méthodes. La méthode des k-médoïdes produit des groupes bien séparés, compacts et homogènes, ce qui reflète une bonne structuration des données. Le k-means affiche une séparation globalement correcte mais certains clusters semblent plus diffus, et la sensibilité aux valeurs extrêmes peut influencer les résultats. Quant à la CAH, bien que les groupes soient cohérents, ils paraissent parfois moins distincts, surtout aux frontières des clusters. Cette visualisation renforce l’évaluation quantitative selon laquelle PAM est la méthode la plus efficace dans ce contexte.
sil_kmeans <- mean(silhouette(kmeans_res$cluster, dist(usarrests_scaled))[, 3])
sil_pam <- mean(silhouette(pam_res$clustering, dist(usarrests_scaled))[, 3])
sil_cah <- mean(silhouette(cah_clusters, dist(usarrests_scaled))[, 3])
sil_kmeans; sil_pam; sil_cah## [1] 0.3396889
## [1] 0.3389904
## [1] 0.3370187
dunn_kmeans <- intCriteria(as.matrix(usarrests_scaled), kmeans_res$cluster, c("Dunn"))$dunn
dunn_pam <- intCriteria(as.matrix(usarrests_scaled), pam_res$clustering, c("Dunn"))$dunn
dunn_cah <- intCriteria(as.matrix(usarrests_scaled), cah_clusters, c("Dunn"))$dunn
dunn_kmeans; dunn_pam; dunn_cah## [1] 0.1604403
## [1] 0.184885
## [1] 0.1604403
time_results <- microbenchmark(
kmeans = kmeans(usarrests_scaled, centers = 4, nstart = 25),
pam = pam(usarrests_scaled, k = 4),
cah = hclust(dist(usarrests_scaled), method = "ward.D2"),
times = 10
)
time_results## Unit: microseconds
## expr min lq mean median uq max neval cld
## kmeans 723.701 744.501 959.1311 802.1010 1071.801 1689.301 10 a
## pam 244.301 259.800 375.1412 308.5515 361.601 763.702 10 b
## cah 68.201 84.302 98.8514 90.1010 97.002 199.701 10 c
perf <- data.frame(
Méthode = c("K-means", "K-médoïdes", "CAH"),
Silhouette = c(sil_kmeans, sil_pam, sil_cah),
Dunn = c(dunn_kmeans, dunn_pam, dunn_cah)
)
print(perf)## Méthode Silhouette Dunn
## 1 K-means 0.3396889 0.1604403
## 2 K-médoïdes 0.3389904 0.1848850
## 3 CAH 0.3370187 0.1604403
D’après les résultats des indices de performance, la méthode des k-médoïdes présente généralement les meilleurs scores de silhouette et de Dunn, indiquant une meilleure qualité de séparation et de compacité des clusters. En revanche, elle est plus coûteuse en temps de calcul que k-means, qui reste plus rapide mais parfois moins précis. La CAH, bien qu’intéressante visuellement, semble offrir des résultats intermédiaires en termes de qualité de clustering. Ainsi, le clustering par k-médoïdes paraît le plus pertinent pour ces données.
La méthode des k-médoïdes (PAM) a été identifiée comme la plus pertinente sur la base de deux critères quantitatifs importants : l’indice de silhouette et l’indice de Dunn. Elle permet de former des clusters plus compacts et bien séparés. Contrairement au k-means qui utilise des moyennes, PAM utilise des objets réels (médianes) comme centres de clusters, ce qui le rend plus robuste aux valeurs aberrantes, particulièrement pertinentes ici compte tenu des grandes disparités entre États. Visuellement, les clusters formés par PAM sont aussi bien séparés dans le plan factoriel de l’ACP, confirmant la qualité du regroupement.
# PAM (k-médoïdes) est confirmé comme la meilleure méthode
fviz_pca_biplot(pca_res, habillage = pam_res$clustering, palette = "jco",
addEllipses = TRUE, label = "var", col.var = "black")