feat : add include.table_count param to proc_freq

DESCRIPTION

@@ -1,11 +1,12 @@
 Type: Package
 Package: flextable
 Title: Functions for Tabular Reporting
-Version: 0.9.7.008
+Version: 0.9.7.009
 Authors@R: c(
     person("David", "Gohel", , "[email protected]", role = c("aut", "cre")),
     person("ArData", role = "cph"),
     person("Clementine", "Jager", role = "ctb"),
+    person("Eli", "Daniels", role = "ctb"),
     person("Panagiotis", "Skintzos", , "[email protected]", role = "aut"),
     person("Quentin", "Fazilleau", role = "ctb"),
     person("Maxim", "Nazarov", role = "ctb",

NEWS.md

@@ -10,6 +10,7 @@ rmarkdown (issue #632)
 - fix right outer border issue in grid format (issue #650)
 - fix `flextable_to_rmd()` issue with images in pdf (issue #651)
 - fix `flextable_to_rmd()` issue with local chunk `eval` option (issue #631)
+- `proc_freq` can now display only the table percentages without the count using `include.table_count = FALSE`.
 
 # flextable 0.9.6
 

R/proc_freq.R

@@ -117,8 +117,8 @@ relayout_freq_data <- function(x, order_by) {
 
 #' @title Frequency table
 #'
-#' @description This function compute a one or two way
-#' contingency table and create a flextable from the result.
+#' @description This function computes a one or two way
+#' contingency table and creates a flextable from the result.
 #'
 #' The function is largely inspired by "PROC FREQ" from "SAS"
 #' and was written with the intent to make it
@@ -129,6 +129,7 @@ relayout_freq_data <- function(x, order_by) {
 #' @param include.row_percent `boolean` whether to include the row percents; defaults to `TRUE`
 #' @param include.column_percent `boolean` whether to include the column percents; defaults to `TRUE`
 #' @param include.table_percent `boolean` whether to include the table percents; defaults to `TRUE`
+#' @param include.table_count `boolean` whether to include the table counts; defaults to `TRUE`
 #' @param weight `character` column name for weight
 #' @param ... unused arguments
 #' @importFrom stats as.formula
@@ -137,8 +138,10 @@ relayout_freq_data <- function(x, order_by) {
 #' proc_freq(mtcars, "gear", "vs", weight = "wt")
 #' @export
 proc_freq <- function(x, row = character(), col = character(),
-                      include.row_percent = TRUE, include.column_percent = TRUE,
+                      include.row_percent = TRUE,
+                      include.column_percent = TRUE,
                       include.table_percent = TRUE,
+                      include.table_count = TRUE,
                       weight = character(), ...) {
   if (length(row) && !is.factor(x[[row]])) {
     x[[row]] <- as.factor(x[[row]])
@@ -178,15 +181,23 @@ proc_freq <- function(x, row = character(), col = character(),
       first_vline <- 1
     }
 
+    table_label <- "Count"
+    if (!include.table_count && include.table_percent) {
+      table_label <- "Percent"
+    } else if (!include.table_count && !include.table_percent) {
+      stop("At least one of the include.table_*  parameters must be TRUE.")
+    }
     tab <- tabulator(
       x = dat,
       rows = rows_set,
       columns = c(".coltitle.", col),
       stat = as_paragraph(
-        if (include.table_percent) {
+        if (include.table_count & include.table_percent) {
           as_chunk(fmt_n_percent(count, pct))
-        } else {
+        } else if (include.table_count) {
           as_chunk(count, formatter = fmt_int)
+        } else if (include.table_percent) {
+          as_chunk(fmt_pct(pct))
         },
         as_chunk(fmt_freq_table(pct_col, pct_row,
           include.column_percent = include.column_percent,
@@ -199,7 +210,7 @@ proc_freq <- function(x, row = character(), col = character(),
     if (include.column_percent || include.row_percent) {
       ft <- labelizor(
         x = ft,
-        labels = c(.what. = "", count = "Count", "mpct" = margins_label), j = ".what."
+        labels = c(.what. = "", "count" = table_label, "mpct" = margins_label), j = ".what."
       )
       if (!is.na(fnote_lab)) {
         ft <- footnote(ft,

tests/testthat/test-proc-freq.R

@@ -42,6 +42,20 @@ count_only_dump_txt <-
     ""
   )
 
+no_count_full_dump_txt <-
+  c(
+    "o", "", "p", "p", "p", "p", "o", "", "No", "Yes", "Missing", "Total", "No",
+    "Percent", "96.4%", "", "0.2%", "", "0.0%", "", "96.7%", "", "No", "Mar. pct",
+    " (1)", "", "97.4% ; 99.8%", "", "22.1% ; 0.2%", "", "50.0% ; 0.0%", "", "",
+    "Yes", "Percent", "2.5%", "", "0.8%", "", "", "", "3.3%", "", "Yes", "Mar. pct",
+    "", "2.5% ; 75.7%", "", "77.9% ; 24.3%", "", "", "", "", "Missing", "Percent",
+    "0.0%", "", "", "", "0.0%", "", "0.0%", "", "Missing", "Mar. pct", "", "0.0% ; 50.0%",
+    "", "", "", "50.0% ; 50.0%", "", "", "Total", "Percent", "98.9%", "", "1.0%",
+    "", "0.0%", "", "100.0%", "", " (1)", " Columns and rows percentages", "",
+    "", "", "", ""
+  )
+
+
 test_that("proc_freq executes without errors", {
   dummy_df <- data.frame(
     values = rep(letters[1:3], each = 2),
@@ -68,3 +82,16 @@ test_that("proc_freq content", {
 
   expect_error(proc_freq(dat))
 })
+
+test_that("proc_freq content no count", {
+  ft <- proc_freq(dat,
+                  row = "o", col = "p",
+                  include.table_count = FALSE
+  )
+  expect_equal(information_data_chunk(ft)$txt, no_count_full_dump_txt)
+
+  expect_error(proc_freq(dat,
+                         include.table_count = FALSE,
+                         include.table_percent = FALSE)
+  )
+})