fix

easystats · Dec 23, 2024 · 7b6d76c · 7b6d76c
1 parent 8f00140
commit 7b6d76c
Show file tree

Hide file tree

Showing 2 changed files with 61 additions and 42 deletions.
diff --git a/R/data_xtabulate.R b/R/data_xtabulate.R
@@ -281,12 +281,8 @@ print_html.datawizard_crosstabs <- function(x, big_mark = NULL, ...) {
     x <- lapply(x, function(i) {
       # grouped data? if yes, add information on grouping factor
       if (!is.null(i[["Group"]])) {
-        if (identical(format, "html")) {
-          i$groups <- paste0("Grouped by ", i[["Group"]][1])
-          i$Group <- NULL
-        } else {
-          i$Group <- paste0("Grouped by ", i[["Group"]][1])
-        }
+        i$groups <- paste0("Grouped by ", i[["Group"]][1])
+        i$Group <- NULL
       }
       # if we don't have the gt-grouping variable "groups" yet, we use it now
       # for grouping. Else, we use a new column named "Variable", to avoid
@@ -315,10 +311,28 @@ print_html.datawizard_crosstabs <- function(x, big_mark = NULL, ...) {
       out <- data_merge(x, join = "bind")[col_order]
     }
 
-    # remove duplicated names
-    for (i in c("Variable", "Group")) {
-      if (!is.null(out[[i]])) {
-        out[[i]][duplicated(out[[i]])] <- ""
+    # split tables for grouped data frames
+    if (!is.null(out$groups)) {
+      out <- split(out, out$groups)
+      out <- lapply(out, function(subtable) {
+        # for text and markdown, if we split tables, we remove the "groups"
+        # variable. we need to keep it for HTML tables.
+        if (!identical(format, "html")) {
+          attr(subtable, "table_caption") <- c(unique(subtable$groups), "blue")
+          subtable$groups <- NULL
+        }
+        # remove duplicated names
+        for (grpvars in c("Variable", "Group")) {
+          if (!is.null(subtable[[grpvars]])) {
+            subtable[[grpvars]][duplicated(subtable[[grpvars]])] <- ""
+          }
+        }
+        subtable
+      })
+      # no splitting of grouped data frames into list for HTML format,
+      # because splitting is done by the `by` argument later
+      if (identical(format, "html")) {
+        out <- do.call(rbind, out)
       }
     }
 

diff --git a/tests/testthat/_snaps/data_tabulate.md b/tests/testthat/_snaps/data_tabulate.md
@@ -417,39 +417,44 @@
     Code
       print(data_tabulate(grp, "c172code", by = "e16sex", proportions = "row"))
     Output
-      Variable | Value |                  Group |       male |     female
-      ---------+-------+------------------------+------------+-----------
-      c172code |     2 |  Grouped by e42dep (1) | 2 (100.0%) |       <NA>
-               |    NA |                        |     0 (0%) |       <NA>
-               |     2 |  Grouped by e42dep (2) |  2 (50.0%) |  2 (50.0%)
-               |    NA |                        |     0 (0%) |     0 (0%)
-               |     1 |  Grouped by e42dep (3) |  2 (50.0%) |  2 (50.0%)
-               |     2 |                        |  4 (25.0%) | 11 (68.8%)
-               |     3 |                        |  1 (16.7%) |  5 (83.3%)
-               |    NA |                        |  1 (50.0%) |  0  (0.0%)
-               |     1 |  Grouped by e42dep (4) |  3 (75.0%) |  0  (0.0%)
-               |     2 |                        | 23 (54.8%) | 18 (42.9%)
-               |     3 |                        |  3 (30.0%) |  6 (60.0%)
-               |    NA |                        |  3 (42.9%) |  4 (57.1%)
-               |     2 | Grouped by e42dep (NA) | 0   (0.0%) | 2 (100.0%)
-               |    NA |                        | 1 (100.0%) | 0   (0.0%)
+      Grouped by e42dep (1)
       
-      Variable |       <NA> | Total
-      ---------+------------+------
-      c172code | 0   (0.0%) |     2
-               |     0 (0%) |     0
-               |  0  (0.0%) |     4
-               |     0 (0%) |     0
-               |  0  (0.0%) |     4
-               |  1  (6.2%) |    16
-               |  0  (0.0%) |     6
-               |  1 (50.0%) |     2
-               |  1 (25.0%) |     4
-               |  1  (2.4%) |    42
-               |  1 (10.0%) |    10
-               |  0  (0.0%) |     7
-               | 0   (0.0%) |     2
-               | 0   (0.0%) |     1
+      Variable | Value |       male | female |       <NA> | Total
+      ---------+-------+------------+--------+------------+------
+      c172code |     2 | 2 (100.0%) |   <NA> | 0   (0.0%) |     2
+               |    NA |     0 (0%) |   <NA> |     0 (0%) |     0
+      
+      Grouped by e42dep (2)
+      
+      Variable | Value |      male |    female |      <NA> | Total
+      ---------+-------+-----------+-----------+-----------+------
+      c172code |     2 | 2 (50.0%) | 2 (50.0%) | 0  (0.0%) |     4
+               |    NA |    0 (0%) |    0 (0%) |    0 (0%) |     0
+      
+      Grouped by e42dep (3)
+      
+      Variable | Value |      male |     female |      <NA> | Total
+      ---------+-------+-----------+------------+-----------+------
+      c172code |     1 | 2 (50.0%) |  2 (50.0%) | 0  (0.0%) |     4
+               |     2 | 4 (25.0%) | 11 (68.8%) | 1  (6.2%) |    16
+               |     3 | 1 (16.7%) |  5 (83.3%) | 0  (0.0%) |     6
+               |    NA | 1 (50.0%) |  0  (0.0%) | 1 (50.0%) |     2
+      
+      Grouped by e42dep (4)
+      
+      Variable | Value |       male |     female |      <NA> | Total
+      ---------+-------+------------+------------+-----------+------
+      c172code |     1 |  3 (75.0%) |  0  (0.0%) | 1 (25.0%) |     4
+               |     2 | 23 (54.8%) | 18 (42.9%) | 1  (2.4%) |    42
+               |     3 |  3 (30.0%) |  6 (60.0%) | 1 (10.0%) |    10
+               |    NA |  3 (42.9%) |  4 (57.1%) | 0  (0.0%) |     7
+      
+      Grouped by e42dep (NA)
+      
+      Variable | Value |       male |     female |       <NA> | Total
+      ---------+-------+------------+------------+------------+------
+      c172code |     2 | 0   (0.0%) | 2 (100.0%) | 0   (0.0%) |     2
+               |    NA | 1 (100.0%) | 0   (0.0%) | 0   (0.0%) |     1
 
 # data_tabulate, cross tables, markdown