"restrict" <-
function (x, method = c("ser", "manual"), thresh = 2, resmat = NULL)
{
if (!(class(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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.