Fix BRMS report text duplication and filter uninformative priors

NEWS.md

@@ -2,6 +2,7 @@
 
 Bug fixes
 
+* `report.brmsfit()`: fix issue where report text was printed multiple times when different parameters had different priors (#543)
 * Fixed duplicated text output in `report()` for glmmTMB objects by addressing both regex pattern and redundant CI information concatenation in `report_info.lm()` (#481)
 * Fixed issue with missing effect size for the Intercept term in type 3 anova tables (#451)
 

R/report.brmsfit.R

@@ -4,6 +4,10 @@
 #' follows the Sequential Effect eXistence and sIgnificance Testing framework
 #' (see [SEXIT documentation][bayestestR::sexit]).
 #'
+#' @details
+#' Message from the `rstan` package: "To avoid recompilation of unchanged
+#' Stan programs, we recommend calling `rstan_options(auto_write = TRUE)`"
+#'
 #' @inheritParams report.lm
 #' @inherit report return seealso
 #'
@@ -60,7 +64,6 @@ report_text.brmsfit <- report_text.lm
 #' @export
 report_priors.brmsfit <- function(x, ...) {
   params <- bayestestR::describe_prior(x)
-  params <- params[params$Parameter != "(Intercept)", ]
 
   # Return empty if no priors info
   has_no_prior_information <- (!"Prior_Distribution" %in% names(params)) ||
@@ -71,35 +74,174 @@ report_priors.brmsfit <- function(x, ...) {
     return("")
   }
 
-  values <- ifelse(
-    params$Prior_Distribution == "normal",
-    paste0(
-      "mean = ",
-      insight::format_value(params$Prior_Location),
-      ", SD = ",
-      insight::format_value(params$Prior_Scale)
-    ),
-    paste0(
-      "location = ",
-      insight::format_value(params$Prior_Location),
-      ", scale = ",
-      insight::format_value(params$Prior_Scale)
-    )
-  )
+  # Filter out priors with missing/empty information (both location and
+  # scale are NA). This removes uninformative default priors that shouldn't
+  # be reported
+  valid_priors <- !is.na(params$Prior_Location) |
+    !is.na(params$Prior_Scale)
+  params <- params[valid_priors, ]
+
+  # Return empty if no valid priors remain after filtering
+  if (nrow(params) == 0L) {
+    return("")
+  }
+
+  # Create enhanced prior descriptions with parameter information
+  prior_descriptions <- vector("character", length = 0L)
+
+  # Group parameters by type for cleaner reporting
+  intercept_params <- params[params$Parameter == "(Intercept)", ]
+  slope_params <- params[
+    params$Parameter != "(Intercept)" &
+      !grepl("^(sigma|sd_|cor_)", params$Parameter),
+  ]
+  scale_params <- params[grepl("^(sigma|sd_)", params$Parameter), ]
+
+  # Helper function to format individual priors with mathematical notation
+  format_prior <- function(prior_row) {
+    prior_dist <- prior_row$Prior_Distribution
+    prior_loc <- insight::format_value(prior_row$Prior_Location)
+    prior_scale <- insight::format_value(prior_row$Prior_Scale)
+    prior_df <- if (
+      !is.null(prior_row$Prior_df) && !is.na(prior_row$Prior_df)
+    ) {
+      paste0("df = ", insight::format_value(prior_row$Prior_df), ", ")
+    } else {
+      ""
+    }
+
+    if (prior_dist == "normal") {
+      paste0(
+        "Normal(",
+        prior_df,
+        "\u03bc = ",
+        prior_loc,
+        ", \u03c3 = ",
+        prior_scale,
+        ")"
+      )
+    } else if (prior_dist == "student_t") {
+      paste0(
+        "Student-t(",
+        prior_df,
+        "\u03bc = ",
+        prior_loc,
+        ", \u03c3 = ",
+        prior_scale,
+        ")"
+      )
+    } else {
+      # Fallback for other distributions
+      paste0(
+        tools::toTitleCase(prior_dist),
+        "(",
+        prior_df,
+        "location = ",
+        prior_loc,
+        ", scale = ",
+        prior_scale,
+        ")"
+      )
+    }
+  }
+
+  # Process intercept parameters
+  if (nrow(intercept_params) > 0) {
+    intercept_desc <- sapply(seq_len(nrow(intercept_params)), function(i) {
+      format_prior(intercept_params[i, ])
+    })
+    if (length(unique(intercept_desc)) == 1L) {
+      prior_descriptions <- c(
+        prior_descriptions,
+        paste0("Intercept ~ ", intercept_desc[1])
+      )
+    } else {
+      prior_descriptions <- c(
+        prior_descriptions,
+        paste0("Intercepts ~ ", datawizard::text_concatenate(intercept_desc))
+      )
+    }
+  }
 
-  values <- paste0(params$Prior_Distribution, " (", values, ")")
+  # Process slope parameters
+  if (nrow(slope_params) > 0) {
+    slope_names <- slope_params$Parameter
+    slope_desc <- sapply(seq_len(nrow(slope_params)), function(i) {
+      format_prior(slope_params[i, ])
+    })
+
+    if (length(unique(slope_desc)) == 1L) {
+      # All slopes have the same prior
+      param_list <- if (length(slope_names) > 1) {
+        paste0("(", datawizard::text_concatenate(slope_names), ")")
+      } else {
+        paste0("(", slope_names, ")")
+      }
+      prior_descriptions <- c(
+        prior_descriptions,
+        paste0("Slopes ", param_list, " ~ ", slope_desc[1])
+      )
+    } else {
+      # Different priors for different slopes
+      individual_slopes <- paste0(slope_names, " ~ ", slope_desc)
+      prior_descriptions <- c(
+        prior_descriptions,
+        datawizard::text_concatenate(individual_slopes)
+      )
+    }
+  }
 
-  if (length(unique(values)) == 1L && nrow(params) > 1L) {
-    prior_text <- paste0("all set as ", values[1])
+  # Process scale/sigma parameters
+  if (nrow(scale_params) > 0) {
+    scale_desc <- sapply(seq_len(nrow(scale_params)), function(i) {
+      prior_row <- scale_params[i, ]
+      desc <- format_prior(prior_row)
+      # Add + notation for positive-only distributions when appropriate
+      if (
+        grepl("sigma|sd", prior_row$Parameter) && prior_row$Prior_Location >= 0
+      ) {
+        desc <- gsub("Student-t(", "Student-t\u207a(", desc, fixed = TRUE)
+        desc <- gsub("Normal(", "Normal\u207a(", desc, fixed = TRUE)
+      }
+      desc
+    })
+
+    if (length(unique(scale_desc)) == 1L && nrow(scale_params) > 1L) {
+      prior_descriptions <- c(
+        prior_descriptions,
+        paste0("Residual SD (\u03c3) ~ ", scale_desc[1])
+      )
+    } else {
+      scale_names <- gsub(
+        "sigma",
+        "\u03c3",
+        scale_params$Parameter,
+        fixed = TRUE
+      )
+      individual_scales <- paste0(scale_names, " ~ ", scale_desc)
+      prior_descriptions <- c(
+        prior_descriptions,
+        datawizard::text_concatenate(individual_scales)
+      )
+    }
+  }
+
+  # Combine all descriptions
+  if (length(prior_descriptions) > 0) {
+    report_text <- paste0(
+      "Priors were: ",
+      datawizard::text_concatenate(
+        prior_descriptions,
+        sep = "; ",
+        last = "; "
+      ),
+      "."
+    )
   } else {
-    prior_text <- paste0("set as ", values)
+    report_text <- ""
   }
 
-  prior_text <- paste0(
-    "Priors over parameters were ", prior_text,
-    " distributions"
-  )
-  as.report_priors(prior_text)
+  as.report_priors(report_text)
 }
 
 

tests/testthat/test-report.brmsfit.R

@@ -1,6 +1,9 @@
 skip_on_cran()
 skip_if_not_installed("brms")
 
+skip_on_cran()
+skip_if_not_installed("brms")
+
 test_that("report.brms", {
   # skip_if_not_installed("rstan", "2.26.0")
 
@@ -44,9 +47,34 @@ test_that("report.brms", {
     tolerance = 1e-1
   )
 
+  # Test that report text is a single string (not multiple repetitions)
+  # This ensures the fix for issue #543 works correctly
+  report_text <- as.character(r)
+  expect_length(report_text, 1)
+  expect_type(report_text, "character")
+
+  # Ensure the text doesn't contain multiple identical paragraphs (duplications)
+  # Split by double newlines to find paragraphs
+  paragraphs <- strsplit(report_text, "\\n\\n")[[1]]
+  # The main model description paragraph should appear only once
+  model_paragraphs <- paragraphs[grepl("We fitted a Bayesian linear model", paragraphs, fixed = TRUE)]
+  expect_length(model_paragraphs, 1)
+
+  # Test that priors text doesn't contain empty/meaningless entries like "uniform (location = , scale = )"
+  # This ensures proper filtering of empty priors
+  prior_paragraphs <- paragraphs[grepl("Priors over parameters", paragraphs, fixed = TRUE)]
+  if (length(prior_paragraphs) > 0) {
+    # Should not contain empty parentheses or double spaces from empty values
+    expect_false(grepl("(location = , scale = )", prior_paragraphs[1], fixed = TRUE),
+      info = "Prior text should not contain empty parameter values"
+    )
+    expect_false(grepl("\\(,\\s*\\)", prior_paragraphs[1]),
+      info = "Prior text should not contain empty parameter parentheses"
+    )
+  }
   # Note: snapshot test may have slight numerical differences on different platforms
   # Skip snapshot due to platform differences causing CI failures
-  skip("Skipping snapshot test because of cross-platform numerical differences")
-  # set.seed(333)
-  # expect_snapshot(variant = "windows", report(model, verbose = FALSE))
+  skip("Skipping because of a .01 decimal difference in snapshots")
+  set.seed(333)
+  expect_snapshot(variant = "windows", report(model, verbose = FALSE))
 })