Print footer line for prediction intervals

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: modelbased
 Title: Estimation of Model-Based Predictions, Contrasts and Means
-Version: 0.17.0.9
+Version: 0.17.0.10
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",

NEWS.md

@@ -31,6 +31,9 @@
 * `comparison = "ratio"` is a new shortcut to compute pairwise comparisons
   as ratios.
 
+* The printed footer of `estimate_prediction()` and similar functions now
+  names prediction intervals as such (#485).
+
 ## Bug fixes
 
 * Fixed issue in `estimate_contrasts()` with wrong assignment of estimates in

R/estimate_predicted.R

@@ -591,12 +591,21 @@ estimate_relation <- function(
   attr(out, "coef_name") <- "Predicted"
   attr(out, "model_info") <- insight::model_info(model, response = 1)
   attr(out, "predict") <- predict
+  # for the prediction-interval line in the footer, we use the type of
+  # predictions that insight actually used, because insight may change
+  # "prediction" into "expectation" for some models
+  footer_predict <- attr(predictions, "predict", exact = TRUE)
+  if (is.null(footer_predict)) {
+    footer_predict <- predict
+  }
+  footer_info <- c(grid_specs, list(predict = predict), transform = !is.null(transform))
+  footer_info$predict_used <- footer_predict
   attr(out, "table_footer") <- .table_footer(
     out,
     by = grid_specs$at,
     type = "predictions",
     model = model,
-    info = c(grid_specs, list(predict = predict), transform = !is.null(transform))
+    info = footer_info
   )
 
   attributes(out) <- c(

R/table_footer.R

@@ -162,6 +162,16 @@
     }
   }
 
+  # tell user about prediction intervals -------------------------------------
+
+  if (
+    identical(type, "predictions") &&
+      identical(info$predict_used, "prediction") &&
+      "CI_low" %in% colnames(x)
+  ) {
+    table_footer <- paste0(table_footer, "\nIntervals are prediction intervals.")
+  }
+
   # Parameter labels for special hypothesis testing --------------------------
 
   # for special hypothesis testing, like "(b1 - b2) = (b4 - b3)", we want to

tests/testthat/_snaps/brms.md

@@ -25,6 +25,7 @@
 
       Variable predicted: rt, response
       Predictions are on the response-scale.
+      Intervals are prediction intervals.
 
 ---
 
@@ -53,4 +54,5 @@
 
       Variable predicted: rt, response
       Predictions are on the response-scale.
+      Intervals are prediction intervals.
 

tests/testthat/test-table_footer.R

@@ -18,3 +18,50 @@ test_that("table_footer", {
   out <- utils::capture.output(estimate_means(m, "c172code", estimate = "average", verbose = FALSE))
   expect_length(out, 10)
 })
+
+
+test_that("table_footer, prediction intervals", {
+  pi_line <- "Intervals are prediction intervals."
+  m_lm <- lm(mpg ~ wt, data = mtcars)
+  m_glm <- glm(vs ~ wt, data = mtcars, family = binomial())
+
+  out <- utils::capture.output(estimate_prediction(m_lm, data = "grid", length = 3))
+  expect_identical(sum(out == pi_line), 1L)
+  out <- utils::capture.output(estimate_prediction(m_glm, data = "grid", length = 3))
+  expect_identical(sum(out == pi_line), 1L)
+  out <- utils::capture.output(estimate_relation(m_lm, predict = "prediction", length = 3))
+  expect_identical(sum(out == pi_line), 1L)
+
+  # no intervals, no line
+  out <- utils::capture.output(estimate_prediction(m_lm, data = "grid", length = 3, ci = NULL))
+  expect_false(pi_line %in% out)
+
+  # no prediction intervals
+  for (m in list(m_lm, m_glm)) {
+    out <- utils::capture.output(estimate_expectation(m, data = "grid", length = 3))
+    expect_false(pi_line %in% out)
+    out <- utils::capture.output(estimate_relation(m, length = 3))
+    expect_false(pi_line %in% out)
+    out <- utils::capture.output(estimate_link(m, length = 3))
+    expect_false(pi_line %in% out)
+  }
+
+  skip_if_not_installed("lme4")
+  m_lmer <- lme4::lmer(mpg ~ wt + (1 | cyl), data = mtcars)
+  out <- utils::capture.output(estimate_prediction(m_lmer, data = "grid", length = 3))
+  expect_identical(sum(out == pi_line), 1L)
+})
+
+
+test_that("table_footer, no prediction intervals if insight falls back", {
+  skip_if_not_installed("mgcv")
+  m <- mgcv::gam(mpg ~ s(wt), data = mtcars)
+  # insight returns expectations for gam-models, even if prediction is requested
+  predict_type <- attr(
+    suppressWarnings(insight::get_predicted(m, predict = "prediction", ci = 0.95)),
+    "predict"
+  )
+  skip_if(identical(predict_type, "prediction"))
+  out <- utils::capture.output(suppressWarnings(estimate_prediction(m, data = "grid", length = 3)))
+  expect_false("Intervals are prediction intervals." %in% out)
+})