Skip to content

Commit

Permalink
fix
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Dec 23, 2024
1 parent 84bf49b commit 8f00140
Show file tree
Hide file tree
Showing 2 changed files with 57 additions and 6 deletions.
24 changes: 18 additions & 6 deletions R/data_xtabulate.R
Original file line number Diff line number Diff line change
Expand Up @@ -100,8 +100,7 @@ format.datawizard_crosstab <- function(x,
# format_table() returns scientific notation
x <- as.data.frame(x)

# remove group variable
x$Group <- NULL
# find numeric columns, only for these we need row/column sums
numeric_columns <- vapply(x, is.numeric, logical(1))

# compute total N for rows and columns
Expand Down Expand Up @@ -292,7 +291,7 @@ print_html.datawizard_crosstabs <- function(x, big_mark = 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
# overwriting the groups-variable from grouped data frames
if (is.null(i$groups)) {
if (is.null(i$groups) && identical(format, "html")) {
grp_variable <- "groups"
} else {
grp_variable <- "Variable"
Expand All @@ -305,10 +304,23 @@ print_html.datawizard_crosstabs <- function(x, big_mark = NULL, ...) {
# format data frame
format(i, format = format, big_mark = big_mark, include_total_row = FALSE, ...)
})
# now bind, but we need to check for equal number of columns
if (all(lengths(x) == max(length(x)))) {
out <- do.call(rbind, x)
} else {
# if not all tables have identical columns, we can use "data_merge()",
# which safely row-binds all data frames. However, the column order can be
# messed up, so we save column order here and restore it later
col_order <- colnames(x[[which.max(lengths(x))]])
out <- data_merge(x, join = "bind")[col_order]
}

# now reorder and bind
out <- do.call(rbind, x)
out$Variable[duplicated(out$Variable)] <- ""
# remove duplicated names
for (i in c("Variable", "Group")) {
if (!is.null(out[[i]])) {
out[[i]][duplicated(out[[i]])] <- ""
}
}

# prepare table arguments
fun_args <- list(
Expand Down
39 changes: 39 additions & 0 deletions tests/testthat/_snaps/data_tabulate.md
Original file line number Diff line number Diff line change
Expand Up @@ -412,6 +412,45 @@
---------+------------+------------+------
Total | 40 | 46 | 86

# data_tabulate, cross tables, grouped df

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%)
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

# data_tabulate, cross tables, markdown

Code
Expand Down

0 comments on commit 8f00140

Please sign in to comment.