Ensure fit_model and default_prior work when there are no fixed parameters

R/bmm_model_IMM.R

@@ -39,6 +39,7 @@
         ),
         fixed_parameters = list(mu1 = 0, mu2 = 0, kappa2 = -100),
         default_priors = list(
+          mu1 = list(main = "student_t(1, 0, 1)"),
           kappa = list(main = "normal(2,1)", effects = "normal(0,1)"),
           a = list(main = "normal(0,1)", effects = "normal(0,1)"),
           c = list(main = "normal(0,1)", effects = "normal(0,1)")
@@ -90,6 +91,7 @@
                      s = "log"),
         fixed_parameters = list(mu1 = 0, mu2 = 0, kappa2 = -100),
         default_priors = list(
+          mu1 = list(main = "student_t(1, 0, 1)"),
           kappa = list(main = "normal(2,1)", effects = "normal(0,1)"),
           c = list(main = "normal(0,1)", effects = "normal(0,1)"),
           s = list(main = "normal(0,1)", effects = "normal(0,1)")
@@ -144,6 +146,7 @@
         ),
         fixed_parameters = list(mu1 = 0, mu2 = 0, kappa2 = -100),
         default_priors = list(
+          mu1 = list(main = "student_t(1, 0, 1)"),
           kappa = list(main = "normal(2,1)", effects = "normal(0,1)"),
           a = list(main = "normal(0,1)", effects = "normal(0,1)"),
           c = list(main = "normal(0,1)", effects = "normal(0,1)"),

R/bmm_model_mixture2p.R

@@ -36,6 +36,7 @@
       ),
       fixed_parameters = list(mu1 = 0, mu2 = 0, kappa2 = -100),
       default_priors = list(
+        mu1 = list(main = "student_t(1, 0, 1)"),
         kappa = list(main = "normal(2, 1)", effects = "normal(0, 1)"),
         thetat = list(main = "logistic(0, 1)")
       ),

R/bmm_model_mixture3p.R

@@ -41,6 +41,7 @@
       ),
       fixed_parameters = list(mu1 = 0, mu2 = 0, kappa2 = -100),
       default_priors = list(
+        mu1 = list(main = "student_t(1, 0, 1)"),
         kappa = list(main = "normal(2,1)", effects = "normal(0,1)"),
         thetat = list(main = "logistic(0, 1)"),
         thetant = list(main = "logistic(0, 1)")

R/bmm_model_sdmSimple.R

@@ -25,12 +25,13 @@
         kappa = 'Precision parameter of the SDM distribution'
       ),
       links = list(
-        mu = 'identity',
+        mu = 'tan_half',
         c = 'log',
         kappa = 'log'
       ),
       fixed_parameters = list(mu = 0),
       default_priors = list(
+        mu = list(main = "student_t(1, 0, 1)"),
         kappa = list(main = "student_t(5,1.75,0.75)", effects = "normal(0,1)"),
         c = list(main = "student_t(5,2,0.75)", effects = "normal(0,1)")
       ),
@@ -123,9 +124,9 @@ configure_model.sdmSimple <- function(model, data, formula) {
   sdm_simple <- brms::custom_family(
     "sdm_simple",
     dpars = c("mu", "c", "kappa"),
-    links = c("identity", "identity", "log"),
-    lb = c(-pi, NA, NA),
-    ub = c(pi, NA, NA),
+    links = c("tan_half", "identity", "log"),
+    lb = c(NA, NA, NA),
+    ub = c(NA, NA, NA),
     type = "real", loop = FALSE,
     log_lik = log_lik_sdm_simple,
     posterior_predict = posterior_predict_sdm_simple

R/helpers-parameters.R

@@ -27,7 +27,7 @@ k2sd <- function(K) {
     if (K[j] == 0) S[j] <- Inf
     if (is.infinite(K[j])) S[j] <- 0
     if (K[j] >= 0 & !is.infinite(K[j])) {
-      S[j] <- sqrt(-2 * log(besselI(K[j], 1) / besselI(K[j], 0)))
+      S[j] <- sqrt(-2 * log(besselI(K[j], 1, expon.scaled = T) / besselI(K[j], 0, expon.scaled = T)))
     }
   }
   as.numeric(S)

R/helpers-prior.R

@@ -95,17 +95,22 @@ get_model_prior <- function(object, data, model, formula = object, ...) {
 #'   model
 #' @noRd
 fixed_pars_priors <- function(model, formula, additional_pars = list()) {
-  # determine type of parameters
-  bterms <- brms::brmsterms(formula)
-  dpars <- names(bterms$dpars)
-  nlpars <- names(bterms$nlpars)
+  fix_pars <- model$fixed_parameters
+  if (length(fix_pars) == 0) {
+    return(brms::empty_prior())
+  }
 
   # construct parameter names and prior values
   par_list <- c(model$fixed_parameters, additional_pars)
   pars <- names(par_list)
   values <- unlist(par_list)
   priors <- glue::glue("constant({values})")
 
+  # determine type of parameters
+  bterms <- brms::brmsterms(formula)
+  dpars <- names(bterms$dpars)
+  nlpars <- names(bterms$nlpars)
+
   # flexibly set the variables for set_prior
   classes <- ifelse(pars %in% dpars, "Intercept", "b")
   coefs <- ifelse(pars %in% dpars, "", "Intercept")

inst/stan_chunks/sdmSimple_funs.stan

@@ -1,3 +1,5 @@
+  #include 'fun_tan_half.stan'
+
   // utility function trick for converting real to integer type
   int bin_search(real x, int min_val, int max_val) {
       int mid_p;

tests/testthat/test-helpers-prior.R

@@ -95,3 +95,18 @@ test_that("no check for sort_data with default_priors function", {
                                        sdmSimple('dev_rad')))
   expect_false(any(grepl("sort", res)))
 })
+
+
+test_that("default priors work when there are no fixed parameters", {
+  formula <- bmf(mu ~ 1,
+                 c ~ 1,
+                 kappa ~ 1)
+  if (utils::packageVersion("brms") >= "2.20.14") {
+    prior_fn <- default_prior
+  } else {
+    prior_fn <- get_model_prior
+  }
+
+  pr <- prior_fn(formula, OberauerLin_2017, sdmSimple('dev_rad'))
+  expect_s3_class(pr, 'brmsprior')
+})

tests/testthat/test-summary.R

@@ -9,6 +9,6 @@ test_that("summary has reasonable outputs", {
                  "u-95% CI", "Rhat", "Bulk_ESS", "Tail_ESS"))
   expect_output(print(summary1), "Constant Parameters:")
   expect_output(print(summary1), "Model: sdmSimple")
-  expect_output(print(summary1), "Links: mu = identity; c = log; kappa = log")
+  expect_output(print(summary1), "Links: mu = tan_half; c = log; kappa = log")
   expect_output(print(summary1), "Formula: mu = 0")
 })