Add display() methods and support for tinytable (#647)

* Add `display()` methods and support for tinytable

* add to suggests

* fix

* fix

* fix

* fix

* fix

* comment code

* typo

* add tests

* update snaps

* add tests

* fix for tt

* add test

* typo

* fix

* docs

* Update R/data_tabulate.R

Co-authored-by: Etienne Bacher <52219252+etiennebacher@users.noreply.github.com>

* address comments

---------

Co-authored-by: Etienne Bacher <52219252+etiennebacher@users.noreply.github.com>

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: datawizard
 Title: Easy Data Wrangling and Statistical Transformations
-Version: 1.2.0.4
+Version: 1.2.0.5
 Authors@R: c(
     person("Indrajeet", "Patil", , "patilindrajeet.science@gmail.com", role = "aut",
            comment = c(ORCID = "0000-0003-1995-6531")),
@@ -69,6 +69,7 @@ Suggests:
     testthat (>= 3.2.1),
     tibble,
     tidyr,
+    tinytable (>= 0.13.0),
     withr
 VignetteBuilder:
     knitr

NAMESPACE

@@ -74,6 +74,7 @@ S3method(describe_distribution,factor)
 S3method(describe_distribution,grouped_df)
 S3method(describe_distribution,list)
 S3method(describe_distribution,numeric)
+S3method(display,data_codebook)
 S3method(display,datawizard_crosstab)
 S3method(display,datawizard_crosstabs)
 S3method(display,datawizard_table)

NEWS.md

@@ -16,6 +16,11 @@ CHANGES
 * Argument `values_from` in `data_to_wide()` now supports select-helpers like
   the `select` argument in other `{datawizard}` functions (#645).
 
+* Added a `display()` method for `data_codebook()` (#646).
+
+* `display()` methods now support the `{tinytable}` package. Use `format = "tt"`
+  to export tables as `tinytable` objects (#646).
+
 BUG FIXES
 
 * Fixed an issue when `demean()`ing nested structures with more than 2 grouping

R/data_codebook.R

@@ -23,6 +23,7 @@
 #' @param row_color For HTML tables, the fill color for odd rows.
 #' @inheritParams standardize.data.frame
 #' @inheritParams extract_column_names
+#' @inheritParams data_tabulate
 #'
 #' @return A formatted data frame, summarizing the content of the data frame.
 #' Returned columns include the column index of the variables in the original
@@ -414,7 +415,6 @@ print_html.data_codebook <- function(x,
                                      line_padding = 3,
                                      row_color = "#eeeeee",
                                      ...) {
-  insight::check_if_installed("gt")
   caption <- .get_codebook_caption(x)
   attr(x, "table_caption") <- caption
   # since we have each value at its own row, the HTML table contains
@@ -427,12 +427,20 @@ print_html.data_codebook <- function(x,
   odd_rows <- (x$.row_id %% 2 == 1)
   x$.row_id <- NULL
   # create basic table
+  backend <- .check_format_backend(...)
   out <- insight::export_table(
     format(x, format = "html"),
     title = caption,
-    format = "html",
+    format = backend,
     align = .get_codebook_align(x)
   )
+
+  # for tiny table output, we don't need to do any further formatting
+  if (identical(backend, "tt")) {
+    return(out)
+  }
+
+  insight::check_if_installed("gt")
   # no border for rows which are not separator lines
   out <- gt::tab_style(
     out,
@@ -455,6 +463,34 @@ print_html.data_codebook <- function(x,
 }
 
 
+#' @rdname data_codebook
+#' @export
+display.data_codebook <- function(object,
+                                  format = "markdown",
+                                  font_size = "100%",
+                                  line_padding = 3,
+                                  row_color = "#eeeeee",
+                                  ...) {
+  format <- .display_default_format(format)
+
+  fun_args <- list(
+    x = object,
+    font_size = font_size,
+    line_padding = line_padding,
+    row_color = row_color,
+    ...
+  )
+
+  # print table in HTML or markdown format
+  if (format %in% c("html", "tt")) {
+    fun_args$backend <- format
+    do.call(print_html, fun_args)
+  } else {
+    do.call(print_md, fun_args)
+  }
+}
+
+
 #' @export
 print_md.data_codebook <- function(x, ...) {
   caption <- .get_codebook_caption(x)

R/data_tabulate.R

@@ -37,6 +37,12 @@
 #' input. Else, always for multiple table inputs or when `simplify = FALSE`, a
 #' list of tables is returned. This is only relevant for the `as.table()`
 #' methods. To ensure consistent output, the default is `FALSE`.
+#' @param object An object returned by `data_tabulate()`.
+#' @param format String, indicating the output format. Can be `"markdown"`
+#' `"html"`, or `"tt"`. `format = "html"` create an 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 verbose Toggle warnings and messages.
 #' @param ... not used.
 #' @inheritParams extract_column_names
@@ -794,14 +800,23 @@ print.datawizard_tables <- function(x, big_mark = NULL, ...) {
 
 # display --------------------
 
+#' @rdname data_tabulate
 #' @export
 display.datawizard_table <- function(object, big_mark = NULL, format = "markdown", ...) {
-  format <- insight::validate_argument(format, c("markdown", "html", "md"))
+  format <- .display_default_format(format)
+
+  fun_args <- list(
+    x = object,
+    big_mark = big_mark,
+    ...
+  )
+
   # print table in HTML or markdown format
-  if (format == "html") {
-    print_html(object, big_mark = big_mark, ...)
+  if (format %in% c("html", "tt")) {
+    fun_args$backend <- format
+    do.call(print_html, fun_args)
   } else {
-    print_md(object, big_mark = big_mark, ...)
+    do.call(print_md, fun_args)
   }
 }
 
@@ -814,6 +829,11 @@ display.datawizard_crosstab <- display.datawizard_table
 #' @export
 display.datawizard_crosstabs <- display.datawizard_table
 
+.display_default_format <- function(format) {
+  format <- getOption("easystats_display_format", format)
+  insight::validate_argument(format, c("markdown", "html", "md", "tt"))
+}
+
 
 # print_html --------------------
 
@@ -847,7 +867,7 @@ print_html.datawizard_tables <- function(x, big_mark = NULL, ...) {
       out,
       missing = "<NA>",
       caption = ifelse(is_weighted, "Frequency Table (weighted)", "Frequency Table"),
-      format = "html",
+      format = .check_format_backend(...),
       group_by = "Group"
     )
   }
@@ -919,17 +939,36 @@ print_md.datawizard_tables <- function(x, big_mark = NULL, ...) {
   x$Variable <- NULL
   x$Group <- NULL
 
+  # this function is used by all four supported format, markdown, text, html
+  # and tt (tinytable). For tt, we sometimes have format "html" and backend = "tt",
+  # so we need to check for this special case
+  backend <- switch(format,
+    html = ,
+    tt = .check_format_backend(...),
+    format
+  )
   # print table
   insight::export_table(
     format(x, format = format, big_mark = big_mark, ...),
     title = caption,
     footer = footer,
     missing = "(NA)",
-    format = format
+    format = backend
   )
 }
 
 
+# we allow exporting HTML format based on "gt" or "tinytable"
+.check_format_backend <- function(...) {
+  dots <- list(...)
+  if (identical(dots$backend, "tt")) {
+    "tt"
+  } else {
+    "html"
+  }
+}
+
+
 .table_header <- function(x, format = "text") {
   a <- attributes(x)
 

R/data_xtabulate.R

@@ -226,13 +226,21 @@ print_html.datawizard_crosstab <- function(x, big_mark = NULL, ...) {
     x$Group <- NULL
   }
 
+  # this function is used by all four supported format, markdown, text, html
+  # and tt (tinytable). For tt, we sometimes have format "html" and backend = "tt",
+  # so we need to check for this special case
+  backend <- switch(format,
+    html = ,
+    tt = .check_format_backend(...),
+    format
+  )
   # prepare table arguments
   fun_args <- list(
     format(x, big_mark = big_mark, format = format, ...),
     caption = caption,
-    format = format
+    format = backend
   )
-  if (format != "html") {
+  if (!format %in% c("html", "tt")) {
     fun_args$cross <- "+"
     fun_args$empty_line <- "-"
   }

R/describe_distribution.R

@@ -606,17 +606,42 @@ print_html.parameters_distribution <- function(x, digits = 2, ci_brackets = c("(
     ...
   )
 
-  insight::export_table(formatted_table, format = "html", align = "firstleft", ...)
+  # determine backend
+  backend <- .check_format_backend(...)
+
+  # pass arguments to export_table
+  fun_args <- list(
+    formatted_table,
+    format = backend,
+    ...
+  )
+
+  # no "align" for format "tt" - this currently gives an error. Not sure
+  # if related to insight::export_table or tinytable
+  if (identical(backend, "html")) {
+    fun_args$align <- "firstleft"
+  }
+
+  do.call(insight::export_table, fun_args)
 }
 
 
 #' @export
 display.parameters_distribution <- function(object, format = "markdown", digits = 2, ...) {
-  format <- insight::validate_argument(format, c("md", "markdown", "html"))
-  if (format == "html") {
-    print_html(x = object, digits = digits, ...)
+  format <- .display_default_format(format)
+
+  fun_args <- list(
+    x = object,
+    digits = digits,
+    ...
+  )
+
+  # print table in HTML or markdown format
+  if (format %in% c("html", "tt")) {
+    fun_args$backend <- format
+    do.call(print_html, fun_args)
   } else {
-    print_md(x = object, digits = digits, ...)
+    do.call(print_md, fun_args)
   }
 }