From 2b1dc4c572383c0893d50c90dd70fd2817514ec9 Mon Sep 17 00:00:00 2001
From: Daniel <mail@danielluedecke.de>
Date: Mon, 11 Sep 2023 18:42:35 +0200
Subject: [PATCH] fix

---
 R/utils_format.R                              | 10 +++++
 .../testthat/test-printing_reference_level.R  | 44 +++++++++++++++++++
 2 files changed, 54 insertions(+)
 create mode 100644 tests/testthat/test-printing_reference_level.R

diff --git a/R/utils_format.R b/R/utils_format.R
index 9a168ee12..485934f85 100644
--- a/R/utils_format.R
+++ b/R/utils_format.R
@@ -357,6 +357,11 @@
   # copy object, so we save original data
   out <- params
 
+  # if we use "keep" or "drop", we have less parameters in our data frame,
+  # so we need to make sure we only have those pretty_names, which names match
+  # the parameters in the data frame
+  pretty_names <- pretty_names[names(pretty_names) %in% params$Parameter]
+
   # iterate all factors in the data and check if any factor was used in the model
   for (fn in names(factors)) {
     f <- factors[[fn]]
@@ -1040,6 +1045,11 @@
       tables[[type]][[1]] <- insight::format_value(tables[[type]][[1]], digits = digits, protect_integers = TRUE)
     }
 
+    # add the coefficient for the base-(reference)-level of factors?
+    if (add_reference) {
+      tables[[type]] <- .add_reference_level(tables[[type]])
+    }
+
     formatted_table <- insight::format_table(
       tables[[type]],
       digits = digits, ci_digits = ci_digits,
diff --git a/tests/testthat/test-printing_reference_level.R b/tests/testthat/test-printing_reference_level.R
new file mode 100644
index 000000000..d847fcd4e
--- /dev/null
+++ b/tests/testthat/test-printing_reference_level.R
@@ -0,0 +1,44 @@
+# skip_if(getRversion() < "4.0.0")
+
+# test_that("simple reference level", {
+#   data(PlantGrowth)
+#   d <<- PlantGrowth
+#   m <- lm(weight ~ group, data = d)
+#   mp <- model_parameters(m)
+#   expect_snapshot(print(mp, add_reference = TRUE))
+
+#   data(mtcars)
+#   d <<- mtcars
+#   d$cyl <- as.factor(d$cyl)
+#   d$am <- as.factor(d$am)
+#   m <- lm(mpg ~ hp + cyl + gear + am, data = d)
+#   mp <- model_parameters(m)
+#   expect_snapshot(print(mp, add_reference = TRUE))
+
+#   data(iris)
+#   d <<- iris
+#   m <- lm(Sepal.Length ~ Sepal.Width * Species, data = d)
+#   mp <- model_parameters(m)
+#   expect_snapshot(print(mp, add_reference = TRUE))
+
+#   data(mtcars)
+#   d <<- mtcars
+#   d$gear <- as.factor(d$gear)
+#   m <- glm(vs ~ wt + gear, data = d, family = "binomial")
+#   expect_snapshot(print(model_parameters(m, exponentiate = TRUE, drop = "(Intercept)"), add_reference = TRUE))
+# })
+
+# test_that("reference for models with multiple components", {
+#   skip_on_cran()
+#   skip_if_not_installed("glmmTMB")
+#   data("fish")
+
+#   m1 <- glmmTMB::glmmTMB(
+#     count ~ child + camper + zg + (1 | ID),
+#     ziformula = ~ child + camper + (1 | persons),
+#     data = fish,
+#     family = glmmTMB::truncated_poisson()
+#   )
+
+#   print(model_parameters(m1), add_reference = TRUE)
+# })