badp_vignette.R
In badp: Bayesian Averaging for Dynamic Panels

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  fig.width = 5,
  fig.height = 3,
  dpi = 72
)

## ----eval=FALSE---------------------------------------------------------------
# install.packages("badp")

## -----------------------------------------------------------------------------
library(badp)

## -----------------------------------------------------------------------------
economic_growth[1:12,1:10]

## -----------------------------------------------------------------------------
original_economic_growth[1:12,1:10]

## -----------------------------------------------------------------------------
economic_growth <- join_lagged_col(
  df            = original_economic_growth,
  col           = gdp,
  col_lagged    = lag_gdp,
  timestamp_col = year,
  entity_col    = country,
  timestep      = 10
)

## -----------------------------------------------------------------------------
data_standardized_features <- feature_standardization(
    df            = economic_growth,
    excluded_cols = c(country, year, gdp)
  )

## -----------------------------------------------------------------------------
data_prepared <- feature_standardization(
    df            = data_standardized_features,
    group_by_col  = year,
    excluded_cols = country,
    scale         = FALSE
  )

## ----eval=FALSE---------------------------------------------------------------
# full_model_space <- optim_model_space(
#   df            = data_prepared,
#   dep_var_col   = gdp,
#   timestamp_col = year,
#   entity_col    = country,
#   init_value    = function(n) rep(0.5, n)
# )

## ----eval=FALSE---------------------------------------------------------------
# model_space_nonnested <- optim_model_space(
#   df            = data_prepared,
#   dep_var_col   = gdp,
#   timestamp_col = year,
#   entity_col    = country,
#   init_value    = function(n) rep(0.5, n),
#   nested = FALSE
# )

## -----------------------------------------------------------------------------
full_model_space$params[1:10, 1:5]

## -----------------------------------------------------------------------------
full_model_space$stats[, 1:5]

## ----eval=FALSE---------------------------------------------------------------
# model_space <- optim_model_space(
#   df            = data_prepared,
#   dep_var_col   = gdp,
#   timestamp_col = year,
#   entity_col    = country,
#   init_value    = function(n) rep(0.5, n)
# )

## ----eval=FALSE---------------------------------------------------------------
# library(parallel)
# # Leave one core free so the session remains responsive.
# cores <- max(1, detectCores() - 1)
# cl <- makeCluster(cores)
# # Only needed when init_value draws at random; set.seed() does not reach
# # the workers, where the per-model optimization runs.
# clusterSetRNGStream(cl, 20240812)

## ----eval=FALSE---------------------------------------------------------------
# model_space <- optim_model_space(
#   df            = data_prepared,
#   dep_var_col   = gdp,
#   timestamp_col = year,
#   entity_col    = country,
#   init_value    = function(n) rep(0.5, n),
#   cl            = cl
# )
# 
# stopCluster(cl)

## -----------------------------------------------------------------------------
bma_results <- bma(full_model_space, round = 3)

## ----eval = FALSE-------------------------------------------------------------
# bma_results_mb2012 <- bma(full_model_space, round = 3, weighting = "mb2012")

## ----eval = FALSE-------------------------------------------------------------
# bma_results_eta <- bma(full_model_space, round = 3, eta = 0.1)

## -----------------------------------------------------------------------------
bma_results[[1]]

## -----------------------------------------------------------------------------
bma_results[[2]]

## -----------------------------------------------------------------------------
bma_results[[16]]

## ----fig=TRUE-----------------------------------------------------------------
for_models <- model_pmp(bma_results)

## ----fig=TRUE-----------------------------------------------------------------
for_models <- model_pmp(bma_results, top = 10)

## ----fig=TRUE-----------------------------------------------------------------
size_graphs <- model_sizes(bma_results)

## -----------------------------------------------------------------------------
best_8_models <- best_models(bma_results, prior = "binomial", best = 8)
best_8_models[[1]]

## -----------------------------------------------------------------------------
best_3_models <- best_models(bma_results, prior = "beta", best = 3)
best_3_models[[5]]

## ----fig=TRUE-----------------------------------------------------------------
best_3_models <- best_models(bma_results, prior = "beta", best = 3)
best_3_models[[9]]

## -----------------------------------------------------------------------------
jointness(bma_results)

## -----------------------------------------------------------------------------
jointness(bma_results, measure = "LS")

## -----------------------------------------------------------------------------
jointness(bma_results, measure = "DW")

## ----fig=TRUE-----------------------------------------------------------------
coef_plots <- coef_hist(bma_results)
coef_plots[[1]]

## ----fig=TRUE-----------------------------------------------------------------
coef_plots2 <- coef_hist(bma_results, use_kernel = 1)
coef_plots2[[1]]

## ----fig=TRUE-----------------------------------------------------------------
library(gridExtra)
grid.arrange(coef_plots[[1]], coef_plots[[2]], coef_plots2[[1]],
             coef_plots2[[2]], nrow = 2, ncol = 2)

## ----fig=TRUE-----------------------------------------------------------------
coef_plots3 <- coef_hist(bma_results, weight = "beta")
coef_plots3[[1]]

## ----fig=TRUE-----------------------------------------------------------------
distPlots <- posterior_dens(bma_results, prior = "binomial", SE = "standard")
grid.arrange(distPlots[[2]], distPlots[[3]], nrow = 2, ncol = 1)

## -----------------------------------------------------------------------------
bma_results2 <- bma(full_model_space, round = 3, EMS = 2)

## -----------------------------------------------------------------------------
bma_results2[[16]]

## ----fig=TRUE-----------------------------------------------------------------
size_graphs2 <- model_sizes(bma_results2)

## ----fig=TRUE-----------------------------------------------------------------
model_graphs2 <- model_pmp(bma_results2)

## -----------------------------------------------------------------------------
bma_results2[[1]]

## -----------------------------------------------------------------------------
bma_results2[[2]]

## -----------------------------------------------------------------------------
jointness(bma_results2, measure = "HCGHM", rho = 0.5, round = 3)

## -----------------------------------------------------------------------------
bma_results8 <- bma(full_model_space, round = 3, EMS = 8)
bma_results8[[16]]

## ----fig=TRUE-----------------------------------------------------------------
size_graphs8 <- model_sizes(bma_results8)

## ----fig=TRUE-----------------------------------------------------------------
model_graphs8 <- model_pmp(bma_results8)

## -----------------------------------------------------------------------------
bma_results8[[1]]

## -----------------------------------------------------------------------------
bma_results8[[2]]

## -----------------------------------------------------------------------------
jointness(bma_results8, measure = "HCGHM", rho = 0.5, round = 3)

## -----------------------------------------------------------------------------
bma_results_dil <- bma(
  model_space = full_model_space,
  round       = 3,
  dilution    = 1
  )

## ----fig=TRUE-----------------------------------------------------------------
size_graphs_dil <- model_sizes(bma_results_dil)

## ----fig=TRUE-----------------------------------------------------------------
bma_results_dil01 <- bma(
  model_space = full_model_space,
  round       = 3,
  dilution    = 1,
  omega     = 0.1
)
size_graphs_dil01 <- model_sizes(bma_results_dil01)

## ----fig=TRUE-----------------------------------------------------------------
bma_results_dil2 <- bma(
  model_space = full_model_space,
  round       = 3,
  dilution    = 1,
  omega     = 2
)
size_graphs_dil2 <- model_sizes(bma_results_dil2)

## -----------------------------------------------------------------------------
bma_results_dil2[[2]]