diff --git a/NEWS.md b/NEWS.md index 17b62fba..fb13862c 100644 --- a/NEWS.md +++ b/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) diff --git a/R/report.brmsfit.R b/R/report.brmsfit.R index 2e753ac7..e9785876 100644 --- a/R/report.brmsfit.R +++ b/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) } diff --git a/man/report.brmsfit.Rd b/man/report.brmsfit.Rd index 106ebe6f..04a34193 100644 --- a/man/report.brmsfit.Rd +++ b/man/report.brmsfit.Rd @@ -19,6 +19,10 @@ Create reports for Bayesian models. The description of the parameters follows the Sequential Effect eXistence and sIgnificance Testing framework (see \link[bayestestR:sexit]{SEXIT documentation}). } +\details{ +Message from the \code{rstan} package: "To avoid recompilation of unchanged +Stan programs, we recommend calling \code{rstan_options(auto_write = TRUE)}" +} \examples{ \dontshow{if (require("brms", quietly = TRUE)) withAutoprint(\{ # examplesIf} \donttest{ diff --git a/tests/testthat/test-report.brmsfit.R b/tests/testthat/test-report.brmsfit.R index 392d08d1..c8345919 100644 --- a/tests/testthat/test-report.brmsfit.R +++ b/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)) })