Skip to content

fsv to new version #9

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 16 commits into
base: 0.5.0.9000
Choose a base branch
from
Draft

fsv to new version #9

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
16 commits
Select commit Hold shift + click to select a range
9eb4ee6
Using a smaller package for development. Adding fsv in C++ only.
ankargren Jun 7, 2019
f118288
Some updates. Not tested yet.
Jun 7, 2019
9d39083
fsv2 now working
ankargren Jun 10, 2019
c0b11d2
Adding parallel option.
Jun 10, 2019
ba23f25
Adding SS versions of fsv
Jun 11, 2019
2311b88
Added DL. Not tested.
Jun 11, 2019
f3e66b9
Working on DL. Note the order of the pars in rgig!
ankargren Jun 12, 2019
1332250
Reversed order of chi psi
ankargren Jun 12, 2019
9cf2828
Removed Rcouts.
ankargren Jun 13, 2019
0e84e45
Forgot to thin.
ankargren Jun 13, 2019
cc8f6a2
Minor
ankargren Jun 13, 2019
e6569b7
Corrected burnin.
ankargren Jun 13, 2019
043137c
Fixed the storage condition.
ankargren Jun 13, 2019
67da1d4
dl fsv works now.
ankargren Jun 14, 2019
30bf9a9
Fixed some thinning issues.
Jun 19, 2019
adc4dc0
update
Jun 26, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 17 additions & 3 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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")),
Expand All @@ -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
11 changes: 5 additions & 6 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
122 changes: 10 additions & 112 deletions R/RcppExports.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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) {
Expand Down Expand Up @@ -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)
}
Expand All @@ -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))
}
Expand Down
Loading