Make display() visible (#535)

* Make `display()` visible

* fix

* typo, tests

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: modelbased
 Title: Estimation of Model-Based Predictions, Contrasts and Means
-Version: 0.12.0.1
+Version: 0.12.0.2
 Authors@R:
     c(person(given = "Dominique",
              family = "Makowski",
@@ -98,6 +98,7 @@ Suggests:
     see (>= 0.11.0),
     survival,
     testthat (>= 3.2.1),
+    tinytable,
     vdiffr,
     withr
 VignetteBuilder:
@@ -111,3 +112,4 @@ Roxygen: list(markdown = TRUE)
 Config/Needs/check: stan-dev/cmdstanr
 Config/Needs/website: easystats/easystatstemplate
 LazyData: true
+Remotes: easystats/insight

NEWS.md

@@ -5,6 +5,9 @@
 * `estimate_expectation()` and `estimate_relation()` now support objects of
   class `htest`.
 
+* Documentation of the `display()` method for *modelbased* objects has been
+  added.
+
 # modelbased 0.12.0
 
 ## Changes

R/display.R

@@ -1,10 +1,39 @@
+#' @rdname print.estimate_contrasts
 #' @export
-display.estimate_contrasts <- function(object, format = "markdown", ...) {
-  insight::validate_argument(format, c("md", "markdown", "html"))
-  if (format == "html") {
-    print_html(object, ...)
+display.estimate_contrasts <- function(object,
+                                       select = NULL,
+                                       include_grid = NULL,
+                                       full_labels = NULL,
+                                       format = "markdown",
+                                       ...) {
+  # Process argument ---------------------------------------------------------
+  # --------------------------------------------------------------------------
+
+  format <- insight::validate_argument(format, c("md", "markdown", "html", "tt"))
+
+  # set defaults
+  if (is.null(select)) {
+    select <- getOption("modelbased_select", NULL)
+  }
+  if (is.null(include_grid)) {
+    include_grid <- getOption("modelbased_include_grid", FALSE)
+  }
+  if (is.null(full_labels)) {
+    full_labels <- getOption("modelbased_full_labels", TRUE)
+  }
+
+  fun_args <- list(
+    x = object,
+    select = select,
+    include_grid = include_grid,
+    full_labels = full_labels
+  )
+
+  if (format %in% c("html", "tt")) {
+    fun_args$backend <- format
+    do.call(print_html, c(fun_args, list(...)))
   } else {
-    print_md(object, ...)
+    do.call(print_md, c(fun_args, list(...)))
   }
 }
 

R/print.R

@@ -3,7 +3,7 @@
 #' `print()` method for **modelbased** objects. Can be used to tweak the output
 #' of tables.
 #'
-#' @param x An object returned by the different `estimate_*()` functions.
+#' @param x,object An object returned by the different `estimate_*()` functions.
 #' @param include_grid Logical, if `TRUE`, the data grid is included in the
 #' table output. Only applies to prediction-functions like `estimate_relation()`
 #' or `estimate_link()`. Default is `NULL`, which will set the value based on
@@ -12,6 +12,11 @@
 #' are shown. If `FALSE`, redundant (duplicated) labels are removed from rows.
 #' Default is `NULL`, which will set the value based on
 #' `options(modelbased_full_labels)`, and use `TRUE` is no option is set.
+#' @param format String, indicating the output format. Can be `"markdown"`
+#' `"html"`, or `"tt"`. `format = "html"` create a HTML table using the *gt*
+#' package. `format = "tt"` creates a `tinytable` object, which is either
+#' printed as markdown or HTML table, depending on the environment. See
+#' [`insight::export_table()`] for details.
 #' @param ... Arguments passed to `insight::format_table()` or
 #' `insight::export_table()`.
 #'

man/print.estimate_contrasts.Rd

@@ -1,3 +1,42 @@
+# estimate_means - using display() to print multiple by's
+
+    Code
+      display(estimate_means(fit, c("c12hour = c(50, 100)", "c172code", "c161sex")),
+      format = "tt")
+    Output
+      
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | c12hour | c172code                        | c161sex | Mean  | SE   | 95% CI         | t(791) |
+      +=========+=================================+=========+=======+======+================+========+
+      | 50      | low level of education          | Male    | 11.05 | 0.84 | ( 9.40, 12.69) | 13.16  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 100     | low level of education          | Male    | 10.38 | 1.98 | ( 6.49, 14.26) | 5.25   |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 50      | intermediate level of education | Male    | 12.35 | 0.59 | (11.20, 13.50) | 21.05  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 100     | intermediate level of education | Male    | 13.31 | 1.26 | (10.83, 15.78) | 10.54  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 50      | high level of education         | Male    | 11.70 | 0.67 | (10.39, 13.02) | 17.45  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 100     | high level of education         | Male    | 12.43 | 1.24 | (10.00, 14.87) | 10.01  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 50      | low level of education          | Female  | 11.99 | 0.33 | (11.35, 12.63) | 36.73  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 100     | low level of education          | Female  | 11.72 | 0.48 | (10.79, 12.66) | 24.61  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 50      | intermediate level of education | Female  | 12.09 | 0.21 | (11.69, 12.50) | 58.05  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 100     | intermediate level of education | Female  | 12.91 | 0.35 | (12.23, 13.60) | 37.19  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 50      | high level of education         | Female  | 12.84 | 0.42 | (12.01, 13.67) | 30.36  |
+      +---------+---------------------------------+---------+-------+------+----------------+--------+
+      | 100     | high level of education         | Female  | 13.21 | 0.84 | (11.56, 14.85) | 15.75  |
+      +=========+=================================+=========+=======+======+================+========+
+      | Variable predicted: neg_c_7<br>Predictors modulated: c12hour = c(50, 100), c172code,         |
+      | c161sex<br>Predictors averaged: barthtot (65)                                                |
+      +=========+=================================+=========+=======+======+================+========+
+      Table: Estimated Marginal Means 
+
 # estimate_contrasts - by with special character
 
     Code

tests/testthat/_snaps/print.md

@@ -41,6 +41,17 @@ test_that("estimate_means - print multiple by's", {
 })
 
 
+test_that("estimate_means - using display() to print multiple by's", {
+  skip_if_not_installed("tinytable")
+  data(efc, package = "modelbased")
+
+  # make categorical
+  efc <- datawizard::to_factor(efc, c("c161sex", "c172code", "e16sex"))
+  fit <- lm(neg_c_7 ~ c12hour * barthtot * c161sex * c172code, data = efc)
+  expect_snapshot(display(estimate_means(fit, c("c12hour = c(50, 100)", "c172code", "c161sex")), format = "tt"))
+})
+
+
 test_that("estimate_means - full labels", {
   data(efc, package = "modelbased")
   # make categorical