在 R 中使用 VECM 进行格兰杰因果关系检验

Question

I am trying to compute the Granger causality test using the Vector Error Correction Model (VECM) in R. I calculated the VECM in R using tsDyn package. Since I have I (1) and cointegrated variables, VECM is assumed to implement the Granger causality test. However I didn't find any function in R, that could perform the Granger Granger causality test for VECM. I would like to ask You, whether someone does know such a function. Here is my example:

dols.est <- dynlm(ts_ln.API.real.1~ts_MR.var.nom.1+L(d(ts_MR.var.nom.1), -3:3)) # Estimate θ with DOLS

est.theta <- dols.est$coefficients[2]

int.mts <- ts.union(ts_ln.API.real.1, ts_MR.var.nom.1) # Create a multivariate time series

VEC.est <- VECM(int.mts, lag=1, r=1, include = c("both"), beta = est. theta)

Any help will be greatly appreciated. Thank You in advance!

Answer 1

0 Before all, perform ADF test by taking into account the usage of common sample for all the lags. For example: (causfinder::adfcs and causfinder::adfcstable):

adfcs <- function (t, max = floor(12 * (length(t)/100)^(1/4)), type = c("c"))  
# Augmented Dickey-Fuller function that takes into account the usage of common sample for all the lags
{
    x <- ts(t)
    x1d <- diff(x, differences = 1)
    x1l <- lag(x, -1)
    if (max == 0) {
        x_names <- c("x1d", "x1l")
        DLDlag <- ts.intersect(x1d, x1l)
        DLDlag.df <- data.frame(DLDlag, obspts = c(time(DLDlag)))
    }
    else {
        x_names <- c("x1d", "x1l", sapply(1:max, function(i) paste("x1d", i, "l", sep = "")))
    }
    if (max != 0) {
        for (i in as.integer(1:max)) {
            assign(x_names[i + 2], lag(x1d, -i))
        }
        DLDlag <- do.call(ts.intersect, sapply(x_names, as.symbol))
        DLDlag.df <- data.frame(DLDlag, obspts = c(time(DLDlag)))
        DifferenceLags <- as.vector(names(DLDlag.df), mode = "any")[3:(length(DLDlag.df) - 1)]
    }
    lmresults <- array(list())
    SBCvalues <- array(list())
    AICvalues <- array(list())
    for (i in as.integer(0:max)) {
        if (type == c("nc")) {
            if (i == 0) {
                lmresults[[max + 1]] <- lm(as.formula(paste("x1d ~x1l")), data = DLDlag.df)
                SBCvalues[[max + 1]] <- BIC(lmresults[[max + 1]])
                AICvalues[[max + 1]] <- AIC(lmresults[[max + 1]])
            }
            if (i > 0) {
                lmresults[[i]] <- lm(as.formula(paste("x1d ~ x1l+", paste(DifferenceLags[1:i], collapse = "+"))), data = DLDlag.df)
                SBCvalues[[i]] <- BIC(lmresults[[i]])
                AICvalues[[i]] <- AIC(lmresults[[i]])
            }
        }
        if (type == c("c")) {
            if (i == 0) {
                lmresults[[max + 1]] <- lm(as.formula(paste("x1d ~1+x1l")), data = DLDlag.df)
                SBCvalues[[max + 1]] <- BIC(lmresults[[max + 1]])
                AICvalues[[max + 1]] <- AIC(lmresults[[max + 1]])
            }
            if (i > 0) {
                lmresults[[i]] <- lm(as.formula(paste("x1d ~ 1+x1l+", paste(DifferenceLags[1:i], collapse = "+"))), data = DLDlag.df)
                SBCvalues[[i]] <- BIC(lmresults[[i]])
                AICvalues[[i]] <- AIC(lmresults[[i]])
            }
        }
        if (type == c("ct")) {
            if (i == 0) {
                lmresults[[max + 1]] <- lm(as.formula(paste("x1d ~ 1+x1l+seq_along(x1d)", collapse = "")), data = DLDlag.df)
                SBCvalues[[max + 1]] <- BIC(lmresults[[max + 1]])
                AICvalues[[max + 1]] <- AIC(lmresults[[max + 1]])
            }
            if (i > 0) {
                lmresults[[i]] <- lm(as.formula(paste("x1d ~ 1+x1l+seq_along(x1d)+", paste(DifferenceLags[1:i], collapse = "+"))), data = DLDlag.df)
                SBCvalues[[i]] <- BIC(lmresults[[i]])
                AICvalues[[i]] <- AIC(lmresults[[i]])
            }
        }
    }
    out <- list()
    out$optmins <- list(which.min(SBCvalues), which.min(AICvalues))
    out$SBCAIC <- as.data.frame(cbind(SBCvalues, AICvalues))
    typespecified <- type
    if (which.min(SBCvalues) == max + 1) {
        scs <- (max + 2) - (0 + 1)
        out$adfcst <- unitrootTest(x[scs:length(x)], lags = 0, 
            type = typespecified)
    }
    else {
        scs <- (max + 2) - (which.min(SBCvalues) + 1)
        out$adfcst <- unitrootTest(x[scs:length(x)], lags = which.min(SBCvalues), 
            type = typespecified)
    }
    out
}

and of course, one can present whole the related ADF statistics in a table (as we did in our CAD paper in Procedia) which is given by causfinder::adfcstable:

adfcstable <- function (d, max = 5) 
{
    d <- as.data.frame(d)
    LevelADFtable <- matrix(, nrow = dim(d)[[2]] * 3, ncol = 10)
    FirstDiffADFtable <- matrix(, nrow = dim(d)[[2]] * 3, ncol = 9)
    Result <- matrix(, nrow = dim(d)[[2]] * 3, ncol = 1)
    ADFtable <- as.data.frame(cbind(LevelADFtable, FirstDiffADFtable, Result), stringsAsFactors = FALSE)
    colnames(ADFtable) <- c("var", "type", "inc", "levelt", "Pc", "c", "Pt", "t", "prob", "omlo", "type", "inc", "1stDifft", "Pc", "c", "Pt", "t", "prob", "omlo", "intorder")
    for (i in as.integer(1:dim(d)[[2]])) {
        for (j in as.integer(1:3)) {
            ADFtable[3 * (i - 1) + j, 1] <- colnames(d)[[i]]
        }
        ADFtable[3 * i - 2, 2] <- "dt"
        ADFtable[3 * i - 2, 11] <- "dt"
        ADFtable[3 * i - 1, 2] <- "d"
        ADFtable[3 * i - 1, 11] <- "d"
        ADFtable[3 * i, 2] <- "-"
        ADFtable[3 * i, 11] <- "-"
        ADFtable[3 * i - 2, 3] <- round(adfcs(d[, i], type = c("ct"))$adfcst@test$regression$coefficients[2, 1], digits = 3)
        ADFtable[3 * i - 1, 3] <- round(adfcs(d[, i], type = c("c"))$adfcst@test$regression$coefficients[2, 1], digits = 3)
        ADFtable[3 * i, 3] <- round(adfcs(d[, i], type = c("nc"))$adfcst@test$regression$coefficients[1, 1], digits = 3)
        ADFtable[3 * i - 2, 12] <- round(adfcs(diff(d[, i], differences = 1), type = c("ct"))$adfcst@test$regression$coefficients[2, 1], digits = 3)
        ADFtable[3 * i - 1, 12] <- round(adfcs(diff(d[, i], differences = 1), type = c("c"))$adfcst@test$regression$coefficients[2, 1], digits = 3)
        ADFtable[3 * i, 12] <- round(adfcs(diff(d[, i], differences = 1), type = c("nc"))$adfcst@test$regression$coefficients[1, 1], digits = 3)
        ADFtable[3 * i - 2, 4] <- round(adfcs(d[, i], type = c("ct"))$adfcst@test$statistic, digits = 3)
        ADFtable[3 * i - 1, 4] <- round(adfcs(d[, i], type = c("c"))$adfcst@test$statistic, digits = 3)
        ADFtable[3 * i, 4] <- round(adfcs(d[, i], type = c("nc"))$adfcst@test$statistic, digits = 3)
        ADFtable[3 * i - 2, 13] <- round(adfcs(diff(d[, i], differences = 1), type = c("ct"))$adfcst@test$statistic, digits = 3)
        ADFtable[3 * i - 1, 13] <- round(adfcs(diff(d[, i], differences = 1), type = c("c"))$adfcst@test$statistic, digits = 3)
        ADFtable[3 * i, 13] <- round(adfcs(diff(d[, i], differences = 1), type = c("nc"))$adfcst@test$statistic, digits = 3)
        ADFtable[3 * i - 2, 5] <- round(adfcs(d[, i], type = c("ct"))$adfcst@test$regression$coefficients[1, 4], digits = 3)
        ADFtable[3 * i - 2, 7] <- round(adfcs(d[, i], type = c("ct"))$adfcst@test$regression$coefficients[3, 4], digits = 3)
        ADFtable[3 * i - 1, 5] <- round(adfcs(d[, i], type = c("c"))$adfcst@test$regression$coefficients[1, 4], digits = 3)
        ADFtable[3 * i - 1, 7] <- "X"
        ADFtable[3 * i, 5] <- "X"
        ADFtable[3 * i, 7] <- "X"
        ADFtable[3 * i - 2, 14] <- round(adfcs(diff(d[, i], differences = 1), type = c("ct"))$adfcst@test$regression$coefficients[1, 4], digits = 3)
        ADFtable[3 * i - 2, 16] <- round(adfcs(diff(d[, i], differences = 1), type = c("ct"))$adfcst@test$regression$coefficients[3, 4], digits = 3)
        ADFtable[3 * i - 1, 14] <- round(adfcs(diff(d[, i], differences = 1), type = c("c"))$adfcst@test$regression$coefficients[1, 4], digits = 3)
        ADFtable[3 * i - 1, 16] <- "X"
        ADFtable[3 * i, 14] <- "X"
        ADFtable[3 * i, 16] <- "X"
        if (ADFtable[3 * i - 2, 5] < 0.05) {
            ADFtable[3 * i - 2, 6] <- "s"
        }
        else {
            ADFtable[3 * i - 2, 6] <- " "
        }
        if (ADFtable[3 * i - 2, 7] < 0.05) {
            ADFtable[3 * i - 2, 8] <- "s"
        }
        else {
            ADFtable[3 * i - 2, 8] <- " "
        }
        if (ADFtable[3 * i - 1, 5] < 0.05) {
            ADFtable[3 * i - 1, 6] <- "s"
        }
        else {
            ADFtable[3 * i - 1, 6] <- " "
        }
        ADFtable[3 * i - 1, 8] <- "X"
        ADFtable[3 * i, 6] <- "X"
        ADFtable[3 * i, 8] <- "X"
        if (ADFtable[3 * i - 2, 14] < 0.05) {
            ADFtable[3 * i - 2, 15] <- "s"
        }
        else {
            ADFtable[3 * i - 2, 15] <- " "
        }
        if (ADFtable[3 * i - 2, 16] < 0.05) {
            ADFtable[3 * i - 2, 17] <- "s"
        }
        else {
            ADFtable[3 * i - 2, 17] <- " "
        }
        if (ADFtable[3 * i - 1, 14] < 0.05) {
            ADFtable[3 * i - 1, 15] <- "s"
        }
        else {
            ADFtable[3 * i - 1, 15] <- " "
        }
        ADFtable[3 * i - 1, 17] <- "X"
        ADFtable[3 * i, 15] <- "X"
        ADFtable[3 * i, 17] <- "X"
        ADFtable[3 * i - 2, 9] <- round(adfcs(d[, i], type = c("ct"))$adfcst@test$p.value[[1]], digits = 3)
        ADFtable[3 * i - 1, 9] <- round(adfcs(d[, i], type = c("c"))$adfcst@test$p.value[[1]], digits = 3)
        ADFtable[3 * i, 9] <- round(adfcs(d[, i], type = c("nc"))$adfcst@test$p.value[[1]], digits = 3)
        ADFtable[3 * i - 2, 18] <- round(adfcs(diff(d[, i], differences = 1), type = c("ct"))$adfcst@test$p.value[[1]], digits = 3)
        ADFtable[3 * i - 1, 18] <- round(adfcs(diff(d[, i], differences = 1), type = c("c"))$adfcst@test$p.value[[1]], digits = 3)
        ADFtable[3 * i, 18] <- round(adfcs(diff(d[, i], differences = 1), type = c("nc"))$adfcst@test$p.value[[1]], digits = 3)
        ADFtable[3 * i - 2, 10] <- round(adfcs(d[, i], type = c("ct"))$adfcst@test$parameter, digits = 3)
        ADFtable[3 * i - 1, 10] <- round(adfcs(d[, i], type = c("c"))$adfcst@test$parameter, digits = 3)
        ADFtable[3 * i, 10] <- round(adfcs(d[, i], type = c("nc"))$adfcst@test$parameter, digits = 3)
        ADFtable[3 * i - 2, 19] <- round(adfcs(diff(d[, i], differences = 1), type = c("ct"))$adfcst@test$parameter, digits = 3)
        ADFtable[3 * i - 1, 19] <- round(adfcs(diff(d[, i], differences = 1), type = c("c"))$adfcst@test$parameter, digits = 3)
        ADFtable[3 * i, 19] <- round(adfcs(diff(d[, i], differences = 1), type = c("nc"))$adfcst@test$parameter, digits = 3)
        if (sum(as.numeric(c(ADFtable[3 * i - 2, 9] < 0.05 && ADFtable[3 * i - 2, 3] < 0, ADFtable[3 * i - 1, 9] < 0.05 && ADFtable[3 * i - 1, 3] < 0, ADFtable[3 * i, 9] < 0.05 && ADFtable[3 * i, 3] < 0))) > 1) {
            ADFtable[3 * i - 1, 20] <- "I(0)"
        }
        else {
            if (sum(as.numeric(c(ADFtable[3 * i - 2, 18] < 0.05 && ADFtable[3 * i - 2, 12] < 0, ADFtable[3 * i - 1, 18] < 0.05 && ADFtable[3 * i - 1, 12] < 0, ADFtable[3 * i, 18] < 0.05 && ADFtable[3 * i, 12] < 0))) > 1) {
                ADFtable[3 * i - 1, 20] <- "I(1)"
            }
            else {
                ADFtable[3 * i - 1, 20] <- "variableoi"
            }
        }
        ADFtable[3 * i - 2, 20] <- ""
        ADFtable[3 * i, 20] <- ""
    }
    ADFtable
}

1 Even for VECM models (eg, our variables are I(1) and cointegrated), we select number of lags based on information criteria on VAR model on levels of our time series. Functions of the same duty with differing capacity:

vars::VARselect # or 
FIAR::ARorder # or 
causfinder::ARorderG # or 
causfinder::VARomlop (the last package is not free)

is to be run on variables in levels (not differenced).

2 To check cointegration, use

ca.jo(..,K=cointegrationLength)

Argument K in ca.jo controls the number of lags of VECM model. Pass the number of lags found in VARomlop (or in others) as argument K. Determine the cointegration rank using ca.jo. ecdet option is "none" for no intercept in cointegration equation, "const" for constant term in cointegration equation and "trend" for trend variable in cointegration equation.

Normalization of the long-run relationship are specified according to 1st column in mydata, which can be changed (if desired) via changing the columns of submitted mydata via, eg, mydata[,"X2","X1","X3","X4"].

K is the number of lags for the VAR in levels, so K - 1 is the number of lags in the VECM representation. eg,

summary(ca.jo(mydata, ecdet="none", type="eigen", K=29))

Based on the results of eigen/trace test, determine the existence of cointegration, and cointegration rank r.

3 If cointegration is detected above among the series in the system, fit a vector error correction model (VECM) by taking the cointegration rank into account. ie, we are fitting a VECM model using the ca.jo's cointegration vectors in above step. The result of ca.jo and the number of cointegration vectors are passed to cajorls. cajorls has the argument r (cointegration rank).

A normalized cointegration vector is produced by estimating a restricted VECM with the command cajorls(). eg,

cajorls(...,K=lagLength)
cajorls(ca.jo(mydata, ecdet="none", type="eigen", K=29),r=1)

The error correction term may be included in each equation of the VECM only once. It is either lagged by 1 or by p where p is the lag order of the VECM; the corresponding representations of the VECM are known as long-run and transitory; it is still the same model, just different representations; we pick the one we like.

4 To convert VECM to VAR:

vars::vec2var

Analyze:
http://www.r-bloggers.com/cointegration-r-irish-mortgage-debt-and-property-prices/ that answers your questions as well.

If you have a 2-variable VAR system, remain in classical G-causality. If you have a ">2"-variable VAR system, you must go to advanced G-causality: Conditional G-causality, Partial G-causality, Harmonic G-causality, Canonical G-causality, Global G-causality etc.

You may study the following papers as well:

1. "Causfinder: An R package for Systemwise Analysis of Conditional and Partial Granger Causalities", International Journal of Science and Advanced Technology, October 2014. http://www.ijsat.com/view.php?id=2014:October:Volume%204%20Issue%2010

2. "Determinants of Current Account Deficit in Turkey: The Conditional and Partial Granger Causality Approach" (Extended; 33 pages) https://www.academia.edu/17698799/Determinants_of_Current_Account_Deficit_in_Turkey_The_Conditional_and_Partial_Granger_Causality_Approach_Extended_

"Determinants of Current Account Deficit in Turkey: The Conditional and Partial Granger Causality Approach" (9 pages), Procedia Economics and Finance, Vol. 26, 2015, p.92-100 https://www.academia.edu/17057780/Determinants_of_Current_Account_Deficit_in_Turkey_The_Conditional_and_Partial_Granger_Causality_Approach

causfinder is a GENERALIZATION of FIAR package (You can find FIAR in CRAN archieve. FIAR 0.3, 0.4 and 0.5. FIAR is totally free). https://cran.r-project.org/src/contrib/Archive/FIAR I highly suggest FIAR 0.3 since 0.3 version is clearly more and more extendable than the later versions. Even you do not need to analyze 0.4 and 0.5 version. Hence, I constructed causfinder over FIAR 0.3.

In FIAR, you find the CGCs one by one. In causfinder, it gives ALL the CGCs systemwisely and at once. In 6-variable system, there are 6*5=30 CGC and 30 PGC. These 30+30=60 CGCs and PGCs are calculated one by one in FIAR (60 commands). In causfinder, these 30+30 GCs are calculated with only 2 commands. In 5-variable system, there are 5*4=20 CGC and 20 PGC. These 20+20=40 CGCs and PGCs are calculated one by one in FIAR (40 commands). In causfinder, these 20+20 GCs are calculated with only 2 commands.

What causfinder provides (over FIAR) is extreme speed/pace, simplicity, visualization, and ease of analysis; nothing else.

If you wanna study CGC or PGC, you can do it via FIAR as well: Journal of Statistical Software (JSS): https://www.jstatsoft.org/article/view/v044i13 FIAR: An R Package for Analyzing Functional Integration in the Brain

Note that:

In R:

The packages that can perform CGC and PGC analysis: FIAR and causfinder

In Matlab:

The packages that can perform CGC and PGC analysis:

GCCA (Granger Causal Connectivity Analysis) (Anil SETH) 2009:
MVGC (Multivariate Granger Causality) 2014: New version of GCCA
GrangerCausalityGUI (the resultant work of Jianfeng FENG group that was developed in accompany of some papers through 2008-2013.

In 2011, Roelstraete and Rosseel's FIAR R package that handles advanced G-causality analysis revealed a bug in GCCA!

To my knowledge, in other statistical/econometric softwares, there is no package/function that can perform CGC and PGC.
Programming in Matlab is definitely more difficult than it is in R. Hence, I wrote causfinder in R (after I experience the coding in Gretl and Eviews.). (We think therefore we R!)

5 After you obtained VAR (from VECM) in which restriction caused by the cointegration is loaded on the coefficients of VAR; (do the following if you have ">2"-variable system in Step 0. If not, there are already classical G-causality packages in R; use them)

FIAR::condGranger
FIAR::partGranger

or

causfinder::conditionalGgFp
causfinder::partialGgFp

If you want bootstrapping as well, then:

causfinder::conditionalGblup
causfinder::partialGblup

Answer 2

您可以在 R 中使用 Toda-Yamamoto 方法Toda-Yamamoto 实现。