Solutions des TPs
651
8.11- Dunsurs <- diag(1/sqrt(diag(S)))
8.12- Z <- Xpoint% * %Dunsurs
8.13- t(Z)% * %Z/n
(R <- cor(X))
8.14- Lambda <- diag(eigen(R)$values)
W <- eigen(R,symmetric=TRUE)$vectors
8.15- theta <- seq(0,2 * pi,.05)
x <- cos(theta)
y <- sin(theta)
plot(x,y,type="l")
abline(h=0,v=0)
A <- W% * %Lambda^(1/2)
text(A[,1:2],colnames(X))
arrows(rep(0,4),rep(0,4),A[,1],A[,2],length=0.1)
8.16- p <- ncol(X)
cumsum(diag(Lambda))/p * 100
Les deux premiers axes expliquent 87.6 % de l’inertie totale.
8.17- CW <- Z% * %W
8.18- dev.new()
plot(CW[,c(1,2)],type="p",xlab="Axe 1",ylab="Axe 2")
text(CW[,c(1,2)],labels=ANNEE)
abline(h=0,v=0)
8.19- plot(CW[,c(1,2)],type="n",xlab="Axe 1",ylab="Axe 2")
bon <- CW[QUALITE==1,c(1,2)]
moyen <- CW[QUALITE==2,c(1,2)]
mediocre <- CW[QUALITE==3,c(1,2)]
text(bon,labels=ANNEE[QUALITE==1],col="red")
text(moyen,labels=ANNEE[QUALITE==2],col="blue")
text(mediocre,labels=ANNEE[QUALITE==3],col="green")
abline(h=0,v=0)
legend("topleft",c("bon","moyen","mediocre"),fill =
c("red","blue","green"))
8.20- QLT <- apply(sweep(CW^2,1,apply(CW^2,FUN=sum,1),FUN="/")[,1:2],
FUN=sum,1)
round(QLT,2)
8.21- require("ade4")
8.22- rownames(X) <- climatvin[,1]
res <- dudi.pca(X) # Entrez 2 pour le nombre d’axes.
scatter(res)
s.class(res$li,as.factor(climatvin[,6]))