HW6Q1
Mai AlSwayan
4/21/2017
The Question: 1.Obtain quarterly time series for U.S. real GDP FRED/GDPC96 , GDP deflator FRED/GDPDEF and quarterly closing value of S&P 500 Index YAHOO/INDEX_GSPC/CLOSE. 2.Estimate a bivariate reduced form VAR for y[t] =(y1,t, y2,t)’for the periods 1961Q1 to 2016Q4 using information criteria. To find the extent of correlation of residuals in model and implications. 3.Run the Granger Causality Test. 4.Estimating two restricted VAR models for removing the lags based on Granger Causality Test. 5.Estimating the results found. 6.Plot IRFs and FEVD for VAR models based on Choleski decomoposition and reversing the order after that. 7.Reestimate your VAR, with a third variable, Leading Index for the United States, FRED/USSLIND.Use the augmented VAR from (e) to create a forecast for the period 2017Q1-2017Q4. Compare your forecast for real GDP growth rate in 2017Q1 with (1) the Federal Bank of New York Nowcast, (2) the GDPNow Federal Bank of Atlanta forecast, and (3) the minimum, the average, and the maximum forecasts in the Wall Street Journal Economic Forecasting Survey. 8.Use the augmented VAR from (e) to create a forecast for the period 2017Q1-2017Q4. Compare your forecast for real GDP growth rate in 2017Q1 with (1) the Federal Bank of New York Nowcast, (2) the GDPNow Federal Bank of Atlanta forecast, and (3) the minimum, the average, and the maximum forecasts in the Wall Street Journal Economic Forecasting Survey.
Answers
Part 1
obtaining the data , and data summury
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(stargazer)##
## Please cite as:## Hlavac, Marek (2015). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2. http://CRAN.R-project.org/package=stargazerlibrary(vars)## Loading required package: MASS## Loading required package: strucchange## Loading required package: sandwich## Loading required package: urca## Loading required package: lmtestlibrary(zoo)
library(xts)
library(dygraphs)
library(knitr)
library(forecast)
library(urca)Quandl.api_key('rxVQhZ8_nxxeo2yy4Uz4')
GDP <- Quandl("FRED/GDPC96", collapse="quarter", type="zoo")
DEF <- Quandl("FRED/GDPDEF", type="zoo" )
SP500 <- Quandl("YAHOO/INDEX_GSPC/CLOSE", collapse="quarter", type="zoo")
str(GDP, DEF, SP500)## 'zooreg' series from 1947 Q1 to 2016 Q4
## Data:## Warning in if (le > iv.len) object[seq_len(iv.len)] else object: the
## condition has length > 1 and only the first element will be used## Warning in seq_len(iv.len): first element used of 'length.out' argument## Warning in if (le > v.len) " ...": the condition has length > 1 and only
## the first element will be used## num [1:280] 1934 1932 1930 1961 1990 2022 2033 2035 2008 2001 2023 2005 2085 2148 2230 2273 2305 2345 2393 2398 2423 2429 ...
## Index: Class 'yearqtr'## Warning in if (le > iv.len) object[seq_len(iv.len)] else object: the
## condition has length > 1 and only the first element will be used## Warning in seq_len(iv.len): first element used of 'length.out' argument## Warning in if (le > v.len) " ...": the condition has length > 1 and only
## the first element will be used## num [1:280] 1947 1947 1948 1948 1948 1948 1948 1949 1949 1949 1950 1950 1950 1950 1950 1951 1951 1951 1952 1952 1952 1952 ...
## Frequency: 4summary(GDP, DEF, SP500)## Index GDP
## Min. :1947.0000 Min. : 1930.3150000000001
## 1st Qu.:1964.4375 1st Qu.: 3754.2420000000002
## Median :1981.8750 Median : 6551.5429999999997
## Mean :1981.8750 Mean : 7869.4229999999998
## 3rd Qu.:1999.3125 3rd Qu.:12000.1620000000003
## Max. :2016.7500 Max. :16813.3280000000013y1.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="", ylab="", main="Log of Diff Growth Rate of GDP")
plot(y2.t, xlab="", ylab="", main="Log of Diff Inflation Adjusted Return of S&P500")
Part 2
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.829987var1 <- 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.0000From the table, we found that the correlation between residuals of v1t and v2t to be 0.1644 This means there is some sort of causal relationship between two variables. Let’s test by Granger Causality test to know whether V1 has causal effect on V2. #Part 3
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.01566The table doesnt show the causality between var1 and var2 in both direction.
Part 4
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.07695147Part 5
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")
There are complete differences in the figures(the extent of v1 and v2). This shift says that by reversing the path of variables, the path of description forecast error variance of each variable by exogenous shocks to other variable is affected.
Part 6
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.466496testing lag 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.0000Part 7
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.1832429