Skip to content

Commit

Permalink
include compute_fitted_values #25
Browse files Browse the repository at this point in the history
+ cpp wrapper of bsvars function
+ R method
+ doc
+ tests
  • Loading branch information
donotdespair committed Jul 16, 2024
1 parent 0dd79ba commit b4faf0e
Show file tree
Hide file tree
Showing 8 changed files with 248 additions and 20 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

S3method(compute_fitted_values,PosteriorBSVARSIGN)
S3method(compute_structural_shocks,PosteriorBSVARSIGN)
S3method(estimate,BSVARSIGN)
S3method(forecast,PosteriorBSVARSIGN)
Expand Down
65 changes: 64 additions & 1 deletion R/compute.R
Original file line number Diff line number Diff line change
Expand Up @@ -50,9 +50,72 @@ compute_structural_shocks.PosteriorBSVARSIGN <- function(posterior) {
Y = posterior$last_draw$data_matrices$Y
X = posterior$last_draw$data_matrices$X

ss = .Call(`_bsvarSIGNs_structural_shocks`, posterior_B, posterior_A, Y, X)
ss = .Call(`_bsvarSIGNs_bsvarSIGNs_structural_shocks`, posterior_B, posterior_A, Y, X)
class(ss) = "PosteriorShocks"

return(ss)
} # END compute_structural_shocks.PosteriorBSVARSIGN





#' @method compute_fitted_values PosteriorBSVARSIGN
#'
#' @title Computes posterior draws from data predictive density
#'
#' @description Each of the draws from the posterior estimation of models from
#' packages \pkg{bsvars} or \pkg{bsvarSIGNs} is transformed into
#' a draw from the data predictive density.
#'
#' @param posterior posterior estimation outcome - an object of class
#' \code{PosteriorBSVARSIGN} obtained by running the \code{estimate} function.
#'
#' @return An object of class \code{PosteriorFitted}, that is, an \code{NxTxS}
#' array with attribute \code{PosteriorFitted} containing \code{S} draws from
#' the data predictive density.
#'
#' @seealso \code{\link{estimate}}, \code{\link{summary}}, \code{\link{plot}}
#'
#' @author Xiaolei Wang \email{[email protected]} and Tomasz Woźniak \email{[email protected]}
#'
#' @examples
#' # upload data
#' data(oil)
#'
#' # specify the model and set seed
#' set.seed(123)
#' sign_irf = array(matrix(c(-1, -1, 1, rep(0, 6)), nrow = 3), dim = c(3, 3, 1))
#' specification = specify_bsvarSIGN$new(oil, sign_irf = sign_irf)
#'
#' # run the burn-in
#' posterior = estimate(specification, 10)
#'
#' # compute draws from in-sample predictive density
#' fitted = compute_fitted_values(posterior)
#'
#' # workflow with the pipe |>
#' ############################################################
#' set.seed(123)
#' oil |>
#' specify_bsvarSIGN$new(sign_irf = sign_irf) |>
#' estimate(S = 20) |>
#' compute_fitted_values() -> fitted
#'
#' @export
compute_fitted_values.PosteriorBSVARSIGN <- function(posterior) {

posterior_A = posterior$posterior$A
posterior_B = posterior$posterior$B

N = dim(posterior_A)[1]
T = dim(posterior$last_draw$data_matrices$X)[2]
S = dim(posterior_A)[3]
posterior_sigma = array(1, c(N, T, S))
X = posterior$last_draw$data_matrices$X

fv = .Call(`_bsvarSIGNs_bsvarSIGNs_fitted_values`, posterior_A, posterior_B, posterior_sigma, X)
class(fv) = "PosteriorFitted"

return(fv)
}
35 changes: 28 additions & 7 deletions inst/include/bsvarSIGNs_RcppExports.h
Original file line number Diff line number Diff line change
Expand Up @@ -109,17 +109,38 @@ namespace bsvarSIGNs {
return Rcpp::as<Rcpp::List >(rcpp_result_gen);
}

inline arma::cube structural_shocks(const arma::cube& posterior_B, const arma::cube& posterior_A, const arma::mat& Y, const arma::mat& X) {
typedef SEXP(*Ptr_structural_shocks)(SEXP,SEXP,SEXP,SEXP);
static Ptr_structural_shocks p_structural_shocks = NULL;
if (p_structural_shocks == NULL) {
validateSignature("arma::cube(*structural_shocks)(const arma::cube&,const arma::cube&,const arma::mat&,const arma::mat&)");
p_structural_shocks = (Ptr_structural_shocks)R_GetCCallable("bsvarSIGNs", "_bsvarSIGNs_structural_shocks");
inline arma::cube bsvarSIGNs_structural_shocks(const arma::cube& posterior_B, const arma::cube& posterior_A, const arma::mat& Y, const arma::mat& X) {
typedef SEXP(*Ptr_bsvarSIGNs_structural_shocks)(SEXP,SEXP,SEXP,SEXP);
static Ptr_bsvarSIGNs_structural_shocks p_bsvarSIGNs_structural_shocks = NULL;
if (p_bsvarSIGNs_structural_shocks == NULL) {
validateSignature("arma::cube(*bsvarSIGNs_structural_shocks)(const arma::cube&,const arma::cube&,const arma::mat&,const arma::mat&)");
p_bsvarSIGNs_structural_shocks = (Ptr_bsvarSIGNs_structural_shocks)R_GetCCallable("bsvarSIGNs", "_bsvarSIGNs_bsvarSIGNs_structural_shocks");
}
RObject rcpp_result_gen;
{
RNGScope RCPP_rngScope_gen;
rcpp_result_gen = p_structural_shocks(Shield<SEXP>(Rcpp::wrap(posterior_B)), Shield<SEXP>(Rcpp::wrap(posterior_A)), Shield<SEXP>(Rcpp::wrap(Y)), Shield<SEXP>(Rcpp::wrap(X)));
rcpp_result_gen = p_bsvarSIGNs_structural_shocks(Shield<SEXP>(Rcpp::wrap(posterior_B)), Shield<SEXP>(Rcpp::wrap(posterior_A)), Shield<SEXP>(Rcpp::wrap(Y)), Shield<SEXP>(Rcpp::wrap(X)));
}
if (rcpp_result_gen.inherits("interrupted-error"))
throw Rcpp::internal::InterruptedException();
if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen))
throw Rcpp::LongjumpException(rcpp_result_gen);
if (rcpp_result_gen.inherits("try-error"))
throw Rcpp::exception(Rcpp::as<std::string>(rcpp_result_gen).c_str());
return Rcpp::as<arma::cube >(rcpp_result_gen);
}

inline arma::cube bsvarSIGNs_fitted_values(arma::cube& posterior_A, arma::cube& posterior_B, arma::cube& posterior_sigma, arma::mat& X) {
typedef SEXP(*Ptr_bsvarSIGNs_fitted_values)(SEXP,SEXP,SEXP,SEXP);
static Ptr_bsvarSIGNs_fitted_values p_bsvarSIGNs_fitted_values = NULL;
if (p_bsvarSIGNs_fitted_values == NULL) {
validateSignature("arma::cube(*bsvarSIGNs_fitted_values)(arma::cube&,arma::cube&,arma::cube&,arma::mat&)");
p_bsvarSIGNs_fitted_values = (Ptr_bsvarSIGNs_fitted_values)R_GetCCallable("bsvarSIGNs", "_bsvarSIGNs_bsvarSIGNs_fitted_values");
}
RObject rcpp_result_gen;
{
RNGScope RCPP_rngScope_gen;
rcpp_result_gen = p_bsvarSIGNs_fitted_values(Shield<SEXP>(Rcpp::wrap(posterior_A)), Shield<SEXP>(Rcpp::wrap(posterior_B)), Shield<SEXP>(Rcpp::wrap(posterior_sigma)), Shield<SEXP>(Rcpp::wrap(X)));
}
if (rcpp_result_gen.inherits("interrupted-error"))
throw Rcpp::internal::InterruptedException();
Expand Down
29 changes: 29 additions & 0 deletions inst/tinytest/test_compute_fitted_values.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,29 @@

data(oil)

set.seed(1)
suppressMessages(
specification_no1 <- specify_bsvarSIGN$new(oil)
)
run_no1 <- estimate(specification_no1, 3, 1, show_progress = FALSE)
fv <- compute_fitted_values(run_no1)

set.seed(1)
suppressMessages(
fv2 <- oil |>
specify_bsvarSIGN$new() |>
estimate(S = 3, thin = 1, show_progress = FALSE) |>
compute_fitted_values()
)



expect_true(
all(dim(fv) == dim(fv2)),
info = "compute_fitted_values: same output dimentions for normal and pipe workflow."
)

expect_identical(
fv[1,1,1], fv2[1,1,1],
info = "compute_fitted_values: identical for normal and pipe workflow."
)
52 changes: 52 additions & 0 deletions man/compute_fitted_values.PosteriorBSVARSIGN.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

58 changes: 49 additions & 9 deletions src/RcppExports.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -173,24 +173,61 @@ RcppExport SEXP _bsvarSIGNs_bsvar_sign_cpp(SEXP SSEXP, SEXP pSEXP, SEXP YSEXP, S
UNPROTECT(1);
return rcpp_result_gen;
}
// structural_shocks
arma::cube structural_shocks(const arma::cube& posterior_B, const arma::cube& posterior_A, const arma::mat& Y, const arma::mat& X);
static SEXP _bsvarSIGNs_structural_shocks_try(SEXP posterior_BSEXP, SEXP posterior_ASEXP, SEXP YSEXP, SEXP XSEXP) {
// bsvarSIGNs_structural_shocks
arma::cube bsvarSIGNs_structural_shocks(const arma::cube& posterior_B, const arma::cube& posterior_A, const arma::mat& Y, const arma::mat& X);
static SEXP _bsvarSIGNs_bsvarSIGNs_structural_shocks_try(SEXP posterior_BSEXP, SEXP posterior_ASEXP, SEXP YSEXP, SEXP XSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< const arma::cube& >::type posterior_B(posterior_BSEXP);
Rcpp::traits::input_parameter< const arma::cube& >::type posterior_A(posterior_ASEXP);
Rcpp::traits::input_parameter< const arma::mat& >::type Y(YSEXP);
Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP);
rcpp_result_gen = Rcpp::wrap(structural_shocks(posterior_B, posterior_A, Y, X));
rcpp_result_gen = Rcpp::wrap(bsvarSIGNs_structural_shocks(posterior_B, posterior_A, Y, X));
return rcpp_result_gen;
END_RCPP_RETURN_ERROR
}
RcppExport SEXP _bsvarSIGNs_structural_shocks(SEXP posterior_BSEXP, SEXP posterior_ASEXP, SEXP YSEXP, SEXP XSEXP) {
RcppExport SEXP _bsvarSIGNs_bsvarSIGNs_structural_shocks(SEXP posterior_BSEXP, SEXP posterior_ASEXP, SEXP YSEXP, SEXP XSEXP) {
SEXP rcpp_result_gen;
{
Rcpp::RNGScope rcpp_rngScope_gen;
rcpp_result_gen = PROTECT(_bsvarSIGNs_structural_shocks_try(posterior_BSEXP, posterior_ASEXP, YSEXP, XSEXP));
rcpp_result_gen = PROTECT(_bsvarSIGNs_bsvarSIGNs_structural_shocks_try(posterior_BSEXP, posterior_ASEXP, YSEXP, XSEXP));
}
Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
if (rcpp_isInterrupt_gen) {
UNPROTECT(1);
Rf_onintr();
}
bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen);
if (rcpp_isLongjump_gen) {
Rcpp::internal::resumeJump(rcpp_result_gen);
}
Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
if (rcpp_isError_gen) {
SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
UNPROTECT(1);
Rf_error("%s", CHAR(rcpp_msgSEXP_gen));
}
UNPROTECT(1);
return rcpp_result_gen;
}
// bsvarSIGNs_fitted_values
arma::cube bsvarSIGNs_fitted_values(arma::cube& posterior_A, arma::cube& posterior_B, arma::cube& posterior_sigma, arma::mat& X);
static SEXP _bsvarSIGNs_bsvarSIGNs_fitted_values_try(SEXP posterior_ASEXP, SEXP posterior_BSEXP, SEXP posterior_sigmaSEXP, SEXP XSEXP) {
BEGIN_RCPP
Rcpp::RObject rcpp_result_gen;
Rcpp::traits::input_parameter< arma::cube& >::type posterior_A(posterior_ASEXP);
Rcpp::traits::input_parameter< arma::cube& >::type posterior_B(posterior_BSEXP);
Rcpp::traits::input_parameter< arma::cube& >::type posterior_sigma(posterior_sigmaSEXP);
Rcpp::traits::input_parameter< arma::mat& >::type X(XSEXP);
rcpp_result_gen = Rcpp::wrap(bsvarSIGNs_fitted_values(posterior_A, posterior_B, posterior_sigma, X));
return rcpp_result_gen;
END_RCPP_RETURN_ERROR
}
RcppExport SEXP _bsvarSIGNs_bsvarSIGNs_fitted_values(SEXP posterior_ASEXP, SEXP posterior_BSEXP, SEXP posterior_sigmaSEXP, SEXP XSEXP) {
SEXP rcpp_result_gen;
{
Rcpp::RNGScope rcpp_rngScope_gen;
rcpp_result_gen = PROTECT(_bsvarSIGNs_bsvarSIGNs_fitted_values_try(posterior_ASEXP, posterior_BSEXP, posterior_sigmaSEXP, XSEXP));
}
Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
if (rcpp_isInterrupt_gen) {
Expand Down Expand Up @@ -945,7 +982,8 @@ static int _bsvarSIGNs_RcppExport_validate(const char* sig) {
signatures.insert("arma::cube(*ir1_cpp)(const arma::mat&,const arma::mat&,int,const int&)");
signatures.insert("arma::field<arma::cube>(*bsvarSIGNs_ir)(arma::cube&,arma::cube&,const int,const int)");
signatures.insert("Rcpp::List(*bsvar_sign_cpp)(const int&,const int&,const arma::mat&,const arma::mat&,const arma::field<arma::mat>&,const arma::cube&,const arma::mat&,const arma::mat&,const arma::field<arma::mat>&,const Rcpp::List&,const Rcpp::List&,const bool,const int,const int&)");
signatures.insert("arma::cube(*structural_shocks)(const arma::cube&,const arma::cube&,const arma::mat&,const arma::mat&)");
signatures.insert("arma::cube(*bsvarSIGNs_structural_shocks)(const arma::cube&,const arma::cube&,const arma::mat&,const arma::mat&)");
signatures.insert("arma::cube(*bsvarSIGNs_fitted_values)(arma::cube&,arma::cube&,arma::cube&,arma::mat&)");
signatures.insert("arma::cube(*forecast_bsvarSIGNs)(arma::cube&,arma::cube&,arma::vec&,arma::mat&,arma::mat&,const int&)");
signatures.insert("bool(*match_sign_narrative)(const arma::mat&,const arma::mat&,const arma::cube&)");
signatures.insert("double(*weight_narrative)(const int&,arma::mat,const arma::cube&)");
Expand All @@ -971,7 +1009,8 @@ RcppExport SEXP _bsvarSIGNs_RcppExport_registerCCallable() {
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_ir1_cpp", (DL_FUNC)_bsvarSIGNs_ir1_cpp_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_bsvarSIGNs_ir", (DL_FUNC)_bsvarSIGNs_bsvarSIGNs_ir_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_bsvar_sign_cpp", (DL_FUNC)_bsvarSIGNs_bsvar_sign_cpp_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_structural_shocks", (DL_FUNC)_bsvarSIGNs_structural_shocks_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_bsvarSIGNs_structural_shocks", (DL_FUNC)_bsvarSIGNs_bsvarSIGNs_structural_shocks_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_bsvarSIGNs_fitted_values", (DL_FUNC)_bsvarSIGNs_bsvarSIGNs_fitted_values_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_forecast_bsvarSIGNs", (DL_FUNC)_bsvarSIGNs_forecast_bsvarSIGNs_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_match_sign_narrative", (DL_FUNC)_bsvarSIGNs_match_sign_narrative_try);
R_RegisterCCallable("bsvarSIGNs", "_bsvarSIGNs_weight_narrative", (DL_FUNC)_bsvarSIGNs_weight_narrative_try);
Expand All @@ -996,7 +1035,8 @@ static const R_CallMethodDef CallEntries[] = {
{"_bsvarSIGNs_ir1_cpp", (DL_FUNC) &_bsvarSIGNs_ir1_cpp, 4},
{"_bsvarSIGNs_bsvarSIGNs_ir", (DL_FUNC) &_bsvarSIGNs_bsvarSIGNs_ir, 4},
{"_bsvarSIGNs_bsvar_sign_cpp", (DL_FUNC) &_bsvarSIGNs_bsvar_sign_cpp, 14},
{"_bsvarSIGNs_structural_shocks", (DL_FUNC) &_bsvarSIGNs_structural_shocks, 4},
{"_bsvarSIGNs_bsvarSIGNs_structural_shocks", (DL_FUNC) &_bsvarSIGNs_bsvarSIGNs_structural_shocks, 4},
{"_bsvarSIGNs_bsvarSIGNs_fitted_values", (DL_FUNC) &_bsvarSIGNs_bsvarSIGNs_fitted_values, 4},
{"_bsvarSIGNs_forecast_bsvarSIGNs", (DL_FUNC) &_bsvarSIGNs_forecast_bsvarSIGNs, 6},
{"_bsvarSIGNs_match_sign_narrative", (DL_FUNC) &_bsvarSIGNs_match_sign_narrative, 3},
{"_bsvarSIGNs_weight_narrative", (DL_FUNC) &_bsvarSIGNs_weight_narrative, 3},
Expand Down
18 changes: 16 additions & 2 deletions src/compute.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -9,12 +9,26 @@ using namespace arma;

// [[Rcpp::interfaces(cpp)]]
// [[Rcpp::export]]
arma::cube structural_shocks (
arma::cube bsvarSIGNs_structural_shocks (
const arma::cube& posterior_B, // (N, N, S)
const arma::cube& posterior_A, // (N, K, S)
const arma::mat& Y, // NxT dependent variables
const arma::mat& X // KxT dependent variables
) {
cube structural_shocks = bsvars::bsvars_structural_shocks (posterior_B, posterior_A, Y, X);
return structural_shocks;
} // END structural_shocks
} // END bsvarSIGNs_structural_shocks



// [[Rcpp::interfaces(cpp)]]
// [[Rcpp::export]]
arma::cube bsvarSIGNs_fitted_values (
arma::cube& posterior_A, // NxKxS
arma::cube& posterior_B, // NxNxS
arma::cube& posterior_sigma, // NxTxS
arma::mat& X // KxT
) {
cube fitted_values = bsvars::bsvars_fitted_values (posterior_A, posterior_B, posterior_sigma, X);
return fitted_values;
} // END bsvarSIGNs_fitted_values
10 changes: 9 additions & 1 deletion src/compute.h
Original file line number Diff line number Diff line change
Expand Up @@ -5,12 +5,20 @@
#include <RcppArmadillo.h>


arma::cube structural_shocks (
arma::cube bsvarSIGNs_structural_shocks (
const arma::cube& posterior_B, // (N, N, S)
const arma::cube& posterior_A, // (N, K, S)
const arma::mat& Y, // NxT dependent variables
const arma::mat& X // KxT dependent variables
);


arma::cube bsvarSIGNs_fitted_values (
arma::cube& posterior_A, // NxKxS
arma::cube& posterior_B, // NxNxS
arma::cube& posterior_sigma, // NxTxS
arma::mat& X // KxT
);


#endif // _COMPUTE_H_

0 comments on commit b4faf0e

Please sign in to comment.