From cae3745395c2a223fe40f7ff609478d82bc462e3 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Fri, 11 Oct 2024 11:25:04 +0200
Subject: [PATCH] fix printing issue

---
 R/utils_format.R                        | 13 +++++++++++++
 tests/testthat/test-include_reference.R | 14 ++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/R/utils_format.R b/R/utils_format.R
index d672d494a..deec16664 100644
--- a/R/utils_format.R
+++ b/R/utils_format.R
@@ -440,6 +440,19 @@
       }
       # create a pretty level for the reference category
       pretty_level <- paste0(fn_clean, " [", sub(fn, "", reference_level, fixed = TRUE), "]")
+      pretty_level <- gsub("_", " ", pretty_level, fixed = TRUE)
+      # special handling for "cut()"
+      pattern_cut_right <- "(.*)\\((.*),(.*)\\]\\]$"
+      pattern_cut_left <- "(.*)\\[(.*),(.*)\\)\\]$"
+      if (all(grepl(pattern_cut_right, pretty_level))) {
+        lower_bounds <- gsub(pattern_cut_right, "\\2", pretty_level)
+        upper_bounds <- gsub(pattern_cut_right, "\\3", pretty_level)
+        pretty_level <- gsub(pattern_cut_right, paste0("\\1>", as.numeric(lower_bounds), "-", upper_bounds, "]"), pretty_level)
+      } else if (all(grepl(pattern_cut_left, pretty_level))) {
+        lower_bounds <- gsub(pattern_cut_left, "\\2", pretty_level)
+        upper_bounds <- gsub(pattern_cut_left, "\\3", pretty_level)
+        pretty_level <- gsub(pattern_cut_left, paste0("\\1", as.numeric(lower_bounds), "-<", upper_bounds, "]"), pretty_level)
+      }
       # insert new pretty level at the correct position in "pretty_names"
       pretty_names <- .insert_element_at(
         pretty_names,
diff --git a/tests/testthat/test-include_reference.R b/tests/testthat/test-include_reference.R
index b99cb87b2..4cc45e560 100644
--- a/tests/testthat/test-include_reference.R
+++ b/tests/testthat/test-include_reference.R
@@ -42,3 +42,17 @@ test_that("include_reference, on-the-fly factors", {
 
   expect_equal(attributes(out1)$pretty_names, attributes(out3)$pretty_names, ignore_attr = TRUE)
 })
+
+test_that("include_reference, with pretty formatted cut", {
+  data(mtcars)
+  mtcars$mpg_cut <- cut(mtcars$mpg, breaks = c(0, 20, 30, 100))
+  m <- lm(wt ~ mpg_cut, data = mtcars)
+  out <- parameters(m, include_reference = TRUE)
+  expect_identical(
+    attributes(out)$pretty_names,
+    c(
+      `(Intercept)` = "(Intercept)", `mpg_cut(0,20]` = "mpg cut [>0-20]",
+      `mpg_cut(20,30]` = "mpg cut [>20-30]", `mpg_cut(30,100]` = "mpg cut [>30-100]"
+    )
+  )
+})