226 NULL report in chevron

DESCRIPTION

@@ -36,6 +36,7 @@ Suggests:
     rmarkdown,
     scda,
     scda.2021,
+    testthat (>= 3.0.0),
     tidyr
 VignetteBuilder:
     knitr
@@ -45,6 +46,7 @@ LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.1
 Collate:
+    'utils.R'
     'chevron_tlg-S4class.R'
     'aet01.R'
     'aet02.R'
@@ -66,6 +68,6 @@ Collate:
     'mht01.R'
     'package.R'
     'sample_study_object.R'
-    'utils.R'
     'vst01.R'
     'vst02.R'
+Config/testthat/edition: 3

NAMESPACE

@@ -102,6 +102,7 @@ export(mht01_1)
 export(mht01_1_lyt)
 export(mht01_1_main)
 export(mht01_1_pre)
+export(report_null)
 export(run)
 export(sample_study_object)
 export(std_deco)

R/aet01.R

@@ -55,7 +55,7 @@ aet01_1_main <- function(adam_db,
   tbl <- set_decoration(tbl, deco)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl
@@ -333,7 +333,7 @@ aet01_2_main <- function(adam_db,
   tbl <- set_decoration(tbl, deco)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl

R/aet02.R

@@ -34,7 +34,7 @@ aet02_1_main <- function(adam_db,
   tbl <- build_table(lyt, dbsel$adae, alt_counts_df = dbsel$adsl)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl_sorted <- tbl %>%
@@ -203,7 +203,7 @@ aet02_2_main <- function(adam_db,
   tbl <- build_table(lyt, dbsel$adae, alt_counts_df = dbsel$adsl)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl_sorted <- tbl %>%
@@ -363,19 +363,28 @@ aet02_3_main <- function(adam_db,
     deco = deco
   )
 
-  tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)
+  tbl_top <- build_table(lyt$lyt_top, adam_db$adae, alt_counts_df = adam_db$adsl)
 
-  if (prune_0) {
-    tbl <- prune_table(tbl)
-  }
+  tbl_bottom <- build_table(lyt$lyt_bottom, adam_db$adae, alt_counts_df = adam_db$adsl)
 
-  tbl_sorted <- tbl %>%
+  # needed to handle empty adae tables.
+  tbl_bottom <- tbl_bottom %>%
     sort_at_path(
-      "AEDECOD",
-      scorefun = score_occurrences
+      c("DOMAIN", "*", "AEDECOD"),
+      scorefun = score_occurrences # score_occurrences
     )
 
-  tbl_sorted
+  res <- if (nrow(tbl_bottom) > 0L) {
+    rbind(tbl_top, tbl_bottom)
+  } else {
+    tbl_top
+  }
+
+  if (prune_0) {
+    trim_rows(res)
+  } else {
+    res
+  }
 }
 
 #' @describeIn aet02_3 Layout
@@ -396,7 +405,7 @@ aet02_3_lyt <- function(armvar = .study$actualarm,
                           lbl_overall = NULL
                         ),
                         ...) {
-  basic_table_deco(deco) %>%
+  lyt_top <- basic_table_deco(deco) %>%
     split_cols_by(var = armvar) %>%
     add_colcounts() %>%
     ifneeded_add_overall_col(lbl_overall) %>%
@@ -408,8 +417,19 @@ aet02_3_lyt <- function(armvar = .study$actualarm,
         nonunique = "Total number of events"
       )
     ) %>%
+    append_topleft(lbl_aedecod)
+
+  lyt_bottom <- basic_table_deco(deco) %>%
+    split_cols_by(var = armvar) %>%
+    add_colcounts() %>%
+    ifneeded_add_overall_col(lbl_overall) %>%
+    # needed to handle empty df.
+    split_rows_by(var = "DOMAIN", split_fun = drop_split_levels, child_labels = "hidden") %>%
     count_occurrences(vars = "AEDECOD", .indent_mods = -2L) %>%
     append_topleft(lbl_aedecod)
+
+
+  list(lyt_top = lyt_top, lyt_bottom = lyt_bottom)
 }
 
 #' @describeIn aet02_3 Preprocessing
@@ -428,7 +448,8 @@ aet02_3_pre <- function(adam_db, ...) {
     dm_update_zoomed() %>%
     dm_zoom_to("adae") %>%
     mutate(
-      AEDECOD = tern::explicit_na(tern::sas_na(.data$AEDECOD), label = "No Coding available")
+      AEDECOD = tern::explicit_na(tern::sas_na(.data$AEDECOD), label = "No Coding available"),
+      DOMAIN = "AE" # necessary to handle empty tables
     ) %>%
     dm_update_zoomed()
 }

R/chevron_tlg-S4class.R

@@ -72,12 +72,14 @@ methods::setValidity("chevron_tlg", function(object) {
 #' @param adam_datasets (`character`) representing the name of the table from an `AdAM` dataset required for `tlg`
 #'   creation.
 #'
+#' @include utils.R
+#'
 #' @export
 #' @examples
 #' x <- chevron_tlg(aet01_1_main, aet01_1_pre, adam_datasets = c("adsl", "adae"))
 chevron_tlg <- function(main = function(adam_db, ...) adam_db,
                         preprocess = function(adam_db, ...) adam_db,
-                        postprocess = function(tlg, ...) tlg,
+                        postprocess = report_null,
                         adam_datasets = NA_character_) {
   res <- .chevron_tlg(
     main = main,

R/cmt01a.R

@@ -47,7 +47,7 @@ cmt01a_1_main <- function(adam_db,
   tbl <- build_table(lyt, dbsel$adcm, alt_counts_df = dbsel$adsl)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl_sorted <- tbl %>%
@@ -209,7 +209,7 @@ cmt01a_2_main <- function(adam_db,
   tbl <- build_table(lyt, dbsel$adcm, alt_counts_df = dbsel$adsl)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl_sorted <- tbl %>%
@@ -316,7 +316,7 @@ cmt01a_3_main <- function(adam_db,
   tbl <- build_table(lyt, dbsel$adcm, alt_counts_df = dbsel$adsl)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl_sorted <- tbl %>%

R/cmt02_pt.R

@@ -31,12 +31,12 @@ cmt02_pt_1_main <- function(adam_db,
   tbl <- build_table(lyt, dbsel$adcm, alt_counts_df = dbsel$adsl)
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl %>%
     sort_at_path(
-      path = c("CMDECOD"),
+      path = c("DOMAIN", "*", "CMDECOD"),
       scorefun = score_occurrences
     )
 }
@@ -67,6 +67,7 @@ cmt02_pt_1_lyt <- function(armvar = .study$planarm,
         nonunique = "Total number of treatments"
       )
     ) %>%
+    split_rows_by("DOMAIN", split_fun = drop_split_levels, child_labels = "hidden") %>%
     count_occurrences(vars = "CMDECOD", .indent_mods = 0L) %>%
     append_topleft("Other Treatment")
 }
@@ -86,7 +87,10 @@ cmt02_pt_1_pre <- function(adam_db, ...) {
     filter(.data$ANL01FL == "Y") %>%
     dm_update_zoomed() %>%
     dm_zoom_to("adcm") %>%
-    mutate(CMSEQ = as.factor(.data$CMSEQ)) %>%
+    mutate(
+      CMSEQ = as.factor(.data$CMSEQ),
+      DOMAIN = "CM"
+    ) %>%
     dm_update_zoomed()
 }
 

R/dmt01.R

@@ -55,7 +55,7 @@ dmt01_1_main <- function(adam_db,
   tbl <- build_table(lyt, adam_db$adsl)
 
   if (prune_0) {
-    prune_table(tbl)
+    smart_prune(tbl)
   } else {
     tbl
   }
@@ -99,6 +99,7 @@ dmt01_1_lyt <- function(armvar = .study$planarm,
     split_cols_by(var = armvar) %>%
     add_colcounts() %>%
     ifneeded_add_overall_col(lbl_overall) %>%
+    split_rows_by("DOMAIN", split_fun = drop_split_levels, child_labels = "hidden") %>%
     summarize_vars(vars = summaryvars, var_labels = summaryvars_lbls)
 }
 
@@ -121,6 +122,7 @@ dmt01_1_pre <- function(adam_db, ...) {
       SEX = factor(.data$SEX, levels = c("Female", "Male"))
     ) %>%
     mutate(SEX = formatters::with_label(.data$SEX, adsl_lbs["SEX"])) %>%
+    mutate(DOMAIN = "ADSL") %>%
     dm_update_zoomed()
   db
 }

R/dst01.R

@@ -93,7 +93,7 @@ dst01_1_main <- function(adam_db,
     df = adam_db$adsl
   )
 
-  if (prune_0) tbl_other <- tbl_other %>% prune_table()
+  if (prune_0) tbl_other <- tbl_other %>% smart_prune()
 
   col_info(tbl_other) <- col_info(tbl_completed)
 
@@ -147,7 +147,8 @@ dst01_1_lyt <- function(armvar = .study$planarm,
   layout_table <- basic_table_deco(deco) %>%
     split_cols_by(armvar) %>%
     add_colcounts() %>%
-    ifneeded_add_overall_col(lbl_overall)
+    ifneeded_add_overall_col(lbl_overall) %>%
+    split_rows_by(var = "DOMAIN", split_fun = drop_split_levels, child_labels = "hidden")
 
   layout_table_completed <-
     layout_table %>%
@@ -191,7 +192,10 @@ dst01_1_lyt <- function(armvar = .study$planarm,
 #' @examples
 #' dst01_1_pre(syn_test_data())
 dst01_1_pre <- function(adam_db, ...) {
-  adam_db
+  adam_db %>%
+    dm_zoom_to("adsl") %>%
+    mutate(DOMAIN = "ADSL") %>%
+    dm_update_zoomed()
 }
 
 #' DST01 Table 1 (Default) Patient Disposition Table 1.
@@ -282,7 +286,7 @@ dst01_2_main <- function(adam_db,
     df = adam_db$adsl
   )
 
-  if (prune_0) tbl_other <- tbl_other %>% prune_table()
+  if (prune_0) tbl_other <- tbl_other %>% smart_prune()
 
   col_info(tbl_other) <- col_info(tbl_completed)
 
@@ -336,7 +340,8 @@ dst01_2_lyt <- function(armvar = .study$planarm,
   layout_table <- basic_table_deco(deco) %>%
     split_cols_by(armvar) %>%
     add_colcounts() %>%
-    ifneeded_add_overall_col(lbl_overall)
+    ifneeded_add_overall_col(lbl_overall) %>%
+    split_rows_by(var = "DOMAIN", split_fun = drop_split_levels, child_labels = "hidden")
 
   layout_table_completed <- layout_table %>%
     count_values(
@@ -396,6 +401,7 @@ dst01_2_pre <- function(adam_db,
       .data[[reason]] == "<Missing>" ~ "<Missing>",
       TRUE ~ "Non-safety"
     )) %>%
+    mutate(DOMAIN = "ADSL") %>%
     dm_update_zoomed()
 }
 
@@ -516,15 +522,15 @@ dst01_3_main <- function(adam_db,
     df = adam_db$adsl
   )
 
-  if (prune_0) tbl_other <- tbl_other %>% prune_table()
+  if (prune_0) tbl_other <- tbl_other %>% smart_prune()
 
   col_info(tbl_other) <- col_info(tbl_completed)
 
   tbl2 <- rbind(tbl_completed, tbl_other)
 
   col_info(tbl) <- col_info(tbl2)
 
-  if (prune_0) tbl <- prune_table(tbl)
+  if (prune_0) tbl <- smart_prune(tbl)
 
   tbl <- rbind(tbl2, tbl)
 
@@ -570,6 +576,7 @@ dst01_3_lyt <- function(armvar = .study$planarm,
     split_cols_by(armvar) %>%
     add_colcounts() %>%
     ifneeded_add_overall_col(lbl_overall) %>%
+    split_rows_by(var = "DOMAIN", split_fun = drop_split_levels, child_labels = "hidden") %>%
     count_values(
       vars = status_treatment,
       values = completed_lbl,
@@ -616,6 +623,7 @@ dst01_3_pre <- function(adam_db,
       .data[[reason]] == "<Missing>" ~ "<Missing>",
       TRUE ~ "Non-safety"
     )) %>%
+    mutate(DOMAIN = "ADSL") %>%
     dm_update_zoomed()
 }
 

R/dtht01.R

@@ -60,7 +60,7 @@ dtht01_1_main <- function(adam_db,
   }
 
   if (prune_0) {
-    tbl <- prune_table(tbl)
+    tbl <- smart_prune(tbl)
   }
 
   tbl

R/egt01.R

@@ -50,7 +50,7 @@ egt01_1_main <- function(adam_db,
     df = adam_db$adeg
   )
 
-  if (prune_0) tbl <- prune_table(tbl)
+  if (prune_0) tbl <- smart_prune(tbl)
 
   tbl
 }