Fix snapshot tests (#1037)

* Fix snapshot tests Fixes #1036 * fix * fix * fix * fix * add snapshot * typo, lintr
easystats · Nov 4, 2024 · 6533602 · 6533602
1 parent d50163f
commit 6533602
Show file tree

Hide file tree

Showing 20 changed files with 115 additions and 44 deletions.
diff --git a/R/1_model_parameters.R b/R/1_model_parameters.R
@@ -504,7 +504,7 @@ parameters <- model_parameters
 #' - 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

diff --git a/R/methods_lme4.R b/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

diff --git a/man/model_parameters.averaging.Rd b/man/model_parameters.averaging.Rd
diff --git a/man/model_parameters.cgam.Rd b/man/model_parameters.cgam.Rd
diff --git a/man/model_parameters.default.Rd b/man/model_parameters.default.Rd
diff --git a/man/model_parameters.glht.Rd b/man/model_parameters.glht.Rd
diff --git a/man/model_parameters.htest.Rd b/man/model_parameters.htest.Rd
diff --git a/man/model_parameters.merMod.Rd b/man/model_parameters.merMod.Rd
diff --git a/man/model_parameters.mlm.Rd b/man/model_parameters.mlm.Rd
diff --git a/man/model_parameters.rma.Rd b/man/model_parameters.rma.Rd
diff --git a/man/model_parameters.zcpglm.Rd b/man/model_parameters.zcpglm.Rd
diff --git a/man/n_clusters.Rd b/man/n_clusters.Rd
diff --git a/tests/testthat/_snaps/printing2.md b/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

diff --git a/tests/testthat/test-compare_parameters.R b/tests/testthat/test-compare_parameters.R
@@ -2,7 +2,7 @@ skip_if_not_installed("withr")
 
 # 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)

diff --git a/tests/testthat/test-format_parameters.R b/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

diff --git a/tests/testthat/test-pipe.R b/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 |      |                 |       |       "
-  )
-})
+)
diff --git a/tests/testthat/test-print_AER_labels.R b/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"))
+  })
+)
diff --git a/tests/testthat/test-printing.R b/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))
+  })
 )
diff --git a/tests/testthat/test-printing2.R b/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}")
+      )
+    })
+  }
+)
diff --git a/vignettes/model_parameters_print.Rmd b/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