add option to remove empty columns in tm_t_crosstable

NEWS.md

@@ -5,6 +5,9 @@
 ### Bug fixes
 * Fixes output is not updated when filter is added for the modules:  `tm_a_pca`, `tm_a_regression`, `tm_g_scatterplot`, `tm_g_association`, `tm_g_bivariate`, `tm_g_distribution`, `tm_g_response`, `tm_t_crosstable` (#870)
 
+### Enhancements
+* Added `remove_zero_columns` to `tm_t_crosstable` to add an option to remove empty columns (#890)
+
 # teal.modules.general 0.4.0
 
 ### Enhancements

R/tm_t_crosstable.R

@@ -19,12 +19,23 @@
 #' @param show_total (`logical(1)`)
 #' Indicates whether to show total column.
 #' Defaults to `TRUE`.
+#' @param remove_zero_columns (`logical(1)`)
+#' Indicates whether to remove columns that contain only zeros from the output table.
+#' Defaults to `FALSE`.
 #'
 #' @note For more examples, please see the vignette "Using cross table" via
 #' `vignette("using-cross-table", package = "teal.modules.general")`.
 #'
 #' @inherit shared_params return
 #'
+#' @section Table Settings:
+#' The module provides several table settings that can be adjusted:
+#' \itemize{
+#'   \item \code{Show column percentage}: Shows column percentages when enabled
+#'   \item \code{Show total column}: Shows a total column when enabled
+#'   \item \code{Remove zero-only columns}: Removes columns that contain only zeros from the output table
+#' }
+#'
 #' @section Decorating Module:
 #'
 #' This module generates the following objects, which can be modified in place using decorators:
@@ -155,6 +166,7 @@
                             y,
                             show_percentage = TRUE,
                             show_total = TRUE,
+                            remove_zero_columns = FALSE,
                             pre_output = NULL,
                             post_output = NULL,
                             basic_table_args = teal.widgets::basic_table_args(),
@@ -175,6 +187,7 @@
 
   checkmate::assert_flag(show_percentage)
   checkmate::assert_flag(show_total)
+  checkmate::assert_flag(remove_zero_columns)
   checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_class(basic_table_args, classes = "basic_table_args")
@@ -189,6 +202,7 @@
     label = label,
     x = x,
     y = y,
+    remove_zero_columns = remove_zero_columns,
     basic_table_args = basic_table_args,
     decorators = decorators
   )
@@ -207,7 +221,7 @@
 }
 
 # UI function for the cross-table module
-ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, post_output, ...) {
+ui_t_crosstable <- function(id, x, y, show_percentage, show_total, remove_zero_columns, pre_output, post_output, ...) {
   args <- list(...)
   ns <- NS(id)
   is_single_dataset <- teal.transform::is_single_dataset(x, y)
@@ -245,7 +259,8 @@
         bslib::accordion_panel(
           title = "Table settings",
           checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage),
-          checkboxInput(ns("show_total"), "Show total column", value = show_total)
+          checkboxInput(ns("show_total"), "Show total column", value = show_total),
+          checkboxInput(ns("remove_zero_columns"), "Remove zero-only columns", value = remove_zero_columns)
         )
       ),
       ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "table"))
@@ -259,7 +274,7 @@
 }
 
 # Server function for the cross-table module
-srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args, decorators) {
+srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, remove_zero_columns, basic_table_args, decorators) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -352,6 +367,7 @@
 
       show_percentage <- input$show_percentage
       show_total <- input$show_total
+      remove_zero_columns <- input$remove_zero_columns
 
       plot_title <- paste(
         "Cross-Table of",
@@ -368,7 +384,7 @@
         ANL
       )
 
-      teal.code::eval_code(
+      obj <- teal.code::eval_code(
         merged$anl_q_r(),
         substitute(
           expr = {
@@ -413,14 +429,32 @@
           )
         ) %>%
         teal.code::eval_code(
-          substitute(
-            expr = {
-              ANL <- tern::df_explicit_na(ANL)
-              table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ])
-            },
-            env = list(y_name = y_name)
-          )
+          expression(ANL <- tern::df_explicit_na(ANL))
         )
+
+      if (remove_zero_columns) {
+        obj <- obj %>%
+          teal.code::eval_code(
+            substitute(
+              expr = {
+                ANL[[y_name]] <- droplevels(ANL[[y_name]])
+                table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ])
+              },
+              env = list(y_name = y_name)
+            )
+          )
+      } else {
+        obj <- obj %>%
+          teal.code::eval_code(
+            substitute(
+              expr = {
+                table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ])
+              },
+              env = list(y_name = y_name)
+            )
+          )
+      }
+      obj
     })
 
     decorated_output_q <- srv_decorate_teal_data(