R/restrict.R

In vars: VAR Modelling

"restrict" <- 
function (x, method = c("ser", "manual"), thresh = 2, resmat = NULL) 
{
    if (!is(x, "varest")) {
        stop("\nPlease provide an object of class 'varest', generated by 'var()'.\n")
    }
    method <- match.arg(method)
    thresh <- abs(thresh)
    K <- x$K
    p <- x$p
    datasub <- x$datamat[, -c(1:K)]
    namesall <- colnames(datasub)
    yendog <- x$datamat[, c(1:K)]
    sample <- x$obs
    ser <- function(x, y) {
        tvals <- abs(coef(summary(x))[, 3])
        datares <- datasub
        if(min(tvals) >= thresh){
          lmres <- x
          datares <- datasub
        } else {
          while (min(tvals) < thresh) {
            if (ncol(datares) > 1) {
              cnames <- colnames(datares)
              datares <- as.data.frame(datares[, -1 * which.min(tvals)])
              colnames(datares) <- cnames[-1 * which.min(tvals)]
              lmres <- lm(y ~ -1 + ., data = datares)
              tvals <- abs(coef(summary(lmres))[, 3])
            } else {
              lmres <- NULL
              datares <- NULL
              break
            }
          }
        }
        return(list(lmres = lmres, datares = datares))

      }
    if (method == "ser") {
        x$restrictions <- matrix(0, nrow = K, ncol = ncol(datasub))
        colnames(x$restrictions) <- namesall
        rownames(x$restrictions) <- colnames(yendog)
        for (i in 1:K) {
            temp <- ser(x$varresult[[i]], yendog[, i])
            if (is.null(temp$lmres)) {
                stop(paste("\nNo significant regressors remaining in equation for", 
                  colnames(yendog)[i], ".\n"))
            }
            x$varresult[[i]] <- temp[[1]]
            namessub <- colnames(temp[[2]])
            x$restrictions[i, namesall %in% namessub] <- 1
        }
    }
    else if (method == "manual") {
        resmat <- as.matrix(resmat)
        if (!(nrow(resmat) == K) | !(ncol(resmat) == ncol(datasub))) {
            stop(paste("\n Please provide resmat with dimensions:", 
                K, "x", ncol(datasub), "\n"))
        }
        x$restrictions <- resmat
        colnames(x$restrictions) <- namesall
        rownames(x$restrictions) <- colnames(yendog)
        for (i in 1:K) {
            datares <- data.frame(datasub[, which(x$restrictions[i, ] == 1)])
            colnames(datares) <- colnames(datasub)[which(x$restrictions[i, ] == 1)]
            y <- yendog[, i]
            lmres <- lm(y ~ -1 + ., data = datares)
            x$varresult[[i]] <- lmres
        }
    }
    return(x)
}