Fix snapshot tests

R/1_model_parameters.R

@@ -180,7 +180,7 @@
 #'
 #' Compared to fixed effects (or single-level) models, determining appropriate
 #' df for Wald-based inference in mixed models is more difficult.
 #' See [the R GLMM FAQ](https://bbolker.github.io/mixedmodels-misc/glmmFAQ.html#what-are-the-p-values-listed-by-summaryglmerfit-etc.-are-they-reliable)
 #' for a discussion.
 #'
 #' Several approximate methods for computing df are available, but you should
@@ -504,7 +504,7 @@
 #' - If `s_value = TRUE`, the p-value will be replaced by the S-value in the
 #'   output (cf. _Rafi and Greenland 2020_).
 #' - `pd` adds an additional column with the _probability of direction_ (see
-#'   [`bayestestR::p_direction()`] for details). urthermore, see 'Examples' for
+#'   [`bayestestR::p_direction()`] for details). Furthermore, see 'Examples' for
 #'   this function.
 #' - For developers, whose interest mainly is to get a "tidy" data frame of
 #'   model summaries, it is recommended to set `pretty_names = FALSE` to speed

R/methods_lme4.R

@@ -45,7 +45,7 @@
 #' - If `s_value = TRUE`, the p-value will be replaced by the S-value in the
 #'   output (cf. _Rafi and Greenland 2020_).
 #' - `pd` adds an additional column with the _probability of direction_ (see
-#'   [`bayestestR::p_direction()`] for details). urthermore, see 'Examples' for
+#'   [`bayestestR::p_direction()`] for details). Furthermore, see 'Examples' for
 #'   this function.
 #' - For developers, whose interest mainly is to get a "tidy" data frame of
 #'   model summaries, it is recommended to set `pretty_names = FALSE` to speed

tests/testthat/_snaps/printing2.md

@@ -141,6 +141,40 @@
       -------------------------------------------------------------------------------------------
         Observations                        |            150 |         |            150 |        
 
+---
+
+    Code
+      print(out, groups = list(Species = c("Species [versicolor]",
+        "Species [virginica]"), Interactions = c(
+        "Species [versicolor] * Petal Length", "Species [virginica] * Petal Length"),
+      Controls = "Petal Length"), select = "{estimate}|{p}")
+    Output
+      Parameter                             | Estimate (lm1) | p (lm1)
+      ----------------------------------------------------------------
+      Species                               |                |        
+        Species [versicolor]                |          -1.60 |  <0.001
+        Species [virginica]                 |          -2.12 |  <0.001
+      Interactions                          |                |        
+        Species [versicolor] * Petal Length |                |        
+        Species [virginica] * Petal Length  |                |        
+      Controls                              |                |        
+        Petal Length                        |           0.90 |  <0.001
+      ----------------------------------------------------------------
+        Observations                        |            150 |        
+
+      Parameter                             | Estimate (lm2) | p (lm2)
+      ----------------------------------------------------------------
+      Species                               |                |        
+        Species [versicolor]                |          -1.69 |   0.003
+        Species [virginica]                 |          -1.19 |   0.048
+      Interactions                          |                |        
+        Species [versicolor] * Petal Length |          -0.01 |   0.961
+        Species [virginica] * Petal Length  |          -0.15 |   0.574
+      Controls                              |                |        
+        Petal Length                        |           0.39 |   0.138
+      ----------------------------------------------------------------
+        Observations                        |            150 |        
+
 # combination of different models
 
     Code

tests/testthat/test-compare_parameters.R

@@ -2,7 +2,7 @@
 
 # make sure we have the correct interaction mark for tests
 withr::with_options(
-  list(parameters_interaction = "*"),
+  list(parameters_interaction = "*", easystats_table_width = Inf),
   {
     data(iris)
     m1 <- lm(Sepal.Length ~ Species, data = iris)
@@ -79,7 +79,7 @@
     m2 <- glm(vs ~ wt + cyl, data = mtcars, family = "binomial")
 
     test_that("compare_parameters, column name with escaping regex characters", {
       out <- utils::capture.output(compare_parameters(m1, m2, column_names = c("linear model (m1)", "logistic reg. (m2)")))
       expect_identical(out[1], "Parameter    |    linear model (m1) |   logistic reg. (m2)")
     })
 
@@ -150,7 +150,7 @@
       )
 
       # with reference level
       cp <- compare_parameters(lm1, lm2, select = "{estimate} ({ci})|{p}", drop = "^\\(Intercept", include_reference = TRUE)
       out <- print_md(cp, groups = list(
         Groups = 2:4,
         Interactions = 5:6,

tests/testthat/test-format_parameters.R

@@ -2,7 +2,7 @@ skip_if_not_installed("splines")
 
 # make sure we have the correct interaction mark for tests
 withr::with_options(
-  list(parameters_interaction = "*"),
+  list(parameters_interaction = "*", easystats_table_width = Inf),
   {
     # define here because messes up the expected output
     bs <- splines::bs

tests/testthat/test-pipe.R

@@ -14,15 +14,20 @@ test_that("print in pipe", {
   )
 })
 
-test_that("print in pipe, on-the-fly factor", {
-  data(mtcars)
-  out <- capture.output({
-    mtcars |>
-      lm(mpg ~ cut(wt, c(0, 2.5, 3, 5)), data = _) |>
-      model_parameters(include_reference = TRUE)
+
+skip_if_not_installed("withr")
+withr::with_options(
+  list(easystats_table_width = Inf),
+  test_that("print in pipe, on-the-fly factor", {
+    data(mtcars)
+    out <- capture.output({
+      mtcars |>
+        lm(mpg ~ cut(wt, c(0, 2.5, 3, 5)), data = _) |>
+        model_parameters(include_reference = TRUE)
+    })
+    expect_identical(
+      out[4],
+      "cut(wt, c(0, 2.5, 3, 5)) [>0-2.5] |        0.00 |      |                 |       |       "
+    )
   })
-  expect_identical(
-    out[4],
-    "cut(wt, c(0, 2.5, 3, 5)) [>0-2.5] |        0.00 |      |                 |       |       "
-  )
-})
+)

tests/testthat/test-print_AER_labels.R

@@ -1,9 +1,13 @@
 skip_if_not_installed("AER")
 skip_if_not_installed("datawizard")
+skip_if_not_installed("withr")
 
-test_that("templates", {
-  data(efc, package = "datawizard")
-  model <- AER::tobit(neg_c_7 ~ e42dep + c172code, data = efc)
-  mp <- model_parameters(model)
-  expect_snapshot(print(mp, pretty_names = "labels"))
-})
+withr::with_options(
+  list(easystats_table_width = Inf),
+  test_that("templates", {
+    data(efc, package = "datawizard")
+    model <- AER::tobit(neg_c_7 ~ e42dep + c172code, data = efc)
+    mp <- model_parameters(model)
+    expect_snapshot(print(mp, pretty_names = "labels"))
+  })
+)

tests/testthat/test-printing.R

@@ -3,7 +3,7 @@ skip_if_not_installed("withr")
 skip_if(getRversion() < "4.0.0")
 
 withr::with_options(
-  list(parameters_interaction = "*"),
+  list(parameters_interaction = "*", easystats_table_width = Inf),
   {
     # Splitting model components ----
     test_that("print model with multiple components", {
@@ -111,12 +111,10 @@ withr::with_options(
 
 withr::with_options(
   list(parameters_warning_exponentiate = TRUE),
-  {
-    test_that("message about interpretation of log-resoponse", {
-      data(mtcars)
-      m <- lm(log(mpg) ~ gear, data = mtcars)
-      out <- model_parameters(m, exponentiate = TRUE)
-      expect_snapshot(print(out))
-    })
-  }
+  test_that("message about interpretation of log-resoponse", {
+    data(mtcars)
+    m <- lm(log(mpg) ~ gear, data = mtcars)
+    out <- model_parameters(m, exponentiate = TRUE)
+    expect_snapshot(print(out))
+  })
 )

tests/testthat/test-printing2.R

@@ -2,7 +2,7 @@ skip_if_not_installed("withr")
 skip_if(getRversion() < "4.0.0")
 
 withr::with_options(
-  list(parameters_interaction = "*"),
+  list(parameters_interaction = "*", easystats_table_width = Inf),
   {
     lm1 <- lm(Sepal.Length ~ Species, data = iris)
     lm2 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris)
@@ -66,7 +66,7 @@ withr::with_options(
             "Species [virginica]"
           ),
           Interactions = c(
-            "Species [versicolor] * Petal Length", # note the unicode char!
+            "Species [versicolor] * Petal Length",
             "Species [virginica] * Petal Length"
           ),
           Controls = "Petal Length"
@@ -79,7 +79,7 @@ withr::with_options(
             "Species [virginica]"
           ),
           Interactions = c(
-            "Species [versicolor] * Petal Length", # note the unicode char!
+            "Species [versicolor] * Petal Length",
             "Species [virginica] * Petal Length"
           ),
           Controls = "Petal Length"
@@ -112,3 +112,31 @@ withr::with_options(
     })
   }
 )
+
+
+withr::with_options(
+  list(parameters_interaction = "*"),
+  {
+    lm1 <- lm(Sepal.Length ~ Species + Petal.Length, data = iris)
+    lm2 <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
+
+    # remove intercept
+    out <- compare_parameters(lm1, lm2, drop = "^\\(Intercept")
+
+    test_that("templates, glue-3, separate columnns", {
+      expect_snapshot(
+        print(out, groups = list(
+          Species = c(
+            "Species [versicolor]",
+            "Species [virginica]"
+          ),
+          Interactions = c(
+            "Species [versicolor] * Petal Length",
+            "Species [virginica] * Petal Length"
+          ),
+          Controls = "Petal Length"
+        ), select = "{estimate}|{p}")
+      )
+    })
+  }
+)

vignettes/model_parameters_print.Rmd

@@ -119,7 +119,9 @@ Redundant columns are removed. The related model component is shown as table hea
 
 ```{r eval=successfully_loaded["glmmTMB"]}
 mp <- model_parameters(model)
-print(mp, split_component = FALSE)
+# We use `table_width` here to print a wider table,
+# which is not split into multiple tables
+print(mp, split_component = FALSE, table_width = Inf)
 ```
 
 ## Adding model information