From dadfa88a12857e7a547dc8fa7603036b5095523c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Wo=C5=BAniak?= Date: Thu, 25 Jul 2024 16:17:54 +1000 Subject: [PATCH] included summary.PosteriorBVARPANEL #17 + required importing from stats + changed the forecast output name "Global" to "global" for consistency --- NAMESPACE | 3 + R/bvarPANELs-package.R | 1 + ...riance_decompositions.PosteriorBVARPANEL.R | 2 +- R/summary.R | 194 ++++++++++++++++++ man/summary.PosteriorBVARPANEL.Rd | 54 +++++ 5 files changed, 253 insertions(+), 1 deletion(-) create mode 100644 R/summary.R create mode 100644 man/summary.PosteriorBVARPANEL.Rd diff --git a/NAMESPACE b/NAMESPACE index 569797a..47ed488 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ S3method(estimate,PosteriorBVARPANEL) S3method(forecast,PosteriorBVARPANEL) S3method(plot,ForecastsPANEL) S3method(plot,PosteriorFEVDPANEL) +S3method(summary,PosteriorBVARPANEL) export(specify_bvarPANEL) export(specify_panel_data_matrices) export(specify_posterior_bvarPANEL) @@ -19,4 +20,6 @@ importFrom(RcppTN,rtn) importFrom(bsvars,compute_variance_decompositions) importFrom(bsvars,estimate) importFrom(bsvars,forecast) +importFrom(stats,quantile) +importFrom(stats,sd) useDynLib(bvarPANELs, .registration = TRUE) diff --git a/R/bvarPANELs-package.R b/R/bvarPANELs-package.R index 2bc7e9f..df54a26 100644 --- a/R/bvarPANELs-package.R +++ b/R/bvarPANELs-package.R @@ -34,6 +34,7 @@ #' @importFrom Rcpp sourceCpp #' @importFrom R6 R6Class #' @importFrom RcppTN rtn dtn +#' @importFrom stats sd quantile #' @import RcppProgress #' @note This package is currently in active development. #' @author Tomasz Woźniak \email{wozniak.tom@pm.me} diff --git a/R/compute_variance_decompositions.PosteriorBVARPANEL.R b/R/compute_variance_decompositions.PosteriorBVARPANEL.R index 61ad84d..4b3767d 100644 --- a/R/compute_variance_decompositions.PosteriorBVARPANEL.R +++ b/R/compute_variance_decompositions.PosteriorBVARPANEL.R @@ -85,7 +85,7 @@ compute_variance_decompositions.PosteriorBVARPANEL <- function(posterior, horizo fevd[[c]] = fevd_c } - names(fevd) = c(c_names, "Global") + names(fevd) = c(c_names, "global") class(fevd) <- "PosteriorFEVDPANEL" return(fevd) diff --git a/R/summary.R b/R/summary.R new file mode 100644 index 0000000..eda3f24 --- /dev/null +++ b/R/summary.R @@ -0,0 +1,194 @@ + + +#' @title Provides posterior estimation summary for Bayesian Hierarchical Panel +#' Vector Autoregressions +#' +#' @description Provides posterior mean, standard deviations, as well as 5 and 95 +#' percentiles of the parameters for all \code{C} countries. +#' +#' @param object an object of class \code{PosteriorBVARPANEL} obtained using the +#' \code{estimate()} function applied to +#' Vector Autoregressions containing draws from the posterior distribution of +#' the parameters. +#' @param ... additional arguments affecting the summary produced. +#' +#' @return A list reporting the posterior mean, standard deviations, as well as 5 and 95 +#' percentiles of the country-specific and global parameters. +#' +#' @method summary PosteriorBVARPANEL +#' +#' @seealso \code{\link{estimate.BVARPANEL}}, \code{\link{specify_bvarPANEL}} +#' +#' @author Tomasz Woźniak \email{wozniak.tom@pm.me} +#' +#' @examples +#' # upload data +#' data(ilo_cubic_panel) # load the data +#' data(ilo_exogenous_variables) # load the exogenous variables +#' +#' set.seed(123) +#' +#' # specify the model +#' specification = specify_bvarPANEL$new(ilo_cubic_panel, exogenous = ilo_exogenous_variables) +#' burn_in = estimate(specification, 10) # run the burn-in +#' posterior = estimate(burn_in, 10) # estimate the model +#' summary(posterior) +#' +#' # workflow with the pipe |> +#' ############################################################ +#' set.seed(123) +#' ilo_cubic_panel |> +#' specify_bvarPANEL$new(exogenous = ilo_exogenous_variables) |> +#' estimate(S = 10) |> +#' estimate(S = 10) |> +#' summary() +#' +#' @export +summary.PosteriorBVARPANEL = function( + object, + ... +) { + + S = dim(object$posterior$A_c)[4] + C = dim(object$posterior$A_c)[3] + N = dim(object$posterior$A_c)[2] + K = dim(object$posterior$A_c)[1] + p = object$last_draw$p + d = K - N * p + + out = list() + param = c("A", "Sigma") + country_names = names(object$last_draw$data_matrices$Y) + + # country-specific parameter summary + for (c in 1:C) { + + out_c = list() + out_c$Sigma = list() + out_c$A = list() + + for (n in 1:N) { + + Sigma_c = matrix(object$posterior$Sigma_c[n,1:n,c,], nrow = n) + out_c$Sigma[[n]] = matrix( + cbind( + apply(Sigma_c, 1, mean), + apply(Sigma_c, 1, sd), + apply(Sigma_c, 1, quantile, probs = 0.05), + apply(Sigma_c, 1, quantile, probs = 0.95) + ), + ncol = 4 + ) + colnames(out_c$Sigma[[n]]) = c("mean", "sd", "5% quantile", "95% quantile") + rownames(out_c$Sigma[[n]]) = paste0("Sigma[", n, ",", 1:n, "]") + + A_c = object$posterior$A_c[,n,c,] + out_c$A[[n]] = cbind( + apply(A_c, 1, mean), + apply(A_c, 1, sd), + apply(A_c, 1, quantile, probs = 0.05), + apply(A_c, 1, quantile, probs = 0.95) + ) + colnames(out_c$A[[n]]) = c("mean", "sd", "5% quantile", "95% quantile") + + Anames = c( + paste0( + rep("lag", p * N), + kronecker((1:p), rep(1, N)), + rep("_var", p * N), + kronecker((1:N), rep(1, p)) + ), + "const" + ) + if (d > 1) { + Anames = c(Anames, paste0("exo", 1:(d - 1))) + } + rownames(out_c$A[[n]]) = Anames + } # END n loop + + names(out_c$Sigma) = paste0("equation", 1:N) + names(out_c$A) = paste0("equation", 1:N) + + out[[c]] = out_c + } # END c loop + + names(out) = country_names + + + # global parameter summary + out_g = list() + out_g$A = list() + out_g$Sigma = list() + out_g$V = list() + out_g$hyper = list() + + for (n in 1:N) { + + Sigma = matrix(object$posterior$Sigma[n,1:n,], nrow = n) + out_g$Sigma[[n]] = matrix( + cbind( + apply(Sigma, 1, mean), + apply(Sigma, 1, sd), + apply(Sigma, 1, quantile, probs = 0.05), + apply(Sigma, 1, quantile, probs = 0.95) + ), + ncol = 4 + ) + colnames(out_g$Sigma[[n]]) = c("mean", "sd", "5% quantile", "95% quantile") + rownames(out_g$Sigma[[n]]) = paste0("Sigma[", n, ",", 1:n, "]") + + A = object$posterior$A[,n,] + out_g$A[[n]] = cbind( + apply(A, 1, mean), + apply(A, 1, sd), + apply(A, 1, quantile, probs = 0.05), + apply(A, 1, quantile, probs = 0.95) + ) + colnames(out_g$A[[n]]) = c("mean", "sd", "5% quantile", "95% quantile") + rownames(out_g$A[[n]]) = Anames + + } # END n loop + + names(out_g$Sigma) = paste0("equation", 1:N) + names(out_g$A) = paste0("equation", 1:N) + + + for (k in 1:K) { + + V = matrix(object$posterior$V[k,1:k,], nrow = k) + out_g$V[[k]] = matrix( + cbind( + apply(V, 1, mean), + apply(V, 1, sd), + apply(V, 1, quantile, probs = 0.05), + apply(V, 1, quantile, probs = 0.95) + ), + ncol = 4 + ) + colnames(out_g$V[[k]]) = c("mean", "sd", "5% quantile", "95% quantile") + rownames(out_g$V[[k]]) = paste0("V[", k, ",", 1:k, "]") + + } # END k loop + + hyper = t(cbind( + object$posterior$nu, + object$posterior$m, + object$posterior$w, + object$posterior$s + )) + out_g$hyper = matrix( + cbind( + apply(hyper, 1, mean), + apply(hyper, 1, sd), + apply(hyper, 1, quantile, probs = 0.05), + apply(hyper, 1, quantile, probs = 0.95) + ), + ncol = 4 + ) + colnames(out_g$hyper) = c("mean", "sd", "5% quantile", "95% quantile") + rownames(out_g$hyper) = c("nu", "m", "w", "s") + + out$global = out_g + + return(out) +} # END summary.PosteriorBVARPANEL diff --git a/man/summary.PosteriorBVARPANEL.Rd b/man/summary.PosteriorBVARPANEL.Rd new file mode 100644 index 0000000..0095f68 --- /dev/null +++ b/man/summary.PosteriorBVARPANEL.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary.R +\name{summary.PosteriorBVARPANEL} +\alias{summary.PosteriorBVARPANEL} +\title{Provides posterior estimation summary for Bayesian Hierarchical Panel +Vector Autoregressions} +\usage{ +\method{summary}{PosteriorBVARPANEL}(object, ...) +} +\arguments{ +\item{object}{an object of class \code{PosteriorBVARPANEL} obtained using the +\code{estimate()} function applied to +Vector Autoregressions containing draws from the posterior distribution of +the parameters.} + +\item{...}{additional arguments affecting the summary produced.} +} +\value{ +A list reporting the posterior mean, standard deviations, as well as 5 and 95 +percentiles of the country-specific and global parameters. +} +\description{ +Provides posterior mean, standard deviations, as well as 5 and 95 +percentiles of the parameters for all \code{C} countries. +} +\examples{ +# upload data +data(ilo_cubic_panel) # load the data +data(ilo_exogenous_variables) # load the exogenous variables + +set.seed(123) + +# specify the model +specification = specify_bvarPANEL$new(ilo_cubic_panel, exogenous = ilo_exogenous_variables) +burn_in = estimate(specification, 10) # run the burn-in +posterior = estimate(burn_in, 10) # estimate the model +summary(posterior) + +# workflow with the pipe |> +############################################################ +set.seed(123) +ilo_cubic_panel |> + specify_bvarPANEL$new(exogenous = ilo_exogenous_variables) |> + estimate(S = 10) |> + estimate(S = 10) |> + summary() + +} +\seealso{ +\code{\link{estimate.BVARPANEL}}, \code{\link{specify_bvarPANEL}} +} +\author{ +Tomasz Woźniak \email{wozniak.tom@pm.me} +}