## ----setup0, include = FALSE-------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----echo = FALSE, warning=FALSE---------------------------------------------- text_tbl <- data.frame( FM = c("VAR", "fevd", "irf", "predict", "summary", "arch.test_sh", "normality.test_sh", "serial.test_sh", "stability_sh"), CL = c("varshrinkest, varest", "varfevd", "varshirf, varirf", "varprd", "varshsum, varsum", "varcheck", "varcheck", "varcheck", "varstabil"), MC = c("coef, fevd, fitted, irf, logLik, Phi, plot, predict, print, Psi, resid, summary", "plot, print", "plot, print", "plot, print", "print", "plot, print", "plot, print", "plot, print", "plot, print"), FC = c("Acoef_sh, arch.test_sh, Bcoef_sh, BQ_sh, causality_sh, normality.test_sh, restrict_sh, roots_sh, serial.test_sh, stability_sh", " ", " ", "fanchart", " ", " ", " ", " ", " ") ) colnames(text_tbl) <- c("Function or method", "Class", "Methods for class", "Functions for class") kableExtra::column_spec( knitr::kable(text_tbl, caption = "Table 1. Structure of the package VARshrink."), 1:4, width = "7em", border_left = FALSE, border_right = FALSE) ## ----setup, include = FALSE--------------------------------------------------- library(VARshrink) ## ----results = "hide", message=FALSE------------------------------------------ set.seed(1000) myCoef <- list(A = list(matrix(c(0.5, 0, 0, 0.5), 2, 2)), c = c(0.2, 0.7)) myModel <- list(Coef = myCoef, Sigma = diag(0.1^2, 2), dof = Inf) Y <- simVARmodel(numT = 100, model = myModel, burnin = 10) resu_estim <- list() ## ----modeldemo, include = FALSE----------------------------------------------- load("table2_modeldemo.RData") ## ----------------------------------------------------------------------------- resu_estim$`Ridge regression` ## ----------------------------------------------------------------------------- summary(resu_estim$`Ridge regression`) ## ----------------------------------------------------------------------------- resu_estim$`Nonparametric shrinkage` ## ----------------------------------------------------------------------------- summary(resu_estim$`Nonparametric shrinkage`) ## ----------------------------------------------------------------------------- resu_estim$`Full Bayes (fixed dof)` ## ----------------------------------------------------------------------------- summary(resu_estim$`Full Bayes (fixed dof)`) ## ----------------------------------------------------------------------------- resu_estim$`Full Bayes (estim dof)` ## ----------------------------------------------------------------------------- resu_estim$`Semi Bayes (fixed dof)` summary(resu_estim$`Semi Bayes (fixed dof)`) ## ----------------------------------------------------------------------------- resu_estim$`Semi Bayes (estim dof)` ## ----------------------------------------------------------------------------- resu_estim$`K-fold CV (fixed dof)` ## ----eval = FALSE------------------------------------------------------------- # resu_estim$`K-fold CV (estim dof)` <- # VARshrink(Y, p = 1, type = "const", method = "kcv", dof = NULL, # lambda = NULL, lambda_var = NULL, prior_type = "NCJ", # num_folds = 5, m0 = ncol(Y)) ## ----------------------------------------------------------------------------- resu_sse <- data.frame(SSE = sapply(resu_estim, function(x) calcSSE_Acoef(Acoef_sh(x), myCoef$A))) ## ----echo = FALSE------------------------------------------------------------- knitr::kable(round(resu_sse, 3), caption = "Table 2. Sum of squared errors of VAR coefficients estimated by the shrinkage methods.") ## ----diffCanada, out.width='70%', fig.cap = "Figure 1. The benchmark data set obtained by differencing the Canada data."---- data(Canada, package = "vars") Y = diff(Canada) plot(Y, cex.lab = 1.3) ## ----eval = FALSE------------------------------------------------------------- # set.seed(1000) # resu_model <- array(NA, dim = c(5, 2, 3), # dimnames = list(c("Ridge regression", "Nonparametric shrinkage", # "Full Bayes", "Semi Bayes", "K-fold CV"), # c("AIC", "BIC"), c("p=1", "p=2", "p=3"))) # for (p in 1:3) { # EstimRidge <- VARshrink(Y, p = p, type = "const", method = "ridge") # resu_model["Ridge regression", , p] <- c(AIC(EstimRidge), BIC(EstimRidge)) # # EstimNS <- VARshrink(Y, p = p, type = "none", method = "ns") # resu_model["Nonparametric shrinkage", , p] <- # c(AIC(EstimNS), BIC(EstimNS)) # # EstimFB <- VARshrink(Y, p = p, type = "const", method = "fbayes", dof = NULL) # resu_model["Full Bayes", , p] <- c(AIC(EstimFB), BIC(EstimFB)) # # EstimSB <- VARshrink(Y, p = p, type = "const", method = "sbayes", # dof = NULL, prior_type = "NCJ") # resu_model["Semi Bayes", , p] <- c(AIC(EstimSB), BIC(EstimSB)) # # EstimKCV <- VARshrink(Y, p = p, type = "const", method = "kcv", # dof = NULL, prior_type = "NCJ") # resu_model["K-fold CV", , p] <- c(AIC(EstimKCV), BIC(EstimKCV)) # } ## ----include = FALSE---------------------------------------------------------- load("table3_modelcomp.RData") ## ----modelcomp, echo = FALSE-------------------------------------------------- knitr::kable(round(resu_model, 1), caption = "Table 3. Information criteria (AIC, BIC) for model comparison.") ## ----pred, fig.cap="Figure 2. A 10-step ahead Forecasting of time series by the VAR model estimated by the nonparametric shrinkage method. The differenced Canada data were modeled by a VAR(2) model selected at the minimum BIC."---- plot(predict(VARshrink(Y, p = 2, type = "none", method = "ns")), names = "U")