Le tp de la séance dernière est terminé et est sur campus dans TP1 Clustering

options(repos = c(CRAN = "https://cran.rstudio.com"))

QUESTION 1 (et un peu de la 3 j’ai trop anticipé..)

library(cluster.datasets)
library(dbscan)
## 
## Attaching package: 'dbscan'
## The following object is masked from 'package:stats':
## 
##     as.dendrogram
library(cluster)
library(ggplot2)

data(mammal.dentition)

# Sauvegarder les données dans un fichier CSV
#write.csv(mammal.dentition, "mammal_dentition.csv", row.names = FALSE)


mammal.data <- mammal.dentition[,-1]
mammal.scaled <- scale(mammal.data)

# Application de DBSCAN (une seule fois)
dbscan.result <- dbscan(mammal.scaled, eps=0.5, minPts=5)
dbscan.silhouette <- silhouette(dbscan.result$cluster, dist(mammal.scaled))
mean_dbscan_silhouette <- mean(dbscan.silhouette[, "sil_width"])

# Initialisation des dataframes pour enregistrer les scores
k_values <- 3:15
silhouette_scores <- data.frame()

# Boucle sur différentes valeurs de k
for (k in k_values) {
  # K-Means
  set.seed(42)
  kmeans.result <- kmeans(mammal.scaled, centers=k)
  kmeans.silhouette <- silhouette(kmeans.result$cluster, dist(mammal.scaled))
  mean_kmeans_silhouette <- mean(kmeans.silhouette[, "sil_width"])
  
  # Clustering Hiérarchique
  hclust.result <- hclust(dist(mammal.scaled), method="ward.D2")
  clusters <- cutree(hclust.result, k)
  hclust.silhouette <- silhouette(clusters, dist(mammal.scaled))
  mean_hclust_silhouette <- mean(hclust.silhouette[, "sil_width"])

  # Enregistrer les scores
  silhouette_scores <- rbind(silhouette_scores, data.frame(
    K = k,
    Method = "K-Means",
    SilhouetteScore = mean_kmeans_silhouette
  ))
  silhouette_scores <- rbind(silhouette_scores, data.frame(
    K = k,
    Method = "Hierarchical",
    SilhouetteScore = mean_hclust_silhouette
  ))
}

# Ajouter DBSCAN (même score pour chaque k)
dbscan_scores <- data.frame(
  K = k_values,
  Method = "DBSCAN",
  SilhouetteScore = rep(mean_dbscan_silhouette, length(k_values))
)
silhouette_scores <- rbind(silhouette_scores, dbscan_scores)

# Créer un graphique
ggplot(silhouette_scores, aes(x = K, y = SilhouetteScore, color = Method)) +
  geom_line() +
  geom_point() +
  ggtitle("Scores de silhouette pour différentes valeurs de K et méthodes de clustering") +
  xlab("Nombre de clusters (K)") +
  ylab("Score moyen de silhouette") +
  theme_minimal() +
  scale_color_brewer(palette = "Set1")

DBSCAN ne prend pas k en entrée, il est donc ici constant.

Il semble que jusqu’a k=9, Kmeans et Hierarchical donnent des résultats similaires en terme de clustering, puis que que Hierarchical prend un avantage ensuite pou environ 0.1 point de plus que Kmeans sur les 6 prochains k testés.

set.seed(42)

library(cluster)  # pour charger la bibliothèque nécessaire
data(mammal.dentition)  # charger les données

# Supprimer la première colonne comme demandé
mammal.data <- mammal.dentition[,-1]  
# Normalisation des données
mammal.scaled <- scale(mammal.data)

# Calcul de la somme des carrés des distances pour différents nombres de clusters
wss <- (nrow(mammal.scaled)-1)*sum(apply(mammal.scaled,2,var))
for (i in 2:10) {
  wss[i] <- sum(kmeans(mammal.scaled, centers=i)$withinss)
}


# Création d'un plot pour visualiser la méthode du coude
plot(1:10, wss, type="b", xlab="Nombre de Clusters", ylab="Somme des carrés des distances intra-cluster",
     main="Méthode du Coude pour le Clustering K-Means")

Par la methode du coude en tuilisant Kmeans, on voit qu’on peut donner k=3, k=6 ou il y coupure de coude, également k=8 même si le coude est concave, mais ce chiffre k=8 revient par la suite donc on le notifie ici.

library(ggplot2)
library(scales)

variance_intra <- function(data, clusters) {
  # Calcul de la moyenne pour chaque cluster et chaque variable
  cluster_means <- aggregate(data, by=list(cluster=clusters), FUN=mean)
  
  # Suppression de la colonne de cluster
  cluster_means <- cluster_means[, -1]

  # Calcul de la variance intra-cluster
  intra_variance_sum <- 0
  num_points <- 0
  for (k in unique(clusters)) {
    cluster_data <- data[clusters == k, ]
    num_points <- num_points + nrow(cluster_data)
    for (col in 1:ncol(cluster_data)) {
      intra_variance_sum <- intra_variance_sum + sum((cluster_data[, col] - cluster_means[k, col])^2)
    }
  }

  # Moyenne de la variance intra-cluster
  intra_variance_sum / (num_points - length(unique(clusters)))
}



# Fonction pour calculer la variance inter-classe
variance_inter <- function(data, clusters) {
  # Supprimer les points de bruit dans DBSCAN, si nécessaire
  data <- data[clusters > 0, ]
  clusters <- clusters[clusters > 0]

  # Calculer la moyenne globale
  global_mean <- colMeans(data)

  # Calculer la moyenne pour chaque cluster
  inter_variance_sum <- 0
  for (k in unique(clusters)) {
    cluster_data <- data[clusters == k, ]
    cluster_mean <- colMeans(cluster_data)
    diff_mean <- cluster_mean - global_mean
    inter_variance_sum <- inter_variance_sum + nrow(cluster_data) * sum(diff_mean^2)
  }

  # Normaliser la variance inter-cluster
  inter_variance_sum / (length(unique(clusters)) - 1)
}


# Calcul des variances pour K-Means
intra_kmeans <- variance_intra(mammal.data, kmeans.result$cluster)
inter_kmeans <- variance_inter(mammal.data, kmeans.result$cluster)

# Calcul des variances pour Clustering Hiérarchique
intra_hclust <- variance_intra(mammal.data, clusters)
inter_hclust <- variance_inter(mammal.data, clusters)

# Calcul des variances pour DBSCAN
intra_dbscan <- variance_intra(mammal.data, dbscan.result$cluster)
inter_dbscan <- variance_inter(mammal.data, dbscan.result$cluster)

# Préparation des données pour le graphique
variance_data <- data.frame(
  Method = c("K-Means", "Hierarchical", "DBSCAN"),
  IntraClusterVariance = c(intra_kmeans, intra_hclust, intra_dbscan),
  InterClusterVariance = c(inter_kmeans, inter_hclust, inter_dbscan)
)

ggplot(variance_data, aes(x = Method)) +
  geom_bar(aes(y = IntraClusterVariance, fill = "Intra-Cluster Variance"), stat = "identity", position = position_dodge()) +
  geom_line(aes(y = InterClusterVariance*max(variance_data$IntraClusterVariance)/max(variance_data$InterClusterVariance), group = 1, color = "Inter-Cluster Variance"), size = 1) +
  geom_point(aes(y = InterClusterVariance*max(variance_data$IntraClusterVariance)/max(variance_data$InterClusterVariance), color = "Inter-Cluster Variance"), size = 3) +
  scale_y_continuous("Variance", sec.axis = sec_axis(~ . * max(variance_data$InterClusterVariance) / max(variance_data$IntraClusterVariance), name = "Scaled Variance")) +
  scale_fill_manual(name = "Variance Type", values = c("Intra-Cluster Variance" = "red")) +
  scale_color_manual(name = "Variance Type", values = c("Inter-Cluster Variance" = "blue")) +
  labs(title = "Intra and Inter-Cluster Variances for Different Clustering Methods") +
  theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Use of `variance_data$IntraClusterVariance` is discouraged.
## ℹ Use `IntraClusterVariance` instead.
## Warning: Use of `variance_data$InterClusterVariance` is discouraged.
## ℹ Use `InterClusterVariance` instead.
## Warning: Use of `variance_data$IntraClusterVariance` is discouraged.
## ℹ Use `IntraClusterVariance` instead.
## Warning: Use of `variance_data$InterClusterVariance` is discouraged.
## ℹ Use `InterClusterVariance` instead.

On a scalé la variance inter sur celle intra (d’ou l’égalité inter et intra poue DBSCAN, car pas la meme echelle comme on peut l’imaginer)

On voit que les variances inter et intra pour Kmeans et Hierarchical sont trés similaires.

Mais, celle inter de DBSCAN écrase les 2 autres. Donc les clusters de DBSCAN sont bien plsu entendu que ceux des autres méthodes.

De plus, la variance inter est plus élévé pour DBSCAN que pour les 2 autres. Donc les centroides inter sont aussi plus eloingés dans DBSCAN.

De pars les variances intra, il semble que Kmeans et hierarchical soient préférable pour des clusters moins étendus.

Maintenant des visualtions de nos données en 2D et 3D selon plusieurs colonnes.

library(ggplot2)
# Choix des deux premières dimensions pour la visualisation

# Exécution de K-means avec 6 clusters
kmeans.result <- kmeans(mammal.scaled, centers = 3)
hclust_result <- hclust(dist(mammal.scaled), method = "ward.D2")

# Découpe du dendrogramme pour obtenir 6 clusters
clusters <- cutree(hclust_result, k = 3)



mammal.plot.data <- as.data.frame(mammal.scaled)
mammal.plot.data$KMeans <- as.factor(kmeans.result$cluster)
mammal.plot.data$Hierarchical <- as.factor(clusters)
mammal.plot.data$DBSCAN <- as.factor(dbscan.result$cluster)

# Vérifier les noms des colonnes de mammal.plot.data
names(mammal.plot.data)
##  [1] "top.i"        "bottom.i"     "top.c"        "bottom.c"     "top.pm"      
##  [6] "bottom.pm"    "top.m"        "bottom.m"     "KMeans"       "Hierarchical"
## [11] "DBSCAN"
DIM1 <- mammal.plot.data$top.i
DIM2 <- mammal.plot.data$bottom.i


# Visualisation K-Means
ggplot(mammal.plot.data, aes(x = DIM1, y = DIM2, color = KMeans)) + 
  geom_point() + 
  labs(title = "K-Means Clustering") + 
  theme_minimal()

# Visualisation Clustering hiérarchique
ggplot(mammal.plot.data, aes(x = DIM1, y = DIM2, color = Hierarchical)) + 
  geom_point() + 
  labs(title = "Hierarchical Clustering") + 
  theme_minimal()

# Visualisation DBSCAN
ggplot(mammal.plot.data, aes(x = DIM1, y = DIM2, color = DBSCAN)) + 
  geom_point() + 
  labs(title = "DBSCAN Clustering") + 
  theme_minimal()

# On voit que pour les 3 méthodes les résulats ne sont pas trés différents, les mêmes clusters semblent revenir, vérifions cela en 3D.

Kmeans

# Installer et charger plotly si nécessaire
if (!require(plotly)) install.packages("plotly")
## Loading required package: plotly
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(plotly)

DIM3 <- mammal.plot.data$top.c

# Visualisation K-Means en 3D
plot_ly(mammal.plot.data, x = ~DIM1, y = ~DIM2, z = ~DIM3, color = ~KMeans, type = 'scatter3d', mode = 'markers')
# Visualisation Clustering hiérarchique en 3D
plot_ly(mammal.plot.data, x = ~DIM1, y = ~DIM2, z = ~DIM3, color = ~Hierarchical, type = 'scatter3d', mode = 'markers')

Les 2 plots sont ici moins similaires qu’il n’y parait, on a les 3 points en bas a droite puis celui du haut est moins net comme cluster.

# Visualisation DBSCAN en 3D
plot_ly(mammal.plot.data, x = ~DIM1, y = ~DIM2, z = ~DIM3, color = ~DBSCAN, type = 'scatter3d', mode = 'markers')

AVEC PCA POUR GARDER LES 3 AXES PRINCIPAUX ET ESPERER MIEUX Y VOIR

On commence par garder les couleurs des cluster précédents

library(ggplot2)
library(plotly)
library(stats)

# Appliquer PCA sur les données normalisées
pca_result <- prcomp(mammal.scaled, center = TRUE, scale. = TRUE)
# Extraire les scores des trois premières composantes principales
mammal.pca <- as.data.frame(pca_result$x[, 1:3])

# Ajouter les résultats des clusters au jeu de données PCA
mammal.pca$KMeans <- as.factor(kmeans.result$cluster)
mammal.pca$Hierarchical <- as.factor(clusters)
mammal.pca$DBSCAN <- as.factor(dbscan.result$cluster)

# Visualisation K-Means en 2D avec PCA
ggplot(mammal.pca, aes(x = PC1, y = PC2, color = KMeans)) + 
  geom_point() + 
  labs(title = "K-Means Clustering with PCA") + 
  theme_minimal()

### Il semble y avoir 2 individus qui ne rentrent pas dans aucun des clusters en haut à droite et en bas à gauche. ### Donc ce sont surement des animaux assez différnents au niveau de la dentition des autres, même si de la même espece.

En plus de cela, on semble voir pour le cluster de 3 points précedent 3 groupes avec un mélange pour un groupe.

library(ggplot2)
library(plotly)
library(stats)

# Appliquer PCA sur les données normalisées
pca_result <- prcomp(mammal.scaled, center = TRUE, scale. = TRUE)
# Extraire les scores des trois premières composantes principales
mammal.pca <- as.data.frame(pca_result$x[, 1:3])

# Appliquer K-means avec 3 clusters
kmeans_result_3 <- kmeans(mammal.scaled, centers = 3)

# Ajouter les résultats des clusters au jeu de données PCA
mammal.pca$KMeans <- as.factor(kmeans_result_3$cluster)
# Assurez-vous que les résultats des autres méthodes de clustering sont également disponibles
mammal.pca$Hierarchical <- as.factor(clusters)
mammal.pca$DBSCAN <- as.factor(dbscan.result$cluster)

# Visualisation K-Means en 2D avec PCA
ggplot(mammal.pca, aes(x = PC1, y = PC2, color = KMeans)) + 
  geom_point() + 
  labs(title = "K-Means Clustering with PCA (k = 3)") + 
  theme_minimal()

En refaisant Kmeans sur les données PCA, on voit que les clusters sont presque les mêmes, il n’y a pas beaucoup de changement du au PCA.

# Visualisation Clustering hiérarchique en 2D avec PCA
ggplot(mammal.pca, aes(x = PC1, y = PC2, color = Hierarchical)) + 
  geom_point() + 
  labs(title = "Hierarchical Clustering with PCA") + 
  theme_minimal()

# Visualisation DBSCAN en 2D avec PCA
ggplot(mammal.pca, aes(x = PC1, y = PC2, color = DBSCAN)) + 
  geom_point() + 
  labs(title = "DBSCAN Clustering with PCA") + 
  theme_minimal()

Ici, on remarque que DBSCAN marche bien moins avec PCA que les 2 autres. Ce qui est cohérent avec le fait que les variances inter et intra sont plus haut nettement pour cette méthode.

# Visualisation K-Means en 3D avec PCA
plot_ly(mammal.pca, x = ~PC1, y = ~PC2, z = ~PC3, color = ~KMeans, type = 'scatter3d', mode = 'markers')

Ici, on voit mieux les 3 clusters

# Visualisation Clustering hiérarchique en 3D avec PCA
plot_ly(mammal.pca, x = ~PC1, y = ~PC2, z = ~PC3, color = ~Hierarchical, type = 'scatter3d', mode = 'markers')

Resultat pour k=6 pour Hierarchical, on voit que il est difficile de juger selon la valeur de k.

# Visualisation DBSCAN en 3D avec PCA
plot_ly(mammal.pca, x = ~PC1, y = ~PC2, z = ~PC3, color = ~DBSCAN, type = 'scatter3d', mode = 'markers')

Encore une fois, pour DBSCAN, le résultat est bien moins bon.

# Tracer le graphique de l'inertie cumulée pour PCA
pca_var <- pca_result$sdev^2
pca_var_percent <- pca_var / sum(pca_var)
pca_cum_var_percent <- cumsum(pca_var_percent)

plot(1:length(pca_var_percent), pca_cum_var_percent, xlab = "Nombre de composantes principales", 
     ylab = "Variance expliquée cumulée", type = "b", pch = 19, frame = FALSE, 
     main = "Variance expliquée cumulée par PCA")
abline(h = 0.9, col = "red", lty = 2)  # Ligne pour le seuil de variance expliquée cumulée souhaité

## On ne voit pas de coude dans la courbe des inerties cumulées, mais en tout cas pour 3 composantes principales, on a plus de 90% de l’inertie expliquée ce qui est déjà trés bien.

On retest la méthode du coude avec les données PCA pour voir si un nombre de cluster k apparait plus clairement

La réponse est non et c’est même pire car on a une courbe plutôt regulière sans coude, ou alors on peut voir k=5 en forcant le trait.

set.seed(42)  # Pour la reproductibilité

library(cluster)
# Supposons que les données mammal.dentition sont déjà chargées et que la première colonne a été supprimée.
mammal.data <- mammal.dentition[,-1]  
# Normalisation des données
mammal.scaled <- scale(mammal.data)

# Appliquer PCA sur les données normalisées
pca_result <- prcomp(mammal.scaled)
# Conserver uniquement les trois premières composantes principales
mammal.pca <- pca_result$x[, 1:3]

# Calculer la somme des carrés des distances pour K-Means sur les données réduites par PCA
wss_pca <- numeric(10)
wss_pca[1] <- sum(mammal.pca^2)  # WSS pour le clustering à un seul cluster est juste la somme des carrés de toutes les données
for (i in 2:10) {
  set.seed(42)  # Réinitialiser le seed avant chaque boucle pour la reproductibilité
  kmeans.result.pca <- kmeans(mammal.pca, centers=i, nstart=25)
  wss_pca[i] <- sum(kmeans.result.pca$withinss)
}

# Création d'un plot pour visualiser la méthode du coude avec les données réduites par PCA
plot(1:10, wss_pca, type="b", xlab="Nombre de Clusters", ylab="Somme des carrés des distances intra-cluster",
     main="Méthode du Coude pour le Clustering K-Means avec PCA")

Maintenant on va comparer les résutats qu’on obtient pour différentes distances

# pour kcca qui permet différentes distances
if (!require(flexclust)) {
    install.packages("flexclust")
    library(flexclust)
}
## Loading required package: flexclust
## Loading required package: grid
## Loading required package: lattice
## Loading required package: modeltools
## Loading required package: stats4
library(flexclust)
library(ggplot2)

set.seed(42)
data(mammal.dentition)
mammal.data <- mammal.dentition[,-1]
mammal.scaled <- scale(mammal.data)

# Liste des distances à comparer
distances <- c("kmeans", "angle", "kmedians")  # euclidean pour kmeans, angle pour approximation de cosinus

wss_results <- list()

dist = distances[1]
wss <- numeric(10)
for (k in 2:10) {
    cl <- kcca(mammal.scaled, k, family=kccaFamily(dist))
    size <- table(cl@cluster)
    centers <- cl@centers
    withinss <- numeric(k)
    
    for (j in 1:k) {
        # S'assurer que les données sélectionnées sont toujours une matrice
        cluster_points <- mammal.scaled[cl@cluster == j, , drop = FALSE]
        withinss[j] <- sum(rowSums((cluster_points - centers[j,])^2))
    }
    
    wss[k] <- sum(withinss)
}
wss_results[[dist]] <- wss

# Créer un plot pour visualiser la méthode du coude pour chaque distance
plot(1:10, wss, type="b", xlab="Nombre de Clusters", ylab="Somme des carrés des distances intra-cluster",
     main=paste("Méthode du Coude pour le Clustering K-Means avec la distance", dist))

Ce qui donne k=2 ici et pour les autres distancs, ce qui n’est pas cohérent, cette méthode de variance intra n’aboutie pas, la méthode prochaine de score silouette est meilleur en terme de résultat.

dist = distances[2]
wss <- numeric(10)
for (k in 2:10) {
    cl <- kcca(mammal.scaled, k, family=kccaFamily(dist))
    size <- table(cl@cluster)
    centers <- cl@centers
    withinss <- numeric(k)
    
    for (j in 1:k) {
        # S'assurer que les données sélectionnées sont toujours une matrice
        cluster_points <- mammal.scaled[cl@cluster == j, , drop = FALSE]
        withinss[j] <- sum(rowSums((cluster_points - centers[j,])^2))
    }
    
    wss[k] <- sum(withinss)
}
wss_results[[dist]] <- wss

# Créer un plot pour visualiser la méthode du coude pour chaque distance
plot(1:10, wss, type="b", xlab="Nombre de Clusters", ylab="Somme des carrés des distances intra-cluster",
     main=paste("Méthode du Coude pour le Clustering K-Means avec la distance", dist))

dist = distances[3]
wss <- numeric(10)
for (k in 2:10) {
    cl <- kcca(mammal.scaled, k, family=kccaFamily(dist))
    size <- table(cl@cluster)
    centers <- cl@centers
    withinss <- numeric(k)
    
    for (j in 1:k) {
        # S'assurer que les données sélectionnées sont toujours une matrice
        cluster_points <- mammal.scaled[cl@cluster == j, , drop = FALSE]
        withinss[j] <- sum(rowSums((cluster_points - centers[j,])^2))
    }
    
    wss[k] <- sum(withinss)
}
wss_results[[dist]] <- wss

# Créer un plot pour visualiser la méthode du coude pour chaque distance
plot(1:10, wss, type="b", xlab="Nombre de Clusters", ylab="Somme des carrés des distances intra-cluster",
     main=paste("Méthode du Coude pour le Clustering K-Means avec la distance", dist))

On ne retrouve absolumnt pas des résulats cohérents avec la partie précédente. Ici il semble clairement que k=2,

Or ici on a du coder nous même le plot et il y a surement une erreur, bien qu’il ne me semble pas…

 library(cluster)

silhouette_scores <- data.frame()

for (dist in distances) {
    for (k in 3:15) {
        set.seed(42)
        cl <- kcca(mammal.scaled, k, family=kccaFamily(dist))
        clusters <- cl@cluster

        # Calcul du score de silhouette pour chaque point de données
        silhouette_values <- silhouette(clusters, dist(mammal.scaled, method = "euclidean"))
        mean_silhouette_score <- mean(silhouette_values[, "sil_width"])
        
        silhouette_scores <- rbind(silhouette_scores, data.frame(
            K = k,
            Distance = dist,
            SilhouetteScore = mean_silhouette_score
        ))
    }
}

# Créer un graphique pour comparer les scores de silhouette
ggplot(silhouette_scores, aes(x = K, y = SilhouetteScore, color = Distance)) +
    geom_line() +
    geom_point() +
    ggtitle("Scores de silhouette pour différentes valeurs de K et méthodes de clustering") +
    xlab("Nombre de clusters (K)") +
    ylab("Score moyen de silhouette") +
    theme_minimal() +
    scale_color_brewer(palette = "Set1")

Le score silhouette lui semble donner k=7 ou k=12 pour les 3 distances

library(ggplot2)
library(plotly)

# Appliquer PCA pour réduire la dimensionnalité
pca_result <- prcomp(mammal.scaled)
mammal.pca <- pca_result$x[, 1:3]

dist = distances[1]
set.seed(42)
cl <- kcca(mammal.pca, k=4, family=kccaFamily(dist))  # Exemple avec k=4

mammal.plot.data <- as.data.frame(mammal.pca)
mammal.plot.data$Cluster <- as.factor(cl@cluster)

# Visualisation en 2D avec ggplot2
p2d <- ggplot(mammal.plot.data, aes(x = PC1, y = PC2, color = Cluster)) + 
    geom_point() + 
    labs(title = paste("Clustering en 2D : distance", dist)) +
    theme_minimal()
print(p2d)  # Utilisation de print pour afficher le graphique ggplot2

# Visualisation en 3D avec plotly
p3d <- plot_ly(mammal.plot.data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~Cluster, type = 'scatter3d', mode = 'markers') %>%
    layout(title = paste("Clustering en 3D : distance", dist))
print(p3d)  # Utilisation de print pour afficher le graphique plotly
dist = distances[2]
set.seed(42)
cl <- kcca(mammal.pca, k=4, family=kccaFamily(dist))  # Exemple avec k=4

mammal.plot.data <- as.data.frame(mammal.pca)
mammal.plot.data$Cluster <- as.factor(cl@cluster)

# Visualisation en 2D avec ggplot2
p2d <- ggplot(mammal.plot.data, aes(x = PC1, y = PC2, color = Cluster)) + 
    geom_point() + 
    labs(title = paste("Clustering en 2D : distance", dist)) +
    theme_minimal()
print(p2d)  # Utilisation de print pour afficher le graphique ggplot2

# Visualisation en 3D avec plotly
p3d <- plot_ly(mammal.plot.data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~Cluster, type = 'scatter3d', mode = 'markers') %>%
    layout(title = paste("Clustering en 3D : distance", dist))
print(p3d)  # Utilisation de print pour afficher le graphique plotly
dist = distances[3]
set.seed(42)
cl <- kcca(mammal.pca, k=4, family=kccaFamily(dist))  # Exemple avec k=4

mammal.plot.data <- as.data.frame(mammal.pca)
mammal.plot.data$Cluster <- as.factor(cl@cluster)

# Visualisation en 2D avec ggplot2
p2d <- ggplot(mammal.plot.data, aes(x = PC1, y = PC2, color = Cluster)) + 
    geom_point() + 
    labs(title = paste("Clustering en 2D : distance", dist)) +
    theme_minimal()
print(p2d)  # Utilisation de print pour afficher le graphique ggplot2

# Visualisation en 3D avec plotly
p3d <- plot_ly(mammal.plot.data, x = ~PC1, y = ~PC2, z = ~PC3, color = ~Cluster, type = 'scatter3d', mode = 'markers') %>%
    layout(title = paste("Clustering en 3D : distance", dist))
print(p3d)  # Utilisation de print pour afficher le graphique plotly

On voit que Kmeans et Kmedian donnent des résulats quasi similaires, et la distance sur les angles mélange un cluster à un autre en plus.

On comprend cela car ici la medianne vaut presque la moyenne donc on pouvait s’attendre à une distance quasi identique.

QUESTION 2

Voici les animaux à classer à la main

print(mammal.dentition$name)
##  [1] "Opossum"         "Hairy tail mole" "Common mole"     "Star nose mole" 
##  [5] "Brown bat"       "Silver hair bat" "Pigmy bat"       "House bat"      
##  [9] "Red bat"         "Hoary bat"       "Lump nose bat"   "Armadillo"      
## [13] "Pika"            "Snowshoe rabbit" "Beaver"          "Marmot"         
## [17] "Groundhog"       "Prairie Dog"     "Ground Squirrel" "Chipmunk"       
## [21] "Gray squirrel"   "Fox squirrel"    "Pocket gopher"   "Kangaroo rat"   
## [25] "Pack rat"        "Field mouse"     "Muskrat"         "Black rat"      
## [29] "House mouse"     "Porcupine"       "Guinea pig"      "Coyote"         
## [33] "Wolf"            "Fox"             "Bear"            "Civet cat"      
## [37] "Raccoon"         "Marten"          "Fisher"          "Weasel"         
## [41] "Mink"            "Ferrer"          "Wolverine"       "Badger"         
## [45] "Skunk"           "River otter"     "Sea otter"       "Jaguar"         
## [49] "Ocelot"          "Cougar"          "Lynx"            "Fur seal"       
## [53] "Sea lion"        "Walrus"          "Grey seal"       "Elephant seal"  
## [57] "Peccary"         "Elk"             "Deer"            "Moose"          
## [61] "Reindeer"        "Antelope"        "Bison"           "Mountain goat"  
## [65] "Musk ox"         "Mountain sheep"

Voici une classification possible selon la classe d’animal :

Ce qui nous donne k=7

Mais il y a beaucoup de possibilité et cette classification est trés arbitraire, il ne me semble pas y avoir de k parfait.

Cela donne :

0 : Mammifères Volants 1 : Mammifères Fossoriaux (Creuseurs) 2 : Rongeurs 3 : Mammifères de Petite Taille Terrestres 4 : Carnivores Terrestres 5 : Mammifères de Grande Taille Terrestres 6 : Mammifères Aquatiques ou Semi-Aquatiques

mammal_data <- mammal.dentition


# Définir la correspondance entre les noms d'animaux et les identifiants numériques de catégorie
categories <- c(
    # Mammifères Volants
    "Brown bat" = 0, "Silver hair bat" = 0, "Pigmy bat" = 0, "House bat" = 0, "Red bat" = 0, "Hoary bat" = 0, "Lump nose bat" = 0,
    
    # Mammifères Fossoriaux (Creuseurs)
    "Hairy tail mole" = 1, "Common mole" = 1, "Star nose mole" = 1, "Ground Squirrel" = 1, "Pocket gopher" = 1, "Kangaroo rat" = 1,

    # Rongeurs
    "Field mouse" = 2, "Muskrat" = 2, "Black rat" = 2, "House mouse" = 2, "Beaver" = 2, "Marmot" = 2, "Groundhog" = 2, "Prairie Dog" = 2, "Chipmunk" = 2, "Gray squirrel" = 2, "Fox squirrel" = 2, "Pack rat" = 2, "Guinea pig" = 2,
    
    # Mammifères de Petite Taille Terrestres
    "Opossum" = 3, "Pika" = 3, "Snowshoe rabbit" = 3, "Porcupine" = 3,
    
    # Carnivores Terrestres
    "Coyote" = 4, "Wolf" = 4, "Fox" = 4, "Bear" = 4, "Civet cat" = 4, "Raccoon" = 4, "Marten" = 4, "Fisher" = 4, "Weasel" = 4, "Mink" = 4, "Ferrer" = 4, "Wolverine" = 4, "Badger" = 4, "Skunk" = 4, "River otter" = 4, "Sea otter" = 4, "Jaguar" = 4, "Ocelot" = 4, "Cougar" = 4, "Lynx" = 4,
    
    # Mammifères de Grande Taille Terrestres
    "Peccary" = 5, "Elk" = 5, "Deer" = 5, "Moose" = 5, "Reindeer" = 5, "Antelope" = 5, "Bison" = 5, "Mountain goat" = 5, "Musk ox" = 5, "Mountain sheep" = 5, "Armadillo" = 5,
    
    # Mammifères Aquatiques ou Semi-Aquatiques
    "Fur seal" = 6, "Sea lion" = 6, "Walrus" = 6, "Grey seal" = 6, "Elephant seal" = 6
)

# Assigner les catégories numériques en utilisant le vecteur 'categories'
mammal_data$category_id <- sapply(mammal_data$name, function(name) categories[name])

# Vérifier les données
mammal_data$category_id
##  [1] 3 1 1 1 0 0 0 0 0 0 0 5 3 3 2 2 2 2 1 2 2 2 1 1 2 2 2 2 2 3 2 4 4 4 4 4 4 4
## [39] 4 4 4 4 4 4 4 4 4 4 4 4 4 6 6 6 6 6 5 5 5 5 5 5 5 5 5 5

Visualisation de notre classification manuelle

library(ggplot2)
library(plotly)

# Sélectionner les trois premières colonnes pour la visualisation
mammal_plot_data <- mammal_data[, 2:4]
mammal_plot_data$Category <- as.factor(mammal_data$category_id)

# Donner des noms aux colonnes pour la clarté
names(mammal_plot_data) <- c("V1", "V2", "V3", "Category")

# Visualisation en 2D avec les données sélectionnées
ggplot(mammal_plot_data, aes(x = V1, y = V2, color = Category)) + 
  geom_point() + 
  labs(title = "Classification Manuelle en 2D") + 
  theme_minimal()

# Visualisation en 3D avec les données sélectionnées
plot_ly(mammal_plot_data, x = ~V1, y = ~V2, z = ~V3, color = ~Category, type = 'scatter3d', mode = 'markers') %>%
  layout(title = "Classification Manuelle en 3D")

Ces resulats sont pas proches de ceux obtenus en première partie, donc notre classification à la main est peut-être (surement) hasardeuse.

library(ggplot2)
library(plotly)
library(scales)


# Normaliser (mise à l'échelle) les trois premières colonnes
mammal_scaled <- scale(mammal_data[, 2:4])

# Créer un dataframe pour la visualisation
mammal_plot_data <- as.data.frame(mammal_scaled)
mammal_plot_data$Category <- as.factor(mammal_data$category_id)

# Nommer les colonnes pour la clarté
names(mammal_plot_data) <- c("V1", "V2", "V3", "Category")

# Visualisation en 2D avec les données normalisées
ggplot(mammal_plot_data, aes(x = V1, y = V2, color = Category)) + 
  geom_point() + 
  labs(title = "Classification Manuelle avec Données Normalisées en 2D") + 
  theme_minimal()

# Visualisation en 3D avec les données normalisées
plot_ly(mammal_plot_data, x = ~V1, y = ~V2, z = ~V3, color = ~Category, type = 'scatter3d', mode = 'markers') %>%
  layout(title = "Classification Manuelle avec Données Normalisées en 3D")

On refait sur d’autres colonnes ( 4,5 et 6)

library(ggplot2)
library(plotly)

# Supposons que mammal_data est déjà chargé et contient une colonne category_id

# Normaliser les colonnes spécifiques
mammal_scaled <- scale(mammal_data[, c(4, 5, 6)])

# Créer un dataframe pour la visualisation
mammal_plot_data <- as.data.frame(mammal_scaled)
mammal_plot_data$Category <- as.factor(mammal_data$category_id)

# Nommer les colonnes pour la clarté
names(mammal_plot_data) <- c("V1", "V2", "V3", "Category")


# Visualisation en 3D avec les données normalisées
fig <- plot_ly(mammal_plot_data, x = ~V1, y = ~V2, z = ~V3, color = ~Category, type = 'scatter3d', mode = 'markers')
fig <- fig %>% layout(title = "Classification Manuelle avec Données Normalisées en 3D")
fig

Même commentaire que pour précédemment. On peut ajouter qu’il est difficile de voit visuellement les cluster car par exemple la colonne 3 prend soit 0 soit 1 comme valeur, et donc cela creer un “faux” cluster.

library(class)
library(caret)

# Supposons que mammal_data est votre dataframe et qu'il est déjà chargé
# Assurez-vous que mammal_data contient les bonnes colonnes pour l'entraînement

# Supprimer la colonne 'name' si elle existe
mammal_data$name <- NULL

# Diviser les données en ensembles d'entraînement et de test
set.seed(123) # Pour la reproductibilité
index <- createDataPartition(mammal_data$category_id, p = 0.8, list = FALSE)
train_data <- mammal_data[index, ]
test_data <- mammal_data[-index, ]

# Séparer les étiquettes de classe
train_labels <- train_data$category_id
test_labels <- test_data$category_id

# Supprimer la colonne des étiquettes de classe des données d'entraînement et de test
train_data$category_id <- NULL
test_data$category_id <- NULL

# Assurez-vous que train_labels et test_labels ont les mêmes niveaux
train_labels_factor <- factor(train_labels, levels = sort(unique(c(train_labels, test_labels))))
test_labels_factor <- factor(test_labels, levels = levels(train_labels_factor))

# Entraîner le modèle KNN
knn_model <- knn(train = train_data, test = test_data, cl = train_labels_factor, k = 6)

# Construire la matrice de confusion
conf_matrix <- table(Predicted = knn_model, Actual = test_labels_factor)

# Afficher la matrice de confusion
print(conf_matrix)
##          Actual
## Predicted 0 1 2 3 4 5 6
##         0 2 0 0 0 0 0 0
##         1 0 0 0 0 0 0 0
##         2 0 0 2 1 0 0 0
##         3 0 0 0 0 0 0 0
##         4 0 1 0 1 2 0 1
##         5 0 0 0 0 0 2 0
##         6 0 0 0 0 0 0 0
# Calculer les métriques à partir de la matrice de confusion
metrics <- confusionMatrix(as.factor(knn_model), test_labels_factor)

# Afficher les métriques
print(metrics)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 0 1 2 3 4 5 6
##          0 2 0 0 0 0 0 0
##          1 0 0 0 0 0 0 0
##          2 0 0 2 1 0 0 0
##          3 0 0 0 0 0 0 0
##          4 0 1 0 1 2 0 1
##          5 0 0 0 0 0 2 0
##          6 0 0 0 0 0 0 0
## 
## Overall Statistics
##                                           
##                Accuracy : 0.6667          
##                  95% CI : (0.3489, 0.9008)
##     No Information Rate : 0.1667          
##     P-Value [Acc > NIR] : 0.0001555       
##                                           
##                   Kappa : 0.6             
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: 0 Class: 1 Class: 2 Class: 3 Class: 4 Class: 5
## Sensitivity            1.0000  0.00000   1.0000   0.0000   1.0000   1.0000
## Specificity            1.0000  1.00000   0.9000   1.0000   0.7000   1.0000
## Pos Pred Value         1.0000      NaN   0.6667      NaN   0.4000   1.0000
## Neg Pred Value         1.0000  0.91667   1.0000   0.8333   1.0000   1.0000
## Prevalence             0.1667  0.08333   0.1667   0.1667   0.1667   0.1667
## Detection Rate         0.1667  0.00000   0.1667   0.0000   0.1667   0.1667
## Detection Prevalence   0.1667  0.00000   0.2500   0.0000   0.4167   0.1667
## Balanced Accuracy      1.0000  0.50000   0.9500   0.5000   0.8500   1.0000
##                      Class: 6
## Sensitivity           0.00000
## Specificity           1.00000
## Pos Pred Value            NaN
## Neg Pred Value        0.91667
## Prevalence            0.08333
## Detection Rate        0.00000
## Detection Prevalence  0.00000
## Balanced Accuracy     0.50000

On a peu de data test 12, ce qui n’est pas incroyable. 80% train 20% test.

On a tout de même 75% d’accuracy, ce qui nous parait enorme sachant que dans la suite on verra qu’on a du mal a trouver un nombre k.

QUESTION 3 : meilleur choix de k

methode du coude avec KNN(k) pour y=WSS

library(cluster)
library(ggplot2)

# Supposons que mammal_data est votre dataframe

# Normaliser les données
mammal_scaled <- scale(mammal.data)  # Modifier selon les colonnes pertinentes

# Calcul de la somme des carrés des distances pour différents nombres de clusters
wss <- (nrow(mammal_scaled) - 1) * sum(apply(mammal_scaled, 2, var))
for (i in 2:15) {
  set.seed(123)
  wss[i] <- sum(kmeans(mammal_scaled, centers = i)$withinss)
}

# Créer un data frame pour le plot
elbow_data <- data.frame(Clusters = 1:15, WSS = wss)

# Tracer le graphique
ggplot(elbow_data, aes(x = Clusters, y = WSS)) + 
  geom_line() + 
  geom_point() +
  ggtitle("Méthode du Coude pour le Clustering K-Means") + 
  xlab("Nombre de Clusters") + 
  ylab("Somme des carrés des distances intra-cluster (WSS)")

Avec la méthode du coude qu’on a deja vu, on revient à k=4 ou k=8.

library(cluster)
library(ggplot2)

# Supposons que mammal_data est votre dataframe

# Normaliser les données
mammal_scaled <- scale(mammal.data)  # Modifier selon les colonnes pertinentes

# Initialiser un dataframe pour stocker les scores de silhouette
silhouette_scores <- data.frame()

# Calculer le score de silhouette pour différents nombres de clusters
for (k in 2:15) {
  set.seed(123)
  km_result <- kmeans(mammal_scaled, centers = k)
  silhouette_score <- silhouette(km_result$cluster, dist(mammal_scaled))
  mean_sil_score <- mean(silhouette_score[, "sil_width"])
  
  silhouette_scores <- rbind(silhouette_scores, data.frame(
    k = k,
    silhouette_score = mean_sil_score
  ))
}

# Tracer le graphique
ggplot(silhouette_scores, aes(x = k, y = silhouette_score)) + 
  geom_line() + 
  geom_point() +
  ggtitle("Scores de Silhouette pour différents nombres de clusters") + 
  xlab("Nombre de Clusters") + 
  ylab("Score moyen de Silhouette")

Par la méthode du score de silhouette, on a k=2, k=8 possiblement

Methode hierarchique (ward)

library(cluster)

# Supposons que mammal_data est votre dataframe
# Normaliser les données
mammal_scaled <- scale(mammal_data[, 2:9])  # Assurez-vous que ce sont les colonnes appropriées

# Appliquer le clustering hiérarchique
hc <- hclust(dist(mammal_scaled), method = "ward.D2")

# Créer un dendrogramme
dendrogram <- as.dendrogram(hc)

# Tracer le dendrogramme
plot(dendrogram, main = "Dendrogramme pour le Clustering Hiérarchique")

Ici on peut voir k=10, k=8 ou k = 4 selon qu’on est dur sur le saut ou pas.

Methode hierarchique (Single Linkage)

hc_single <- hclust(dist(mammal_scaled), method = "single")
plot(as.dendrogram(hc_single), main = "Clustering Hiérarchique - Single Linkage")

# ici k=2 ou k=7 de même selon le saut.

methode hierarchique Complete Linkage

hc_complete <- hclust(dist(mammal_scaled), method = "complete")
plot(as.dendrogram(hc_complete), main = "Clustering Hiérarchique - Complete Linkage")

# ici k=7

Methode Average Linkage

hc_average <- hclust(dist(mammal_scaled), method = "average")
plot(as.dendrogram(hc_average), main = "Clustering Hiérarchique - Average Linkage")

ici k = 9

Centroide

hc_centroid <- hclust(dist(mammal_scaled), method = "centroid")
plot(as.dendrogram(hc_centroid), main = "Clustering Hiérarchique - Centroid Method")

ici k = 12

Median

hc_median <- hclust(dist(mammal_scaled), method = "median")
plot(as.dendrogram(hc_median), main = "Clustering Hiérarchique - Median Method")

ici k = 4

Pour conclure, on n’a pas de valeur de k qui se dégage de notre étude, cependant quelques valeurs reviennent trés souvent : 4, 8 et 12, sachant qu’a la main selon les noms des animaux on donne k=6. Surement que les données ne peuvent êtres classées selon ces features.