Forecasting

library(bvhar)

Simulation

Given VAR coefficient and VHAR coefficient each,

We use coefficient matrix estimated by VAR in introduction vignette.

Consider

coef(ex_fit)
#>               GVZCLS   OVXCLS    EVZCLS VXFXICLS
#> GVZCLS_1    0.827400  0.04626 -0.000391  0.03992
#> OVXCLS_1    0.015706  0.96702  0.005990  0.04646
#> EVZCLS_1    0.132533 -0.04692  0.904523  0.18498
#> VXFXICLS_1  0.004158  0.04648  0.015187  0.91243
#> GVZCLS_2   -0.000881 -0.04728 -0.034850 -0.11226
#> OVXCLS_2   -0.019997 -0.05515  0.000953 -0.04565
#> EVZCLS_2   -0.026889  0.12805  0.043199 -0.08272
#> VXFXICLS_2 -0.004366 -0.05029 -0.015050 -0.01171
#> GVZCLS_3    0.087844  0.13821  0.073276  0.06775
#> OVXCLS_3    0.000178  0.00884 -0.007817  0.07639
#> EVZCLS_3    0.029150 -0.02714  0.051464  0.05883
#> VXFXICLS_3 -0.026709 -0.01440 -0.016283 -0.02096
#> GVZCLS_4    0.053766 -0.04758 -0.010970 -0.05345
#> OVXCLS_4    0.015398 -0.02214 -0.007277 -0.08517
#> EVZCLS_4   -0.121808  0.03472 -0.035454 -0.05358
#> VXFXICLS_4 -0.002586 -0.03650  0.003372  0.06740
#> GVZCLS_5   -0.036884 -0.11553 -0.031572  0.00612
#> OVXCLS_5   -0.000271  0.08879  0.012152  0.01653
#> EVZCLS_5    0.004416 -0.08393  0.005238 -0.05806
#> VXFXICLS_5  0.034091  0.07256  0.012626  0.02516
#> const       0.322322  0.35255  0.217529  0.68646
ex_fit$covmat
#>          GVZCLS OVXCLS EVZCLS VXFXICLS
#> GVZCLS    0.583  0.363  0.157    0.478
#> OVXCLS    0.363  3.339  0.187    1.021
#> EVZCLS    0.157  0.187  0.251    0.234
#> VXFXICLS  0.478  1.021  0.234    2.564

Then

m <- ncol(ex_fit$coefficients)
# generate VAR(5)-----------------
y <- sim_var(
  1500, 
  100, 
  coef(ex_fit), 
  5, 
  diag(ex_fit$covmat) %>% diag(), 
  matrix(0L, nrow = 5, ncol = m)
)
# colname: y1, y2, ...------------
colnames(y) <- paste0("y", 1:m)
head(y)
#>        y1   y2   y3   y4
#> [1,] 15.8 47.5 9.11 32.2
#> [2,] 15.4 46.7 8.99 31.8
#> [3,] 16.6 45.4 8.84 32.6
#> [4,] 17.3 44.1 8.66 33.2
#> [5,] 17.9 43.7 8.00 35.6
#> [6,] 18.8 42.6 8.11 32.1
h <- 20
y_eval <- divide_ts(y, h)
y_train <- y_eval$train # train
y_test <- y_eval$test # test

Fitting Models

VAR(5) and VHAR

# VAR(5)
model_var <- var_lm(y_train, 5)
# VHAR
model_vhar <- vhar_lm(y_train)

BVAR(5)

Minnesota prior

# hyper parameters---------------------------
y_sig <- apply(y_train, 2, sd) # sigma vector
y_lam <- .2 # lambda
y_delta <- rep(.2, m) # delta vector (0 vector since RV stationary)
eps <- 1e-04 # very small number
spec_bvar <- set_bvar(y_sig, y_lam, y_delta, eps)
# fit---------------------------------------
model_bvar <- bvar_minnesota(y_train, 5, spec_bvar)

BVHAR

VAR-type Minnesota

spec_bvhar_v1 <- set_bvhar(y_sig, y_lam, y_delta, eps)
# fit---------------------------------------
model_bvhar_v1 <- bvhar_minnesota(y_train, spec_bvhar_v1)

VHAR-type Minnesota

# weights----------------------------------
y_day <- rep(.2, m)
y_week <- rep(.1, m)
y_month <- rep(.1, m)
# spec-------------------------------------
spec_bvhar_v2 <- set_weight_bvhar(
  y_sig,
  y_lam,
  eps,
  y_day,
  y_week,
  y_month
)
# fit--------------------------------------
model_bvhar_v2 <- bvhar_minnesota(y_train, spec_bvhar_v2)

Forecasting

You can forecast using predict() method with above objects. You should set the step of the forecasting using n_ahead argument.

In addition, the result of this forecast will return another class called predbvhar.

VAR

(pred_var <- predict(model_var, n_ahead = h))
#>         y1   y2   y3   y4
#>  [1,] 14.6 41.1 9.30 18.9
#>  [2,] 14.6 41.3 9.29 19.2
#>  [3,] 14.6 41.2 9.35 19.4
#>  [4,] 14.6 41.2 9.34 19.5
#>  [5,] 14.6 41.1 9.36 19.8
#>  [6,] 14.7 41.0 9.37 19.9
#>  [7,] 14.7 41.0 9.39 20.1
#>  [8,] 14.7 40.9 9.40 20.3
#>  [9,] 14.7 40.8 9.41 20.5
#> [10,] 14.7 40.8 9.42 20.6
#> [11,] 14.7 40.7 9.44 20.8
#> [12,] 14.7 40.7 9.45 21.0
#> [13,] 14.8 40.6 9.46 21.1
#> [14,] 14.8 40.6 9.47 21.3
#> [15,] 14.8 40.5 9.48 21.4
#> [16,] 14.8 40.5 9.49 21.5
#> [17,] 14.8 40.4 9.49 21.7
#> [18,] 14.8 40.4 9.50 21.8
#> [19,] 14.8 40.4 9.51 21.9
#> [20,] 14.8 40.3 9.52 22.0
class(pred_var)
#> [1] "predbvhar"
names(pred_var)
#> [1] "process"     "forecast"    "se"          "lower"       "upper"      
#> [6] "lower_joint" "upper_joint" "y"

The package provides the evaluation function

(mse_var <- mse(pred_var, y_test))
#>     y1     y2     y3     y4 
#>  0.664 63.483  0.601  9.390

VHAR

(pred_vhar <- predict(model_vhar, n_ahead = h))
#>         y1   y2   y3   y4
#>  [1,] 14.5 41.5 9.32 19.1
#>  [2,] 14.5 41.4 9.33 19.3
#>  [3,] 14.6 41.2 9.35 19.5
#>  [4,] 14.6 41.1 9.37 19.7
#>  [5,] 14.6 41.0 9.40 19.8
#>  [6,] 14.5 40.9 9.42 19.9
#>  [7,] 14.5 40.8 9.44 20.0
#>  [8,] 14.5 40.7 9.45 20.1
#>  [9,] 14.5 40.7 9.46 20.2
#> [10,] 14.5 40.6 9.46 20.3
#> [11,] 14.5 40.5 9.46 20.5
#> [12,] 14.5 40.5 9.46 20.6
#> [13,] 14.5 40.4 9.46 20.7
#> [14,] 14.4 40.4 9.45 20.8
#> [15,] 14.4 40.3 9.44 20.9
#> [16,] 14.4 40.3 9.43 21.1
#> [17,] 14.5 40.3 9.42 21.2
#> [18,] 14.5 40.3 9.41 21.4
#> [19,] 14.5 40.3 9.40 21.5
#> [20,] 14.5 40.2 9.40 21.6

MSE:

(mse_vhar <- mse(pred_vhar, y_test))
#>     y1     y2     y3     y4 
#>  0.761 61.461  0.560  8.451

BVAR

(pred_bvar <- predict(model_bvar, n_ahead = h))
#>         y1   y2   y3   y4
#>  [1,] 14.6 41.3 9.24 19.2
#>  [2,] 14.6 41.3 9.25 19.5
#>  [3,] 14.6 41.2 9.26 19.7
#>  [4,] 14.6 41.1 9.27 20.0
#>  [5,] 14.6 41.0 9.29 20.2
#>  [6,] 14.7 40.9 9.31 20.4
#>  [7,] 14.7 40.9 9.32 20.6
#>  [8,] 14.7 40.8 9.33 20.8
#>  [9,] 14.7 40.7 9.35 21.0
#> [10,] 14.7 40.7 9.36 21.2
#> [11,] 14.7 40.6 9.37 21.4
#> [12,] 14.7 40.6 9.38 21.6
#> [13,] 14.7 40.5 9.39 21.8
#> [14,] 14.7 40.5 9.40 21.9
#> [15,] 14.7 40.4 9.41 22.1
#> [16,] 14.7 40.4 9.42 22.2
#> [17,] 14.7 40.3 9.43 22.4
#> [18,] 14.7 40.3 9.43 22.5
#> [19,] 14.8 40.3 9.44 22.7
#> [20,] 14.8 40.2 9.45 22.8

MSE:

(mse_bvar <- mse(pred_bvar, y_test))
#>     y1     y2     y3     y4 
#>  0.666 61.956  0.538 11.618

BVHAR

VAR-type Minnesota

(pred_bvhar_v1 <- predict(model_bvhar_v1, n_ahead = h))
#>         y1   y2   y3   y4
#>  [1,] 14.5 41.4 9.28 19.2
#>  [2,] 14.5 41.2 9.27 19.4
#>  [3,] 14.5 41.1 9.26 19.6
#>  [4,] 14.6 40.9 9.27 19.8
#>  [5,] 14.5 40.8 9.28 20.0
#>  [6,] 14.5 40.8 9.30 20.2
#>  [7,] 14.5 40.7 9.31 20.3
#>  [8,] 14.5 40.6 9.31 20.5
#>  [9,] 14.5 40.5 9.32 20.6
#> [10,] 14.5 40.4 9.32 20.8
#> [11,] 14.5 40.4 9.33 20.9
#> [12,] 14.6 40.3 9.33 21.0
#> [13,] 14.6 40.3 9.33 21.2
#> [14,] 14.6 40.2 9.34 21.3
#> [15,] 14.6 40.2 9.34 21.4
#> [16,] 14.6 40.2 9.34 21.6
#> [17,] 14.6 40.1 9.34 21.7
#> [18,] 14.6 40.1 9.35 21.8
#> [19,] 14.6 40.1 9.35 22.0
#> [20,] 14.6 40.1 9.36 22.1

MSE:

(mse_bvhar_v1 <- mse(pred_bvhar_v1, y_test))
#>     y1     y2     y3     y4 
#>  0.740 59.190  0.489  9.776

VHAR-type Minnesota

(pred_bvhar_v2 <- predict(model_bvhar_v2, n_ahead = h))
#>         y1   y2   y3   y4
#>  [1,] 14.5 41.4 9.27 19.1
#>  [2,] 14.5 41.2 9.25 19.3
#>  [3,] 14.5 41.0 9.23 19.5
#>  [4,] 14.6 40.9 9.24 19.7
#>  [5,] 14.5 40.8 9.25 19.8
#>  [6,] 14.5 40.7 9.26 19.9
#>  [7,] 14.5 40.6 9.26 20.1
#>  [8,] 14.5 40.5 9.27 20.2
#>  [9,] 14.5 40.5 9.27 20.3
#> [10,] 14.5 40.4 9.27 20.4
#> [11,] 14.5 40.4 9.28 20.5
#> [12,] 14.5 40.3 9.28 20.6
#> [13,] 14.5 40.3 9.28 20.8
#> [14,] 14.5 40.3 9.28 20.9
#> [15,] 14.5 40.2 9.28 21.0
#> [16,] 14.5 40.2 9.29 21.1
#> [17,] 14.5 40.2 9.29 21.2
#> [18,] 14.5 40.2 9.29 21.3
#> [19,] 14.5 40.2 9.30 21.5
#> [20,] 14.5 40.2 9.30 21.6

MSE:

(mse_bvhar_v2 <- mse(pred_bvhar_v2, y_test))
#>     y1     y2     y3     y4 
#>  0.752 59.272  0.455  8.682

Compare

Region

autoplot(predbvhar) and autolayer(predbvhar) draws the results of the forecasting.

autoplot(pred_var, x_cut = 1450, ci_alpha = .7) +
  autolayer(pred_vhar, ci_alpha = .5) +
  autolayer(pred_bvar, ci_alpha = .4) +
  autolayer(pred_bvhar_v1, ci_alpha = .2) +
  autolayer(pred_bvhar_v2, ci_alpha = .1)

Error

Mean of MSE

list(
  VAR = mse_var,
  VHAR = mse_vhar,
  BVAR = mse_bvar,
  BVHAR1 = mse_bvhar_v1,
  BVHAR2 = mse_bvhar_v2
) %>% 
  lapply(mean) %>% 
  unlist() %>% 
  sort()
#> BVHAR2 BVHAR1   VHAR    VAR   BVAR 
#>   17.3   17.5   17.8   18.5   18.7

For each variable

list(
  pred_var,
  pred_vhar,
  pred_bvar,
  pred_bvhar_v1,
  pred_bvhar_v2
) %>% 
  gg_loss(y = y_test, "mse")