From 7b6d76ceaefd82b007c915afd150cc2a2d205086 Mon Sep 17 00:00:00 2001 From: Daniel Date: Mon, 23 Dec 2024 15:01:35 +0100 Subject: [PATCH] fix --- R/data_xtabulate.R | 34 +++++++++---- tests/testthat/_snaps/data_tabulate.md | 69 ++++++++++++++------------ 2 files changed, 61 insertions(+), 42 deletions(-) diff --git a/R/data_xtabulate.R b/R/data_xtabulate.R index f72395035..6bd015171 100644 --- 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 index d95dab07e..323658ccc 100644 --- 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 | | 0 (0%) | - | 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 | | 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 | | Total + ---------+-------+------------+--------+------------+------ + c172code | 2 | 2 (100.0%) | | 0 (0.0%) | 2 + | NA | 0 (0%) | | 0 (0%) | 0 + + Grouped by e42dep (2) + + Variable | Value | male | female | | 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 | | 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 | | 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 | | 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