library("zoo")
library("forecast")
library("tseries")
library("urca")
library ("Quandl")
library("vars")
library("Quandl")
Quandl.api_key("DLk9RQrfTVkD4UTKc7op")
library("VARsignR")
library("stargazer")
library("gdata")

Problem 2

Obtain quarterly time series for Disposable Personal Income FRED/DPI and for Personal Consumption Expenditures FRED/PCEC.

Introduction and Data :

In this problem, data is analysed about Disposable Personal Income and Personal Consumption Expenditures from 1947 to 2015. The quaterly data for this problem is collectd from Quandl.

DPI_d<-Quandl("FRED/DPI", type="zoo")
DPI <- window(DPI_d[,2], start=1947, end=2015)
str(DPI)
## 'zooreg' series from 1947 Q1 to 2015 Q1
##   Data: num [1:273] 171 170 178 180 185 ...
##   Index: Class 'yearqtr'  num [1:273] 1947 1947 1948 1948 1948 ...
##   Frequency: 4
head(DPI)
## 1947 Q1 1947 Q2 1947 Q3 1947 Q4 1948 Q1 1948 Q2 
##   171.0   170.4   178.0   179.8   185.4   193.2
tail(DPI)
## 2013 Q4 2014 Q1 2014 Q2 2014 Q3 2014 Q4 2015 Q1 
## 12524.7 12697.5 12858.7 12982.7 13116.8 13179.8
tsdisplay(DPI, lag.max = 100, xlab=" Years 1947-2015", ylab= "Billions of Dollars Seasonally Adjusted Annual Rate ", main ="Disposable Personal Income from 1947 to 2015,Quaterly")

PCEC_d<-Quandl("FRED/PCEC", type="zoo")
PCEC <- window(PCEC_d, start=1947, end=2015)

str(PCEC)
## 'zooreg' series from 1947 Q1 to 2015 Q1
##   Data: num [1:273] 156 160 164 168 170 ...
##   Index: Class 'yearqtr'  num [1:273] 1947 1947 1948 1948 1948 ...
##   Frequency: 4
head(PCEC)
## 1947 Q1 1947 Q2 1947 Q3 1947 Q4 1948 Q1 1948 Q2 
##   156.3   160.2   163.7   167.8   170.5   174.3
tail(PCEC)
## 2013 Q4 2014 Q1 2014 Q2 2014 Q3 2014 Q4 2015 Q1 
## 11556.9 11640.3 11813.0 11949.1 12061.4 12055.5
tsdisplay(PCEC, lag.max = 100, xlab=" Years 1947-2015", ylab= "Billions of Dollars Seasonally Adjusted Annual Rate ", main ="Personal Consumption Expenditures from 1947 to 2015,Quaterly")

The monthly data for Disposable Personal Income from 1947 to 2015 has increasing trend with a shift in a year. The PACF does not have peaks, while ACF peaks decays very slowly.

The monthly data for Personal Consumption Expenditures from 1947 to 2015 has mostly increasing trend with a shift in a year. The PACF does not have peaks, while ACF peaks decays very slowly.

(a) Let \(y_{1,t} = log PCE_t\) and \(y_{2,t} = log PDI_t\). Test these log transformed time series and their first differences for unit root to verify that \(y_{1,t}\) and \(y_{2,t}\) are I(1).

y1=log(DPI)
y2=log(PCEC)
V1<-cbind(y1,y2)
plot(V1,xlab = "year",main="Disposable Personal Income(y1) and Personal Consumption Expenditures(y2) from 1947 to 2015")

D_y1<-diff(y1)
D_y2<-diff(y2)
par(mfrow=c(1,2))
plot(D_y1,xlab = "year",main="Disposable Personal Income  from 1947 to 2015")
plot(D_y2,xlab = "year",main="Personal Consumption Expenditures from 1947 to 2015")

# unit root tests - levels

summary( ur.ers(y1, type="P-test", lag.max=8, model="trend") )
## 
## ############################################### 
## # Elliot, Rothenberg and Stock Unit Root Test # 
## ############################################### 
## 
## Test of type P-test 
## detrending of series with intercept and trend 
## 
## Value of test-statistic is: 77.9407 
## 
## Critical values of P-test are:
##                 1pct 5pct 10pct
## critical values 3.96 5.62  6.89
summary( ur.ers(y2, type="P-test", lag.max=8, model="trend") )
## 
## ############################################### 
## # Elliot, Rothenberg and Stock Unit Root Test # 
## ############################################### 
## 
## Test of type P-test 
## detrending of series with intercept and trend 
## 
## Value of test-statistic is: 59.0748 
## 
## Critical values of P-test are:
##                 1pct 5pct 10pct
## critical values 3.96 5.62  6.89
# unit root tests - first differences

summary( ur.ers(D_y1, type="P-test", lag.max=8, model="trend") )
## 
## ############################################### 
## # Elliot, Rothenberg and Stock Unit Root Test # 
## ############################################### 
## 
## Test of type P-test 
## detrending of series with intercept and trend 
## 
## Value of test-statistic is: 2.3524 
## 
## Critical values of P-test are:
##                 1pct 5pct 10pct
## critical values 3.96 5.62  6.89
summary( ur.ers(D_y2, type="P-test", lag.max=8, model="trend") )
## 
## ############################################### 
## # Elliot, Rothenberg and Stock Unit Root Test # 
## ############################################### 
## 
## Test of type P-test 
## detrending of series with intercept and trend 
## 
## Value of test-statistic is: 1.8985 
## 
## Critical values of P-test are:
##                 1pct 5pct 10pct
## critical values 3.96 5.62  6.89

Both series are not stationary in levels. The first difference makes both series are stationary. The Disposable Personal Income and Personal Consumption Expenditures are I(1).

(b) The disposable income hypothesis suggest that \(PCE_t = {\phi}DPI_t\) where \({\phi}\) is the marginal propensity to consume. Consumption and disposable income should thus be growing at the same rate, and \(log PCE_t - log PDI_t- log \phi\) should be I(0). Perform the trace and max eigenvalue tests for cointegration of\(y_{1,t}\) and \(y_{2,t}\). Interpret the results.

# cointegration test - Johansen's methodology
A.ca <- ca.jo(V1, ecdet="trend", type="trace", K=2, spec="transitory")
summary(A.ca)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: trace statistic , with linear trend in cointegration 
## 
## Eigenvalues (lambda):
## [1] 1.152736e-01 2.977920e-02 4.336483e-17
## 
## Values of teststatistic and critical values of test:
## 
##           test 10pct  5pct  1pct
## r <= 1 |  8.19 10.49 12.25 16.26
## r = 0  | 41.38 22.76 25.32 30.45
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##                  y1.l1        y2.l1    trend.l1
## y1.l1     1.0000000000  1.000000000  1.00000000
## y2.l1    -0.9454240012 -1.151247662 -1.90650792
## trend.l1 -0.0008593598  0.003822549  0.01558044
## 
## Weights W:
## (This is the loading matrix)
## 
##           y1.l1        y2.l1      trend.l1
## y1.d 0.01709977 -0.021358479 -3.608184e-15
## y2.d 0.12948636 -0.007295366  8.074477e-14
A.ca <- ca.jo(V1, ecdet="trend", type="eigen", K=2, spec="transitory")
summary(A.ca)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: maximal eigenvalue statistic (lambda max) , with linear trend in cointegration 
## 
## Eigenvalues (lambda):
## [1] 1.152736e-01 2.977920e-02 4.336483e-17
## 
## Values of teststatistic and critical values of test:
## 
##           test 10pct  5pct  1pct
## r <= 1 |  8.19 10.49 12.25 16.26
## r = 0  | 33.19 16.85 18.96 23.65
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##                  y1.l1        y2.l1    trend.l1
## y1.l1     1.0000000000  1.000000000  1.00000000
## y2.l1    -0.9454240012 -1.151247662 -1.90650792
## trend.l1 -0.0008593598  0.003822549  0.01558044
## 
## Weights W:
## (This is the loading matrix)
## 
##           y1.l1        y2.l1      trend.l1
## y1.d 0.01709977 -0.021358479 -3.608184e-15
## y2.d 0.12948636 -0.007295366  8.074477e-14

(c) Perform the test for the presence of a restricted constant rather than unrestricted constant, interpret the result. If necessary rerun the cointegration test from (b).

# test for the presence of the constant term in the cointegration relationship
lttest(A.ca, r=1)
## LR-test for no linear trend
## 
## H0: H*2(r<=1)
## H1: H2(r<=1)
## 
## Test statistic is distributed as chi-square
## with 1 degress of freedom
##         test statistic p-value
## LR test          10.02       0

(d) Estimate the unrestricted VEC model, examine significance of variables in the two equations.

# VEC model
A.ca.VEC <- cajorls(A.ca, r=1)
A.ca.VEC
## $rlm
## 
## Call:
## lm(formula = substitute(form1), data = data.mat)
## 
## Coefficients:
##           y1.d       y2.d     
## ect1       0.017100   0.129486
## constant   0.002144  -0.040200
## y1.dl1    -0.029105   0.175425
## y2.dl1     0.462648   0.044868
## 
## 
## $beta
##                   ect1
## y1.l1     1.0000000000
## y2.l1    -0.9454240012
## trend.l1 -0.0008593598
# to see t-statistics and p-values
summary(A.ca.VEC$rlm)
## Response y1.d :
## 
## Call:
## lm(formula = y1.d ~ ect1 + constant + y1.dl1 + y2.dl1 - 1, data = data.mat)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.051926 -0.004800 -0.000565  0.004618  0.058121 
## 
## Coefficients:
##           Estimate Std. Error t value Pr(>|t|)    
## ect1      0.017100   0.027842   0.614    0.540    
## constant  0.002144   0.010958   0.196    0.845    
## y1.dl1   -0.029105   0.067468  -0.431    0.667    
## y2.dl1    0.462648   0.072442   6.387  7.5e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.01017 on 267 degrees of freedom
## Multiple R-squared:  0.7312, Adjusted R-squared:  0.7272 
## F-statistic: 181.6 on 4 and 267 DF,  p-value: < 2.2e-16
## 
## 
## Response y2.d :
## 
## Call:
## lm(formula = y2.d ~ ect1 + constant + y1.dl1 + y2.dl1 - 1, data = data.mat)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.036667 -0.004284 -0.000278  0.004564  0.059153 
## 
## Coefficients:
##           Estimate Std. Error t value Pr(>|t|)    
## ect1      0.129486   0.023904   5.417 1.35e-07 ***
## constant -0.040200   0.009409  -4.273 2.69e-05 ***
## y1.dl1    0.175425   0.057926   3.028   0.0027 ** 
## y2.dl1    0.044868   0.062197   0.721   0.4713    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.008734 on 267 degrees of freedom
## Multiple R-squared:  0.785,  Adjusted R-squared:  0.7818 
## F-statistic: 243.7 on 4 and 267 DF,  p-value: < 2.2e-16

(e) Perform following three tests: (1) \({\beta_2}=-1\), (2) \({\alpha_2}=0\), (3) joint hypothesis \({\beta_2}=-1\), and \({\alpha_2}=0\). Interpret the results.

# test for restricted cointegrating vector betta
#  H0: betta2 = -1

rest.betta1 <- matrix(c(0,-1,0,
                        0,0,1), c(3,2))
A.rbetta1 <- blrtest(A.ca, H=rest.betta1, r=1)
summary(A.rbetta1)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Estimation and testing under linear restrictions on beta 
## 
## The VECM has been estimated subject to: 
## beta=H*phi and/or alpha=A*psi
## 
##      [,1] [,2]
## [1,]    0    0
## [2,]   -1    0
## [3,]    0    1
## 
## Eigenvalues of restricted VAR (lambda):
## [1] 0.036 0.002
## 
## The value of the likelihood ratio test statistic:
## 23.25 distributed as chi square with 1 df.
## The p-value of the test statistic is: 0 
## 
## Eigenvectors, normalised to first column
## of the restricted VAR:
## 
##      [,1] [,2]
## [1,]  NaN  NaN
## [2,] -Inf -Inf
## [3,]  Inf  Inf
## 
## Weights W of the restricted VAR:
## 
##      [,1] [,2]
## y1.d  NaN  NaN
## y2.d  NaN  NaN
# test for restricted adjustment parameters alpha
rest.alpha <- matrix(c(1,0), c(2,1))
A.ralpha <- alrtest(A.ca, A=rest.alpha, r=1)
summary(A.ralpha)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Estimation and testing under linear restrictions on beta 
## 
## The VECM has been estimated subject to: 
## beta=H*phi and/or alpha=A*psi
## 
##      [,1]
## [1,]    1
## [2,]    0
## 
## Eigenvalues of restricted VAR (lambda):
## [1] 0.0428 0.0000 0.0000
## 
## The value of the likelihood ratio test statistic:
## 21.33 distributed as chi square with 1 df.
## The p-value of the test statistic is: 0 
## 
## Eigenvectors, normalised to first column
## of the restricted VAR:
## 
##                [,1]
## RK.y1.l1     1.0000
## RK.y2.l1    -0.9945
## RK.trend.l1  0.0003
## 
## Weights W of the restricted VAR:
## 
##         [,1]
## [1,] -0.0725
## [2,]  0.0000
# joint test for restricted adjustment parameters alpha and restricted cointegrating vector betta
A.rboth1 <- ablrtest(A.ca, A=rest.alpha, H=rest.betta1, r=1)
summary(A.rboth1)
## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Estimation and testing under linear restrictions on alpha and beta 
## 
## The VECM has been estimated subject to: 
## beta=H*phi and/or alpha=A*psi
## 
##      [,1] [,2]
## [1,]    0    0
## [2,]   -1    0
## [3,]    0    1
## 
## 
##      [,1]
## [1,]    1
## [2,]    0
## 
## Eigenvalues of restricted VAR (lambda):
## [1] 0.0154 0.0000
## 
## The value of the likelihood ratio test statistic:
## 28.98 distributed as chi square with 1 df.
## The p-value of the test statistic is: 0 
## 
## Eigenvectors, normalised to first column
## of the restricted VAR:
## 
##      [,1]
## [1,]  NaN
## [2,]  Inf
## [3,] -Inf
## 
## Weights W of the restricted VAR:
## 
##      [,1]
## [1,]    0
## [2,]    0

(f) Convert the VEC model into a VAR model in levels. Create and plot eight quarter ahead forecast.

A.VAR <- vec2var(A.ca, r=1)
# forecast using VAR in levels
A.VAR.fcst <- predict(A.VAR, n.ahead=8)


par( mar=c(4,4,2,1), cex=0.75)
plot(A.VAR.fcst)