Homework 6, Problem 1
Hassan
April 22, 2017
Vector Autoregression (VAR) Models
library(Quandl)## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary("zoo")
library(xts)
library(dygraphs)
library(knitr)
library(forecast)
library(urca)
library(vars)## Loading required package: MASS## Loading required package: strucchange## Loading required package: sandwich## Loading required package: lmtestQuandl.api_key('CEFP3eWxEJwr_uUP9a2D')
GDP <- Quandl("FRED/GDPC96", collapse="quarter", type="zoo")
DEF <- Quandl("FRED/GDPDEF", type="zoo" )
SP500 <- Quandl("YAHOO/INDEX_GSPC/CLOSE", collapse="quarter", type="zoo")y1.t=400*diff(log(GDP))
y2.t=400*(diff(log(SP500))-diff(log(DEF)))
par(mfrow=c(1,2), cex=0.7)plot(y1.t, xlab="year", ylab="Growth Rate of GDP", main="Log of Difference of Growth Rate of GDP")
plot(y2.t, xlab="year", ylab="Inflation Adjusted Return", main="Log of Difference of Inflation Adjusted Return of S&P500")
(a) Correlation of residual in the model
y.Q <- cbind(y1.t, y2.t)
y.Q <- window(y.Q, start="1961 Q1", end="2016 Q4")
VARselect(y.Q, lag.max=8, type="const")## $selection
## AIC(n) HQ(n) SC(n) FPE(n)
## 2 2 2 2
##
## $criteria
## 1 2 3 4 5
## AIC(n) 9.175989 9.091016 9.113119 9.131058 9.150883
## HQ(n) 9.213867 9.154146 9.201502 9.244693 9.289771
## SC(n) 9.269747 9.247279 9.331887 9.412331 9.494662
## FPE(n) 9662.353374 8875.343350 9073.962580 9238.681869 9424.421932
## 6 7 8
## AIC(n) 9.173800 9.182950 9.207869
## HQ(n) 9.337940 9.372341 9.422513
## SC(n) 9.580084 9.651738 9.739163
## FPE(n) 9644.003179 9734.167942 9981.829987with respect to information criteria we will have choose 2 lags
var1 <- VAR(y.Q, p=2, type="const")
summary(var1)##
## VAR Estimation Results:
## =========================
## Endogenous variables: y1.t, y2.t
## Deterministic variables: const
## Sample size: 222
## Log Likelihood: -1629.844
## Roots of the characteristic polynomial:
## 0.3746 0.3243 0.257 0.257
## Call:
## VAR(y = y.Q, p = 2, type = "const")
##
##
## Estimation results for equation y1.t:
## =====================================
## y1.t = y1.t.l1 + y2.t.l1 + y1.t.l2 + y2.t.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y1.t.l1 0.216477 0.064678 3.347 0.000963 ***
## y2.t.l1 0.016139 0.006032 2.675 0.008032 **
## y1.t.l2 0.168937 0.063182 2.674 0.008070 **
## y2.t.l2 0.024020 0.006122 3.924 0.000117 ***
## const 1.718875 0.293197 5.863 1.68e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.886 on 217 degrees of freedom
## Multiple R-Squared: 0.2373, Adjusted R-squared: 0.2232
## F-statistic: 16.88 on 4 and 217 DF, p-value: 4.602e-12
##
##
## Estimation results for equation y2.t:
## =====================================
## y2.t = y1.t.l1 + y2.t.l1 + y1.t.l2 + y2.t.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y1.t.l1 0.60370 0.72774 0.830 0.408
## y2.t.l1 0.10200 0.06787 1.503 0.134
## y1.t.l2 -0.88416 0.71091 -1.244 0.215
## y2.t.l2 -0.07823 0.06888 -1.136 0.257
## const 3.84222 3.29900 1.165 0.245
##
##
## Residual standard error: 32.47 on 217 degrees of freedom
## Multiple R-Squared: 0.02376, Adjusted R-squared: 0.005766
## F-statistic: 1.32 on 4 and 217 DF, p-value: 0.2633
##
##
##
## Covariance matrix of residuals:
## y1.t y2.t
## y1.t 8.329 15.4
## y2.t 15.404 1054.4
##
## Correlation matrix of residuals:
## y1.t y2.t
## y1.t 1.0000 0.1644
## y2.t 0.1644 1.0000We find that the Correlation of residuals is 0.1644.
(b) Granger casuality test for both variables
causality(var1, cause="y1.t")## $Granger
##
## Granger causality H0: y1.t do not Granger-cause y2.t
##
## data: VAR object var1
## F-Test = 0.87077, df1 = 2, df2 = 434, p-value = 0.4194
##
##
## $Instant
##
## H0: No instantaneous causality between: y1.t and y2.t
##
## data: VAR object var1
## Chi-squared = 5.8402, df = 1, p-value = 0.01566causality(var1, cause="y2.t")## $Granger
##
## Granger causality H0: y2.t do not Granger-cause y1.t
##
## data: VAR object var1
## F-Test = 12.1, df1 = 2, df2 = 434, p-value = 7.696e-06
##
##
## $Instant
##
## H0: No instantaneous causality between: y2.t and y1.t
##
## data: VAR object var1
## Chi-squared = 5.8402, df = 1, p-value = 0.01566results: We cannot reject Null hypothesis that y1.t do not Granger cause y2.t since the p-value in this case is 0.4194.However, we will reject the Null hypothesis that y2.t do not Granger cause y1.t.
(c) restricted VAR analysis
mat.r <- matrix(1, nrow=2, ncol=5)
mat.r[2, c(1,3)] <- 0
mat.r## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 0 1 0 1 1var1.r <- restrict(var1, method="manual", resmat=mat.r)
summary(var1.r)##
## VAR Estimation Results:
## =========================
## Endogenous variables: y1.t, y2.t
## Deterministic variables: const
## Sample size: 222
## Log Likelihood: -1630.756
## Roots of the characteristic polynomial:
## 0.5333 0.3168 0.2774 0.2774
## Call:
## VAR(y = y.Q, p = 2, type = "const")
##
##
## Estimation results for equation y1.t:
## =====================================
## y1.t = y1.t.l1 + y2.t.l1 + y1.t.l2 + y2.t.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y1.t.l1 0.216477 0.064678 3.347 0.000963 ***
## y2.t.l1 0.016139 0.006032 2.675 0.008032 **
## y1.t.l2 0.168937 0.063182 2.674 0.008070 **
## y2.t.l2 0.024020 0.006122 3.924 0.000117 ***
## const 1.718875 0.293197 5.863 1.68e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.886 on 217 degrees of freedom
## Multiple R-Squared: 0.5877, Adjusted R-squared: 0.5782
## F-statistic: 61.86 on 5 and 217 DF, p-value: < 2.2e-16
##
##
## Estimation results for equation y2.t:
## =====================================
## y2.t = y2.t.l1 + y2.t.l2 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y2.t.l1 0.10770 0.06736 1.599 0.111
## y2.t.l2 -0.07695 0.06713 -1.146 0.253
## const 2.97269 2.19560 1.354 0.177
##
##
## Residual standard error: 32.45 on 219 degrees of freedom
## Multiple R-Squared: 0.02454, Adjusted R-squared: 0.01118
## F-statistic: 1.836 on 3 and 219 DF, p-value: 0.1414
##
##
##
## Covariance matrix of residuals:
## y1.t y2.t
## y1.t 8.329 15.4
## y2.t 15.404 1062.9
##
## Correlation matrix of residuals:
## y1.t y2.t
## y1.t 1.0000 0.1637
## y2.t 0.1637 1.0000var1.r$restrictions## y1.t.l1 y2.t.l1 y1.t.l2 y2.t.l2 const
## y1.t 1 1 1 1 1
## y2.t 0 1 0 1 1Acoef(var1.r)## [[1]]
## y1.t.l1 y2.t.l1
## y1.t 0.2164775 0.01613929
## y2.t 0.0000000 0.10770248
##
## [[2]]
## y1.t.l2 y2.t.l2
## y1.t 0.168937 0.02402029
## y2.t 0.000000 -0.07695147(d) Choleski decomposition
var1.irfs <- irf(var1, n.ahead=10)
par(mfcol=c(2,2), cex=0.6)
plot(var1.irfs, plot.type="single")
var1.fevd <- fevd(var1, n.ahead=10)
var1.fevd[[1]][c(1,3,6,10),]## y1.t y2.t
## [1,] 1.0000000 0.0000000
## [2,] 0.8927329 0.1072671
## [3,] 0.8813672 0.1186328
## [4,] 0.8812738 0.1187262var1.fevd[[2]][c(1,3,6,10),]## y1.t y2.t
## [1,] 0.02701807 0.9729819
## [2,] 0.03617662 0.9638234
## [3,] 0.03661349 0.9633865
## [4,] 0.03661909 0.9633809plot(var1.fevd)
plot(var1.fevd, addbars=8)
y.Q.ord2 <- cbind(y2.t, y1.t)
y.Q.ord2 <- window(y.Q.ord2, start="1961 Q1", end="2016 Q4")
var1.ord2 <- VAR(y.Q.ord2, p=1, type="const")
var1.ord1 <- VAR(y.Q, p=1, type="const")var1.irfs.ord1 <- irf(var1.ord1, n.ahead=10)
var1.irfs.ord2 <- irf(var1.ord2, n.ahead=10)
par(mfcol=c(2,2), cex=0.6)
plot(var1.irfs.ord1, plot.type="single")
par(mfcol=c(2,2), cex=0.6)
plot(var1.irfs.ord2, plot.type="single")
Order does not matter here.
(e) Having a third variable
LI <- Quandl("FRED/USSLIND", collapse="quarter", type="zoo")
y.Q3 <- cbind(y1.t, y2.t, LI)
y.Q3 <- window(y.Q3, start="1982 Q1", end="2016 Q4")
VARselect(y.Q3, lag.max=8, type="const")## $selection
## AIC(n) HQ(n) SC(n) FPE(n)
## 1 1 1 1
##
## $criteria
## 1 2 3 4 5 6
## AIC(n) 6.230625 6.251471 6.305958 6.400474 6.484579 6.528610
## HQ(n) 6.337120 6.437837 6.572194 6.746580 6.910557 7.034458
## SC(n) 6.492698 6.710099 6.961140 7.252211 7.532871 7.773456
## FPE(n) 508.101461 518.930646 548.304356 603.288349 657.321273 688.592527
## 7 8
## AIC(n) 6.479784 6.479059
## HQ(n) 7.065504 7.144649
## SC(n) 7.921185 8.117015
## FPE(n) 657.997454 660.466496for VAR we choose lag of 1
var3 <- VAR(y.Q3, p=1, type="const")
summary(var3)##
## VAR Estimation Results:
## =========================
## Endogenous variables: y1.t, y2.t, LI
## Deterministic variables: const
## Sample size: 139
## Log Likelihood: -1016.246
## Roots of the characteristic polynomial:
## 0.8175 0.05397 0.0003733
## Call:
## VAR(y = y.Q3, p = 1, type = "const")
##
##
## Estimation results for equation y1.t:
## =====================================
## y1.t = y1.t.l1 + y2.t.l1 + LI.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y1.t.l1 0.073562 0.097953 0.751 0.4540
## y2.t.l1 0.010787 0.005631 1.916 0.0575 .
## LI.l1 1.430689 0.304969 4.691 6.57e-06 ***
## const 0.607696 0.324310 1.874 0.0631 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.055 on 135 degrees of freedom
## Multiple R-Squared: 0.3478, Adjusted R-squared: 0.3333
## F-statistic: 24 on 3 and 135 DF, p-value: 1.648e-12
##
##
## Estimation results for equation y2.t:
## =====================================
## y2.t = y1.t.l1 + y2.t.l1 + LI.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y1.t.l1 0.23011 1.52438 0.151 0.880
## y2.t.l1 0.05512 0.08763 0.629 0.530
## LI.l1 2.13256 4.74604 0.449 0.654
## const 2.58312 5.04703 0.512 0.610
##
##
## Residual standard error: 31.98 on 135 degrees of freedom
## Multiple R-Squared: 0.01024, Adjusted R-squared: -0.01176
## F-statistic: 0.4653 on 3 and 135 DF, p-value: 0.7069
##
##
## Estimation results for equation LI:
## ===================================
## LI = y1.t.l1 + y2.t.l1 + LI.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## y1.t.l1 0.032029 0.020023 1.600 0.112026
## y2.t.l1 0.003511 0.001151 3.050 0.002754 **
## LI.l1 0.742442 0.062342 11.909 < 2e-16 ***
## const 0.243431 0.066295 3.672 0.000346 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 0.4201 on 135 degrees of freedom
## Multiple R-Squared: 0.7551, Adjusted R-squared: 0.7497
## F-statistic: 138.8 on 3 and 135 DF, p-value: < 2.2e-16
##
##
##
## Covariance matrix of residuals:
## y1.t y2.t LI
## y1.t 4.2231 11.791 0.4748
## y2.t 11.7913 1022.775 3.6929
## LI 0.4748 3.693 0.1765
##
## Correlation matrix of residuals:
## y1.t y2.t LI
## y1.t 1.0000 0.1794 0.5500
## y2.t 0.1794 1.0000 0.2749
## LI 0.5500 0.2749 1.0000(f) forcasting
var3.f <- predict(var3, n.ahead=4, ci=0.9)
plot(var3.f)
fanchart(var3.f)
var3.f## $y1.t
## fcst lower upper CI
## [1,] 3.092573 -0.2876226 6.472768 3.380195
## [2,] 3.053202 -0.6096188 6.716022 3.662821
## [3,] 3.022398 -0.7957658 6.840561 3.818164
## [4,] 2.997271 -0.9204381 6.914980 3.917709
##
## $y2.t
## fcst lower upper CI
## [1,] 6.954187 -45.64963 59.55800 52.60382
## [2,] 6.872361 -45.87955 59.62427 52.75191
## [3,] 6.818508 -45.96813 59.60514 52.78664
## [4,] 6.775241 -46.03306 59.58354 52.80830
##
## $LI
## fcst lower upper CI
## [1,] 1.497875 0.8068976 2.188852 0.6909771
## [2,] 1.478985 0.5267156 2.431255 0.9522696
## [3,] 1.463412 0.3669462 2.559879 1.0964663
## [4,] 1.450675 0.2674320 2.633918 1.1832429Real GDP growth in 2017Q1 is predicted to be 3.09%. Which is higher than FRBNY Staff Nowcast (2.7%), Economic Forecasting Survey (1.4%) and a lot higher than Atlanta FED forecast, which is 0.5%.