data_tabulate() for crosstables prints NA-proportions when no value…

…s are available (#493) * `data_tabulate()` for crosstables prints NA-proportions when no values are available Fixes #492 * add test * Update snapshots, add snapshot * be accurate * cleaner snapshot [skip ci] --------- Co-authored-by: Etienne Bacher <[email protected]>
easystats · Mar 26, 2024 · 0b785e6 · 0b785e6
1 parent 9c2deb7
commit 0b785e6
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 10 deletions.
diff --git a/R/data_xtabulate.R b/R/data_xtabulate.R
@@ -108,17 +108,23 @@ format.dw_data_xtabulate <- function(x, format = "text", digits = 1, big_mark =
     tmp <- x
     if (identical(props, "row")) {
       for (i in seq_len(nrow(x))) {
-        tmp[i, -1] <- paste(
-          format(x[i, -1]),
-          format(sprintf("(%.*f%%)", digits, 100 * x[i, -1] / sum(x[i, -1], na.rm = TRUE)), justify = "right")
-        )
+        row_sum <- sum(x[i, -1], na.rm = TRUE)
+        if (row_sum == 0) {
+          row_sum_string <- "(0%)"
+        } else {
+          row_sum_string <- sprintf("(%.*f%%)", digits, 100 * x[i, -1] / row_sum)
+        }
+        tmp[i, -1] <- paste(format(x[i, -1]), format(row_sum_string, justify = "right"))
       }
     } else if (identical(props, "column")) {
       for (i in seq_len(ncol(x))[-1]) {
-        tmp[, i] <- paste(
-          format(x[, i]),
-          format(sprintf("(%.*f%%)", digits, 100 * x[, i] / sum(x[, i], na.rm = TRUE)), justify = "right")
-        )
+        col_sum <- sum(x[, i], na.rm = TRUE)
+        if (col_sum == 0) {
+          col_sum_string <- "(0%)"
+        } else {
+          col_sum_string <- sprintf("(%.*f%%)", digits, 100 * x[, i] / col_sum)
+        }
+        tmp[, i] <- paste(format(x[, i]), format(col_sum_string, justify = "right"))
       }
     } else if (identical(props, "full")) {
       for (i in seq_len(ncol(x))[-1]) {

diff --git a/tests/testthat/_snaps/data_tabulate.md b/tests/testthat/_snaps/data_tabulate.md
@@ -430,7 +430,7 @@
       c172code |       male |       <NA> | Total
       ---------+------------+------------+------
       2        | 2 (100.0%) | 0   (0.0%) |     2
-      <NA>     |   0 (NaN%) |   0 (NaN%) |     0
+      <NA>     |     0 (0%) |     0 (0%) |     0
       ---------+------------+------------+------
       Total    |          2 |          0 |     2
       
@@ -439,7 +439,7 @@
       c172code |      male |    female |      <NA> | Total
       ---------+-----------+-----------+-----------+------
       2        | 2 (50.0%) | 2 (50.0%) | 0  (0.0%) |     4
-      <NA>     |  0 (NaN%) |  0 (NaN%) |  0 (NaN%) |     0
+      <NA>     |    0 (0%) |    0 (0%) |    0 (0%) |     0
       ---------+-----------+-----------+-----------+------
       Total    |         2 |         2 |         0 |     4
       
@@ -548,3 +548,17 @@
       attr(,"class")
       [1] "knitr_kable" "character"  
 
+# data_tabulate, correct 0% for proportions
+
+    Code
+      print(out[[1]])
+    Output
+      c172code |       male |     female |   <NA> | Total
+      ---------+------------+------------+--------+------
+      1        |  5 (10.9%) |  3  (5.6%) | 0 (0%) |     8
+      2        | 32 (69.6%) | 34 (63.0%) | 0 (0%) |    66
+      3        |  4  (8.7%) | 12 (22.2%) | 0 (0%) |    16
+      <NA>     |  5 (10.9%) |  5  (9.3%) | 0 (0%) |    10
+      ---------+------------+------------+--------+------
+      Total    |         46 |         54 |      0 |   100
+
diff --git a/tests/testthat/test-data_tabulate.R b/tests/testthat/test-data_tabulate.R
@@ -398,3 +398,11 @@ test_that("data_tabulate, validate against table", {
   out1[[2]] <- as.character(out1[[2]])
   expect_equal(out1, out2, ignore_attr = TRUE)
 })
+
+
+test_that("data_tabulate, correct 0% for proportions", {
+  data(efc, package = "datawizard")
+  out <- data_tabulate(efc, "c172code", by = "e16sex", proportions = "column")
+  expect_identical(format(out[[1]])[[4]], c("0 (0%)", "0 (0%)", "0 (0%)", "0 (0%)", "", "0"))
+  expect_snapshot(print(out[[1]]))
+})