find_transformation incorrectly detects power transformations (#813)

* `find_transformation` incorrectly detects power transformations Fixes #812 * add test * version * add more tests, found exception * fix - * add test * comment * add test
easystats · Sep 26, 2023 · 0ef5213 · 0ef5213
1 parent 7332c7f
commit 0ef5213
Show file tree

Hide file tree

Showing 6 changed files with 60 additions and 7 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.19.5.3
+Version: 0.19.5.4
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

diff --git a/R/find_terms.R b/R/find_terms.R
@@ -188,8 +188,10 @@ find_terms.mipo <- function(x, flatten = FALSE, ...) {
   # protect "-1"
   f$conditional <- gsub("(-1|- 1)(?![^(]*\\))", "#1", f$conditional, perl = TRUE)
 
+  # This regular expression matches any of the characters *, +, :, |, -, or /,
+  # unless they are preceded by a ^ and followed by a closing parenthesis ).
   f <- lapply(f, function(.x) {
-    pattern <- "[*+:|\\-\\/](?![^(]*\\))" # was: "[\\*\\+:\\-\\|/](?![^(]*\\))"
+    pattern <- "(?<!\\^)[*+:|\\-\\/](?![^(]*\\))" # was: "[\\*\\+:\\-\\|/](?![^(]*\\))"
     f_parts <- gsub("~", "", trim_ws(unlist(
       strsplit(split = pattern, x = .x, perl = TRUE),
       use.names = FALSE

diff --git a/R/find_transformation.R b/R/find_transformation.R
@@ -115,7 +115,7 @@ find_transformation <- function(x) {
 
   # power-transformation
 
-  if (any(grepl("I\\((.*)\\^\\s*2\\)", rv))) {
+  if (any(grepl("(.*)(\\^|\\*\\*)\\s?-?(\\d+|[()])", rv))) {
     transform_fun <- "power"
   }
 

diff --git a/R/get_transformation.R b/R/get_transformation.R
@@ -29,12 +29,12 @@
 #' get_transformation(model)
 #'
 #' # log-function
-#' get_transformation(model)$transformation(.3)
-#' log(.3)
+#' get_transformation(model)$transformation(0.3)
+#' log(0.3)
 #'
 #' # inverse function is exp()
-#' get_transformation(model)$inverse(.3)
-#' exp(.3)
+#' get_transformation(model)$inverse(0.3)
+#' exp(0.3)
 #' @export
 get_transformation <- function(x) {
   transform_fun <- find_transformation(x)
@@ -59,6 +59,11 @@ get_transformation <- function(x) {
   } else if (transform_fun == "sqrt") {
     out <- list(transformation = sqrt, inverse = function(x) x^2)
   } else if (transform_fun == "power") {
+    ## TODO: detect power - can we turn this into a function?
+    # power <- .safe(gsub("\\(|\\)", "", gsub("(.*)(\\^|\\*\\*)\\s*(\\d+|[()])", "\\3", find_terms(x)[["response"]])))
+    # if (is.null(power)) {
+    #   power <- 2
+    # }
     out <- list(transformation = function(x) x^2, inverse = sqrt)
   } else if (transform_fun == "expm1") {
     out <- list(transformation = expm1, inverse = log1p)

diff --git a/tests/testthat/test-find_terms.R b/tests/testthat/test-find_terms.R
@@ -64,3 +64,14 @@ test_that("find_terms", {
   )
   expect_true(has_intercept(m))
 })
+
+test_that("find_terms, - in response", {
+  m <- lm(Sepal.Length - Sepal.Width ~ Species, data = iris)
+  expect_identical(find_terms(m)$response, c("Sepal.Length", "Sepal.Width"))
+  m <- lm(cbind(Sepal.Length - Sepal.Width) ~ Species, data = iris)
+  expect_identical(find_terms(m)$response, "cbind(Sepal.Length - Sepal.Width)")
+  m <- lm(Sepal.Length^-0.5 ~ Species, data = iris)
+  expect_identical(find_terms(m)$response, "Sepal.Length^-0.5")
+  m <- lm(I(Sepal.Length^-0.5) ~ Species, data = iris)
+  expect_identical(find_terms(m)$response, "I(Sepal.Length^-0.5)")
+})
diff --git a/tests/testthat/test-find_transformation.R b/tests/testthat/test-find_transformation.R
@@ -47,3 +47,38 @@ test_that("find_transformation - strange bayestestR example", {
   mod <- lm(log(mpg) ~ gear + hp, data = mtcars)
   expect_identical(find_transformation(mod), "log")
 })
+
+test_that("find_transformation - detect powers", {
+  data(iris)
+  m1 <- lm(Sepal.Length^(1 / 2) ~ Species, data = iris)
+  m2 <- lm(Sepal.Length^2 ~ Species, data = iris)
+  m3 <- lm(I(Sepal.Length^(1 / 2)) ~ Species, data = iris)
+  m4 <- lm(I(Sepal.Length^3) ~ Species, data = iris)
+  m5 <- lm(I(Sepal.Length^2) ~ Species, data = iris)
+  m6 <- lm(Sepal.Length ^ 2.3 ~ Species, data = iris)
+  m7 <- lm(Sepal.Length^-0.5 ~ Species, data = iris)
+
+  expect_identical(insight::find_transformation(m1), "power")
+  expect_identical(insight::find_transformation(m2), "power")
+  expect_identical(insight::find_transformation(m3), "power")
+  expect_identical(insight::find_transformation(m4), "power")
+  expect_identical(insight::find_transformation(m5), "power")
+  expect_identical(insight::find_transformation(m6), "power")
+  expect_identical(insight::find_transformation(m7), "power")
+
+  # power **
+
+  m1 <- lm(Sepal.Length**(1 / 2) ~ Species, data = iris)
+  m2 <- lm(Sepal.Length**2 ~ Species, data = iris)
+  m3 <- lm(I(Sepal.Length**(1 / 2)) ~ Species, data = iris)
+  m4 <- lm(I(Sepal.Length**3) ~ Species, data = iris)
+  m5 <- lm(I(Sepal.Length**2) ~ Species, data = iris)
+  m6 <- lm(I(Sepal.Length ** 1.8) ~ Species, data = iris)
+
+  expect_identical(insight::find_transformation(m1), "power")
+  expect_identical(insight::find_transformation(m2), "power")
+  expect_identical(insight::find_transformation(m3), "power")
+  expect_identical(insight::find_transformation(m4), "power")
+  expect_identical(insight::find_transformation(m5), "power")
+  expect_identical(insight::find_transformation(m6), "power")
+})