diff --git a/DESCRIPTION b/DESCRIPTION index 8525efd09..b3c8fdee2 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.17 +Version: 0.17.0.18 Authors@R: c(person(given = "Dominique", family = "Makowski", diff --git a/NEWS.md b/NEWS.md index 27a83785f..f3c1db511 100644 --- a/NEWS.md +++ b/NEWS.md @@ -59,6 +59,17 @@ ## Bug fixes +* For non-linear models, the footer of predictions or contrasts on the + link-scale no longer says "FALSE-transformed" or "TRUE-transformed". This + footer appears, for example, with `estimate_link()`, or with + `estimate_means()` and `predict = "link"`. Without `transform`, the footer + now says "link-scale". Except with `backend = "emmeans"`, a function as + `transform` gives "transformed link-scale". `estimate_contrasts()` with + `predict = "link"` and a function as `transform` (for example + `transform = exp`) no longer fails with an error. If the output of an + earlier call is the `data` argument, the footer of `estimate_expectation()`, + `estimate_prediction()` and `estimate_link()` now names the right scale. + * With `backend = "marginaleffects"`, `estimate_means()`, `estimate_slopes()` and `estimate_contrasts()` no longer drop or rename a `by` variable with a name such as `type`, `n` or `value`. They also no longer mislabel other diff --git a/R/estimate_predicted.R b/R/estimate_predicted.R index 3aaa48ace..dffd9d318 100644 --- a/R/estimate_predicted.R +++ b/R/estimate_predicted.R @@ -583,6 +583,7 @@ estimate_relation <- function( attr(out, "keep_iterations") <- keep_iterations attr(out, "response") <- model_response attr(out, "transform") <- !is.null(transform) + attr(out, "transform_arg") <- transform attr(out, "model") <- model attr(out, "datagrid") <- data attr(out, "focal_terms") <- grid_specs$at_specs$varname @@ -598,7 +599,12 @@ estimate_relation <- function( if (is.null(footer_predict)) { footer_predict <- predict } - footer_info <- c(grid_specs, list(predict = predict), transform = !is.null(transform)) + # an earlier output passed as `data` has its own "predict" and "transform" + # attributes in `grid_specs`, so we replace them with those of this call + footer_info <- grid_specs + footer_info$predict <- predict + footer_info$transform <- !is.null(transform) + footer_info$transform_arg <- transform footer_info$predict_used <- footer_predict attr(out, "table_footer") <- .table_footer( out, @@ -610,7 +616,7 @@ estimate_relation <- function( attributes(out) <- c( attributes(out), - grid_specs[!names(grid_specs) %in% names(attributes(out))] + grid_specs[!names(grid_specs) %in% c(names(attributes(out)), "transform_arg")] ) # Class diff --git a/R/get_marginalcontrasts.R b/R/get_marginalcontrasts.R index 8b3a281cc..70ae023df 100644 --- a/R/get_marginalcontrasts.R +++ b/R/get_marginalcontrasts.R @@ -184,6 +184,7 @@ get_marginalcontrasts <- function( contrast = my_args$contrast, predict = predict, transform = transform, + transform_arg = transform, comparison = my_args$comparison, estimate = estimate, p_adjust = p_adjust, diff --git a/R/get_marginalmeans.R b/R/get_marginalmeans.R index 405e1c8db..4138f5ed0 100644 --- a/R/get_marginalmeans.R +++ b/R/get_marginalmeans.R @@ -238,7 +238,9 @@ get_marginalmeans <- function( fun_args$vcov <- FALSE } - # transform reponse? + # transform response? we keep the argument as passed by the user for the + # table footer + transform_arg <- transform if (isTRUE(transform)) { transform <- insight::get_transformation(model, verbose = FALSE)$inverse } @@ -318,6 +320,7 @@ get_marginalmeans <- function( estimate = estimate, datagrid = datagrid, transform = !is.null(transform), + transform_arg = transform_arg, iterations = iterations, keep_iterations = keep_iterations, joint_test = joint_test, @@ -665,6 +668,8 @@ get_marginalmeans <- function( # - slope: the type of slope, e.g. "dx/dy". equals the "slope" argument when # calling avg_slopes() # - model_info: object from insight::model_info() +# - transform_arg: the `transform` argument as passed by the user (`transform` +# is often only a logical), used for the scale line of the table footer # - renamed_focal: focal terms with the name of an output column, named by # their old names, with the new names ".1" as values #' @keywords internal @@ -696,8 +701,8 @@ get_marginalmeans <- function( # fmt: skip c( "at", "by", "focal_terms", "adjusted_for", "predict", "trend", "comparison", - "contrast", "estimate", "p_adjust", "transform", "datagrid", "preserve_range", - "coef_name", "slope", "ci", "model_info", "contrast_filter", "null", + "contrast", "estimate", "p_adjust", "transform", "transform_arg", "datagrid", + "preserve_range", "coef_name", "slope", "ci", "model_info", "contrast_filter", "null", "iterations", "keep_iterations", "joint_test", "omnibus_test", "vcov", "equivalence", "context_effects", "renamed_focal" ) diff --git a/R/table_footer.R b/R/table_footer.R index ba7a0ec66..f82650d6e 100644 --- a/R/table_footer.R +++ b/R/table_footer.R @@ -131,9 +131,10 @@ predict ) # we may have link-scale and transformation. to avoid confusion, tell this - # here - if (predict == "link" && !is.null(transform)) { - predict <- paste0(transform, "-transformed ", predict) + # here. `info$transform` is often only a logical (and always `TRUE` for + # emmeans), so we use the `transform` argument as passed by the user + if (predict == "link") { + predict <- .link_transform_label(info$transform_arg, model) } # if we have contrasts of slope for GLMs, the default is to calculate # ORs or IRRs - in this case, we don't add information about the scale @@ -225,6 +226,29 @@ } +# name of the link-scale, including a transformation ------------------------- + +.link_transform_label <- function(transform, model = NULL) { + if (is.character(transform) && length(transform) == 1) { + # transformation given by name, like "exp" + paste0(transform, "-transformed link") + } else if (is.function(transform)) { + "transformed link" + } else if (isTRUE(transform)) { + # `transform = TRUE` applies the inverse of the response transformation, + # which changes nothing if the response is not transformed + trans_fun <- .safe(insight::find_transformation(model)) + if (is.null(trans_fun) || all(trans_fun == "identity")) { + "link" + } else { + "transformed link" + } + } else { + "link" + } +} + + # Table footer slopes ========================================================= .table_footer_slopes <- function(x, model = NULL, info = NULL) { diff --git a/tests/testthat/_snaps/plot-ordinal/plot-ordinal-bracl.svg b/tests/testthat/_snaps/plot-ordinal/plot-ordinal-bracl.svg index 48b824030..6553f8ae2 100644 --- a/tests/testthat/_snaps/plot-ordinal/plot-ordinal-bracl.svg +++ b/tests/testthat/_snaps/plot-ordinal/plot-ordinal-bracl.svg @@ -27,17 +27,17 @@ - - - - - - - + + + + + + + - - + + @@ -48,13 +48,13 @@ 10% 20% -30% +30% 40% 50% - + - + diff --git a/tests/testthat/test-table_footer.R b/tests/testthat/test-table_footer.R index 9156b6b50..2c315ff63 100644 --- a/tests/testthat/test-table_footer.R +++ b/tests/testthat/test-table_footer.R @@ -53,6 +53,108 @@ test_that("table_footer, prediction intervals", { }) +test_that("table_footer, link-scale without transform", { + d <- mtcars + d$cyl <- factor(d$cyl) + g <- glm(am ~ wt + cyl, data = d, family = binomial) + pred_line <- "Predictions are on the link-scale." + contr_line <- "Contrasts are on the link-scale." + + out <- utils::capture.output(estimate_link(g, by = "cyl")) + expect_true(pred_line %in% out) + for (backend in c("marginaleffects", "emmeans")) { + out <- utils::capture.output( + estimate_means(g, "cyl", predict = "link", backend = backend) + ) + expect_true(pred_line %in% out) + out <- utils::capture.output( + estimate_contrasts(g, "cyl", predict = "link", backend = backend) + ) + expect_true(contr_line %in% out) + } +}) + + +test_that("table_footer, link-scale with transform", { + d <- mtcars + d$cyl <- factor(d$cyl) + g <- glm(am ~ wt + cyl, data = d, family = binomial) + + # a transformation function + out <- utils::capture.output( + estimate_contrasts(g, "cyl", predict = "link", transform = exp) + ) + expect_true("Contrasts are on the transformed link-scale." %in% out) + out <- utils::capture.output(estimate_link(g, by = "cyl", transform = exp)) + expect_true("Predictions are on the transformed link-scale." %in% out) + out <- utils::capture.output( + estimate_means(g, "cyl", predict = "link", transform = exp) + ) + expect_true("Predictions are on the transformed link-scale." %in% out) + + # transform = TRUE + out <- utils::capture.output(estimate_link(g, by = "cyl", transform = TRUE)) + expect_false(any(grepl("TRUE-transformed|FALSE-transformed", out))) + # the response is not transformed, so `transform = TRUE` changes nothing + out <- utils::capture.output( + estimate_means(g, "cyl", predict = "link", transform = TRUE) + ) + expect_true("Predictions are on the link-scale." %in% out) + + # name of the transformation + out <- utils::capture.output( + estimate_contrasts(g, "cyl", predict = "link", transform = "exp") + ) + expect_true("Contrasts are on the exp-transformed link-scale." %in% out) +}) + + +test_that("table_footer, scale of predictions with earlier output as data", { + d <- mtcars + d$cyl <- factor(d$cyl) + g <- glm(am ~ wt + cyl, data = d, family = binomial) + resp_line <- "Predictions are on the response-scale." + + out <- utils::capture.output( + estimate_expectation(g, data = estimate_link(g, by = "cyl")) + ) + expect_true(resp_line %in% out) + out <- utils::capture.output( + estimate_prediction(g, data = estimate_link(g, by = "cyl")) + ) + expect_true(resp_line %in% out) + out <- utils::capture.output( + estimate_link(g, data = estimate_expectation(g, by = "cyl")) + ) + expect_true("Predictions are on the link-scale." %in% out) +}) + + +test_that("table_footer, link-scale for contrasts of predictions and slopes", { + d <- mtcars + d$cyl <- factor(d$cyl) + g <- glm(am ~ wt + cyl, data = d, family = binomial) + + # contrasts of an earlier output + out <- utils::capture.output(estimate_contrasts(estimate_link(g, by = "cyl"))) + expect_true("Contrasts are on the link-scale." %in% out) + out <- utils::capture.output( + estimate_contrasts(estimate_link(g, by = "cyl", transform = exp)) + ) + expect_true("Contrasts are on the transformed link-scale." %in% out) + + # contrasts of slopes + out <- utils::capture.output( + estimate_contrasts(g, "wt", by = "cyl", predict = "link") + ) + expect_true("Contrasts are on the link-scale." %in% out) + out <- utils::capture.output( + estimate_contrasts(g, "wt", by = "cyl", predict = "link", transform = exp) + ) + expect_true("Contrasts are on the transformed link-scale." %in% out) +}) + + test_that("table_footer, no prediction intervals if insight falls back", { skip_if_not_installed("mgcv") m <- mgcv::gam(mpg ~ s(wt), data = mtcars)