diff --git a/DESCRIPTION b/DESCRIPTION index e14b5c72a..fddf7b278 100644 --- a/DESCRIPTION +++ b/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", diff --git a/NEWS.md b/NEWS.md index e6e975aa5..4285ae4a2 100644 --- a/NEWS.md +++ b/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 diff --git a/R/estimate_predicted.R b/R/estimate_predicted.R index 169f42b95..3aaa48ace 100644 --- a/R/estimate_predicted.R +++ b/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( diff --git a/R/table_footer.R b/R/table_footer.R index e6349197f..99bba080a 100644 --- a/R/table_footer.R +++ b/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 diff --git a/tests/testthat/_snaps/brms.md b/tests/testthat/_snaps/brms.md index bf59e23fd..e96144b43 100644 --- a/tests/testthat/_snaps/brms.md +++ b/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. diff --git a/tests/testthat/test-table_footer.R b/tests/testthat/test-table_footer.R index 581f85bd4..9156b6b50 100644 --- a/tests/testthat/test-table_footer.R +++ b/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) +})