binary and time-to-event informed priors (#29)

* adds informed prior distributions for dichotomous and time to event outcomes based on Cochrane Database of Systematic Reviews to `prior_informed()` function
* fixes: fixes: #20
* add `bridgesampling_object()` (fixes: #28)
* Update prior_informed_medicine_names.Rd
* `Na/NaN` tests for `check_` functions (fixes: #26)
* update priors with the pre-print
* fix minor issues
* add vdiffr

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BayesTools
 Title: Tools for Bayesian Analyses
-Version: 0.2.16
+Version: 0.2.17
 Description: Provides tools for conducting Bayesian analyses and Bayesian model averaging 
     (Kass and Raftery, 1995, <doi:10.1080/01621459.1995.10476572>, 
     Hoeting et al., 1999, <doi:10.1214/ss/1009212519>). The package contains 

NAMESPACE

@@ -51,6 +51,7 @@ export(JAGS_summary_table)
 export(JAGS_to_monitor)
 export(Savage_Dickey_BF)
 export(add_column)
+export(bridgesampling_object)
 export(ccdf)
 export(cdf)
 export(check_bool)

NEWS.md

@@ -1,3 +1,12 @@
+## version 0.2.17
+### Features
+- adding informed prior distributions for dichotomous and time to event outcomes based on Cochrane Database of Systematic Reviews to `prior_informed()` function
+- adding bridge object convenience function `bridge_object()` (fixes: https://github.com/FBartos/BayesTools/issues/28)
+- adding `Na/NaN` tests for `check_` functions (fixes: https://github.com/FBartos/BayesTools/issues/26)
+
+### Fixes
+- ability to run more than 4 chains (fixes: https://github.com/FBartos/BayesTools/issues/20)
+
 ## version 0.2.16
 ### Features
 - update an existing JAGS fit with `JAGS_extend()` function

R/JAGS-fit.R

@@ -226,6 +226,11 @@ JAGS_fit <- function(model_syntax, data = NULL, prior_list = NULL, formula_list
     }
   }
 
+  # stop cluster manually
+  if(parallel){
+    parallel::stopCluster(cl)
+  }
+
   # add information to the fitted object
   attr(fit, "prior_list")   <- prior_list
   attr(fit, "model_syntax") <- model_syntax
@@ -315,6 +320,11 @@ JAGS_extend <- function(fit, autofit_control = list(max_Rhat = 1.05, min_ESS = 5
     converged <- JAGS_check_convergence(fit, prior_list, autofit_control[["max_Rhat"]], autofit_control[["min_ESS"]], autofit_control[["max_error"]], autofit_control[["max_SD_error"]])
   }
 
+  # stop cluster manually
+  if(parallel){
+    parallel::stopCluster(cl)
+  }
+
   # add information to the fitted object
   attr(fit, "prior_list")   <- prior_list
   attr(fit, "model_syntax") <- model_syntax
@@ -797,7 +807,7 @@ JAGS_get_inits            <- function(prior_list, chains, seed){
     temp_inits <- .JAGS_get_inits.fun(prior_list)
 
     temp_inits[[".RNG.seed"]] <- seed + j
-    temp_inits[[".RNG.name"]] <- "base::Super-Duper"
+    temp_inits[[".RNG.name"]] <- if(chains > 4) "lecuyer::RngStream" else "base::Super-Duper"
 
     inits[[j]] <- temp_inits
   }

R/JAGS-marglik.R

@@ -211,6 +211,28 @@ JAGS_bridgesampling <- function(fit, log_posterior, data = NULL, prior_list = NU
   return(posterior)
 }
 
+
+#' @title Create a 'bridgesampling' object
+#'
+#' @description prepares a 'bridgesampling' object with a given
+#' log marginal likelihood.
+#'
+#' @param logml log marginal likelihood. Defaults to \code{-Inf}.
+#'
+#'
+#' @return \code{JAGS_bridgesampling} returns an object of class 'bridge'.
+#'
+#' @export
+bridgesampling_object <- function(logml = -Inf){
+
+  marglik        <- list()
+  marglik$logml  <- logml
+  class(marglik) <- "bridge"
+
+  return(marglik)
+}
+
+
 #' @title Prepare 'JAGS' posterior for 'bridgesampling'
 #'
 #' @description prepares posterior distribution for 'bridgesampling'

R/tools.R

@@ -10,6 +10,8 @@
 #' \code{1}. Set to \code{0} in order to not check object length.
 #' @param allow_NULL whether the object can be \code{NULL}.
 #' If so, no checks are executed.
+#' @param allow_NA whether the object can contain \code{NA} or \code{NaN}
+#' values.
 #' @param allow_values names of values allowed in a character vector.
 #' Defaults to \code{NULL} (do not check).
 #' @param check_names names of entries allowed in a list. Defaults to
@@ -45,7 +47,7 @@
 #' @export check_list
 
 #' @rdname check_input
-check_bool   <- function(x, name, check_length = 1, allow_NULL = FALSE, call = ""){
+check_bool   <- function(x, name, check_length = 1, allow_NULL = FALSE, allow_NA = TRUE, call = ""){
 
   if(is.null(x) || length(x) == 0){
     if(allow_NULL){
@@ -61,11 +63,14 @@ check_bool   <- function(x, name, check_length = 1, allow_NULL = FALSE, call = "
   if(check_length != 0  && length(x) != check_length)
     stop(paste0(call, "The '", name, "' argument must have length '", check_length, "'."), call. = FALSE)
 
+  if(!allow_NA && anyNA(x))
+    stop(paste0(call, "The '", name, "' argument cannot contain NA/NaN values."), call. = FALSE)
+
   return()
 }
 
 #' @rdname check_input
-check_char   <- function(x, name, check_length = 1, allow_values = NULL, allow_NULL = FALSE, call = ""){
+check_char   <- function(x, name, check_length = 1, allow_values = NULL, allow_NULL = FALSE, allow_NA = TRUE, call = ""){
 
   if(is.null(x) || length(x) == 0){
     if(allow_NULL){
@@ -84,11 +89,14 @@ check_char   <- function(x, name, check_length = 1, allow_values = NULL, allow_N
   if(!is.null(allow_values) && any(!x %in% allow_values))
     stop(paste0(call, "The '", paste0(x[!x %in% allow_values], collapse = "', '") ,"' values are not recognized by the '", name, "' argument."), call. = FALSE)
 
+  if(!allow_NA && anyNA(x))
+    stop(paste0(call, "The '", name, "' argument cannot contain NA/NaN values."), call. = FALSE)
+
   return()
 }
 
 #' @rdname check_input
-check_real   <- function(x, name, lower = -Inf, upper = Inf, allow_bound = TRUE, check_length = 1, allow_NULL = FALSE, call = ""){
+check_real   <- function(x, name, lower = -Inf, upper = Inf, allow_bound = TRUE, check_length = 1, allow_NULL = FALSE, allow_NA = TRUE, call = ""){
 
   if(is.null(x) || length(x) == 0){
     if(allow_NULL){
@@ -124,11 +132,15 @@ check_real   <- function(x, name, lower = -Inf, upper = Inf, allow_bound = TRUE,
   if(check_length != 0 && length(x) != check_length)
     stop(paste0(call, "The '", name, "' argument must have length '", check_length, "'."), call. = FALSE)
 
+
+  if(!allow_NA && anyNA(x))
+    stop(paste0(call, "The '", name, "' argument cannot contain NA/NaN values."), call. = FALSE)
+
   return()
 }
 
 #' @rdname check_input
-check_int    <- function(x, name, lower = -Inf, upper = Inf, allow_bound = TRUE, check_length = 1, allow_NULL = FALSE, call = ""){
+check_int    <- function(x, name, lower = -Inf, upper = Inf, allow_bound = TRUE, check_length = 1, allow_NULL = FALSE, allow_NA = TRUE, call = ""){
 
   if(is.null(x) || length(x) == 0){
     if(allow_NULL){
@@ -138,9 +150,9 @@ check_int    <- function(x, name, lower = -Inf, upper = Inf, allow_bound = TRUE,
     }
   }
 
-  check_real(x, name, lower, upper, allow_bound, check_length, allow_NULL, call = call)
+  check_real(x, name = name, lower = lower, upper = upper, allow_bound = allow_bound, check_length = check_length, allow_NULL = allow_NULL, allow_NA = allow_NA, call = call)
 
-  if(!all(.is.wholenumber(x)))
+  if(!all(.is.wholenumber(x, na.rm = TRUE)))
     stop(paste0(call, "The '", name ,"' argument must be an integer vector."), call. = FALSE)
 
   return()
@@ -176,8 +188,12 @@ check_list   <- function(x, name, check_length = 0, check_names = NULL, all_obje
 }
 
 # helper functions
-.is.wholenumber  <- function(x, tol = .Machine$double.eps^0.5){
-  abs(x - round(x)) < tol
+.is.wholenumber  <- function(x, na.rm = FALSE, tol = .Machine$double.eps^0.5){
+  if(na.rm){
+    return(abs(x - round(stats::na.omit(x))) < tol)
+  }else{
+    return(abs(x - round(x)) < tol)
+  }
 }
 
 # check transformation argument

inst/REFERENCES.bib

@@ -53,22 +53,26 @@ @article{maier2020robust
 }
 
 
-@unpublished{bartos2021no,
-  title     = {Robust Bayesian meta-analysis: {M}odel-averaging across complementary publication bias adjustment methods},
+@article{bartos2021no,
+  title     = {Robust {B}ayesian meta-analysis: {M}odel-averaging across complementary publication bias adjustment methods},
   author    = {Barto{\v{s}}, Franti{\v{s}}ek and Maier, Maximilian and Wagenmakers, Eric-Jan and Doucouliagos, Hristos and Stanley, Tom D.},
-  year      = {in press},
-  publisher = {Research Synthesis Methods},
-  note      = {preprint at \url{https://doi.org/10.31234/osf.io/kvsp7}},
-  doi       = {10.31234/osf.io/kvsp7}
+  year      = {2022},
+  journal   = {Research Synthesis Methods},
+  url       = {https://doi.org/10.1002/jrsm.1594},
+  volume    = {14},
+  number    = {1},
+  pages     = {99-116}
 }
 
-@unpublished{bartos2020adjusting,
-  title     = {Adjusting for publication bias in {JASP} & {R} -- {S}election models, {PET-PEESE}, and robust {B}ayesian meta-analysis},
-  author    = {Barto{\v{s}}, Franti{\v{s}}ek and Maier, Maximilian and Quintana, Daniel S and Wagenmakers, Eric-Jan},
-  year      = {in press},
-  journal   = {Advances in Methods and Practices in Psychological Science},
-  note      = {preprint at \url{https://doi.org/10.31234/osf.io/75bqn}},
-  doi       = {10.31234/osf.io/75bqn}
+@article{bartos2020adjusting,
+  title   = {Adjusting for publication bias in {JASP} and {R}: {S}election models, {PET-PEESE}, and robust {B}ayesian meta-analysis},
+  author  = {Barto{\v{s}}, Franti{\v{s}}ek and Maier, Maximilian and Quintana, D.S. and Wagenmakers, Eric-Jan},
+  year    = {2022},
+  journal = {Advances in Methods and Practices in Psychological Science},
+  url     = {https://doi.org/10.1177/25152459221109259},
+  volume  = {5},
+  number  = {3},
+  pages   = {1--19}
 }
 
 @misc{jasp14,
@@ -145,6 +149,9 @@ @article{bartos2021bayesian
   title     = {Bayesian model-averaged meta-analysis in medicine},
   author    = {Barto{\v{s}}, Franti{\v{s}}ek and Gronau, Quentin F and Timmers, Bram and Otte, Willem M. and Ly, Alexander and Wagenmakers, Eric-Jan},
   journal   = {Statistics in Medicine},
+  volume    = {40},
+  number    = {30},
+  pages     = {6743--6761},
   doi       = {10.1002/sim.9170},
   year      = {2021}
 }
@@ -223,7 +230,7 @@ @article{wagenmakers2015turning
   author       = {Wagenmakers, Eric-Jan and Beek, Titia F and Rotteveel, Mark and Gierholz, Alex and Matzke, Dora and Steingroever, Helen and Ly, Alexander and Verhagen, Josine and Selker, Ravi and Sasiadek, Adam and others},
   journal      = {Frontiers in Psychology},
   volume       = {6},
-  pages        = {494},
+  pages        = {1--6},
   year         = {2015},
   publisher    = {Frontiers},
   doi          = {10.3389/fpsyg.2015.00494}
@@ -335,6 +342,15 @@ @article{wrinch1921on
 	url          = {https://doi.org/10.1080/14786442108633773}
 }
 
+@unpublished{bartos2023empirical,
+  title        = {Empirical prior distributions for {B}ayesian meta-analyses of binary and time-to-event outcomes},
+  author       = {Barto{\v{s}}, Franti{\v{s}}ek and Otte, Willem M. and Gronau, Quentin F and Timmers, Bram and Ly, Alexander and Wagenmakers, Eric-Jan},
+  year         = {2023},
+  note         = {preprint at \url{https://doi.org/10.48550/arXiv.2306.11468}},
+  doi          = {10.48550/arXiv.2306.11468}
+}
+
+
 @misc{RoBMA,
     title        = {{RoBMA}: {A}n {R} package for robust {B}ayesian meta-analyses},
     author       = {Barto{\v{s}}, Franti{\v{s}}ek and Maier, Maximilian},