47700

1_M 26540

42395

3_TB

33990

2_B

43980

3_TB

35010

2_B

3_TB

39450

1_M 27900

32700

2_B

1_M 22100

11.01

13.06

15.44

15.76

11.28

13.17

14.68

18.36

10.31

14.82

9.72

14.15

11.91

11.02

14.11

13.19

11.20

14.04

Variables actives

Variables illustratives qualitatives

(FINITION) et quantitatives (PRIX et

R‐POIDS.PUIS)

2

Fichier de données

Importation, statistiques descriptives et graphiques

#librairie lecture fichier excel

library(xlsReadWrite)

#changement de répertoire

setwd("D:/_Travaux/university/Cours_Universite/Supports_de_cours/Informat

ique/R/Tutoriels/acp")

#chargement des données dans la première feuille de calcul

#première colonne = label des observations

#les données sont dans la première feuille

autos <- read.xls(file="autos_acp_pour_r.xls",rowNames=T,sheet=1)

#qqs vérifications - affichage

print(autos)

#statistiques descriptives

summary(autos)

#nuages de points

pairs(autos)

#partition des données (var. actives et illustratives)

autos.actifs <- autos[,1:6]

autos.illus <- autos[,7:9]

#nombre d'observations

n <- nrow(autos.actifs)

print(n)

0

2

1

0

6

5

7

1

0

6

1

0

7

1

0

4

1

0

0

0

5

2

60

120

160 175

140 170

25000

CYL

PUISS

LONG

LARG

POIDS

V.MAX

FINITION

PRIX

R.POID.PUIS

1500

400

460

800

1300

1.0

2.5

10

16

0

0

5

1

0

6

4

0

0

4

0

0

3

1

0

0

8

5

.

2

0

.

1

6

1

0

1

FINITION est une variable

qualitative. En général, son

introduction dans ce type

de graphique n’est pas très

indiquée. Néanmoins, on

remarquera qu’on peut

parfois en tirer des

informations utiles : par

exemple, ici, selon la

finition, les prix sont

différents.

3

Analyse en composantes principales

Utiliser la procédure « princomp » - Résultats immédiats

#centrage et réduction des données --> cor = T

#calcul des coordonnées factorielles --> scores = T

acp.autos <- princomp(autos.actifs, cor = T, scores = T)

#print

print(acp.autos)

#summary

print(summary(acp.autos))

#quelles les propriétés associées à l'objet ?

print(attributes(acp.autos))

PRINCOMP fournit les écarts‐types associés aux axes. Le carré correspond

aux variances = valeur propres. Nous avons également le pourcentage

cumulé. Avec ATTRIBUTES, nous avons la liste des informations que nous

pourrons exploiter par la suite.

4

Valeurs propres associés aux axes

Calcul, intervalles de confiance et Scree Plot

#obtenir les variances associées aux axes c.-à-d. les valeurs propres

val.propres <- acp.autos$sdev^2

print(val.propres)

#scree plot (graphique des éboulis des valeurs propres)

plot(1:6,val.propres,type="b",ylab="Valeurs

propres",xlab="Composante",main="Scree plot")

#intervalle de confiance des val.propres à 95% (cf.Saporta, page 172)

val.basse <- val.propres exp(-1.96 sqrt(2.0/(n-1)))

val.haute <- val.propres exp(+1.96 sqrt(2.0/(n-1)))

#affichage sous forme de tableau

tableau <- cbind(val.basse,val.propres,val.haute)

colnames(tableau) <- c("B.Inf.","Val.","B.Sup")

print(tableau,digits=3)

Scree plot

s

e

r

p

o

r

p

s

r

u

e

a

V

l

4

3

2

1

0

1

2

3

4

5

6

Composante

Les deux premiers axes traduisent 88%

de l’information disponible. On se rend

compte ici qu’on pouvait s’en tenir

uniquement au premier facteur.

Mais c’est moins pratique pour les

graphiques ; on suspecte aussi un

« effet taille » dans les données. On va

donc conserver les deux premiers

facteurs.

Les intervalles de confiance d’Anderson

ne sont licites que si le nuage de points

est gaussien. On ne l’affiche donc qu’à

tire indicatif (cf. formules page 172 de

Saporta).

5

Cercle des corrélations

Variables actives

#* corrélation variables-facteurs *

c1 <- acp.autos$loadings[,1]*acp.autos$sdev[1]

c2 <- acp.autos$loadings[,2]*acp.autos$sdev[2]

#affichage

correlation <- cbind(c1,c2)

print(correlation,digits=2)

#carrés de la corrélation (cosinus²)

print(correlation^2,digits=2)

#cumul carrés de la corrélation

print(t(apply(correlation^2,1,cumsum)),digits=2)

# cercle des corrélations - variables actives

plot(c1,c2,xlim=c(-1,+1),ylim=c(-1,+1),type="n")

abline(h=0,v=0)

text(c1,c2,labels=colnames(autos.actifs),cex=0.5)

symbols(0,0,circles=1,inches=F,add=T)

Corrélation variables

– facteurs.

Cercle des corrélations.

0

.

1

5

.

0

Carré de la

corrélation.

2

c

0

.

0

.

5

0

-

.

0

1

-

V.MAX

PUISS

CYL

POIDS

LONG

LARG

Carré cumulé. Au

sixième axe, toutes les

valeurs sont égales à 1.

-1.0

-0.5

0.0

c1

0.5

1.0

6

Carte des individus sur les 2 premiers axes

Individus actifs

#l'option "scores" demandé dans princomp est très important ici

plot(acp.autos$scores[,1],acp.autos$scores[,2],type="n",xlab="Comp.1 -

74%",ylab="Comp.2 - 14%")

abline(h=0,v=0)

text(acp.autos$scores[,1],acp.autos$scores[,2],labels=rownames(autos.actifs),cex=0.75)

Carte des individus dans le premier plan factoriel (88% de l’inertie)

%

4

1

-

2

.

p

m

o

C

.

0

2

5

.

1

0

.

1

5

.

0

0

.

0

5

.

0

-

0

.

1

-

5

.

1

-

Alfetta-1.66

Alfasud TI

enault 30

Fiat 132

Taunus-2000

Mazda-9295

Opel-Rekord

Lancia Beta

Toyota Cor

Citroen GS Club

Lada-1300

Datsun-200L

Simca 1300

Princess-1800

Peugeot 504

Rancho

Renault 16 TL

Audi 100

-4

-2

0

2

4

Comp.1 - 74%

7

Carte des individus et des variables

Individus actifs et variables actives

#* représentation simultanée : individus x variables

cf. Lebart et al., pages 46-48

#*

biplot(acp.autos,cex=0.75)

Graphique « BIPLOT »

-4

-2

0

2

4

Alfetta-1.66

Alfasud TI

.

4

0

V.MAX

enault 30

2

.

0

PUISS

CYL

2

.

p

m

o

C

0

.

0

2

.

0

-

4

.

0

-

Fiat 132

Taunus-2000

Mazda-9295

Toyota Corolla

Opel-Rekord

Citroen GS Club

Lancia Beta

Lada-1300

POIDS

Datsun-200L

LONG

LARG

Simca 1300

Princess-1800

Peugeot 504

Rancho

Renault 16 TL

Audi 100

-0.4

-0.2

0.0

0.2

0.4

Comp.1

4

2

0

2

-

4

-

Attention : N’allons surtout pas chercher une quelconque proximité entre les

individus et les variables dans ce graphique. Ce sont les directions qui sont

importantes !!! (cf. principe et formules dans Lebart et al., pages 46 à 48)

8

COSINUS² des individus avec les composantes

Qualité de représentation des individus sur les composantes

#calcul du carré de la distance d'un individu au center de gravité

d2 <- function(x){return(sum(((x-acp.autos$center)/acp.autos$scale)^2))}

#appliquer à l'ensemble des observations

all.d2 <- apply(autos.actifs,1,d2)

#cosinus^2 pour une composante

cos2 <- function(x){return(x^2/all.d2)}

#cosinus^2 pour les composantes retenues (les 2 premières)

all.cos2 <- apply(acp.autos$scores[,1:2],2,cos2)

print(all.cos2)

La somme pour chaque ligne

(individu) vaut 1 si l’on prend

l’ensemble des composantes (les

6 composantes).

Cf formules dans Tenenhaus,

2006 ; page 162.

9

CONTRIBUTION des individus aux composantes

Déterminer les individus qui pèsent le plus dans la définition d’une composante

#contributions à une composante - calcul pour les 2 premières

composantes

all.ctr <- NULL

for (k in 1:2){all.ctr <-

cbind(all.ctr,100.0(1.0/n)(acp.autos$scores[,k]^2)/

(acp.autos$sdev[k]^2))}

print(all.ctr)

La somme pour chaque colonne

(composante) vaut 100.

cf. Saporta, page 175.

Remarque : toutes les

observations ont le même poids

dans notre exemple.

10

Variables quantitatives illustratives

Positionnement dans le cercle des corrélations

#*

#que faut-il penser de PRIX et R.POIS.PUIS ?

#*

#corrélation de chaque var. illustrative avec le premier axe

ma_cor_1 <- function(x){return(cor(x,acp.autos$scores[,1]))}

s1 <- sapply(autos.illus[,2:3],ma_cor_1)

#corrélation de chaque variable illustrative avec le second axe

ma_cor_2 <- function(x){return(cor(x,acp.autos$scores[,2]))}

s2 <- sapply(autos.illus[,2:3],ma_cor_2)

#position sur le cercle

plot(s1,s2,xlim=c(-1,+1),ylim=c(-1,+1),type="n",main="Variables

illustratives",xlab="Comp.1",ylab="Comp.2")

abline(h=0,v=0)

text(s1,s2,labels=colnames(autos.illus[2:3]),cex=1.0)

symbols(0,0,circles=1,inches=F,add=T)

#représentation simultanée (avec les variables actives)

plot(c(c1,s1),c(c2,s2),xlim=c(-1,+1),ylim=c(-1,+1),type="n",main="Variables

illustratives",xlab="Comp.1",ylab="Comp.2")

text(c1,c2,labels=colnames(autos.actifs),cex=0.5)

text(s1,s2,labels=colnames(autos.illus[2:3]),cex=0.75,col="red")

abline(h=0,v=0)

symbols(0,0,circles=1,inches=F,add=T)

Variables illustratives

2

.

p

m

o

C

0

.

1

5

.

0

0

.

0

5

.

0

-

0

.

1

-

V.MAX

PUISS

CYL

PRIX

POIDS

LONG

LARG

La représentation simultanée est

autrement plus instructive.

La forte corrélation entre une

variable illustrative et un axe est

d’autant plus intéressante que la

variable n’a pas participé à la

construction de l’axe.

R.POID.PUIS

-1.0

-0.5

0.0

0.5

1.0

Comp.1

11

Variables qualitatives illustratives

Positionner les groupes associés aux modalités de la variable illustratives

#*

#positionner les modalités de la variable illustrative + calcul des valeurs test

#*

K <- nlevels(autos.illus[,"FINITION"])

var.illus <- unclass(autos.illus[,"FINITION"])

m1 <- c()

m2 <- c()

for (i in 1:K){m1[i] <- mean(acp.autos$scores[var.illus==i,1])}

for (i in 1:K){m2[i] <- mean(acp.autos$scores[var.illus==i,2])}

cond.moyenne <- cbind(m1,m2)

rownames(cond.moyenne) <- levels(autos.illus[,"FINITION"])

print(cond.moyenne)

#graphique

plot(c(acp.autos$scores[,1],m1),c(acp.autos$scores[,2],m2),xlab="Comp.1",ylab="Com

p.2",main="Positionnement var.illus catégorielle",type="n")

abline(h=0,v=0)

text(acp.autos$scores[,1],acp.autos$scores[,2],rownames(autos.actifs),cex=0.5)

text(m1,m2,rownames(cond.moyenne),cex=0.95,col="red")

Positionnement var.illus catégorielle

Alfetta-1.66

Alfasud TI

Renault 30

2

.

p

m

o

C

5

.

1

5

.

0

5

.

0

-

5

.

1

-

Fiat 132

Taunus-2000

Opel-Rekord

3_TB

Mazda-9295

2_B

Lancia Beta

Toyota Coro

Citroen GS Club

1_M

Lada-1300

Datsun-200L

Simca 1300

Princess-1800

Peugeot 504

Rancho

Renault 16 TL

Audi 100

-4

-2

0

2

4

Comp.1

12

Variables qualitatives illustratives

Moyennes conditionnelles et valeurs test

#*

# calcul des valeurs test

#*

#effectifs par modalité

nk <- as.vector(table(var.illus))

#valeur test par composante (les 2 premières)

vt <- NULL

for (j in 1:2){vt <- cbind(vt,cond.moyenne[,j]/sqrt((val.propres[j]/nk)*((n-

nk)/(n-1))))}

#affichage des valeurs

tableau <- cbind(cond.moyenne,vt)

colnames(tableau) <- c("Coord.1","Coord.2","VT.1","VT.2")

print(tableau)

La valeur test essaie de caractériser la

« significativité » de l’écart par rapport à la moyenne

globale.

Cf. Saporta, page 177. On considère qu’il y a un

écartement significatif lorsqu’elle est supérieure, en

valeur absolue, à 2 voire 3.

Dans notre exemple, les véhicules se différencient

véritablement par la FINITION sur le premier axe

factoriel.

13

Individus illustratifs

Positionner des individus n’ayant pas participé à la construction des axes

Comment situer ces deux nouveaux véhicules ?

Modele

PUISS

Peugeot 604

Peugeot 304 S

2664

1288

472

414

136

74

LONG

LARG

CYL

POIDS

V-MAX

177

157

1410

915

180

160

#chargement de la seconde feuille de calcul + vérification

ind.illus <- read.xls(file="autos_acp_pour_r.xls",rowNames=T,sheet=2)

summary(ind.illus)

#centrage et réduction en utilisant les moyennes et écarts-type de l'ACP

ind.scaled <- NULL

for (i in 1:nrow(ind.illus)){ind.scaled <- rbind(ind.scaled,(ind.illus[i,] -

acp.autos$center)/acp.autos$scale)}

print(ind.scaled)

#calcul des coordonnées factorielles (en utilisant les valeurs propres cf. loadings)

produit.scal <- function(x,k){return(sum(x*acp.autos$loadings[,k]))}

ind.coord <- NULL

for (k in 1:2){ind.coord <- cbind(ind.coord,apply(ind.scaled,1,produit.scal,k))}

print(ind.coord)

#* projection des individus actifs ET illustratifs dans le premier plan factoriel

plot(c(acp.autos$scores[,1],ind.coord[,1]),c(acp.autos$scores[,2],ind.coord[,2]),xlim

=c(-6,6),type="n",xlab="Comp.1",ylab="Comp.2")

abline(h=0,v=0)

text(acp.autos$scores[,1],acp.autos$scores[,2],labels=rownames(autos.actifs),cex=0.5)

text(ind.coord[,1],ind.coord[,2],labels=rownames(ind.illus),cex=0.5,col="red")

.

0

2

.

5

1

.

0

1

.

5

0

.

0

0

5

.

0

-

0

.

1

-

5

.

1

-

Alfetta-1.66

Alfasud TI

Peugeot 304 S

Renault 30

Peugeot 604

Fiat 132

Taunus-2000

Mazda-9295

Opel-Rekord

Citroen GS Club

Toyota Corolla

Lancia Beta

Lada-1300

Datsun-200L

Simca 1300

Princess-1800

Peugeot 504

Rancho

Renault 16 TL

Audi 100

.

2

p

m

o

C

Si on connaît un peu les

voitures de ces années

là, tout ça paraît

cohérent. Tant mieux.

-6

-4

-2

0

2

4

6

Comp.1

14

15