Add options to tm_t_events for sorting and overall rows

NEWS.md

@@ -1,13 +1,5 @@
 # teal.modules.clinical 0.8.16.9016
 
-### Enhancements
-* Updated the documentation and vignettes to demonstrate method to pass `teal_data` object to `teal::init()`.
-
-### Bug fixes
-* Fixed bug in `tm_g_lineplot` forcing module to initialize with a table.
-
-# teal.modules.clinical 0.8.16.9010
-
 ### Enhancements
 * Added more informative error message when grade mapping error occurs in `tm_t_abnormality_by_worst_grade`.
 * Fixed label indentation in `tm_t_abnormality_by_worst_grade`.
@@ -22,6 +14,8 @@
 * Updated `tm_t_pp_basic_info`, `tm_g_pp_therapy`, `tm_g_pp_adverse_events`, and `tm_t_pp_laboratory` to use `rlistings` to print data neatly in reports.
 * Updated `tm_g_lineplot` to allow user to remove interval from plot.
 * Updated the documentation and vignettes to demonstrate method to pass `teal_data` object to `teal::init()`.
+* Added parameter `sort_freq_col` to `tm_t_events` to allow the user to select column to use when sorting by decreasing frequency.
+* Added parameter `incl_overall_sum` to `tm_t_events` to allow the user to choose whether overall summary rows are included at the top of the table.
 
 ### Bug fixes
 * Fixed bug in `tm_t_coxreg` preventing table from being displayed when no covariates are selected.

R/tm_t_events.R

@@ -8,8 +8,11 @@
 #' @param event_type (`character`)\cr type of event that is summarized (e.g. adverse event, treatment).
 #'   Default is "event".
 #' @param sort_criteria (`character`)\cr how to sort the final table. Default option `freq_desc` sorts
-#'   by decreasing total number of patients with event. Alternative option `alpha` sorts events
+#'   on column `sort_freq_col` by decreasing number of patients with event. Alternative option `alpha` sorts events
 #'   alphabetically.
+#' @param sort_freq_col (`character`)\cr column to sort by frequency on if `sort_criteria` is set to `freq_desc`.
+#' @param incl_overall_sum (`flag`)\cr  whether two rows which summarize the overall number of adverse events
+#'   should be included at the top of the table.
 #'
 #' @seealso [tm_t_events()]
 #' @keywords internal
@@ -25,9 +28,11 @@ template_events <- function(dataname,
                             total_label = "All Patients",
                             event_type = "event",
                             sort_criteria = c("freq_desc", "alpha"),
+                            sort_freq_col = total_label,
                             prune_freq = 0,
                             prune_diff = 0,
                             drop_arm_levels = TRUE,
+                            incl_overall_sum = TRUE,
                             basic_table_args = teal.widgets::basic_table_args()) {
   assertthat::assert_that(
     assertthat::is.string(dataname),
@@ -189,20 +194,23 @@ template_events <- function(dataname,
   unique_label <- paste0("Total number of patients with at least one ", event_type)
   nonunique_label <- paste0("Overall total number of ", event_type, "s")
 
-  layout_list <- add_expr(
-    layout_list,
-    substitute(
-      summarize_num_patients(
-        var = "USUBJID",
-        .stats = c("unique", "nonunique"),
-        .labels = c(
-          unique = unique_label,
-          nonunique = nonunique_label
-        )
-      ),
-      env = list(unique_label = unique_label, nonunique_label = nonunique_label)
+  if (incl_overall_sum) {
+    layout_list <- add_expr(
+      layout_list,
+      substitute(
+        summarize_num_patients(
+          var = "USUBJID",
+          .stats = c("unique", "nonunique"),
+          .labels = c(
+            unique = unique_label,
+            nonunique = nonunique_label
+          )
+        ),
+        env = list(unique_label = unique_label, nonunique_label = nonunique_label)
+      )
     )
-  )
+  }
+
 
   one_term <- is.null(hlt) || is.null(llt)
 
@@ -362,10 +370,17 @@ template_events <- function(dataname,
     }
   } else {
     # Sort by decreasing frequency.
+    sort_list <- add_expr(
+      sort_list,
+      substitute(
+        expr = idx_split_col <- which(sapply(col_paths(result), tail, 1) == sort_freq_col),
+        env = list(sort_freq_col = sort_freq_col)
+      )
+    )
 
     # When the "All Patients" column is present we only use that for scoring.
     scorefun_hlt <- if (add_total) {
-      quote(cont_n_onecol(ncol(result)))
+      quote(cont_n_onecol(idx_split_col))
     } else {
       quote(cont_n_allcols)
     }
@@ -495,9 +510,11 @@ tm_t_events <- function(label,
                         total_label = "All Patients",
                         event_type = "event",
                         sort_criteria = c("freq_desc", "alpha"),
+                        sort_freq_col = total_label,
                         prune_freq = 0,
                         prune_diff = 0,
                         drop_arm_levels = TRUE,
+                        incl_overall_sum = TRUE,
                         pre_output = NULL,
                         post_output = NULL,
                         basic_table_args = teal.widgets::basic_table_args()) {
@@ -508,9 +525,11 @@ tm_t_events <- function(label,
   checkmate::assert_string(event_type)
   checkmate::assert_flag(add_total)
   checkmate::assert_string(total_label)
+  checkmate::assert_string(sort_freq_col)
   checkmate::assert_scalar(prune_freq)
   checkmate::assert_scalar(prune_diff)
   checkmate::assert_flag(drop_arm_levels)
+  checkmate::assert_flag(incl_overall_sum)
   sort_criteria <- match.arg(sort_criteria)
   checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
   checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
@@ -537,6 +556,8 @@ tm_t_events <- function(label,
         event_type = event_type,
         label = label,
         total_label = total_label,
+        sort_freq_col = sort_freq_col,
+        incl_overall_sum = incl_overall_sum,
         basic_table_args = basic_table_args
       )
     ),
@@ -596,7 +617,7 @@ ui_t_events_byterm <- function(id, ...) {
           selected = a$sort_criteria,
           multiple = FALSE
         ),
-        shiny::helpText("Pruning Options"),
+        shiny::helpText(shiny::strong("Pruning Options:")),
         shiny::numericInput(
           inputId = ns("prune_freq"),
           label = "Minimum Incidence Rate(%) in any of the treatment groups",
@@ -638,8 +659,10 @@ srv_t_events_byterm <- function(id,
                                 hlt,
                                 llt,
                                 drop_arm_levels,
+                                incl_overall_sum,
                                 label,
                                 total_label,
+                                sort_freq_col,
                                 basic_table_args) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
@@ -761,9 +784,11 @@ srv_t_events_byterm <- function(id,
         total_label = total_label,
         event_type = event_type,
         sort_criteria = input$sort_criteria,
+        sort_freq_col = sort_freq_col,
         prune_freq = input$prune_freq / 100,
         prune_diff = input$prune_diff / 100,
         drop_arm_levels = input$drop_arm_levels,
+        incl_overall_sum = incl_overall_sum,
         basic_table_args = basic_table_args
       )
 

tests/testthat/_snaps/tm_t_events.md

@@ -42,8 +42,10 @@
 
       $sort
       {
+          idx_split_col <- which(sapply(col_paths(result), tail, 1) == 
+              "All Patients")
           pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), 
-              scorefun = cont_n_onecol(ncol(result))) %>% sort_at_path(path = c("AEBODSYS", 
+              scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", 
               "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, 
               ncol(result))))
           pruned_and_sorted_result
@@ -99,8 +101,10 @@
 
       $sort
       {
+          idx_split_col <- which(sapply(col_paths(result), tail, 1) == 
+              "All Patients")
           pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), 
-              scorefun = cont_n_onecol(ncol(result))) %>% sort_at_path(path = c("AEBODSYS", 
+              scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", 
               "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, 
               ncol(result))))
           pruned_and_sorted_result
@@ -142,6 +146,8 @@
 
       $sort
       {
+          idx_split_col <- which(sapply(col_paths(result), tail, 1) == 
+              "All Patients")
           pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("CMDECOD"), 
               scorefun = score_occurrences)
           pruned_and_sorted_result
@@ -247,8 +253,10 @@
 
       $sort
       {
+          idx_split_col <- which(sapply(col_paths(result), tail, 1) == 
+              "All Patients")
           pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), 
-              scorefun = cont_n_onecol(ncol(result))) %>% sort_at_path(path = c("AEBODSYS", 
+              scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", 
               "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, 
               ncol(result))))
           criteria_fun <- function(tr) {
@@ -313,8 +321,10 @@
 
       $sort
       {
+          idx_split_col <- which(sapply(col_paths(result), tail, 1) == 
+              "All Patients")
           pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), 
-              scorefun = cont_n_onecol(ncol(result))) %>% sort_at_path(path = c("AEBODSYS", 
+              scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", 
               "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, 
               ncol(result))))
           criteria_fun <- function(tr) {