recycling seed from brm call for initialisation purposes

Author: dbarneche

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: bayesnec
 Title: A Bayesian No-Effect- Concentration (NEC) Algorithm
-Version: 2.1.0.0
+Version: 2.1.0.1
 Authors@R: c(person("Rebecca", "Fisher", email = "r.fisher@aims.gov.au", role = c("aut", "cre")), person("Diego","Barneche",role="aut"), person("Gerard","Ricardo",role="aut"), person("David","Fox",role="aut"))
 Description: Implementation of No-Effect-Concentration estimation that uses 'brms' (see Burkner (2017)<doi:10.18637/jss.v080.i01>; Burkner (2018)<doi:10.32614/RJ-2018-017>; Carpenter 'et al.' (2017)<doi:10.18637/jss.v076.i01> to fit concentration(dose)-response data using Bayesian methods for the purpose of estimating 'ECX' values, but more particularly 'NEC' (see Fox (2010)<doi:10.1016/j.ecoenv.2009.09.012>. This package expands and supersedes an original version implemented in R2jags, see Fisher, Ricardo and Fox (2020)<doi:10.5281/ZENODO.3966864>.
 Depends:

R/helpers.R

@@ -483,8 +483,13 @@ add_brm_defaults <- function(brm_args, model, family, predictor, response,
                    " fitted using a ", model, " model and a ", msg_tag,
                    " distribution."))
     response_link <- response_link_scale(response, family)
+    init_seed <- NULL
+    if ("seed" %in% names(brm_args)) {
+      init_seed <- brm_args$seed
+    }
     inits <- make_good_inits(model, predictor, response_link,
-                             priors = brm_args$prior, chains = brm_args$chains)
+                             priors = brm_args$prior, chains = brm_args$chains,
+                             seed = init_seed)
     if (length(inits) == 1 && "random" %in% names(inits)) {
       inits <- inits$random
     }

R/inits_functions.R

@@ -90,22 +90,26 @@ make_inits <- function(model, fct_args, priors, chains) {
 #' @param y A \code{\link[base]{numeric}} vector containing the y response.
 #' @param n_trials A \code{\link[base]{numeric}} vector indicating
 #' how many attempts the function should run before giving up.
+#' @param seed seed number for reproducible random number generation. Defaults
+#' to \code{NULL}.
 #' @param ... Additional arguments to \code{\link{make_inits}}.
 #'
 #' @seealso \code{\link{make_inits}}
 #' @return A \code{\link[base]{list}} containing the initialisation values.
 #'
 #' @noRd
-make_good_inits <- function(model, x, y, n_trials = 1e5, ...) {
+make_good_inits <- function(model, x, y, n_trials = 1e5, seed = NULL, ...) {
   limits <- range(y, na.rm = TRUE)
   pred_fct <- get(paste0("pred_", model))
   fct_args <- names(unlist(as.list(args(pred_fct))))
   fct_args <- setdiff(fct_args, "x")
+  set.seed(seed)
   inits <- make_inits(model, fct_args, ...)
   init_ranges <- lapply(inits, get_init_ranges, x, pred_fct, fct_args)
   are_good <- all(sapply(init_ranges, check_limits, limits))
   n_t <- 1
   while (!are_good && n_t <= n_trials) {
+    set.seed(seed + n_t)
     inits <- make_inits(model, fct_args, ...)
     init_ranges <- lapply(inits, get_init_ranges, x, pred_fct, fct_args)
     are_good <- all(sapply(init_ranges, check_limits, limits))