fsv to new version

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mfbvar
 Type: Package
 Title: Mixed-Frequency Bayesian VAR Models 
-Version: 0.5.0.9000
+Version: 0.5.1.9000
 Date: 2019-05-09
 Authors@R: c(
     person("Sebastian", "Ankargren", email = "[email protected]", role = c("cre", "aut"), comment = c(ORCID = "0000-0003-4415-8734")),
@@ -12,10 +12,24 @@ LazyData: TRUE
 URL: https://github.com/ankargren/mfbvar
 BugReports: https://github.com/ankargren/mfbvar/issues
 Imports:
-    Rcpp (>= 0.12.7), ggplot2 (>= 2.2.1), methods, pbapply, utils, factorstochvol, progress, lubridate, GIGrvg
+    Rcpp (>= 0.12.7), 
+    ggplot2 (>= 2.2.1), 
+    methods, 
+    pbapply, 
+    utils, 
+    progress, 
+    lubridate, 
+    GIGrvg, 
+    stochvol (>= 2.0.3), 
+    RcppParallel
 LinkingTo:
-    Rcpp, RcppArmadillo, RcppProgress
+    Rcpp, 
+    RcppArmadillo, 
+    RcppProgress, 
+    stochvol (>= 2.0.3), 
+    RcppParallel
 Depends: R (>= 2.10)
 Suggests: testthat, covr, tidyverse
 RoxygenNote: 6.1.1
 Encoding: UTF-8
+SystemRequirements: GNU make

NAMESPACE

@@ -9,26 +9,25 @@ importFrom(tibble,"tibble")
 importFrom(dplyr, "group_by", "summarize", "ungroup", "mutate", "transmute", "bind_rows")
 importFrom(lubridate, "%m-%", "%m+%", "days", "ymd", "quarter", "month", "year")
 import(ggplot2)
+importFrom(stochvol,svsample)
 S3method(print, mfbvar_prior)
 S3method(summary, mfbvar_prior)
-S3method(mdd, mfbvar_minn_iw)
-S3method(mdd, mfbvar_ss_iw)
-S3method(mcmc_sampler, mfbvar_minn_iw)
-S3method(mcmc_sampler, mfbvar_ss_iw)
 S3method(print, mfbvar)
 S3method(summary, mfbvar)
 S3method(plot, mfbvar_minn)
 S3method(plot, mfbvar_ss)
 S3method(plot, mfbvar_ssng)
 S3method(plot, mfbvar_prior)
+S3method(mcmc_sampler, mfbvar_minn_fsv)
+S3method(mcmc_sampler, mfbvar_dl_fsv)
 S3method(predict, mfbvar)
 S3method(predict, sfbvar)
 importFrom("methods", "hasArg")
 export(set_prior)
 export(update_prior)
 export(estimate_mfbvar)
-export(interval_to_moments)
-export(mdd)
 export(mcmc_sampler)
+export(interval_to_moments)
 export(varplot)
 importFrom(GIGrvg,rgig)
+importFrom(RcppParallel, RcppParallelLibs)

R/RcppExports.R

@@ -26,51 +26,8 @@ create_X_t_noint <- function(y) {
     .Call(`_mfbvar_create_X_t_noint`, y)
 }
 
-#' @title Kalman filter and smoother
-#'
-#' @description Kalman filter and smoother (\code{kf_ragged}) and simulation smoother (\code{kf_sim_smooth}) for mixed-frequency data with ragged edges. This function is more computationally efficient than using a companion form representation.
-#' @param y_ matrix with the data
-#' @param Phi_ matrix with the autoregressive parameters, where the last column is the intercept
-#' @param Sigma_ error covariance matrix
-#' @param Lambda_ aggregation matrix (for quarterly variables only)
-#' @param n_q_ number of quarterly variables
-#' @param T_b_ final time period where all monthly variables are observed
-#' @keywords internal
-#' @return For \code{kf_ragged}, a list with elements:
-#' \item{a}{The one-step predictions (for the compact form)}
-#' \item{a_tt}{The filtered estimates (for the compact form)}
-#' \item{a_tT}{The smoothed estimates (for the compact form)}
-#' \item{Z_tT}{The smoothed estimated (for the original form)}
-#' @details The returned matrices have the same number of rows as \code{y_}, but the first \code{n_lags} rows are zero.
-kf_loglike <- function(y_, Phi_, Sigma_, Lambda_, a00, P00) {
-    .Call(`_mfbvar_kf_loglike`, y_, Phi_, Sigma_, Lambda_, a00, P00)
-}
-
-#' @title Kalman filter and smoother
-#'
-#' @description Kalman filter and smoother (\code{kf_ragged}) and simulation smoother (\code{kf_sim_smooth}) for mixed-frequency data with ragged edges. This function is more computationally efficient than using a companion form representation.
-#' @param y_ matrix with the data
-#' @param Phi_ matrix with the autoregressive parameters, where the last column is the intercept
-#' @param Sigma_ error covariance matrix
-#' @param Lambda_ aggregation matrix (for quarterly variables only)
-#' @param n_q_ number of quarterly variables
-#' @param T_b_ final time period where all monthly variables are observed
-#' @keywords internal
-#' @return For \code{kf_ragged}, a list with elements:
-#' \item{a}{The one-step predictions (for the compact form)}
-#' \item{a_tt}{The filtered estimates (for the compact form)}
-#' \item{a_tT}{The smoothed estimates (for the compact form)}
-#' \item{Z_tT}{The smoothed estimated (for the original form)}
-#' @details The returned matrices have the same number of rows as \code{y_}, but the first \code{n_lags} rows are zero.
-kf_ragged <- function(y_, Phi_, Sigma_, Lambda_, Z1_, n_q_, T_b_) {
-    .Call(`_mfbvar_kf_ragged`, y_, Phi_, Sigma_, Lambda_, Z1_, n_q_, T_b_)
-}
-
-#' @describeIn kf_ragged Simulation smoother
-#' @param Z1 initial values, with \code{n_lags} rows and same number of columns as \code{y_}
-#' @return For \code{kf_sim_smooth}, a matrix with the draw from the posterior distribution.
-kf_sim_smooth <- function(y_, Phi_, Sigma_, Lambda_, Z1_, n_q_, T_b_) {
-    .Call(`_mfbvar_kf_sim_smooth`, y_, Phi_, Sigma_, Lambda_, Z1_, n_q_, T_b_)
+dl_reg <- function(y, x, beta, aux, global, local, prior_Pi_Omega, n_reps, a, gig) {
+    invisible(.Call(`_mfbvar_dl_reg`, y, x, beta, aux, global, local, prior_Pi_Omega, n_reps, a, gig))
 }
 
 #' @title Find maximum eigenvalue
@@ -85,40 +42,12 @@ max_eig_cpp <- function(A) {
     .Call(`_mfbvar_max_eig_cpp`, A)
 }
 
-mcmc_minn_csv <- function(y_in_p, Pi, Sigma, Z, Z_fcst, phi, sigma, f, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, Z_1, priorlatent0, phi_invvar, phi_meaninvvar, prior_sigma2, prior_df, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_minn_csv`, y_in_p, Pi, Sigma, Z, Z_fcst, phi, sigma, f, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, Z_1, priorlatent0, phi_invvar, phi_meaninvvar, prior_sigma2, prior_df, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose))
-}
-
-mcmc_ss_csv <- function(y_in_p, Pi, Sigma, psi, Z, Z_fcst, phi, sigma, f, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, inv_prior_psi_Omega, inv_prior_psi_Omega_mean, check_roots, Z_1, priorlatent0, phi_invvar, phi_meaninvvar, prior_sigma2, prior_df, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_ss_csv`, y_in_p, Pi, Sigma, psi, Z, Z_fcst, phi, sigma, f, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, inv_prior_psi_Omega, inv_prior_psi_Omega_mean, check_roots, Z_1, priorlatent0, phi_invvar, phi_meaninvvar, prior_sigma2, prior_df, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose))
-}
-
-mcmc_ssng_csv <- function(y_in_p, Pi, Sigma, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, phi, sigma, f, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, priorlatent0, phi_invvar, phi_meaninvvar, prior_sigma2, prior_df, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_ssng_csv`, y_in_p, Pi, Sigma, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, phi, sigma, f, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, priorlatent0, phi_invvar, phi_meaninvvar, prior_sigma2, prior_df, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose))
-}
-
-mcmc_minn_diffuse <- function(y_in_p, Pi, Sigma, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, Omega_Pi, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_minn_diffuse`, y_in_p, Pi, Sigma, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, Omega_Pi, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose))
-}
-
-mcmc_minn_iw <- function(y_in_p, Pi, Sigma, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose, prior_nu) {
-    invisible(.Call(`_mfbvar_mcmc_minn_iw`, y_in_p, Pi, Sigma, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose, prior_nu))
-}
-
-mcmc_ss_diffuse <- function(y_in_p, Pi, Sigma, psi, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, Omega_Pi, D_mat, dt, d1, d_fcst_lags, inv_prior_psi_Omega, inv_prior_psi_Omega_mean, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_ss_diffuse`, y_in_p, Pi, Sigma, psi, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, Omega_Pi, D_mat, dt, d1, d_fcst_lags, inv_prior_psi_Omega, inv_prior_psi_Omega_mean, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose))
+mcmc_minn_fsv <- function(y_in_p, Pi, Z, Z_fcst, mu, phi, sigma, f, facload, h, aux, global, local, slice, Lambda_comp, prior_Pi_Omega, prior_Pi_AR1, Z_1, bmu, Bmu, a0idi, b0idi, a0fac, b0fac, Bsigma, B011inv, B022inv, priorh0, armarestr, armatau2, n_fac, n_reps, n_burnin, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose, a, gig) {
+    invisible(.Call(`_mfbvar_mcmc_minn_fsv`, y_in_p, Pi, Z, Z_fcst, mu, phi, sigma, f, facload, h, aux, global, local, slice, Lambda_comp, prior_Pi_Omega, prior_Pi_AR1, Z_1, bmu, Bmu, a0idi, b0idi, a0fac, b0fac, Bsigma, B011inv, B022inv, priorh0, armarestr, armatau2, n_fac, n_reps, n_burnin, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_thin, verbose, a, gig))
 }
 
-mcmc_ss_iw <- function(y_in_p, Pi, Sigma, psi, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, inv_prior_psi_Omega, inv_prior_psi_Omega_mean, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_ss_iw`, y_in_p, Pi, Sigma, psi, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, inv_prior_psi_Omega, inv_prior_psi_Omega_mean, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose))
-}
-
-mcmc_ssng_diffuse <- function(y_in_p, Pi, Sigma, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, Omega_Pi, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_ssng_diffuse`, y_in_p, Pi, Sigma, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, Omega_Pi, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose))
-}
-
-mcmc_ssng_iw <- function(y_in_p, Pi, Sigma, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose) {
-    invisible(.Call(`_mfbvar_mcmc_ssng_iw`, y_in_p, Pi, Sigma, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, Lambda_comp, prior_Pi_Omega, inv_prior_Pi_Omega, Omega_Pi, prior_Pi_mean, prior_S, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose))
+mcmc_ss_fsv <- function(y_in_p, Pi, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, mu, phi, sigma, f, facload, h, Lambda_comp, prior_Pi_Omega, prior_Pi_AR1, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, bmu, Bmu, a0idi, b0idi, a0fac, b0fac, Bsigma, B011inv, B022inv, priorh0, armarestr, armatau2, n_fac, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose, ssng) {
+    invisible(.Call(`_mfbvar_mcmc_ss_fsv`, y_in_p, Pi, psi, phi_mu, lambda_mu, omega, Z, Z_fcst, mu, phi, sigma, f, facload, h, Lambda_comp, prior_Pi_Omega, prior_Pi_AR1, D_mat, dt, d1, d_fcst_lags, prior_psi_mean, c0, c1, s, check_roots, Z_1, bmu, Bmu, a0idi, b0idi, a0fac, b0fac, Bsigma, B011inv, B022inv, priorh0, armarestr, armatau2, n_fac, n_reps, n_q, T_b, n_lags, n_vars, n_T, n_fcst, n_determ, n_thin, verbose, ssng))
 }
 
 variances_fsv <- function(variances, latent, facload, variables_num, n_fac, n_reps, n_T, n_vars, n_plotvars) {
@@ -173,6 +102,10 @@ do_rgig1 <- function(lambda, chi, psi) {
     .Call(`_mfbvar_do_rgig1`, lambda, chi, psi)
 }
 
+rig <- function(mu, lambda) {
+    .Call(`_mfbvar_rig`, mu, lambda)
+}
+
 rmvn <- function(Phi, d, alpha) {
     .Call(`_mfbvar_rmvn`, Phi, d, alpha)
 }
@@ -199,41 +132,6 @@ rmultn <- function(m, Sigma) {
     .Call(`_mfbvar_rmultn`, m, Sigma)
 }
 
-rsimsm_adaptive_cv <- function(y_, Phi, Sigma_chol, Lambda, Z1, n_q_, T_b) {
-    .Call(`_mfbvar_rsimsm_adaptive_cv`, y_, Phi, Sigma_chol, Lambda, Z1, n_q_, T_b)
-}
-
-rsimsm_adaptive_sv <- function(y_, Phi, Sigma_chol, Lambda, Z1, n_q_, T_b) {
-    .Call(`_mfbvar_rsimsm_adaptive_sv`, y_, Phi, Sigma_chol, Lambda, Z1, n_q_, T_b)
-}
-
-rsimsm_adaptive_univariate <- function(y_, Phi, Sigma, Lambda, Z1, n_q_, T_b, f) {
-    .Call(`_mfbvar_rsimsm_adaptive_univariate`, y_, Phi, Sigma, Lambda, Z1, n_q_, T_b, f)
-}
-
-#' @title Smooth and sample from the smoothed distribution
-#'
-#' @description Functions for smoothing and sampling from the (smoothed) distribution \eqn{p(Z_{1:T}|Y_{1:T}, \Theta)}.
-#' @details Implemented in C++.
-#' @aliases smoother simulation_smoother generate_mhh loglike
-#' @describeIn smoother Compute smoothed states
-#' @templateVar Y TRUE
-#' @templateVar Lambda TRUE
-#' @templateVar Pi_comp TRUE
-#' @templateVar Q_comp TRUE
-#' @templateVar n_T TRUE
-#' @templateVar n_vars TRUE
-#' @templateVar n_comp TRUE
-#' @templateVar z0 TRUE
-#' @templateVar P0 TRUE
-#' @template man_template
-#' @keywords internal
-#' @return For \code{loglike}:
-#' \item{}{An \code{n_T}-long vector of the log-likelihoods. \code{exp(sum(loglike(...)))} is the likelihood.}
-loglike <- function(Y, Lambda, Pi_comp, Q_comp, n_T, n_vars, n_comp, z0, P0) {
-    .Call(`_mfbvar_loglike`, Y, Lambda, Pi_comp, Q_comp, n_T, n_vars, n_comp, z0, P0)
-}
-
 update_demean <- function(my, mu_long, y_in_p, mu_mat, d1, Psi_i, Lambda_single, n_vars, n_q, n_Lambda, n_T) {
     invisible(.Call(`_mfbvar_update_demean`, my, mu_long, y_in_p, mu_mat, d1, Psi_i, Lambda_single, n_vars, n_q, n_Lambda, n_T))
 }