coursdirige-tauxinterets/pca.r

## principal component analysis
## données .25,2,3,5,10,30 ans USGG pris sur Bloomberg

## librairies
library("xtable")

yc <- data.matrix(read.table("usgg.csv",header=T, sep=";",na.strings = "#NA"))[,-1]
dt <- yc[,7]
yc <- yc[,-7]
time <- c(.25,2,3,5,10,30)
yc.center <- t(t(yc)-apply(yc,2,mean))

## plot des séries
pdf("PCA-tseries.pdf")
par(mfrow=c(3,2))
ts.plot(yc[,1], main="90 jours")
ts.plot(yc[,2], main="2 ans")
ts.plot(yc[,3], main="3 ans")
ts.plot(yc[,4], main="5 ans")
ts.plot(yc[,5], main="10 ans")
ts.plot(yc[,6], main="30 ans")
dev.off()

## plot de l'observation 1
pdf("PCA-observation1.pdf")
plot(time,yc[1,],type="l")

## plot de l'observation 1 avec spline
lines(spline(time,yc[1,]),type="l", col="red")
dev.off()
## différenciation
yc.diff <- diff(yc.center)

##
## Approche #1 (cov)
##

## matrice de variance covariance des différences
yc.diff.vcov <- cov(yc.diff)

## matrice P (vecteurs propres)
P <- eigen(yc.diff.vcov)$vectors
sink("PCA-Pcov.tex",append=FALSE,split=FALSE)
xtable(P,digits=4)
sink()
## valeurs propres (variance par composant)
lambda <- eigen(yc.diff.vcov)$values
sink("PCA-lambdacov.tex",append=FALSE,split=FALSE)
xtable(t(as.matrix(lambda)),digits=4)
sink()
## écart-type par composant
sq.lambda <- sqrt(lambda)

## variance totale (trace de la matrice de valeurs propres)
totvar <- sum(lambda)

## fraction expliquée par composante
lambda/totvar
sink("PCA-prcov.tex",append=FALSE,split=FALSE)
xtable(t(as.matrix(lambda/totvar)),digits=4)
sink()

##
## Approche #2 (corr)
##

## matrice de corrélations des différences
yc.diff.corr <- cor(yc.diff)
## matrice P (vecteurs propres)
Pcorr <- eigen(yc.diff.corr)$vectors
sink("PCA-Pcorr.tex",append=FALSE,split=FALSE)
xtable(Pcorr,digits=4)
sink()
## valeurs propres (variance par composant)
lambda.corr <- eigen(yc.diff.corr)$values
sink("PCA-lambdacorr.tex",append=FALSE,split=FALSE)
xtable(t(as.matrix(lambda.corr)),digits=4)
sink()
## écart-type par composant
sq.lambda.corr <- sqrt(lambda.corr)
## variance totale (trace de la matrice de valeurs propres)
totvar.corr <- sum(lambda.corr)
## fraction expliquée par composante
lambda.corr/totvar.corr
sink("PCA-prcorr.tex",append=FALSE,split=FALSE)
xtable(t(as.matrix(lambda.corr/totvar.corr)),digits=4)
sink()

## graphiques (3 premieres composantes: parallel shift, tilt, curvature)
pdf("PCA-composantes1-2-3.pdf")
par(mfrow=c(2,3))
plot(time,P[,1],col="blue", ylim=c(-1,1), type="l")
plot(time,P[,2],col="blue", ylim=c(-1,1), type="l")
plot(time,P[,3],col="blue", ylim=c(-1,1), type="l")
plot(time,Pcorr[,1],col="red", ylim=c(-1,1), type="l")
plot(time,Pcorr[,2],col="red", ylim=c(-1,1), type="l")
plot(time,Pcorr[,3],col="red", ylim=c(-1,1), type="l")
dev.off()

## produits Score (volatilité expliquée par composante)
Score <- yc.center %*% P
Scorecorr <- yc.center %*% Pcorr
pdf("PCA-score.pdf")
par(mfrow=c(2,1))
ts.plot(Score,col="blue")
ts.plot(Scorecorr,col="red")
dev.off()

## utilisation de la fonction princomp pour fins de comparaison
yc.princomp <- prcomp(yc.diff)
pdf("PCA-verif-princomp.pdf")
plot(yc.princomp, type="l")
dev.off()