S parameter's initial value must be in range iff value is estimated, …

…thanks @bjoelle, fix #46

R/create_param.R

@@ -703,8 +703,22 @@ create_s_param <- create_param_s <- function(
   estimate = FALSE,
   value = 0.0,
   lower = 0.0,
-  upper = 0.0
+  upper = Inf
 ) {
+  if (estimate == TRUE) {
+    if (lower >= upper) {
+      stop(
+       "'lower' must be less than 'upper' when S is estimated. ",
+        "lower: ", lower, ", upper: ", upper
+      )
+    }
+    if (value < lower || value > upper) {
+      stop(
+        "'value' must be between 'lower' and 'upper' when S is estimated. ",
+        "value: ", value, ", lower: ", lower, ", upper: ", upper
+      )
+    }
+  }
   beautier::create_param(
     name = "s",
     id = id,

R/create_random.R

@@ -532,10 +532,16 @@ create_rnd_rln_clock_model <- function() {
 #' Create a random s parameter
 #' @author Richel J.C. Bilderbeek
 create_rnd_s_param <- function() {
+  lower <- stats::runif(n = 1, min = -10, max = 10)
+  value <- lower + stats::runif(n = 1, min = 0.1, max = 10)
+  upper <- value + stats::runif(n = 1, min = 0.1, max = 10)
+  testit::assert(lower < value)
+  testit::assert(value < upper)
   create_s_param(
     estimate = create_rnd_estimate(), # nolint internal function
-    value = stats::runif(n = 1, min = -10, max = 10),
-    lower = stats::runif(n = 1, min = -10, max = 10)
+    value = value,
+    lower = lower,
+    upper = upper
   )
 }
 

tests/testthat/test-create_param.R

@@ -167,3 +167,26 @@ test_that("abuse", {
     "invalid parameter name, must be one these:"
   )
 })
+
+test_that("abuse, create_s_param", {
+  # https://github.com/richelbilderbeek/beautier/issues/46
+  # creating a TN93 model with the default settings
+  # creates two log-normal distributions
+  # as priors for kappa1 and kappa2,
+  # where the S parameter has lower=0, upper=0 and value=1.25.
+  # This works if S is not estimated,
+  # because BEAST2 only checks upper and lower
+  # when modifying the value (not when initialising it)
+  # but it will break if S is estimated.
+  expect_silent(
+    create_s_param(estimate = FALSE, lower = 0.0, upper = Inf, value = 1.25)
+  )
+  expect_error(
+    create_s_param(estimate = TRUE, lower = 2.0, upper = 1.0, value = 1.5),
+    "'lower' must be less than 'upper' when S is estimated"
+  )
+  expect_error(
+    create_s_param(estimate = TRUE, lower = 0.0, upper = 1.0, value = 1.25),
+    "'value' must be between 'lower' and 'upper' when S is estimated"
+  )
+})