Merge pull request #232 from venpopov/priors_nlformula

Priors nlformula

NEWS.md

@@ -3,7 +3,10 @@
 # bmm 1.1.0
 
 ### New features
-- Updates to the `bmf2bf` S3 methods to more flexibly accommodate the translation of `bmmformulas` into `brmsformulas`
+* Updates to the `bmf2bf` S3 methods to more flexibly accommodate the translation of `bmmformulas` into `brmsformulas`
+
+### Bug fixes
+* Fix a conflict in setting default priors when model parameters were transformed in a non-linear formula
 
 # bmm 1.0.0
 

R/helpers-data.R

@@ -272,7 +272,7 @@ rad2deg <- function(rad) {
 #' str(sdata1)
 #' @importFrom brms standata
 #' @export
-standata.bmmformula <- function(object, data, model, prior = NULL, ...) {
+standata.bmmformula <- function(object, data, model, ...) {
   # check model, formula and data, and transform data if necessary
   formula <- object
   configure_options(list(...))
@@ -283,12 +283,9 @@ standata.bmmformula <- function(object, data, model, prior = NULL, ...) {
   # generate the model specification to pass to brms later
   config_args <- configure_model(model, data, formula)
 
-  # configure the default prior and combine with user-specified prior
-  prior <- configure_prior(model, data, config_args$formula, prior)
-
-  # extract stan code
+  # extract stan data
   dots <- list(...)
-  fit_args <- combine_args(nlist(config_args, dots, prior))
+  fit_args <- combine_args(nlist(config_args, dots))
   fit_args$object <- fit_args$formula
   fit_args$formula <- NULL
   brms::do_call(brms::standata, fit_args)

R/helpers-prior.R

@@ -116,17 +116,29 @@ set_default_prior <- function(model, data, formula) {
     return(NULL)
   }
 
+  prior <- brms::empty_prior()
+  bterms <- brms::brmsterms(formula)
+  bterms$allpars <- c(bterms$dpars, bterms$nlpars)
+  nlpars <- names(bterms$nlpars)
+  pars <- names(bterms$allpars)
+
   default_priors <- model$default_priors
   stopif(
     !is.list(default_priors) || !all(sapply(default_priors, is.list)),
     "The default_priors should be a list of lists"
   )
 
-  prior <- brms::empty_prior()
-  bterms <- brms::brmsterms(formula)
-  bterms$allpars <- c(bterms$dpars, bterms$nlpars)
-  nlpars <- names(bterms$nlpars)
-  pars <- names(bterms$allpars)
+  # remove default priors if one of them is transformed in a non-linear formula
+  dpar_is_nl <- names(which(sapply(formula$pforms, is_nl)))
+  default_priors[dpar_is_nl] <- NULL
+  warnif(
+    any(dpar_is_nl %in% names(model$parameter)),
+    "Your formula contains non-linear transformations of model parameters.
+     We advise to pass priors for the non-linear parameters to improve parameter estimation.
+     Otherwise, improper flat priors will be used by default."
+    )
+
+
 
   pars_key <- names(default_priors)
   pars <- pars[pars %in% pars_key]

tests/testthat/test-default-priors.R

@@ -197,3 +197,16 @@ test_that("default priors work when there are no fixed parameters", {
   pr <- default_prior(formula, oberauer_lin_2017, sdm('dev_rad'))
   expect_s3_class(pr, 'brmsprior')
 })
+
+test_that("default priors work when there are non-linear transformations of default parameters", {
+  expect_warning(
+    dp <- default_prior(
+      object = bmmformula(c ~ exp(nlc), nlc ~ 1),
+      data = oberauer_lin_2017,
+      model = sdm(resp_error = "dev_rad")
+    ),
+    "contains non-linear transformations of model parameters"
+  )
+  expect_true(!("c" %in% dp$dpar))
+  expect_true("nlc" %in% dp$nlpar)
+})