Merge pull request #26 from bsvars/develop-glp

intermediate progress on develop-glp

DESCRIPTION

@@ -16,7 +16,8 @@ LinkingTo:
     bsvars, 
     Rcpp, 
     RcppArmadillo, 
-    RcppProgress
+    RcppProgress,
+    ramcmc
 Depends: 
     R (>= 2.10),
     bsvars

NAMESPACE

@@ -17,5 +17,4 @@ importFrom(bsvars,compute_structural_shocks)
 importFrom(bsvars,compute_variance_decompositions)
 importFrom(bsvars,estimate)
 importFrom(bsvars,forecast)
-importFrom(stats,lm)
 useDynLib(bsvarSIGNs, .registration = TRUE)

R/RcppExports.R

@@ -9,20 +9,8 @@ riwish_cpp <- function(S, nu) {
     .Call(`_bsvarSIGNs_riwish_cpp`, S, nu)
 }
 
-niw_cpp <- function(Y, X, prior) {
-    .Call(`_bsvarSIGNs_niw_cpp`, Y, X, prior)
-}
-
-mn_prior <- function(p, lambda, psi) {
-    .Call(`_bsvarSIGNs_mn_prior`, p, lambda, psi)
-}
-
-update_prior <- function(p, hyper, model, prior) {
-    .Call(`_bsvarSIGNs_update_prior`, p, hyper, model, prior)
-}
-
-extend_dummy <- function(p, hyper, model, Y, X) {
-    .Call(`_bsvarSIGNs_extend_dummy`, p, hyper, model, Y, X)
+niw_cpp <- function(Y, X, prior_B, prior_V, prior_S, prior_nu) {
+    .Call(`_bsvarSIGNs_niw_cpp`, Y, X, prior_B, prior_V, prior_S, prior_nu)
 }
 
 log_dgamma <- function(x, k, theta) {
@@ -41,16 +29,28 @@ log_mvgamma <- function(n, x) {
     .Call(`_bsvarSIGNs_log_mvgamma`, n, x)
 }
 
-log_ml <- function(p, b, Omega, Psi, d, inv_Omega, Y, X) {
-    .Call(`_bsvarSIGNs_log_ml`, p, b, Omega, Psi, d, inv_Omega, Y, X)
+log_ml <- function(b, Omega, Psi, d, Y, X) {
+    .Call(`_bsvarSIGNs_log_ml`, b, Omega, Psi, d, Y, X)
+}
+
+log_ml_dummy <- function(hyper, model, Y, X, prior) {
+    .Call(`_bsvarSIGNs_log_ml_dummy`, hyper, model, Y, X, prior)
+}
+
+log_posterior_hyper <- function(hyper, model, Y, X, prior) {
+    .Call(`_bsvarSIGNs_log_posterior_hyper`, hyper, model, Y, X, prior)
+}
+
+extend_hyper <- function(init, model, hypers) {
+    .Call(`_bsvarSIGNs_extend_hyper`, init, model, hypers)
 }
 
-log_ml_dummy <- function(p, hyper, model, Y, X, prior) {
-    .Call(`_bsvarSIGNs_log_ml_dummy`, p, hyper, model, Y, X, prior)
+narrow_hyper <- function(model, hypers) {
+    .Call(`_bsvarSIGNs_narrow_hyper`, model, hypers)
 }
 
-log_posterior_hyper <- function(p, hyper, model, Y, X, prior) {
-    .Call(`_bsvarSIGNs_log_posterior_hyper`, p, hyper, model, Y, X, prior)
+sample_hyper <- function(S, start, init, model, Y, X, W, prior) {
+    .Call(`_bsvarSIGNs_sample_hyper`, S, start, init, model, Y, X, W, prior)
 }
 
 # Register entry points for exported C++ functions

R/bsvarSIGNs-package.R

@@ -16,7 +16,6 @@
 #' @import bsvars
 #' @import RcppArmadillo
 #' @import RcppProgress
-#' @importFrom stats lm
 #' @note This package is currently in active development. We give no
 #' warranty that anything here works.
 #' @author Xiaolei Wang \email{[email protected]} Tomasz Woźniak \email{[email protected]}

R/estimate.BSVARSIGN.R

@@ -92,7 +92,7 @@
 #' posterior      = estimate(specification, S = 10)
 #' 
 #' @export
-estimate.BSVARSIGN <- function(specification, S, thin = 1, show_progress = TRUE) {
+estimate.BSVARSIGN = function(specification, S, thin = 1, show_progress = TRUE) {
 
   # get the inputs to estimation
   # prior               = specification$last_draw$prior$get_prior()
@@ -109,6 +109,7 @@ estimate.BSVARSIGN <- function(specification, S, thin = 1, show_progress = TRUE)
                               identification$sign_irf, identification$sign_narrative, 
                               identification$sign_B, identification$zero_irf,
                               prior, starting_values, show_progress, thin, max_tries)
+
 
   specification$starting_values$set_starting_values(qqq$last_draw)
   output              = specify_posterior_bsvarSIGN$new(specification, qqq$posterior)