Foram utilziados os pacotes xts, ggplot2, fredr, reshape2, factoextra, stargazer, corrplot e kableExtra.

Todos os dados utilizados são obtidos através do pacote fredr, o qual possibilita o downolad de séries disponíveis na base de dados do FRED (Federal Reserve Bank of St. Louis) diretamente através do R. Todas as séries foram transformadas em formato xts de forma a facilitar análises e modelagens.

start<-as.Date("1990-01-01")
end<-as.Date("2020-05-15")
series<-c("DGS1","DGS2","DGS3","DGS5","DGS7","DGS10")
serie<-c()
int<-c()
date<-c()
for (s in 1:length(series)) {
  serie<-as.data.frame(fredr(series_id = series[s],
                observation_start = start,
                observation_end = end))[,3]
  date<-as.data.frame((fredr(series_id = series[s],
                observation_start = start,
                observation_end = end)))[,1]
  int<-cbind(int,serie)
}
int<-as.data.frame(cbind(date,int))
colnames(int)<-c("Data","1year","2years","3years","5years","7years","10years")
int_xts<-na.omit(xts(int[,2:length(int)],order.by=as.Date(int$Data)))

A base de dados possui 45594 observações com frequência diária das taxas publicadas pelo Federal Reserve Board e baseadas no yield médio de diversos títulos do Tesouro Americano, ajustadas para o equivalente à maturação em 1, 2, 3, 5, 7 e 10 anos. Tais taxas são utilizadas para determinar o custo de empréstimos com juros variáveis, por exemplo. A série tem início em 1990-01-01 e a última observação coletada é de 2020-05-15.

O código abaixo computa os autovetores e autovalores da matriz de covariância das taxas de juros. Para obtê-la, realiza-se apenas uma transformação dos dados de centralização à média (“mean-centring”). A transformação para obter variância constante (“scaling”) não foi realizada, uma vez que as taxas de juros aqui analisadas não possuem magnitudes díspares. Os Componentes Principais encontrados são apresentados abaixo:

int.pca<-prcomp(int_xts,scale=FALSE,center =TRUE )
int.pca$rotation
##                PC1        PC2         PC3        PC4         PC5         PC6
## 1year   -0.4268366  0.5872510  0.58503515  0.3387101 -0.08216476 -0.09594330
## 2years  -0.4377911  0.3288672 -0.21468893 -0.5258808  0.30627209  0.53267312
## 3years  -0.4302766  0.1225845 -0.46403997 -0.1929299 -0.13974141 -0.72646572
## 5years  -0.4064598 -0.2206205 -0.33155728  0.4212477 -0.57246547  0.41354624
## 7years  -0.3848234 -0.4044560 -0.03171151  0.4235878  0.70931846 -0.06900259
## 10years -0.3573694 -0.5654181  0.53420370 -0.4632782 -0.22151593 -0.05932908

A partir dos gráficos abaixo é possível perceber que o Primeiro Componente explica mais de 95% da variância. A Tabela 1 apresenta a % Explicada da Variância de cada Componente Principal. Os dois primeiros componentes explicam mais de 99.5% da variância total.

par(mfrow=c(1,2))
plot(int.pca$sdev^2/sum(int.pca$sdev^2),xlab="Componente Principal",ylab="% explicada da variância",type=
"b")
plot(cumsum(int.pca$sdev^2/sum(int.pca$sdev^2)),xlab="Componente Principal",ylab="% da variância explicada (cumulativo)",type="b")

Percentual da Variância Explicada pelos Componentes Principais
Componente Principal % Explicada da Variância
CP1 97.36
CP2 2.53
CP3 0.09
CP4 0.01
CP5 0.01
CP6 0

Pode-se considerar, assim, que é possível explicar praticamente toda a variância (mais de 99%) apenas através dos dois primeiros componentes, reduzindo a dimensão da análise. Os outros quatro componentes não trazem quase nenhuma relevância. No gráfico abaixo, é possível perceber que o Primeiro Componente, em vermelho, com inclinação quase nula, corresponde a movimentos paralelos na curva de Yield e é negativamente correlacionado com as taxas de todas as maturações. Já o segundo componente é positivamente correlacionado com as taxas de maturações de prazo mais curto (1,3,5 anos) e negativamente correlacionado com as taxas de maturações de prazo mais longo (5, 7 e 10 anos), sendo assim um fator que altera a inclinação da curva.

pcs<-data.frame(cbind(c(1,2,3,5,7,10),int.pca$rotation[,1:2]))
pcs<-melt(pcs,id="V1")

ggplot(pcs,aes(x=V1,y=value,colour=variable,group=variable))+
  geom_line(size=1)+
  theme_minimal()+
  theme(panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
      axis.line = element_line(color="black",size=1),
      panel.border=element_rect(colour="black",fill=NA,size=0.1),
      legend.background = element_blank(),
      legend.box.background = element_rect(colour="black",size=1),
      strip.text = element_text(size = 16, color = "black"),
      axis.title = element_text(color = "black", hjust = 0, face = "italic"),
      axis.text = element_text(color = "black"), 
      plot.title = element_text(face = "bold", size = (10)),
      plot.subtitle = element_text(face = "italic", size = (8)))+
  labs(y="Taxa (% p.y.)",x="Tempo (anos)",title="Gráfico 2: Componentes Principais",subtitle = "Os dois primeiros componentes explicam mais de 99.5% da variância")

Através do correlograma abaixo, é perceptível a forte correlação entre a primeira componente e todas as curvas de yield de diferentes maturações (1,2,3,5,7 e 10 anoS). A segunda componente apresenta correlação mais significativa (superior, em módulo, a 0.2) apenas com as curvas de yield com maturação em 1 e 10 anos. Os demais Componentes Principais possuem correlação praticamente nula com as curvas de yield.

tabela2<-cor(int_xts,int.pca$x)
corrplot(tabela2,method = "number")

No conjunto de gráficos abaixo, comparam-se as séries obtidas através dos dois primeiros componentes principais (PC1 e PC2) com as séries originais. Conforme esperado, os dois primeiros componentes geram séries muito próximas às originais, uma vez que capturam quase a totalidade da informação contida nas taxas de juros.

int.two.pc <- int.pca$x[,1:2] %*% t(int.pca$rotation[,1:2])
int.two.pc <- t(apply(int.two.pc,1,function(x) x  + int.pca$center))
int.two.pc <- zoo(int.two.pc,time(int_xts))


df <- rbind(fortify(int_xts,melt=TRUE),fortify(int.two.pc,melt=TRUE))
df[,"Rate"] <- c(rep("Original",nrow(df)/2),rep("PCA",nrow(df)/2))
ggplot(df) +
  geom_line(aes(x=Index,y=Value,colour=Rate,group=Rate)) +
  facet_grid(Series ~ .) +
  theme_bw() + ylab("Government Bond Yield %") +
  theme(legend.position="bottom",axis.title.x=element_blank())