# Tag Archives: UIP

In this post, a series of standard linear models will be fitted to a small selection of fundamental economic data I managed to scrape off the internet. The In-sample forecast performance of the Purchasing Power Parity model, Uncovered interest parity model, Dornbusch-Frankel model (with share prices) and the Bayesian averaging model shall be assessed using the standard RMSE measure of forecast accuracy. Requisite data was collected for two currency pairs : GBP/USD and CAD/USD. Instead of differentiating between different types of non-stationarity in the time series of the variables, I simply fitted the model with a variety of assumptions and plotted the results. In both cases, the more complicated Vector Error Correction specifications of the candidate models are found to be inferior to the simpler Vector Autoregression models. The Bayesian Model Averaging technique provided the lowest RMSE for CAD/USD and the second best measure for the GBP/USD pair, a result that speaks in favour of the difficulty encountered when linking exchange rate returns to economic fundamentals with any consistency.

Given model uncertainty in the number of underlying candidate models, the BMA technique helps us select different combinations of underlying models based on performance. By averaging over many different competing models, BMA incorporates model uncertainty into conclusions about parameters and prediction.For k potential variables, the BMA technique implies estimating 2^k variable combinations and thus 2^K models. The model weights for this averaging stem from posterior model probabilities that arise from Bayes’ theorem.

The underlying model for the BMA method is specified as : log (FX) – log (FX-1) = Xβ+εt where X is a matrix of exchange rate determinants. For the CAD/USD currency pair, X  contains the following variables (some variables are defined relative to their US counterparts)  :

• [2] Canadian Industrial Production (CANINDP)
• [4] Canadian Money Supply (CANMSUPP)
• [5] Canadian Share price index (CANSPIND)
• [6] Candian Price Index (CANPI)
• [7] Relative T-bills (REL.TBILL)
• [8] Relative Ind. production (REL.Ind.Prod)
• [9] Relative Money Supply (REL.M.SUPPLY)
• [10] Relative Inflation (REL.Infl)
• [11] Relative Share price (REL.Stock.P)
• [13] Change in Canadian Industrial Production (CANINDP.diff)
• [14] Change in Canadian Inflation (CANINFL..diff)
• [15] Change in Canadian Money Supply (CANMSUPP..diff)
• [16] Change in Canadian Share price index (CANSPIND..diff)
• [17] Change in Candian Price Index (CANPI..diff)
• [18] Crude Oil (Oil)
• [19] Change in Crude Oil (Chg.OIL)

Let’s first load the data and plot the demeaned logarithmic data for the 2 currency pairs and 3 countries.

```
setwd("C:/University of Warwick/R experiments/FxLin")

library(quantmod)
library(timeSeries)
library(RColorBrewer)
library(plotrix)
library(rpanel)
library(symbols)
library(reshape)
library(fUnitRoots)
library(vars)
library(BMS)

txt<-c('3-month TBILL','Ind.Production','Inflation','Money Supply','Stock Index','Price Level')
rmse
################################################################################

#Visualise Data#################################################################

windows(width=14,height=12)
layout(matrix(c(1,1,2,2,3,1,1,2,2,4,5,6,7,8,9),nrow=5,ncol=3,byrow=F))
par(mai=c(0,0,0,0))

plot(ylim=c(min(ca.orig[,1]),max(ca.orig[,1])+0.065),ca.orig[,1],type='l',col='blue',lwd=1.5,xlab='',xaxt='n',ylab='')
grid(col='black')
rect(-15,max(ca.orig[,1])+0.05,length(ca.orig),max(ca.orig[,1])+1,density=NA,col='darkblue',lty=1,border='black')

#par(mai=c(0.15,0,0,0))
plot(ylim=c(min(uk.orig[,1]),max(uk.orig[,1])+0.065),uk.orig[,1],type='l',col='red',lwd=1.5,xlab='',xaxt='n',ylab='')
grid(col='black')
rect(-15,max(uk.orig[,1])+0.05,length(uk.orig),max(uk.orig[,1])+1,density=NA,col='darkred',lty=1,border='black')
text(adj=0,col="white",200,max(uk.orig[,1])+0.065,':: Sterling Pounds / US Dollar',font=2,cex=1)

par(mai=c(0,0,0.15,0))
for(i in 2:7){
plot(main=txt[i-1],cex.main=0.85,ca.orig[,i],col='blue',type='l',xlab='',xaxt='n',ylab='',yaxt='n',lwd=1.5,ylim=c(min(ca.orig[,i]),max(ca.orig[,i])+0.1))
lines(uk.orig[,i],col='red',lwd=1.5)
lines(us.orig[,i-1],col='green',lwd=1.5)
}

par(mai=c(0,0,0.15,0))
plot(main='Crude oil index',cex.main=0.85,oil.orig[,1],col='dark orange',type='l',xlab='',xaxt='n',ylab='',yaxt='n',lwd=1.5)

```

kk

After ascertaining nonstationarity for all the variables, the aforementioned models were fitted to the data. A selection of the code which deals with the BMA and a plot of the in-sample fitted values follows. The code is far from elegant but I am not fussed as long as it works.

i

```
#Bayesian Model Averaging####################################################

lines(pdensa\$fit,col='green')

uk.bma.dat<-data.frame(UKUSD=uk.diff[1:313,1],cbind(uk.orig[1:313,2:7],uk.fundamentals[1:313,],uk.diff[1:313,2:7],Oil=oil.orig[1:313,],Chg.OIL=diff(oil.diff,1)[1:313,]))
uk.bma.res = bms(uk.bma.dat, mprior = "uniform", g = "HQ",nmodel=2000,burn = 50000)
image(uk.bma.res,col=cm.colors(3),cex.main=0.75,cex.axis=0.75)
plotModelsize(uk.bma.res)
pdensb = pred.density(uk.bma.res, newdata = uk.bma.dat[1:313,2:20])
plot(uk.diff[1:313,1],type='l',col='black',lwd=1,xlab='',xaxt='n',ylab='')
lines(pdensb\$fit,col='green')

#############################################################################

#In sample Model Predictions#################################################

windows(width=14,height=12)
layout(matrix(c(1,2,3,4,5,6,7,8,8),nrow=3,ncol=3,byrow=F))
par(mai=c(0.05,0,0.15,0.05))
legend(bty='n','bottom',legend=c('Both','Constant','Trend'),fill=c('green','blue','red'),ncol=3,cex=1)

legend(bty='n','bottom',legend=c('Both','Constant','Trend'),fill=c('green','blue','red'),ncol=3,cex=1)

legend(bty='n','bottom',legend=c('Both','Constant','Trend'),fill=c('green','blue','red'),ncol=3,cex=1)

legend(bty='n','bottom',legend=c('B/con','C/con','T/trend','T/con'),fill=c('green','blue','red','dark orange'),ncol=4,cex=1)

legend(bty='n','bottom',legend=c('B/con','C/con','T/trend','T/con'),fill=c('green','blue','red','dark orange'),ncol=4,cex=1)

legend(bty='n','bottom',legend=c('B/con','C/con','T/trend','T/con'),fill=c('green','blue','red','dark orange'),ncol=4,cex=1)

lines(pdensa\$fit,col='purple')

plot(1:100, type="n", axes=T, xlab="", ylab="",bty='o',xaxt='n',yaxt='n')
rect(-10,-100,105,105,density=NA,col='darkblue',lty=1,border='black')
abline(h=98,col='white',lwd=1.5)
abline(h=83,col='white',lwd=1.5)
abline(h=67,col='white',lwd=1.5)
abline(h=51,col='white',lwd=1.5)
abline(h=35,col='white',lwd=1.5)
abline(h=19,col='white',lwd=1.5)
abline(h=4,col='white',lwd=1.5)

#############################################################################

windows(width=14,height=12)
layout(matrix(c(1,2,3,4,5,6,7,8,8),nrow=3,ncol=3,byrow=F))
par(mai=c(0.05,0,0.15,0.05))
plot(main='Uncovered Interest Parity VAR',cex.main=0.85,uk.diff[1:313,1],type='l',col='black',lwd=1,xlab='',xaxt='n',ylab='')
lines(fitted(uk.uip.var.b)[,1],col='green')
lines(fitted(uk.uip.var.c)[,1],col='blue')
lines(fitted(uk.uip.var.t)[,1],col='red')
legend(bty='n','bottom',legend=c('Both','Constant','Trend'),fill=c('green','blue','red'),ncol=3,cex=1)

lines(fitted(uk.ppp.var.b)[,1],col='green')
lines(fitted(uk.ppp.var.c)[,1],col='blue')
lines(fitted(uk.ppp.var.t)[,1],col='red')
legend(bty='n','bottom',legend=c('Both','Constant','Trend'),fill=c('green','blue','red'),ncol=3,cex=1)

plot(main='Fundamentals VAR',cex.main=0.85,uk.diff[1:313,1],type='l',col='black',lwd=1,xlab='',xaxt='n',ylab='')
lines(fitted(uk.fund.var.b)[,1],col='green')
lines(fitted(uk.fund.var.c)[,1],col='blue')
lines(fitted(uk.fund.var.t)[,1],col='red')
legend(bty='n','bottom',legend=c('Both','Constant','Trend'),fill=c('green','blue','red'),ncol=3,cex=1)

plot(main='Uncovered Interest Parity VECM',cex.main=0.85,uk.diff[1:313,1],type='l',col='black',lwd=1,xlab='',xaxt='n',ylab='',yaxt='n')
lines(fitted(uk.uip.vecm.est.bc)[,1],col='green')
lines(fitted(uk.uip.vecm.est.cc)[,1],col='blue')
lines(fitted(uk.uip.vecm.est.tt)[,1],col='red')
lines(fitted(uk.uip.vecm.est.tc)[,1],col='dark orange')
legend(bty='n','bottom',legend=c('B/con','C/con','T/trend','T/con'),fill=c('green','blue','red','dark orange'),ncol=4,cex=1)

lines(fitted(uk.ppp.vecm.est.bc)[,1],col='green')
lines(fitted(uk.ppp.vecm.est.cc)[,1],col='blue')
lines(fitted(uk.ppp.vecm.est.tt)[,1],col='red')
lines(fitted(uk.ppp.vecm.est.tc)[,1],col='dark orange')
legend(bty='n','bottom',legend=c('B/con','C/con','T/trend','T/con'),fill=c('green','blue','red','dark orange'),ncol=4,cex=1)

plot(main='Fundamentals VECM',cex.main=0.85,uk.diff[1:313,1],type='l',col='black',lwd=1,xlab='',xaxt='n',ylab='',yaxt='n')
lines(fitted(uk.fund.vecm.est.bc)[,1],col='green')
lines(fitted(uk.fund.vecm.est.cc)[,1],col='blue')
lines(fitted(uk.fund.vecm.est.tt)[,1],col='red')
lines(fitted(uk.fund.vecm.est.tc)[,1],col='dark orange')
legend(bty='n','bottom',legend=c('B/con','C/con','T/trend','T/con'),fill=c('green','blue','red','dark orange'),ncol=4,cex=1)

plot(main='Bayesian Model Averaging',cex.main=0.85,uk.diff[1:313,1],type='l',col='black',lwd=1,xlab='',xaxt='n',ylab='',yaxt='n')
lines(pdensa\$fit,col='purple')

c.u.v.b<-rmse(uk.diff[1:296,1],fitted(uk.uip.var.b)[,1])
c.u.v.c<-rmse(uk.diff[1:296,1],fitted(uk.uip.var.c)[,1])
c.u.v.t<-rmse(uk.diff[1:296,1],fitted(uk.uip.var.t)[,1])

c.u.ve.bc<-rmse(uk.diff[1:296,1],fitted(uk.uip.vecm.est.bc)[,1])
c.u.ve.cc<-rmse(uk.diff[1:296,1],fitted(uk.uip.vecm.est.cc)[,1])
c.u.ve.tt<-rmse(uk.diff[1:296,1],fitted(uk.uip.vecm.est.tt)[,1])
c.u.ve.tc<-rmse(uk.diff[1:296,1],fitted(uk.uip.vecm.est.tc)[,1])

c.p.v.b<-rmse(uk.diff[1:299,1],fitted(uk.ppp.var.b)[,1])
c.p.v.c<-rmse(uk.diff[1:299,1],fitted(uk.ppp.var.c)[,1])
c.p.v.t<-rmse(uk.diff[1:299,1],fitted(uk.ppp.var.t)[,1])

c.p.ve.bc<-rmse(uk.diff[1:299,1],fitted(uk.ppp.vecm.est.bc)[,1])
c.p.ve.cc<-rmse(uk.diff[1:299,1],fitted(uk.ppp.vecm.est.cc)[,1])
c.p.ve.tt<-rmse(uk.diff[1:299,1],fitted(uk.ppp.vecm.est.tt)[,1])
c.p.ve.tc<-rmse(uk.diff[1:299,1],fitted(uk.ppp.vecm.est.tc)[,1])

c.f.v.b<-rmse(uk.diff[1:311,1],fitted(uk.fund.var.b)[,1])
c.f.v.c<-rmse(uk.diff[1:311,1],fitted(uk.fund.var.c)[,1])
c.f.v.t<-rmse(uk.diff[1:311,1],fitted(uk.fund.var.t)[,1])

c.f.ve.bc<-rmse(uk.diff[1:311,1],fitted(uk.fund.vecm.est.bc)[,1])
c.f.ve.cc<-rmse(uk.diff[1:311,1],fitted(uk.fund.vecm.est.cc)[,1])
c.f.ve.tt<-rmse(uk.diff[1:311,1],fitted(uk.fund.vecm.est.tt)[,1])
c.f.ve.tc<-rmse(uk.diff[1:311,1],fitted(uk.fund.vecm.est.tc)[,1])

c.bma<-rmse(uk.diff[1:313,1],pdensb\$fit)

plot(1:100, type="n", axes=T, xlab="", ylab="",bty='o',xaxt='n',yaxt='n')
rect(-10,-100,105,105,density=NA,col='darkblue',lty=1,border='black')
abline(h=98,col='white',lwd=1.5)
text(50,101,'In-sample accuracy RMSE for GBP/USD',cex=0.95,col="cyan",font=2)
abline(h=83,col='white',lwd=1.5)
abline(h=67,col='white',lwd=1.5)
abline(h=51,col='white',lwd=1.5)
abline(h=35,col='white',lwd=1.5)
abline(h=19,col='white',lwd=1.5)