Merge pull request paul-buerkner#245 from paul-buerkner/feature-issue-240

Feature issue 240

Author: paul-buerkner

DESCRIPTION

@@ -2,7 +2,7 @@ Package: brms
 Encoding: UTF-8
 Type: Package
 Title: Bayesian Regression Models using Stan
-Version: 1.8.0
+Version: 1.8.0.1
 Date: 2017-07-19
 Authors@R: person("Paul-Christian", "Bürkner", email = "[email protected]",
   role = c("aut", "cre"))
@@ -19,6 +19,7 @@ Imports:
     rstantools (>= 1.2.0),
     bayesplot (>= 1.2.0),
     matrixStats,
+    bridgesampling,
     nlme,
     coda,
     abind,

NAMESPACE

@@ -14,6 +14,8 @@ S3method(as.mcmc,brmsfit)
 S3method(auxpar_family,default)
 S3method(auxpar_family,mixfamily)
 S3method(bayes_R2,brmsfit)
+S3method(bayes_factor,brmsfit)
+S3method(bridge_sampler,brmsfit)
 S3method(c,brmsprior)
 S3method(change_effects,btl)
 S3method(check_prior_special,brmsterms)
@@ -74,6 +76,7 @@ S3method(parnames,default)
 S3method(plot,brmsMarginalEffects)
 S3method(plot,brmsfit)
 S3method(plot,brmshypothesis)
+S3method(post_prob,brmsfit)
 S3method(posterior_predict,brmsfit)
 S3method(posterior_samples,brmsfit)
 S3method(posterior_samples,default)
@@ -123,6 +126,7 @@ S3method(valid_auxpars,default)
 S3method(valid_auxpars,mixfamily)
 S3method(vcov,brmsfit)
 S3method(waic,brmsfit)
+export("add_ic<-")
 export(Beta)
 export(LOO)
 export(VarCorr)
@@ -134,8 +138,10 @@ export(add_waic)
 export(as.mcmc)
 export(asym_laplace)
 export(bayes_R2)
+export(bayes_factor)
 export(bernoulli)
 export(bf)
+export(bridge_sampler)
 export(brm)
 export(brmdata)
 export(brmsfamily)
@@ -235,6 +241,7 @@ export(pexgaussian)
 export(pfrechet)
 export(pgen_extreme_value)
 export(pinv_gaussian)
+export(post_prob)
 export(posterior.samples)
 export(posterior_predict)
 export(posterior_samples)
@@ -304,6 +311,8 @@ importFrom(bayesplot,neff_ratio)
 importFrom(bayesplot,nuts_params)
 importFrom(bayesplot,pp_check)
 importFrom(bayesplot,rhat)
+importFrom(bridgesampling,bridge_sampler)
+importFrom(bridgesampling,post_prob)
 importFrom(coda,as.mcmc)
 importFrom(grDevices,devAskNewPage)
 importFrom(loo,loo)

R/brm.R

@@ -89,6 +89,11 @@
 #'   \code{predict} with the noise-free variables but 
 #'   leads to very large \R objects even for models
 #'   of moderate size and complexity.
+#' @param save_all_pars A flag to indicate if samples from
+#'   all variables defined in Stan's \code{parameters} block
+#'   should be saved (default is \code{FALSE}). Saving these samples 
+#'   is required in order to apply the methods \code{bridge_sampler},
+#'   \code{bayes_factor}, and \code{post_prob}.
 #' @param sample_prior Indicate if samples from all specified 
 #'   proper priors should be drawn additionally to the posterior samples
 #'   (defaults to \code{"no"}). Among others, these samples can be used 
@@ -342,11 +347,12 @@
 brm <- function(formula, data, family = gaussian(), prior = NULL, 
                 autocor = NULL, nonlinear = NULL, 
                 threshold = c("flexible", "equidistant"), 
-                cov_ranef = NULL, save_ranef = TRUE, save_mevars = FALSE, 
-                sparse = FALSE, sample_prior = c("no", "yes", "only"), 
-                knots = NULL, stan_funs = NULL, fit = NA, inits = "random", 
-                chains = 4, iter = 2000, warmup = floor(iter / 2),
-                thin = 1, cores = getOption("mc.cores", 1L), control = NULL,
+                cov_ranef = NULL, sample_prior = c("no", "yes", "only"), 
+                sparse = FALSE, knots = NULL, stan_funs = NULL, 
+                fit = NA, save_ranef = TRUE, save_mevars = FALSE, 
+                save_all_pars = FALSE, inits = "random", chains = 4, 
+                iter = 2000, warmup = floor(iter / 2), thin = 1,
+                cores = getOption("mc.cores", 1L), control = NULL,
                 algorithm = c("sampling", "meanfield", "fullrank"),
                 future = getOption("future", FALSE), silent = TRUE, 
                 seed = 12345, save_model = NULL, save_dso = TRUE, ...) {
@@ -410,7 +416,8 @@ brm <- function(formula, data, family = gaussian(), prior = NULL,
     x$ranef <- tidy_ranef(bterms, data = x$data)  
     x$exclude <- exclude_pars(
       bterms, data = x$data, ranef = x$ranef, 
-      save_ranef = save_ranef, save_mevars = save_mevars
+      save_ranef = save_ranef, save_mevars = save_mevars,
+      save_all_pars = save_all_pars
     )
     x$model <- make_stancode(
       formula = formula, data = data, family = family, 

R/brmsfit-helpers.R

@@ -126,6 +126,17 @@ restructure <- function(x, rstr_summary = FALSE) {
       x$ranef$type[x$ranef$type == "mono"] <- "mo"
       x$ranef$type[x$ranef$type == "cse"] <- "cs"
     }
+    if (version <= "1.8.0") {
+      att <- attributes(object$exclude)
+      if (is.null(att$save_ranef)) {
+        attr(object$exclude, "save_ranef") <- 
+          any(grepl("^r_", parnames(object))) || !nrow(object$ranef)
+      }
+      if (is.null(att$save_mevars)) {
+        attr(object$exclude, "save_mevars") <- 
+          any(grepl("^Xme_", parnames(object)))
+      }
+    }
     stan_env <- attributes(x$fit)$.MISC
     if (rstr_summary && exists("summary", stan_env)) {
       stan_summary <- get("summary", stan_env)