From 0ef5213fe6222d3bcc237a15e0eb3c8aa5abbcaa Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Wed, 27 Sep 2023 00:06:09 +0200
Subject: [PATCH] `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
---
 DESCRIPTION                               |  2 +-
 R/find_terms.R                            |  4 ++-
 R/find_transformation.R                   |  2 +-
 R/get_transformation.R                    | 13 ++++++---
 tests/testthat/test-find_terms.R          | 11 +++++++
 tests/testthat/test-find_transformation.R | 35 +++++++++++++++++++++++
 6 files changed, 60 insertions(+), 7 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 5b6bd6e1a..dceb5f902 100644
--- 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
index eb3fcddb8..d6a11f1e1 100644
--- 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
index 452893401..4183b2a7d 100644
--- 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
index d69991a40..5b9f905ca 100644
--- 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
index f7ce38d05..af332b623 100644
--- 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
index 452720b9c..b5530789f 100644
--- 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")
+})