Nothing
R/specify_bsvar_exh.R
In bsvars: Bayesian Estimation of Structural Vector Autoregressive Models
#' R6 Class Representing PriorBSVAREXH
#'
#' @description
#' The class PriorBSVAREXH presents a prior specification for the bsvar model with Exogenous regime change Heteroskedasticity.
#'
#' @examples
#' prior = specify_prior_bsvar_exh$new(N = 3, p = 1) # specify the prior
#' prior$A # show autoregressive prior mean
#'
#' @export
specify_prior_bsvar_exh = R6::R6Class(
"PriorBSVAREXH",
inherit = specify_prior_bsvar,
public = list(
#' @field A an \code{NxK} matrix, the mean of the normal prior distribution
#' for the parameter matrix \eqn{A}.
A = matrix(),
#' @field A_V_inv a \code{KxK} precision matrix of the normal prior distribution
#' for each of the row of the parameter matrix \eqn{A}. This precision matrix is equation invariant.
A_V_inv = matrix(),
#' @field B_V_inv an \code{NxN} precision matrix of the generalised-normal prior
#' distribution for the structural matrix \eqn{B}. This precision matrix is equation invariant.
B_V_inv = matrix(),
#' @field B_nu a positive integer greater of equal than \code{N}, a shape parameter
#' of the generalised-normal prior distribution for the structural matrix \eqn{B}.
B_nu = NA,
#' @field hyper_nu_B a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the overall shrinkage parameter for matrix \eqn{B}.
hyper_nu_B = NA,
#' @field hyper_a_B a positive scalar, the shape parameter of the gamma prior
#' for the second-level hierarchy for the overall shrinkage parameter for matrix \eqn{B}.
hyper_a_B = NA,
#' @field hyper_s_BB a positive scalar, the scale parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{B}.
hyper_s_BB = NA,
#' @field hyper_nu_BB a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{B}.
hyper_nu_BB = NA,
#' @field hyper_nu_A a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the overall shrinkage parameter for matrix \eqn{A}.
hyper_nu_A = NA,
#' @field hyper_a_A a positive scalar, the shape parameter of the gamma prior
#' for the second-level hierarchy for the overall shrinkage parameter for matrix \eqn{A}.
hyper_a_A = NA,
#' @field hyper_s_AA a positive scalar, the scale parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{A}.
hyper_s_AA = NA,
#' @field hyper_nu_AA a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{A}.
hyper_nu_AA = NA,
#' @field sigma_nu a positive scalar, the shape parameter of the inverted-gamma 2 for
#' state-dependent variances of the structural shocks, \eqn{\sigma^2_{n.s_t}}.
sigma_nu = 3,
#' @field sigma_s a positive scalar, the scale parameter of the inverted-gamma 2
#' for state-dependent variances of the structural shocks, \eqn{\sigma^2_{n.s_t}}.
sigma_s = 1,
#' @description
#' Create a new prior specification PriorBSVAREXH
#' @param N a positive integer - the number of dependent variables in the model.
#' @param p a positive integer - the autoregressive lag order of the SVAR model.
#' @param d a positive integer - the number of \code{exogenous} variables in the model.
#' @param stationary an \code{N} logical vector - its element set to \code{FALSE} sets
#' the prior mean for the autoregressive parameters of the \code{N}th equation to the random walk process,
#' otherwise to white noise.
#' @return A new prior specification PriorBSVAREXH
initialize = function(N, p, d = 0, stationary = rep(FALSE, N)){
stopifnot("Argument N must be a positive integer number." = N > 0 & N %% 1 == 0)
stopifnot("Argument p must be a positive integer number." = p > 0 & p %% 1 == 0)
stopifnot("Argument d must be a non-negative integer number." = d >= 0 & d %% 1 == 0)
stopifnot("Argument stationary must be a logical vector of length N." = length(stationary) == N & is.logical(stationary))
super$initialize(N, p, d, stationary)
self$sigma_nu = 3
self$sigma_s = 1
}, # END initialize
#' @description
#' Returns the elements of the prior specification PriorBSVAREXH as a \code{list}.
#'
#' @examples
#' # a prior for 3-variable example with four lags and two regimes
#' prior = specify_prior_bsvar_exh$new(N = 3, p = 4)
#' prior$get_prior() # show the prior as list
#'
get_prior = function(){
list(
A = self$A,
A_V_inv = self$A_V_inv,
B_V_inv = self$B_V_inv,
B_nu = self$B_nu,
hyper_nu_B = self$hyper_nu_B,
hyper_a_B = self$hyper_a_B,
hyper_s_BB = self$hyper_s_BB,
hyper_nu_BB = self$hyper_nu_BB,
hyper_nu_A = self$hyper_nu_A,
hyper_a_A = self$hyper_a_A,
hyper_s_AA = self$hyper_s_AA,
hyper_nu_AA = self$hyper_nu_AA,
sv_a_ = self$sv_a_,
sv_s_ = self$sv_s_,
sigma_nu = self$sigma_nu,
sigma_s = self$sigma_s
)
} # END get_prior
) # END public
) # END specify_prior_bsvar_exh
#' R6 Class Representing StartingValuesBSVAREXH
#'
#' @description
#' The class StartingValuesBSVAREXH presents starting values for the bsvar model
#' with exogenous regime change Heteroskedasticity.
#'
#' @examples
#' # starting values for a bsvar model for a 3-variable system
#' A = matrix(TRUE, 3, 4)
#' B = matrix(TRUE, 3, 3)
#' sv = specify_starting_values_bsvar_exh$new(A = A, B = B, N = 3, p = 1, T = 100)
#'
#' @export
specify_starting_values_bsvar_exh = R6::R6Class(
"StartingValuesBSVAREXH",
inherit = specify_starting_values_bsvar,
public = list(
#' @field A an \code{NxK} matrix of starting values for the parameter \eqn{A}.
A = matrix(),
#' @field B an \code{NxN} matrix of starting values for the parameter \eqn{B}.
B = matrix(),
#' @field hyper a \code{(2*N+1)x2} matrix of starting values for the shrinkage hyper-parameters of the
#' hierarchical prior distribution.
hyper = matrix(),
#' @field sigma2 an \code{NxM} matrix of starting values for the regime-specific
#' variances of the structural shocks. Its elements sum to value \code{M} over the rows.
sigma2 = matrix(),
#' @field xi an \code{MxT} matrix of starting values for the Markov process
#' indicator. Its columns are a chosen column of an identity matrix of order \code{M}.
xi = matrix(),
#' @field lambda a \code{NxT} matrix of starting values for latent variables.
lambda = matrix(),
#' @field df an \code{Nx1} vector of positive numbers with starting values
#' for the equation-specific degrees of freedom parameters of the Student-t
#' conditional distribution of structural shocks.
df = numeric(),
#' @description
#' Create new starting values StartingValuesBSVAREXH.
#' @param A a logical \code{NxK} matrix containing value \code{TRUE} for the elements of
#' the autoregressive matrix \eqn{A} to be estimated and value \code{FALSE} for exclusion restrictions
#' to be set to zero.
#' @param B a logical \code{NxN} matrix containing value \code{TRUE} for the elements of
#' the structural matrix \eqn{B} to be estimated and value \code{FALSE} for exclusion restrictions
#' to be set to zero.
#' @param N a positive integer - the number of dependent variables in the model.
#' @param p a positive integer - the autoregressive lag order of the SVAR model.
#' @param T a positive integer - the the time series dimension of the dependent
#' variable matrix \eqn{Y}.
#' @param d a positive integer - the number of \code{exogenous} variables in the model.
#' @param variance_regimes a \code{T}-vector with exogenous regime indicators that are integer
#' numbers associating the time observation with heteroskedastic regime.
#' @return Starting values StartingValuesBSVAREXH.
initialize = function(A, B, N, p, T, d = 0, variance_regimes = rep(1, T)){
stopifnot("Argument N must be a positive integer number." = N > 0 & N %% 1 == 0)
stopifnot("Argument p must be a positive integer number." = p > 0 & p %% 1 == 0)
stopifnot("Argument T must be a positive integer number." = T > 0 & T %% 1 == 0)
stopifnot("Argument d must be a non-negative integer number." = d >= 0 & d %% 1 == 0)
unique_exh = unique(variance_regimes)
stopifnot("Argument variance_regimes must be a T-vector with integer numbers from 1 to M, where M is th intended number of heteroskedastic regimes." =
is.numeric(variance_regimes) &
all(unique_exh[order(unique_exh)] == 1:max(variance_regimes)) &
all((variance_regimes %% 1) == 0) &
length(variance_regimes) == T
)
super$initialize(A, B, N, T, p, d)
M = max(variance_regimes)
self$sigma2 = matrix(1, N, M)
self$xi = matrix(diag(M)[,variance_regimes], nrow = M)
}, # END initialize
#' @description
#' Returns the elements of the starting values StartingValuesBSVAR-MS as a \code{list}.
#'
#' @examples
#' # starting values for a homoskedastic bsvar with 1 lag for a 3-variable system
#' A = matrix(TRUE, 3, 4)
#' B = matrix(TRUE, 3, 3)
#' sv = specify_starting_values_bsvar_exh$new(A = A, B = B, N = 3, p = 1, T = 100)
#' sv$get_starting_values() # show starting values as list
#'
get_starting_values = function(){
list(
B = self$B,
A = self$A,
hyper = self$hyper,
lambda = self$lambda,
df = self$df,
sigma2 = self$sigma2,
xi = self$xi
)
}, # END get_starting_values
#' @description
#' Returns the elements of the starting values StartingValuesBSVAREXH as a \code{list}.
#' @param last_draw a list containing the last draw.
#' @return An object of class StartingValuesBSVAREXH including the last draw
#' of the current MCMC as the starting value to be passed to the continuation
#' of the MCMC estimation using \code{estimate()}.
#'
#' @examples
#' # starting values for a bsvar model with 1 lag for a 3-variable system
#' A = matrix(TRUE, 3, 4)
#' B = matrix(TRUE, 3, 3)
#' sv = specify_starting_values_bsvar_exh$new(A = A, B = B, N = 3, p = 1, T = 100)
#'
#' # Modify the starting values by:
#' sv_list = sv$get_starting_values() # getting them as list
#' sv_list$A <- matrix(rnorm(12), 3, 4) # modifying the entry
#' sv$set_starting_values(sv_list) # providing to the class object
#'
set_starting_values = function(last_draw) {
self$B = last_draw$B
self$A = last_draw$A
self$hyper = last_draw$hyper
self$lambda = last_draw$lambda
self$df = last_draw$df
self$sigma2 = last_draw$sigma2
self$xi = last_draw$xi
} # END set_starting_values
) # END public
) # END specify_starting_values_bsvar_exh
#' R6 Class representing the specification of the BSVAREXH model with exogenous
#' heteroskedastic regime change.
#'
#' @description
#' The class BSVAREXH presents complete specification for the BSVAR model with
#' exogenous heteroskedastic regime change.
#'
#' @seealso \code{\link{estimate}}, \code{\link{specify_posterior_bsvar_exh}}
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#'
#' @export
specify_bsvar_exh = R6::R6Class(
"BSVAREXH",
private = list(
normal = TRUE
), # END private
public = list(
#' @field p a non-negative integer specifying the autoregressive lag order of the model.
p = numeric(),
#' @field identification an object IdentificationBSVARs with the identifying restrictions.
identification = list(),
#' @field prior an object PriorBSVAREXH with the prior specification.
prior = list(),
#' @field data_matrices an object DataMatricesBSVAR with the data matrices.
data_matrices = list(),
#' @field starting_values an object StartingValuesBSVAREXH with the starting values.
starting_values = list(),
#' @field variance_regimes a \code{T}-vector with exogenous regime indicators that are integer
#' numbers associating the time observation with heteroskedastic regime.
variance_regimes = numeric(),
#' @description
#' Create a new specification of the BSVAR model with Markov Switching Heteroskedasticity, BSVAREXH.
#' @param data a \code{(T+p)xN} matrix with time series data.
#' @param p a positive integer providing model's autoregressive lag order.
#' @param B a logical \code{NxN} matrix containing value \code{TRUE} for the
#' elements of the structural matrix \eqn{B} to be estimated and value \code{FALSE}
#' for exclusion restrictions to be set to zero.
#' @param A a logical \code{NxK} matrix containing value \code{TRUE} for the elements of
#' the autoregressive matrix \eqn{A} to be estimated and value \code{FALSE} for exclusion restrictions
#' to be set to zero.
#' @param distribution a character string specifying the conditional distribution
#' of structural shocks. Value \code{"norm"} sets it to the normal distribution,
#' while value \code{"t"} sets the Student-t distribution.
#' @param exogenous a \code{(T+p)xd} matrix of exogenous variables.
#' @param stationary an \code{N} logical vector - its element set to \code{FALSE} sets
#' the prior mean for the autoregressive parameters of the \code{N}th equation to the random walk process,
#' otherwise to white noise.
#' @param variance_regimes a \code{T}-vector with exogenous regime indicators that are integer
#' numbers associating the time observation with heteroskedastic regime.
#' @return A new complete specification for the bsvar model with exogenous
#' heteroskedastic regime change, BSVAREXH.
initialize = function(
data,
p = 1L,
B,
A,
distribution = c("norm","t"),
exogenous = NULL,
stationary = rep(FALSE, ncol(data)),
variance_regimes = NULL
) {
stopifnot("Argument p has to be a positive integer." = ((p %% 1) == 0 & p > 0))
self$p = p
distribution = match.arg(distribution)
TT = nrow(data)
T = TT - self$p
N = ncol(data)
d = 0
if (!is.null(exogenous)) {
d = ncol(exogenous)
}
K = N * p + 1 + d
if (missing(B)) {
message("The identification is set to the default option of lower-triangular structural matrix.")
B = matrix(FALSE, N, N)
B[lower.tri(B, diag = TRUE)] = TRUE
}
stopifnot("Incorrectly specified argument B." = (is.matrix(B) & is.logical(B)) | (length(B) == 1 & is.na(B)))
if (missing(A)) {
A = matrix(TRUE, N, K)
}
stopifnot("Incorrectly specified argument A." = (is.matrix(A) & is.logical(A)))
if (is.null(variance_regimes)) {
variance_regimes = rep(1, T)
} else {
stopifnot("Argument variance_regimes has to be of the same length as the data." =
length(variance_regimes) == TT
)
variance_regimes = tail(variance_regimes, T)
}
if (distribution == "t") {
private$normal = FALSE
}
self$data_matrices = specify_data_matrices$new(data, p, exogenous)
self$identification = specify_identification_bsvars$new(B, A, N, K)
self$prior = specify_prior_bsvar_exh$new(N, p, d, stationary)
self$starting_values = specify_starting_values_bsvar_exh$new(A, B, N, self$p, T, d, variance_regimes)
}, # END initialize
#' @description
#' Returns the logical value of whether the conditional shock distribution is normal.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_normal()
#'
get_normal = function() {
private$normal
}, # END get_normal
#' @description
#' Returns the data matrices as the DataMatricesBSVAR object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_data_matrices()
#'
get_data_matrices = function() {
self$data_matrices$clone()
}, # END get_data_matrices
#' @description
#' Returns the identifying restrictions as the IdentificationBSVARs object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_identification()
#'
get_identification = function() {
self$identification$clone()
}, # END get_identification
#' @description
#' Returns the prior specification as the PriorBSVAREXH object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_prior()
#'
get_prior = function() {
self$prior$clone()
}, # END get_prior
#' @description
#' Returns the starting values as the StartingValuesBSVAREXH object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_starting_values()
#'
get_starting_values = function() {
self$starting_values$clone()
} # END get_starting_values
) # END public
) # END specify_bsvar_exh
#' R6 Class Representing PosteriorBSVAREXH
#'
#' @description
#' The class PosteriorBSVAREXH contains posterior output and the specification including
#' the last MCMC draw for the bsvar model with exogenous heteroskedastic regime changes.
#' Note that due to the thinning of the MCMC output the starting value in element \code{last_draw}
#' might not be equal to the last draw provided in element \code{posterior}.
#'
#' @seealso \code{\link{estimate}}, \code{\link{specify_bsvar_exh}}
#'
#' @examples
#' # This is a function that is used within estimate()
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' post = estimate(spec, 10, thin = 1)
#' class(post)
#'
#' @export
specify_posterior_bsvar_exh = R6::R6Class(
"PosteriorBSVAREXH",
private = list(
normalised = FALSE
), # END private
public = list(
#' @field last_draw an object of class BSVAREXH with the last draw of the current
#' MCMC run as the starting value to be passed to the continuation of the MCMC
#' estimation using \code{estimate()}.
last_draw = list(),
#' @field posterior a list containing Bayesian estimation output.
posterior = list(),
#' @description
#' Create a new posterior output PosteriorBSVAREXH
#' @param specification_bsvar an object of class BSVAREXH with the last draw
#' of the current MCMC run as the starting value.
#' @param posterior_bsvar a list containing Bayesian estimation output.
#' @return A posterior output PosteriorBSVAREXH
initialize = function(specification_bsvar, posterior_bsvar) {
stopifnot("Argument specification_bsvar must be of class BSVAREXH" = any(class(specification_bsvar) == "BSVAREXH"))
stopifnot("Argument posterior_bsvar must must contain MCMC output." = is.list(posterior_bsvar) & is.array(posterior_bsvar$B) & is.array(posterior_bsvar$A) & is.array(posterior_bsvar$hyper) & is.array(posterior_bsvar$xi))
self$last_draw = specification_bsvar
self$posterior = posterior_bsvar
}, # END initialize
#' @description
#' Returns a list containing Bayesian estimation output.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' post = estimate(spec, 10, thin = 1)
#' post$get_posterior()
#'
get_posterior = function(){
self$posterior
}, # END get_posterior
#' @description
#' Returns an object of class BSVAREXH with the last draw of the current MCMC
#' run as the starting value to be passed to the continuation of the MCMC
#' estimation using \code{estimate()}.
#'
#' @examples
#' # specify the model
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#'
#' # run the burn-in
#' burn = estimate(spec, 10, thin = 2)
#'
#' # estimate the model
#' post = estimate(burn, 10, thin = 2)
#'
get_last_draw = function(){
self$last_draw$clone()
}, # END get_last_draw
#' @description
#' Returns \code{TRUE} if the posterior has been normalised using \code{normalise()} and \code{FALSE} otherwise.
#'
#' @examples
#' # specify the model
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#'
#' # estimate the model
#' post = estimate(spec, 10, thin = 1)
#'
#' # check normalisation status beforehand
#' post$is_normalised()
#'
#' # normalise the posterior
#' BB = post$last_draw$starting_values$B # get the last draw of B
#' B_hat = diag((-1) * sign(diag(BB))) %*% BB # set negative diagonal elements
#' post = normalise(post, B_hat) # draws in posterior are normalised
#'
#' # check normalisation status afterwards
#' post$is_normalised()
#'
is_normalised = function(){
private$normalised
}, # END is_normalised
#' @description
#' Sets the private indicator \code{normalised} to TRUE.
#' @param value (optional) a logical value to be passed to indicator \code{normalised}.
#'
#' @examples
#' # This is an internal function that is run while executing normalise()
#' # Observe its working by analysing the workflow:
#'
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' post = estimate(spec, 10, thin = 1)
#'
#' # check normalisation status beforehand
#' post$is_normalised()
#'
#' # normalise the posterior
#' BB = post$last_draw$starting_values$B # get the last draw of B
#' B_hat = diag(sign(diag(BB))) %*% BB # set positive diagonal elements
#' post = normalise(post, B_hat) # draws in posterior are normalised
#'
#' # check normalisation status afterwards
#' post$is_normalised()
#'
set_normalised = function(value){
if (missing(value)) {
private$normalised <- TRUE
} else {
private$normalised <- value
}
} # END set_normalised
) # END public
) # END specify_posterior_bsvar_exh
Try the bsvars package in your browser
Any scripts or data that you put into this service are public.
bsvars documentation built on Aug. 22, 2026, 5:09 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' R6 Class Representing PriorBSVAREXH
#'
#' @description
#' The class PriorBSVAREXH presents a prior specification for the bsvar model with Exogenous regime change Heteroskedasticity.
#'
#' @examples
#' prior = specify_prior_bsvar_exh$new(N = 3, p = 1) # specify the prior
#' prior$A # show autoregressive prior mean
#'
#' @export
specify_prior_bsvar_exh = R6::R6Class(
"PriorBSVAREXH",
inherit = specify_prior_bsvar,
public = list(
#' @field A an \code{NxK} matrix, the mean of the normal prior distribution
#' for the parameter matrix \eqn{A}.
A = matrix(),
#' @field A_V_inv a \code{KxK} precision matrix of the normal prior distribution
#' for each of the row of the parameter matrix \eqn{A}. This precision matrix is equation invariant.
A_V_inv = matrix(),
#' @field B_V_inv an \code{NxN} precision matrix of the generalised-normal prior
#' distribution for the structural matrix \eqn{B}. This precision matrix is equation invariant.
B_V_inv = matrix(),
#' @field B_nu a positive integer greater of equal than \code{N}, a shape parameter
#' of the generalised-normal prior distribution for the structural matrix \eqn{B}.
B_nu = NA,
#' @field hyper_nu_B a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the overall shrinkage parameter for matrix \eqn{B}.
hyper_nu_B = NA,
#' @field hyper_a_B a positive scalar, the shape parameter of the gamma prior
#' for the second-level hierarchy for the overall shrinkage parameter for matrix \eqn{B}.
hyper_a_B = NA,
#' @field hyper_s_BB a positive scalar, the scale parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{B}.
hyper_s_BB = NA,
#' @field hyper_nu_BB a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{B}.
hyper_nu_BB = NA,
#' @field hyper_nu_A a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the overall shrinkage parameter for matrix \eqn{A}.
hyper_nu_A = NA,
#' @field hyper_a_A a positive scalar, the shape parameter of the gamma prior
#' for the second-level hierarchy for the overall shrinkage parameter for matrix \eqn{A}.
hyper_a_A = NA,
#' @field hyper_s_AA a positive scalar, the scale parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{A}.
hyper_s_AA = NA,
#' @field hyper_nu_AA a positive scalar, the shape parameter of the inverted-gamma 2 prior
#' for the third-level of hierarchy for overall shrinkage parameter for matrix \eqn{A}.
hyper_nu_AA = NA,
#' @field sigma_nu a positive scalar, the shape parameter of the inverted-gamma 2 for
#' state-dependent variances of the structural shocks, \eqn{\sigma^2_{n.s_t}}.
sigma_nu = 3,
#' @field sigma_s a positive scalar, the scale parameter of the inverted-gamma 2
#' for state-dependent variances of the structural shocks, \eqn{\sigma^2_{n.s_t}}.
sigma_s = 1,
#' @description
#' Create a new prior specification PriorBSVAREXH
#' @param N a positive integer - the number of dependent variables in the model.
#' @param p a positive integer - the autoregressive lag order of the SVAR model.
#' @param d a positive integer - the number of \code{exogenous} variables in the model.
#' @param stationary an \code{N} logical vector - its element set to \code{FALSE} sets
#' the prior mean for the autoregressive parameters of the \code{N}th equation to the random walk process,
#' otherwise to white noise.
#' @return A new prior specification PriorBSVAREXH
initialize = function(N, p, d = 0, stationary = rep(FALSE, N)){
stopifnot("Argument N must be a positive integer number." = N > 0 & N %% 1 == 0)
stopifnot("Argument p must be a positive integer number." = p > 0 & p %% 1 == 0)
stopifnot("Argument d must be a non-negative integer number." = d >= 0 & d %% 1 == 0)
stopifnot("Argument stationary must be a logical vector of length N." = length(stationary) == N & is.logical(stationary))
super$initialize(N, p, d, stationary)
self$sigma_nu = 3
self$sigma_s = 1
}, # END initialize
#' @description
#' Returns the elements of the prior specification PriorBSVAREXH as a \code{list}.
#'
#' @examples
#' # a prior for 3-variable example with four lags and two regimes
#' prior = specify_prior_bsvar_exh$new(N = 3, p = 4)
#' prior$get_prior() # show the prior as list
#'
get_prior = function(){
list(
A = self$A,
A_V_inv = self$A_V_inv,
B_V_inv = self$B_V_inv,
B_nu = self$B_nu,
hyper_nu_B = self$hyper_nu_B,
hyper_a_B = self$hyper_a_B,
hyper_s_BB = self$hyper_s_BB,
hyper_nu_BB = self$hyper_nu_BB,
hyper_nu_A = self$hyper_nu_A,
hyper_a_A = self$hyper_a_A,
hyper_s_AA = self$hyper_s_AA,
hyper_nu_AA = self$hyper_nu_AA,
sv_a_ = self$sv_a_,
sv_s_ = self$sv_s_,
sigma_nu = self$sigma_nu,
sigma_s = self$sigma_s
)
} # END get_prior
) # END public
) # END specify_prior_bsvar_exh
#' R6 Class Representing StartingValuesBSVAREXH
#'
#' @description
#' The class StartingValuesBSVAREXH presents starting values for the bsvar model
#' with exogenous regime change Heteroskedasticity.
#'
#' @examples
#' # starting values for a bsvar model for a 3-variable system
#' A = matrix(TRUE, 3, 4)
#' B = matrix(TRUE, 3, 3)
#' sv = specify_starting_values_bsvar_exh$new(A = A, B = B, N = 3, p = 1, T = 100)
#'
#' @export
specify_starting_values_bsvar_exh = R6::R6Class(
"StartingValuesBSVAREXH",
inherit = specify_starting_values_bsvar,
public = list(
#' @field A an \code{NxK} matrix of starting values for the parameter \eqn{A}.
A = matrix(),
#' @field B an \code{NxN} matrix of starting values for the parameter \eqn{B}.
B = matrix(),
#' @field hyper a \code{(2*N+1)x2} matrix of starting values for the shrinkage hyper-parameters of the
#' hierarchical prior distribution.
hyper = matrix(),
#' @field sigma2 an \code{NxM} matrix of starting values for the regime-specific
#' variances of the structural shocks. Its elements sum to value \code{M} over the rows.
sigma2 = matrix(),
#' @field xi an \code{MxT} matrix of starting values for the Markov process
#' indicator. Its columns are a chosen column of an identity matrix of order \code{M}.
xi = matrix(),
#' @field lambda a \code{NxT} matrix of starting values for latent variables.
lambda = matrix(),
#' @field df an \code{Nx1} vector of positive numbers with starting values
#' for the equation-specific degrees of freedom parameters of the Student-t
#' conditional distribution of structural shocks.
df = numeric(),
#' @description
#' Create new starting values StartingValuesBSVAREXH.
#' @param A a logical \code{NxK} matrix containing value \code{TRUE} for the elements of
#' the autoregressive matrix \eqn{A} to be estimated and value \code{FALSE} for exclusion restrictions
#' to be set to zero.
#' @param B a logical \code{NxN} matrix containing value \code{TRUE} for the elements of
#' the structural matrix \eqn{B} to be estimated and value \code{FALSE} for exclusion restrictions
#' to be set to zero.
#' @param N a positive integer - the number of dependent variables in the model.
#' @param p a positive integer - the autoregressive lag order of the SVAR model.
#' @param T a positive integer - the the time series dimension of the dependent
#' variable matrix \eqn{Y}.
#' @param d a positive integer - the number of \code{exogenous} variables in the model.
#' @param variance_regimes a \code{T}-vector with exogenous regime indicators that are integer
#' numbers associating the time observation with heteroskedastic regime.
#' @return Starting values StartingValuesBSVAREXH.
initialize = function(A, B, N, p, T, d = 0, variance_regimes = rep(1, T)){
stopifnot("Argument N must be a positive integer number." = N > 0 & N %% 1 == 0)
stopifnot("Argument p must be a positive integer number." = p > 0 & p %% 1 == 0)
stopifnot("Argument T must be a positive integer number." = T > 0 & T %% 1 == 0)
stopifnot("Argument d must be a non-negative integer number." = d >= 0 & d %% 1 == 0)
unique_exh = unique(variance_regimes)
stopifnot("Argument variance_regimes must be a T-vector with integer numbers from 1 to M, where M is th intended number of heteroskedastic regimes." =
is.numeric(variance_regimes) &
all(unique_exh[order(unique_exh)] == 1:max(variance_regimes)) &
all((variance_regimes %% 1) == 0) &
length(variance_regimes) == T
)
super$initialize(A, B, N, T, p, d)
M = max(variance_regimes)
self$sigma2 = matrix(1, N, M)
self$xi = matrix(diag(M)[,variance_regimes], nrow = M)
}, # END initialize
#' @description
#' Returns the elements of the starting values StartingValuesBSVAR-MS as a \code{list}.
#'
#' @examples
#' # starting values for a homoskedastic bsvar with 1 lag for a 3-variable system
#' A = matrix(TRUE, 3, 4)
#' B = matrix(TRUE, 3, 3)
#' sv = specify_starting_values_bsvar_exh$new(A = A, B = B, N = 3, p = 1, T = 100)
#' sv$get_starting_values() # show starting values as list
#'
get_starting_values = function(){
list(
B = self$B,
A = self$A,
hyper = self$hyper,
lambda = self$lambda,
df = self$df,
sigma2 = self$sigma2,
xi = self$xi
)
}, # END get_starting_values
#' @description
#' Returns the elements of the starting values StartingValuesBSVAREXH as a \code{list}.
#' @param last_draw a list containing the last draw.
#' @return An object of class StartingValuesBSVAREXH including the last draw
#' of the current MCMC as the starting value to be passed to the continuation
#' of the MCMC estimation using \code{estimate()}.
#'
#' @examples
#' # starting values for a bsvar model with 1 lag for a 3-variable system
#' A = matrix(TRUE, 3, 4)
#' B = matrix(TRUE, 3, 3)
#' sv = specify_starting_values_bsvar_exh$new(A = A, B = B, N = 3, p = 1, T = 100)
#'
#' # Modify the starting values by:
#' sv_list = sv$get_starting_values() # getting them as list
#' sv_list$A <- matrix(rnorm(12), 3, 4) # modifying the entry
#' sv$set_starting_values(sv_list) # providing to the class object
#'
set_starting_values = function(last_draw) {
self$B = last_draw$B
self$A = last_draw$A
self$hyper = last_draw$hyper
self$lambda = last_draw$lambda
self$df = last_draw$df
self$sigma2 = last_draw$sigma2
self$xi = last_draw$xi
} # END set_starting_values
) # END public
) # END specify_starting_values_bsvar_exh
#' R6 Class representing the specification of the BSVAREXH model with exogenous
#' heteroskedastic regime change.
#'
#' @description
#' The class BSVAREXH presents complete specification for the BSVAR model with
#' exogenous heteroskedastic regime change.
#'
#' @seealso \code{\link{estimate}}, \code{\link{specify_posterior_bsvar_exh}}
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#'
#' @export
specify_bsvar_exh = R6::R6Class(
"BSVAREXH",
private = list(
normal = TRUE
), # END private
public = list(
#' @field p a non-negative integer specifying the autoregressive lag order of the model.
p = numeric(),
#' @field identification an object IdentificationBSVARs with the identifying restrictions.
identification = list(),
#' @field prior an object PriorBSVAREXH with the prior specification.
prior = list(),
#' @field data_matrices an object DataMatricesBSVAR with the data matrices.
data_matrices = list(),
#' @field starting_values an object StartingValuesBSVAREXH with the starting values.
starting_values = list(),
#' @field variance_regimes a \code{T}-vector with exogenous regime indicators that are integer
#' numbers associating the time observation with heteroskedastic regime.
variance_regimes = numeric(),
#' @description
#' Create a new specification of the BSVAR model with Markov Switching Heteroskedasticity, BSVAREXH.
#' @param data a \code{(T+p)xN} matrix with time series data.
#' @param p a positive integer providing model's autoregressive lag order.
#' @param B a logical \code{NxN} matrix containing value \code{TRUE} for the
#' elements of the structural matrix \eqn{B} to be estimated and value \code{FALSE}
#' for exclusion restrictions to be set to zero.
#' @param A a logical \code{NxK} matrix containing value \code{TRUE} for the elements of
#' the autoregressive matrix \eqn{A} to be estimated and value \code{FALSE} for exclusion restrictions
#' to be set to zero.
#' @param distribution a character string specifying the conditional distribution
#' of structural shocks. Value \code{"norm"} sets it to the normal distribution,
#' while value \code{"t"} sets the Student-t distribution.
#' @param exogenous a \code{(T+p)xd} matrix of exogenous variables.
#' @param stationary an \code{N} logical vector - its element set to \code{FALSE} sets
#' the prior mean for the autoregressive parameters of the \code{N}th equation to the random walk process,
#' otherwise to white noise.
#' @param variance_regimes a \code{T}-vector with exogenous regime indicators that are integer
#' numbers associating the time observation with heteroskedastic regime.
#' @return A new complete specification for the bsvar model with exogenous
#' heteroskedastic regime change, BSVAREXH.
initialize = function(
data,
p = 1L,
B,
A,
distribution = c("norm","t"),
exogenous = NULL,
stationary = rep(FALSE, ncol(data)),
variance_regimes = NULL
) {
stopifnot("Argument p has to be a positive integer." = ((p %% 1) == 0 & p > 0))
self$p = p
distribution = match.arg(distribution)
TT = nrow(data)
T = TT - self$p
N = ncol(data)
d = 0
if (!is.null(exogenous)) {
d = ncol(exogenous)
}
K = N * p + 1 + d
if (missing(B)) {
message("The identification is set to the default option of lower-triangular structural matrix.")
B = matrix(FALSE, N, N)
B[lower.tri(B, diag = TRUE)] = TRUE
}
stopifnot("Incorrectly specified argument B." = (is.matrix(B) & is.logical(B)) | (length(B) == 1 & is.na(B)))
if (missing(A)) {
A = matrix(TRUE, N, K)
}
stopifnot("Incorrectly specified argument A." = (is.matrix(A) & is.logical(A)))
if (is.null(variance_regimes)) {
variance_regimes = rep(1, T)
} else {
stopifnot("Argument variance_regimes has to be of the same length as the data." =
length(variance_regimes) == TT
)
variance_regimes = tail(variance_regimes, T)
}
if (distribution == "t") {
private$normal = FALSE
}
self$data_matrices = specify_data_matrices$new(data, p, exogenous)
self$identification = specify_identification_bsvars$new(B, A, N, K)
self$prior = specify_prior_bsvar_exh$new(N, p, d, stationary)
self$starting_values = specify_starting_values_bsvar_exh$new(A, B, N, self$p, T, d, variance_regimes)
}, # END initialize
#' @description
#' Returns the logical value of whether the conditional shock distribution is normal.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_normal()
#'
get_normal = function() {
private$normal
}, # END get_normal
#' @description
#' Returns the data matrices as the DataMatricesBSVAR object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_data_matrices()
#'
get_data_matrices = function() {
self$data_matrices$clone()
}, # END get_data_matrices
#' @description
#' Returns the identifying restrictions as the IdentificationBSVARs object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_identification()
#'
get_identification = function() {
self$identification$clone()
}, # END get_identification
#' @description
#' Returns the prior specification as the PriorBSVAREXH object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_prior()
#'
get_prior = function() {
self$prior$clone()
}, # END get_prior
#' @description
#' Returns the starting values as the StartingValuesBSVAREXH object.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' spec$get_starting_values()
#'
get_starting_values = function() {
self$starting_values$clone()
} # END get_starting_values
) # END public
) # END specify_bsvar_exh
#' R6 Class Representing PosteriorBSVAREXH
#'
#' @description
#' The class PosteriorBSVAREXH contains posterior output and the specification including
#' the last MCMC draw for the bsvar model with exogenous heteroskedastic regime changes.
#' Note that due to the thinning of the MCMC output the starting value in element \code{last_draw}
#' might not be equal to the last draw provided in element \code{posterior}.
#'
#' @seealso \code{\link{estimate}}, \code{\link{specify_bsvar_exh}}
#'
#' @examples
#' # This is a function that is used within estimate()
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' post = estimate(spec, 10, thin = 1)
#' class(post)
#'
#' @export
specify_posterior_bsvar_exh = R6::R6Class(
"PosteriorBSVAREXH",
private = list(
normalised = FALSE
), # END private
public = list(
#' @field last_draw an object of class BSVAREXH with the last draw of the current
#' MCMC run as the starting value to be passed to the continuation of the MCMC
#' estimation using \code{estimate()}.
last_draw = list(),
#' @field posterior a list containing Bayesian estimation output.
posterior = list(),
#' @description
#' Create a new posterior output PosteriorBSVAREXH
#' @param specification_bsvar an object of class BSVAREXH with the last draw
#' of the current MCMC run as the starting value.
#' @param posterior_bsvar a list containing Bayesian estimation output.
#' @return A posterior output PosteriorBSVAREXH
initialize = function(specification_bsvar, posterior_bsvar) {
stopifnot("Argument specification_bsvar must be of class BSVAREXH" = any(class(specification_bsvar) == "BSVAREXH"))
stopifnot("Argument posterior_bsvar must must contain MCMC output." = is.list(posterior_bsvar) & is.array(posterior_bsvar$B) & is.array(posterior_bsvar$A) & is.array(posterior_bsvar$hyper) & is.array(posterior_bsvar$xi))
self$last_draw = specification_bsvar
self$posterior = posterior_bsvar
}, # END initialize
#' @description
#' Returns a list containing Bayesian estimation output.
#'
#' @examples
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' post = estimate(spec, 10, thin = 1)
#' post$get_posterior()
#'
get_posterior = function(){
self$posterior
}, # END get_posterior
#' @description
#' Returns an object of class BSVAREXH with the last draw of the current MCMC
#' run as the starting value to be passed to the continuation of the MCMC
#' estimation using \code{estimate()}.
#'
#' @examples
#' # specify the model
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#'
#' # run the burn-in
#' burn = estimate(spec, 10, thin = 2)
#'
#' # estimate the model
#' post = estimate(burn, 10, thin = 2)
#'
get_last_draw = function(){
self$last_draw$clone()
}, # END get_last_draw
#' @description
#' Returns \code{TRUE} if the posterior has been normalised using \code{normalise()} and \code{FALSE} otherwise.
#'
#' @examples
#' # specify the model
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#'
#' # estimate the model
#' post = estimate(spec, 10, thin = 1)
#'
#' # check normalisation status beforehand
#' post$is_normalised()
#'
#' # normalise the posterior
#' BB = post$last_draw$starting_values$B # get the last draw of B
#' B_hat = diag((-1) * sign(diag(BB))) %*% BB # set negative diagonal elements
#' post = normalise(post, B_hat) # draws in posterior are normalised
#'
#' # check normalisation status afterwards
#' post$is_normalised()
#'
is_normalised = function(){
private$normalised
}, # END is_normalised
#' @description
#' Sets the private indicator \code{normalised} to TRUE.
#' @param value (optional) a logical value to be passed to indicator \code{normalised}.
#'
#' @examples
#' # This is an internal function that is run while executing normalise()
#' # Observe its working by analysing the workflow:
#'
#' spec = specify_bsvar_exh$new(us_fiscal_lsuw)
#' post = estimate(spec, 10, thin = 1)
#'
#' # check normalisation status beforehand
#' post$is_normalised()
#'
#' # normalise the posterior
#' BB = post$last_draw$starting_values$B # get the last draw of B
#' B_hat = diag(sign(diag(BB))) %*% BB # set positive diagonal elements
#' post = normalise(post, B_hat) # draws in posterior are normalised
#'
#' # check normalisation status afterwards
#' post$is_normalised()
#'
set_normalised = function(value){
if (missing(value)) {
private$normalised <- TRUE
} else {
private$normalised <- value
}
} # END set_normalised
) # END public
) # END specify_posterior_bsvar_exh
Try the bsvars package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.