diff --git a/DESCRIPTION b/DESCRIPTION index e8b5bc7d0..2fdb67ab8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: performance Title: Assessment of Regression Models Performance -Version: 0.12.0.10 +Version: 0.12.0.11 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NEWS.md b/NEWS.md index bf8f36f70..3c9ac74ac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -27,6 +27,9 @@ variable that was named like a valid R function name (e.g., `lm(log(lapply) ~ x)`, when data contained a variable named `lapply`). +* Fixed issue in `check_predictions()` for linear models when response was + transformed as ratio (e.g. `lm(succes/trials ~ x)`). + # performance 0.12.0 ## Breaking diff --git a/R/check_predictions.R b/R/check_predictions.R index e9ee08c78..fbc3b5eaf 100644 --- a/R/check_predictions.R +++ b/R/check_predictions.R @@ -303,10 +303,18 @@ pp_check.lm <- function(object, pattern <- "^(scale|exp|expm1|log|log1p|log10|log2|sqrt)" # check for transformed response, and backtransform simulations - if (!is.null(resp_string) && grepl(paste0(pattern, "\\("), resp_string)) { + if (!is.null(resp_string) && length(resp_string) == 1 && grepl(paste0(pattern, "\\("), resp_string)) { out <- .backtransform_sims(out, resp_string) } + # sanity check - do we have a ratio or similar? + if (is.data.frame(response)) { + # get response data, evaluate formula + response <- eval(str2lang(insight::find_response(object)), + envir = insight::get_response(object) + ) + } + out$y <- response attr(out, "check_range") <- check_range diff --git a/tests/testthat/test-check_predictions.R b/tests/testthat/test-check_predictions.R index 5eb44658f..04bc1d2cd 100644 --- a/tests/testthat/test-check_predictions.R +++ b/tests/testthat/test-check_predictions.R @@ -128,3 +128,18 @@ test_that("check_predictions, glm, binomial", { expect_equal(head(out4$sim_1), c(0, 0, 0, 1, 0, 1), tolerance = 1e-4) expect_true(attributes(out4)$model_info$is_bernoulli) }) + + +test_that("check_predictions, lm, ratio-response", { + skip_if_not_installed("lme4") + data(cbpp, package = "lme4") + model1 <- lm(I(incidence / size) ~ period, data = cbpp) + set.seed(123) + out <- check_predictions(model1) + expect_equal( + head(out$y), + c(0.14286, 0.25, 0.44444, 0, 0.13636, 0.05556), + ignore_attr = TRUE, + tolerance = 1e-4 + ) +})