refactor: enforce line length and use cli for latent prior checks (#580)

Co-authored-by: google-labs-jules[bot] <161369871+google-labs-jules[bot]@users.noreply.github.com>
Co-authored-by: Sam Abbott <s.e.abbott12@gmail.com>

Author: google-labs-jules[bot]

R/prior.R

@@ -44,6 +44,7 @@ epidist_prior <- function(
   enforce_presence = FALSE
 ) {
   assert_epidist(data)
+  .check_latent_priors(data, prior)
   default <- brms::default_prior(formula, data = data)
   model <- epidist_model_prior(data, formula)
   if (!is.null(model)) {
@@ -133,3 +134,45 @@ epidist_family_prior.lognormal <- function(family, formula, ...) {
   prior <- prior + sigma_prior
   return(prior)
 }
+
+.check_latent_priors <- function(data, prior) {
+  if (is_epidist_latent_model(data) && !is.null(prior)) {
+    # Define parameters to check with their severity and messages
+    params <- list(
+      list(
+        name = "swindow_raw",
+        severity = "stop",
+        msg = "Priors for the secondary event window (swindow_raw) must be uniform(0, 1)." # nolint
+      ),
+      list(
+        name = "pwindow_raw",
+        severity = "warning",
+        msg = "Non-uniform priors for the primary event window (pwindow_raw) are not fully supported and may lead to misleading posterior predictions and log-likelihoods." # nolint
+      )
+    )
+
+    for (param in params) {
+      rows <- which(
+        prior$dpar == param$name |
+          grepl(param$name, prior$prior, fixed = TRUE)
+      )
+
+      if (length(rows) > 0) {
+        for (i in rows) {
+          p_str <- prior$prior[i]
+          p_clean <- gsub("\\s+", "", p_str)
+
+          is_uniform <- grepl("uniform(0,1)", p_clean, fixed = TRUE)
+          if (!is_uniform) {
+            if (param$severity == "stop") {
+              cli::cli_abort(param$msg, call = NULL)
+            } else {
+              cli::cli_warn(param$msg, call = NULL)
+            }
+          }
+        }
+      }
+    }
+  }
+  return(invisible(NULL))
+}

tests/testthat/test-prior-latent-model.R

@@ -0,0 +1,47 @@
+test_that("epidist_prior warns or errors for latent model non-uniform priors", {
+  # Mock data object
+  data <- list(
+    relative_obs_time = 1,
+    pwindow = 1,
+    woverlap = 1,
+    swindow = 1,
+    delay = 1,
+    .row_id = 1
+  )
+  class(data) <- c("epidist_latent_model", "data.frame")
+
+  # Mock brmsprior object creator
+  mock_prior <- function(prior_str, class = "b", dpar = "", ...) {
+    return(data.frame(
+      prior = prior_str,
+      class = class,
+      dpar = dpar,
+      stringsAsFactors = FALSE
+    ))
+  }
+  class(mock_prior) <- "brmsprior"
+
+  # Since we cannot easily run epidist_prior because it depends on
+  # brms::default_prior and other things we will test the checking function
+  # directly.
+
+  # Case 1: swindow_raw non-uniform -> Error
+  p1 <- mock_prior("normal(0,1)", dpar = "swindow_raw")
+  expect_error(.check_latent_priors(data, p1), "secondary event")
+
+  # Case 2: swindow_raw uniform -> No error
+  p2 <- mock_prior("uniform(0,1)", dpar = "swindow_raw")
+  expect_no_error(.check_latent_priors(data, p2))
+
+  # Case 3: pwindow_raw non-uniform -> Warning
+  p3 <- mock_prior("normal(0,1)", dpar = "pwindow_raw")
+  expect_warning(.check_latent_priors(data, p3), "primary event")
+
+  # Case 4: pwindow_raw uniform -> No warning
+  p4 <- mock_prior("uniform(0,1)", dpar = "pwindow_raw")
+  expect_no_warning(.check_latent_priors(data, p4))
+
+  # Case 5: mixed
+  p5 <- rbind(p1, p3)
+  expect_error(.check_latent_priors(data, p5), "secondary event")
+})