Exercice 2

# Chargement du package mlbench
library(mlbench)

# Aide de la fonction mlbench.spirals
?mlbench.spirals

# Utilisation
spir = mlbench.spirals(n=200, cycles=0.75, sd=0.025)
X_a = spir$x
par(pty="s")
plot(X_a)

cl_a = spir$classes
X_b = .025 * t(rbind(rnorm(100), rnorm(100)))
cl_b = rep(3,100)
X = rbind(X_a, X_b)
cl = c(cl_a, cl_b)
par(pty="s")
plot(X, col=cl)

library(ade4)
DX = dist.quant(X,1)

Le choix de la distance euclidienne est cohérent car les deux variables sont quantitives et sans unité car il s’agit de données synthétiques. De plus une normalisation de chaque variable serait inutile car elles sont déjà globalement d’écart-type proche de 1.

par(mfrow=c(2,2))
strategies = c("single", "complete", "average", "ward.D2")
for(strat in strategies)  
  plot(hclust(DX,strat),hang=-1,main=paste(strat))

Au vu des dendrogrammes, on voit que la stratégie du minimum est la seule à présenter un saut très fort du critère. Les stratégies du maximum et de Ward donneraient aussi des partitions équilibrées, mais le saut maximal du critère est moins net. Suivant ce critère du saut maximal, on préfèrerait donc la CAH obtenue par la stratgie du minimum, et on sélectionnerait la parition en 3 classes (saut maximal pour le passage de 3 à 2 classes).

par(mfrow=c(2,2))
strategies = c("single", "complete", "average", "ward.D2")
for(strat in strategies)  
{
  cah = hclust(DX,strat)
  cl_cah = cutree(cah,k=3)
  par(pty="s")
  plot(X,col=cl_cah)
  title(strat)
  print(paste("stratégie ",strat,":"))
  print(table(cl,cl_cah))
}
[1] "stratégie  single :"
   cl_cah
cl    1   2   3
  1   0 100   0
  2 100   0   0
  3   0   0 100
[1] "stratégie  complete :"
   cl_cah
cl    1   2   3
  1  45  34  21
  2  36  23  41
  3   0   0 100
[1] "stratégie  average :"
   cl_cah
cl    1   2   3
  1  64   0  36
  2  59  41   0
  3 100   0   0
[1] "stratégie  ward.D2 :"
   cl_cah
cl    1   2   3
  1  33  37  30
  2  31  45  24
  3   0   0 100

  1. On remarque que la stratégie du minimum donne exactement la même partition que la partition originale, et que c’est la seule. Les partitions obtenues avec les autres stratégies sont peu corrélées avec la partition originale. La stratégie du minimum est donc parfaitement adaptée à ce jeu de données. En effet dans ces données les observations d’une même classe peuvent toujours être reliés par un chemin passant par des observations très proches de la même classe, tandis que les classes elles-mêmes sont séparées les unes des autres par des zones vides. La stratégie du minimum est donc adaptée car elle permet de regrouper de proche en proche les observations: les groupes se forment en incorporant une par une les observations les plus voisines, ce qui peut se voir facilement sur le dendrogramme. En général cette propriété est plutôt considérée comme un défaut de la stratégie du minimum, mais cete exemple montre que ça peut aussi être avantageux.

km = kmeans(X, 3)
cl_km = km$cluster
par(pty="s")
plot(X,col=cl_km)
title("")

print(paste("K-moyennes :"))
[1] "K-moyennes :"
table(cl,cl_km)
   cl_km
cl    1   2   3
  1  32  28  40
  2  47  42  11
  3   0   0 100

On voit que la méthode des K-moyennes ne permet pas de retrouver la partition d’origine ; elle donne une partition ayant peu de recoupement avec la partition d’origine, comme les CAH obtneues avec des stratégies autres que celle du minimum.

  1. Lors de l’étape d’affectation de la méthode des K-moyennes, chaque observation est affectée au centre le plus proche. Dans l’exemple précédent on a 3 classes, donc 3 centres. Les zones du plan qui sont plus proches de chaque centre (c’est-à-dire les frontières géométriques des trois classes) sont donc délimitées par les médiatrices du triangle formé par les trois centres. Par conséquent ces zones sont forcément des secteurs angulaires, et elles ne pourraient donc pas séparer les trois classes pour ces données, du fait de la forme “en spirale” des classes.
LS0tCnRpdGxlOiAiQ29ycmVjdGlvbiBkdSBwYXJ0aWVsLCBleGVyY2ljZSAyIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIGRmX3ByaW50OiBwYWdlZAogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQKICBwZGZfZG9jdW1lbnQ6IGRlZmF1bHQKLS0tCgoKRXhlcmNpY2UgMgotLS0tLS0tLS0tCgoxKQpgYGB7cn0KIyBDaGFyZ2VtZW50IGR1IHBhY2thZ2UgbWxiZW5jaApsaWJyYXJ5KG1sYmVuY2gpCgojIEFpZGUgZGUgbGEgZm9uY3Rpb24gbWxiZW5jaC5zcGlyYWxzCj9tbGJlbmNoLnNwaXJhbHMKCiMgVXRpbGlzYXRpb24Kc3BpciA9IG1sYmVuY2guc3BpcmFscyhuPTIwMCwgY3ljbGVzPTAuNzUsIHNkPTAuMDI1KQpYX2EgPSBzcGlyJHgKcGFyKHB0eT0icyIpCnBsb3QoWF9hKQpjbF9hID0gc3BpciRjbGFzc2VzCmBgYAoyKQpgYGB7cn0KWF9iID0gLjAyNSAqIHQocmJpbmQocm5vcm0oMTAwKSwgcm5vcm0oMTAwKSkpCmNsX2IgPSByZXAoMywxMDApCmBgYAoKMykKYGBge3J9ClggPSByYmluZChYX2EsIFhfYikKY2wgPSBjKGNsX2EsIGNsX2IpCmBgYAoKNCkKYGBge3J9CnBhcihwdHk9InMiKQpwbG90KFgsIGNvbD1jbCkKYGBgCgo1KQpgYGB7cn0KbGlicmFyeShhZGU0KQpEWCA9IGRpc3QucXVhbnQoWCwxKQpgYGAKTGUgY2hvaXggZGUgbGEgZGlzdGFuY2UgZXVjbGlkaWVubmUgZXN0IGNvaMOpcmVudCBjYXIgbGVzIGRldXggdmFyaWFibGVzIHNvbnQgcXVhbnRpdGl2ZXMgZXQgc2FucyB1bml0w6kgY2FyIGlsIHMnYWdpdCBkZSBkb25uw6llcyBzeW50aMOpdGlxdWVzLiBEZSBwbHVzIHVuZSBub3JtYWxpc2F0aW9uIGRlIGNoYXF1ZSB2YXJpYWJsZSBzZXJhaXQgaW51dGlsZSBjYXIgZWxsZXMgc29udCBkw6lqw6AgZ2xvYmFsZW1lbnQgZCfDqWNhcnQtdHlwZSBwcm9jaGUgZGUgMS4KCjYpCmBgYHtyfQpwYXIobWZyb3c9YygyLDIpKQpzdHJhdGVnaWVzID0gYygic2luZ2xlIiwgImNvbXBsZXRlIiwgImF2ZXJhZ2UiLCAid2FyZC5EMiIpCmZvcihzdHJhdCBpbiBzdHJhdGVnaWVzKSAgCiAgcGxvdChoY2x1c3QoRFgsc3RyYXQpLGhhbmc9LTEsbWFpbj1wYXN0ZShzdHJhdCkpCmBgYApBdSB2dSBkZXMgZGVuZHJvZ3JhbW1lcywgb24gdm9pdCBxdWUgbGEgc3RyYXTDqWdpZSBkdSBtaW5pbXVtIGVzdCBsYSBzZXVsZSDDoCBwcsOpc2VudGVyIHVuIHNhdXQgdHLDqHMgZm9ydCBkdSBjcml0w6hyZS4gTGVzIHN0cmF0w6lnaWVzIGR1IG1heGltdW0gZXQgZGUgV2FyZCBkb25uZXJhaWVudCBhdXNzaSBkZXMgcGFydGl0aW9ucyDDqXF1aWxpYnLDqWVzLCBtYWlzIGxlIHNhdXQgbWF4aW1hbCBkdSBjcml0w6hyZSBlc3QgbW9pbnMgbmV0LgpTdWl2YW50IGNlIGNyaXTDqHJlIGR1IHNhdXQgbWF4aW1hbCwgb24gcHLDqWbDqHJlcmFpdCBkb25jIGxhIENBSCBvYnRlbnVlIHBhciBsYSBzdHJhdGdpZSBkdSBtaW5pbXVtLCBldCBvbiBzw6lsZWN0aW9ubmVyYWl0IGxhIHBhcml0aW9uIGVuIDMgY2xhc3NlcyAoc2F1dCBtYXhpbWFsIHBvdXIgbGUgcGFzc2FnZSBkZSAzIMOgIDIgY2xhc3NlcykuCgo3KQpgYGB7cn0KcGFyKG1mcm93PWMoMiwyKSkKc3RyYXRlZ2llcyA9IGMoInNpbmdsZSIsICJjb21wbGV0ZSIsICJhdmVyYWdlIiwgIndhcmQuRDIiKQpmb3Ioc3RyYXQgaW4gc3RyYXRlZ2llcykgIAp7CiAgY2FoID0gaGNsdXN0KERYLHN0cmF0KQogIGNsX2NhaCA9IGN1dHJlZShjYWgsaz0zKQogIHBhcihwdHk9InMiKQogIHBsb3QoWCxjb2w9Y2xfY2FoKQogIHRpdGxlKHN0cmF0KQogIHByaW50KHBhc3RlKCJzdHJhdMOpZ2llICIsc3RyYXQsIjoiKSkKICBwcmludCh0YWJsZShjbCxjbF9jYWgpKQp9CmBgYAo4KSBPbiByZW1hcnF1ZSBxdWUgbGEgc3RyYXTDqWdpZSBkdSBtaW5pbXVtIGRvbm5lIGV4YWN0ZW1lbnQgbGEgbcOqbWUgcGFydGl0aW9uIHF1ZSBsYSBwYXJ0aXRpb24gb3JpZ2luYWxlLCBldCBxdWUgYydlc3QgbGEgc2V1bGUuIExlcyBwYXJ0aXRpb25zIG9idGVudWVzIGF2ZWMgbGVzIGF1dHJlcyBzdHJhdMOpZ2llcyBzb250IHBldSBjb3Jyw6lsw6llcyBhdmVjIGxhIHBhcnRpdGlvbiBvcmlnaW5hbGUuCkxhIHN0cmF0w6lnaWUgZHUgbWluaW11bSBlc3QgZG9uYyBwYXJmYWl0ZW1lbnQgYWRhcHTDqWUgw6AgY2UgamV1IGRlIGRvbm7DqWVzLiBFbiBlZmZldCBkYW5zIGNlcyBkb25uw6llcyBsZXMgb2JzZXJ2YXRpb25zIGQndW5lIG3Dqm1lIGNsYXNzZSBwZXV2ZW50IHRvdWpvdXJzIMOqdHJlIHJlbGnDqXMgcGFyIHVuIGNoZW1pbiBwYXNzYW50IHBhciBkZXMgb2JzZXJ2YXRpb25zIHRyw6hzIHByb2NoZXMgZGUgbGEgbcOqbWUgY2xhc3NlLCB0YW5kaXMgcXVlIGxlcyBjbGFzc2VzIGVsbGVzLW3Dqm1lcyBzb250IHPDqXBhcsOpZXMgbGVzIHVuZXMgZGVzIGF1dHJlcyBwYXIgZGVzIHpvbmVzIHZpZGVzLiBMYSBzdHJhdMOpZ2llIGR1IG1pbmltdW0gZXN0IGRvbmMgYWRhcHTDqWUgY2FyIGVsbGUgcGVybWV0IGRlIHJlZ3JvdXBlciBkZSBwcm9jaGUgZW4gcHJvY2hlIGxlcyBvYnNlcnZhdGlvbnM6IGxlcyBncm91cGVzIHNlIGZvcm1lbnQgZW4gaW5jb3Jwb3JhbnQgdW5lIHBhciB1bmUgbGVzIG9ic2VydmF0aW9ucyBsZXMgcGx1cyB2b2lzaW5lcywgY2UgcXVpIHBldXQgc2Ugdm9pciBmYWNpbGVtZW50IHN1ciBsZSBkZW5kcm9ncmFtbWUuIEVuIGfDqW7DqXJhbCBjZXR0ZSBwcm9wcmnDqXTDqSBlc3QgcGx1dMO0dCBjb25zaWTDqXLDqWUgY29tbWUgdW4gZMOpZmF1dCBkZSBsYSBzdHJhdMOpZ2llIGR1IG1pbmltdW0sIG1haXMgY2V0ZSBleGVtcGxlIG1vbnRyZSBxdWUgw6dhIHBldXQgYXVzc2kgw6p0cmUgYXZhbnRhZ2V1eC4KCjkpCmBgYHtyfQprbSA9IGttZWFucyhYLCAzKQpjbF9rbSA9IGttJGNsdXN0ZXIKcGFyKHB0eT0icyIpCnBsb3QoWCxjb2w9Y2xfa20pCnRpdGxlKCIiKQpwcmludChwYXN0ZSgiSy1tb3llbm5lcyA6IikpCnRhYmxlKGNsLGNsX2ttKQpgYGAKCk9uIHZvaXQgcXVlIGxhIG3DqXRob2RlIGRlcyBLLW1veWVubmVzIG5lIHBlcm1ldCBwYXMgZGUgcmV0cm91dmVyIGxhIHBhcnRpdGlvbiBkJ29yaWdpbmUgOyBlbGxlIGRvbm5lIHVuZSBwYXJ0aXRpb24gYXlhbnQgcGV1IGRlIHJlY291cGVtZW50IGF2ZWMgbGEgcGFydGl0aW9uIGQnb3JpZ2luZSwgY29tbWUgbGVzIENBSCBvYnRuZXVlcyBhdmVjIGRlcyBzdHJhdMOpZ2llcyBhdXRyZXMgcXVlIGNlbGxlIGR1IG1pbmltdW0uCgoxMCkKTG9ycyBkZSBsJ8OpdGFwZSBkJ2FmZmVjdGF0aW9uIGRlIGxhIG3DqXRob2RlIGRlcyBLLW1veWVubmVzLCBjaGFxdWUgb2JzZXJ2YXRpb24gZXN0IGFmZmVjdMOpZSBhdSBjZW50cmUgbGUgcGx1cyBwcm9jaGUuIERhbnMgbCdleGVtcGxlIHByw6ljw6lkZW50IG9uIGEgMyBjbGFzc2VzLCBkb25jIDMgY2VudHJlcy4gTGVzIHpvbmVzIGR1IHBsYW4gcXVpIHNvbnQgcGx1cyBwcm9jaGVzIGRlIGNoYXF1ZSBjZW50cmUgKGMnZXN0LcOgLWRpcmUgbGVzIGZyb250acOocmVzIGfDqW9tw6l0cmlxdWVzIGRlcyB0cm9pcyBjbGFzc2VzKSBzb250IGRvbmMgZMOpbGltaXTDqWVzIHBhciBsZXMgbcOpZGlhdHJpY2VzIGR1IHRyaWFuZ2xlIGZvcm3DqSBwYXIgbGVzIHRyb2lzIGNlbnRyZXMuIFBhciBjb25zw6lxdWVudCBjZXMgem9uZXMgc29udCBmb3Jjw6ltZW50IGRlcyBzZWN0ZXVycyBhbmd1bGFpcmVzLCBldCBlbGxlcyBuZSBwb3VycmFpZW50IGRvbmMgcGFzIHPDqXBhcmVyIGxlcyB0cm9pcyBjbGFzc2VzIHBvdXIgY2VzIGRvbm7DqWVzLCBkdSBmYWl0IGRlIGxhIGZvcm1lICJlbiBzcGlyYWxlIiBkZXMgY2xhc3Nlcy4KCg==