tests/testthat/setup-all.R

data("exrates", package = "stochvol")

y <- factorstochvol::logret(exrates[1:15, 1:3], demean = TRUE)
draws <- 27
burnin <- 10

thin_values <- c(1,3)
lag_values <- c(1L,2L,3L)
PHI_priors <- c("normal","HMP", "SSVS", "NG", "DL", "R2D2", "HS") #"HMP"
intercept_values <- c(0,10)
sv_keep <- c("all","last")
semi_groups <- c("global", "olcl-lagwise")
keep <- "last"
# test prior_phi options
res <- list(bvar(y,draws = draws, burnin = burnin,quiet=TRUE))
for(thin in thin_values){
  #for(keep in sv_keep){
    for(lags in lag_values){
      for(intercept in intercept_values){
        myintercept <- if(intercept==0) FALSE else intercept
        for(prior in PHI_priors){
          if(prior == "normal"){
            prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior, normal_sds = 10)
            res <- c(res, list(bvar(y , lags = lags, prior_intercept = myintercept,
                                    draws = draws, burnin = burnin, thin = thin,
                                    prior_phi = prior_phi,
                                    sv_keep = keep,
                                    quiet = TRUE)))
          }else if(prior == "HMP"){
            prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior)
            res <- c(res, list(bvar(y , lags = lags, prior_intercept = myintercept,
                                    draws = draws, burnin = burnin, thin = thin,
                                    prior_phi = prior_phi,
                                    sv_keep = keep,
                                    quiet = TRUE)))
          }else if(prior == "SSVS" || prior == "NG" || prior == "DL" ||
                   prior == "R2D2" || prior == "HS"){
            for(group in semi_groups){
              if(prior == "SSVS"){
                for(ssvs_p in c(0.5, 1)){
                  if(ssvs_p == 1){
                    ssvs_p = c(1,1)
                  }
                  prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior,
                                               global_grouping = group,
                                               SSVS_p = ssvs_p)
                  res <- c(res, list(bvar(y , lags = lags, prior_intercept = myintercept,
                                          draws = draws, burnin = burnin, thin = thin,
                                          prior_phi = prior_phi,
                                          sv_keep = keep,
                                          quiet = TRUE)))
                }
              }else if(prior == "NG" || prior == "DL" || prior == "R2D2" ){
                for(a_shrink in c(0.5,1)){
                  if(a_shrink==1){
                    a_shrink <- cbind(seq(0.1,1,by=.1), rep(1/10,10))
                  }
                  if(prior == "NG"){
                    prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior,
                                                 global_grouping = group,
                                                 NG_a = a_shrink)
                  }else if(prior == "R2D2"){
                    prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior,
                                                 global_grouping = group,
                                                 R2D2_a = a_shrink)
                  }else if(prior == "DL"){
                    prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior,
                                                 global_grouping = group,
                                                 DL_a = a_shrink)
                  }
                  res <- c(res, list(bvar(y , lags = lags, prior_intercept = myintercept,
                                          draws = draws, burnin = burnin, thin = thin,
                                          prior_phi = prior_phi,
                                          sv_keep = keep,
                                          quiet = TRUE)))
                }

              }else if(prior == "HS"){
                prior_phi <- specify_prior_phi(data = y, lags = lags, prior = prior,
                                             global_grouping = group)
                res <- c(res, list(bvar(y , lags = lags, prior_intercept = myintercept,
                                        draws = draws, burnin = burnin, thin = thin,
                                        prior_phi = prior_phi,
                                        sv_keep = keep,
                                        quiet = TRUE)))
              }
            }
          }
        }
      }
    }
  #}
}


SIGMA_priors <- c("normal","HMP", "SSVS", "NG", "DL", "R2D2", "HS")
heteroscedastic <- c(TRUE,FALSE)
res <- list(bvar(y,draws = draws, burnin = burnin,quiet = TRUE))
for(thin in thin_values){
  for(scedastic in heteroscedastic){
    for(prior in SIGMA_priors){

      if(prior == "normal" |prior == "HMP" | prior =="HS"){
        prior_sigma <- specify_prior_sigma(data = y, type = "cholesky",
                                         cholesky_U_prior = prior,
                                         cholesky_heteroscedastic = scedastic,
                                         quiet = TRUE)
        res <- c(res, list(bvar(y , draws = draws, burnin = burnin, thin = thin,
                                prior_sigma = prior_sigma,
                                sv_keep = keep,
                                quiet = TRUE)))
      }else if(prior == "NG" | prior == "R2D2" | prior == "DL"){
        for(a_shrink in c(0.5,1)){
          if(a_shrink==1){
            a_shrink <- cbind(seq(0.1,1,by=.1), rep(1/10,10))
          }
          if(prior == "NG"){
            prior_sigma <- specify_prior_sigma(data = y, type = "cholesky",
                                             cholesky_U_prior = prior,
                                             cholesky_heteroscedastic = scedastic,
                                             cholesky_NG_a = a_shrink,
                                             quiet = TRUE)
          }else if(prior == "R2D2"){
            prior_sigma <- specify_prior_sigma(data = y, type = "cholesky",
                                             cholesky_U_prior = prior,
                                             cholesky_heteroscedastic = scedastic,
                                             cholesky_R2D2_a = a_shrink,
                                             quiet = TRUE)
          }else if(prior == "DL"){
            prior_sigma <- specify_prior_sigma(data = y, type = "cholesky",
                                             cholesky_U_prior = prior,
                                             cholesky_heteroscedastic = scedastic,
                                             cholesky_DL_a =  a_shrink,
                                             quiet = TRUE)
          }
        }
        res <- c(res, list(bvar(y ,draws = draws, burnin = burnin, thin = thin,
                                prior_sigma = prior_sigma,
                                sv_keep = keep,
                                quiet = TRUE)))
      }else if(prior == "SSVS" ){
        for(ssvs_p in c(0.5, 1)){
          if(ssvs_p == 1){
            ssvs_p = c(1,1)
          }
          prior_sigma <- specify_prior_sigma(data = y, type = "cholesky",
                                           cholesky_U_prior = prior,
                                           cholesky_heteroscedastic = scedastic,
                                           cholesky_SSVS_p = ssvs_p,
                                           quiet = TRUE)
          res <- c(res, list(bvar(y , draws = draws, burnin = burnin, thin = thin,
                                  prior_sigma = prior_sigma,
                                  sv_keep = keep,
                                  quiet = TRUE)))
        }

      }
    }
  }
}






# factors_values <- c(0, 1, 3)
# restrict_mat <- matrix(FALSE, nrow = NCOL(y), ncol = max(factors_values))
# restrict_mat[1, 1] <- TRUE  # restrict the upper left element to zero
# restrict_values <- list("upper", "none")
# priorfacloadtype_values <- c("normal", "rowwiseng", "colwiseng")
# priorhomoskedastic <- matrix(c(1.1, 1.1), nrow = NCOL(y),
#                              ncol = 2, byrow = TRUE)
# heteroskedastic_values <- list(TRUE, c(FALSE, FALSE))
#
#
# for (th in thin_values) {
#   for (pflt in priorfacloadtype_values) {
#     for (hsk in heteroskedastic_values) {
#       for (fs in factors_values) {
#         res <- c(res, list(fsvsample(y, draws = draws, burnin = burnin, quiet = TRUE,
#                                      factors = fs, thin = th, priorfacloadtype = pflt,
#                                      restrict = "none",
#                                      heteroskedastic = hsk,
#                                      priorhomoskedastic = if (!isTRUE(hsk)) priorhomoskedastic else NA,
#                                      interweaving = if (!isTRUE(hsk)) 0 else 4,
#                                      runningstore = if (fs == 0) 1 else 6)))
#         if (fs > 1) {
#           for (rst in restrict_values) {
#             res <- c(res, list(fsvsample(y, draws = draws, burnin = burnin, quiet = TRUE,
#                                          factors = fs, thin = th, priorfacloadtype = pflt,
#                                          heteroskedastic = hsk,
#                                          priorhomoskedastic = if (!isTRUE(hsk)) priorhomoskedastic else NA,
#                                          interweaving = if (!isTRUE(hsk)) 0 else 4,
#                                          restrict = rst)))
#           }
#         }
#       }
#     }
#   }
# }

Try the bayesianVARs package in your browser

Any scripts or data that you put into this service are public.

bayesianVARs documentation built on April 3, 2025, 6:25 p.m.