by in export_table() also works for non-html format (#1068)

* `by` in `export_table()` also works for non-html format

* fix

* fix

* add tests

* add example

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 1.2.0.8
+Version: 1.2.0.9
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -26,6 +26,9 @@
   to `get_parameters()`, which is in turn passed to `as.data.frame()`, to
   extract parameters more efficiently.
 
+* The `by` argument in `export_table()` now also splits tables when format is
+  not `"html"`.
+
 # insight 1.2.0
 
 ## Breaking Changes

R/export_table.R

@@ -41,9 +41,10 @@
 #'   equal the number of columns. For instance, `align = "lccrl"` would
 #'   left-align the first column, center the second and third, right-align
 #'   column four and left-align the fifth column.
-#' @param by Name of column in `x` that indicates grouping for tables.
-#'   Only applies when `format = "html"`. `by` is passed down to
-#'   `gt::gt(groupname_col = by)`.
+#' @param by Name of column(s) in `x` that indicates grouping for tables.
+#'   When `format = "html"`, `by` is passed down to `gt::gt(groupname_col = by)`.
+#'   For markdown and text format, `x` is internally split into a list of data
+#'   frames.
 #' @param width Refers to the width of columns (with numeric values). Can be
 #'   either `NULL`, a number or a named numeric vector. If `NULL`, the width for
 #'   each column is adjusted to the minimum required width. If a number, columns
@@ -99,6 +100,9 @@
 #' # split longer tables
 #' export_table(head(iris), table_width = 30)
 #'
+#' # group (split) tables by variables
+#' export_table(head(mtcars, 8), by = "cyl")
+#'
 #' \donttest{
 #' # colored footers
 #' data(iris)
@@ -194,6 +198,8 @@ export_table <- function(x,
   indent_groups <- attributes(x)$indent_groups
   indent_rows <- attributes(x)$indent_rows
 
+  # split data frames?
+  x <- .split_tables(x, by, format)
 
   # table from single data frame --------------------------------------------
 
@@ -360,6 +366,64 @@ print.insight_table <- function(x, ...) {
 
 # small helper ----------------------
 
+# split data frame for text format - unlike HTML, where we need to bind
+# lists of data frames to a single data frame and have a "group_by" variable,
+# we need a list of data frames for text or markdown output (instead of a
+# single data frame)
+.split_tables <- function(x, by, format) {
+  if (!is.null(by) && is.data.frame(x) && !identical(format, "html")) {
+    # convert formula into string
+    if (inherits(by, "formula")) {
+      by <- all.vars(by)
+    }
+    # numeric indices are possible - just extract column names at that positions
+    if (is.numeric(by)) {
+      if (any(by < 1 || by > ncol(x))) {
+        format_error("Indices in `by` cannot be lower than 1 or higher than the number of columns in the data frame.")
+      }
+      by <- colnames(x)[by]
+    }
+    # check if all by columns are in the data
+    if (!all(by %in% colnames(x))) {
+      suggestion <- .misspelled_string(colnames(x), by)
+      msg <- "Not all variables in `by` were found in the data frame."
+      if (is.null(suggestion$msg) || !length(suggestion$msg) || !nzchar(suggestion$msg)) {
+        msg <- paste(msg, "Please use one of the following names:", .to_string(colnames(x)))
+      } else {
+        msg <- paste(msg, suggestion$msg)
+      }
+      format_error(msg)
+    }
+    # convert `by` columns into factor. we do this so split works with correct
+    # order of values in "by" columns. If `by` columns are character vector,
+    # `split()` sorts alpahbetically, which we don't want
+    x[by] <- lapply(x[by], function(i) {
+      factor(i, levels = unique(i))
+    })
+
+    # create titles based on group names and levels
+    groups <- expand.grid(lapply(x[by], unique))
+    groups[] <- lapply(groups, as.character)
+
+    group_titles <- lapply(seq_len(nrow(groups)), function(i) {
+      paste0(colnames(groups), "=", as.character(groups[i, ]), collapse = ", ")
+    })
+
+    # split data frames
+    x <- split(x, x[by])
+
+    # remove by-columns and set title
+    x <- lapply(seq_along(x), function(i) {
+      x[[i]][by] <- NULL
+      attr(x[[i]], "table_title") <- c(paste("Group:", group_titles[[i]]), "blue")
+      x[[i]]
+    })
+  }
+
+  x
+}
+
+
 # check whether "table_caption" or its alias "table_title" is used as attribute
 .check_caption_attr_name <- function(x) {
   attr_name <- "table_caption"

man/export_table.Rd

@@ -283,3 +283,23 @@ test_that("export_table, new column names", {
     regex = "is a named vector"
   )
 })
+
+
+test_that("export_table, by in text format", {
+  data(mtcars)
+  data(iris)
+
+  expect_snapshot(export_table(mtcars, by = c("cyl", "gear")))
+  expect_snapshot(export_table(iris, by = "Species"))
+  expect_snapshot(export_table(mtcars, by = ~ cyl + gear))
+
+  # errors
+  expect_error(
+    export_table(iris, by = "Specis"),
+    regex = "Not all variables"
+  )
+  expect_error(
+    export_table(iris, by = 6),
+    regex = "cannot be lower"
+  )
+})