Fix lbt07 pre-processing (#385)

Also added option for overall column as per Nick's request (see below). Closes #382 --------- Signed-off-by: Emily de la Rua <[email protected]>
insightsengineering · Feb 16, 2023 · f873981 · f873981
1 parent 9868981
commit f873981
Show file tree

Hide file tree

Showing 8 changed files with 185 additions and 167 deletions.
diff --git a/R/lbt07.R b/R/lbt07.R
@@ -23,25 +23,26 @@
 #'
 lbt07_1_main <- function(adam_db,
                          arm_var = "ACTARM",
+                         lbl_overall = NULL,
                          grade_var = c("PARAM", "GRADE_DIR", "GRADE_ANL"),
                          deco = std_deco("LBT07"),
                          lbl_grade_var = c("Parameter", "Direction of Abnormality", "Toxicity Grade"),
                          ...) {
   lbt07_1_check(adam_db, ...)
 
-  lbl_grade_var <- if (is.null(lbl_grade_var)) {
-    var_labels_for(adam_db$adlb, grade_var)
-  } else {
-    lbl_grade_var
-  }
-  map <- unique(adam_db$adlb[adam_db$adlb$GRADE_DIR != "ZERO", c("PARAM", "GRADE_DIR", "GRADE_ANL")]) %>%
-    lapply(as.character) %>%
-    as.data.frame() %>%
-    arrange(PARAM, desc(GRADE_DIR), GRADE_ANL)
+  lbl_grade_var <- if (is.null(lbl_grade_var)) var_labels_for(adam_db$adlb, grade_var) else lbl_grade_var
 
+  map <- expand.grid(
+    PARAM = levels(adam_db$adlb$PARAM),
+    GRADE_DIR = c("LOW", "HIGH"),
+    GRADE_ANL = as.character(1:4),
+    stringsAsFactors = FALSE
+  ) %>%
+    arrange(PARAM, desc(GRADE_DIR), GRADE_ANL)
 
   lyt <- lbt07_1_lyt(
     arm_var = arm_var,
+    lbl_overall = lbl_overall,
     grade_var = grade_var,
     lbl_grade_var = lbl_grade_var,
     deco = deco,
@@ -66,6 +67,7 @@ lbt07_1_main <- function(adam_db,
 #' @export
 #'
 lbt07_1_lyt <- function(arm_var,
+                        lbl_overall,
                         lbl_gradedir,
                         lbl_param,
                         grade_var,
@@ -77,6 +79,7 @@ lbt07_1_lyt <- function(arm_var,
 
   basic_table_deco(deco, show_colcount = TRUE) %>%
     split_cols_by(arm_var) %>%
+    ifneeded_add_overall_col(lbl_overall) %>%
     split_rows_by(
       "PARAM",
       label_pos = "topleft",
@@ -99,7 +102,7 @@ lbt07_1_lyt <- function(arm_var,
       .formats = list(count_fraction = tern::format_count_fraction_fixed_dp),
       .indent_mods = 4L
     ) %>%
-    append_topleft("    Highest NCI CTCAE Grade")
+    append_topleft("            Highest NCI CTCAE Grade")
 }
 
 #' @describeIn lbt07_1 Preprocessing
@@ -112,27 +115,32 @@ lbt07_1_lyt <- function(arm_var,
 lbt07_1_pre <- function(adam_db, ...) {
   checkmate::assert_class(adam_db, "dm")
 
-  db <- adam_db %>%
+  new_format <- list(
+    adlb = list(
+      ATOXGR = list("<Missing>" = c("", NA, "<Missing>", "No Coding available"))
+    )
+  )
+
+  adam_db <- dunlin::apply_reformat(adam_db, new_format)
+
+  adam_db %>%
     dm_zoom_to("adlb") %>%
     filter(
       .data$ATOXGR != "<Missing>",
-      .data$ONTRTFL == "Y"
+      .data$ONTRTFL == "Y",
+      .data$WGRLOFL == "Y" | .data$WGRHIFL == "Y"
     ) %>%
     mutate(
       GRADE_DIR = factor(
         case_when(
-          ATOXGR %in% c("-1", "-2", "-3", "-4") ~ "LOW",
+          ATOXGR %in% c("-1", "-2", "-3", "-4") & .data$WGRLOFL == "Y" ~ "LOW",
           ATOXGR == "0" ~ "ZERO",
-          ATOXGR %in% c("1", "2", "3", "4") ~ "HIGH"
+          ATOXGR %in% c("1", "2", "3", "4") & .data$WGRHIFL == "Y" ~ "HIGH",
+          TRUE ~ "NONE"
         ),
-        levels = c("LOW", "ZERO", "HIGH")
-      ),
-      GRADE_ANL = fct_relevel(
-        forcats::fct_recode(ATOXGR,
-          `1` = "-1", `2` = "-2", `3` = "-3", `4` = "-4"
-        ),
-        c("0", "1", "2", "3", "4")
+        levels = c("LOW", "ZERO", "HIGH", "NONE")
       ),
+      GRADE_ANL = factor(ATOXGR, levels = c(-4:4), labels = abs(c(-4:4))),
       PARAM = as.factor(.data$PARAM)
     ) %>%
     dm_update_zoomed()
@@ -173,6 +181,9 @@ lbt07_1_check <- function(adam_db,
 #' @export
 #'
 lbt07_1_post <- function(tlg, prune_0 = TRUE, ...) {
+  if (prune_0) {
+    tlg <- smart_prune(tlg)
+  }
   std_postprocess(tlg)
 }
 

diff --git a/R/mng01.R b/R/mng01.R
@@ -1,4 +1,3 @@
-
 # mng01_1 ----
 
 #' @describeIn mng01_1 Main TLG Function
@@ -110,7 +109,7 @@ mng01_1_main <- function(adam_db,
   ggtheme <- if (!show_v_grid) {
     ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank())
   } else {
-    ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_line(size = 1))
+    ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_line(linewidth = 1))
   }
 
   ggtheme <- if (!show_h_grid) {
@@ -120,8 +119,8 @@ mng01_1_main <- function(adam_db,
     )
   } else {
     ggtheme + ggplot2::theme(
-      panel.grid.minor.y = ggplot2::element_line(size = 1),
-      panel.grid.major.y = ggplot2::element_line(size = 1)
+      panel.grid.minor.y = ggplot2::element_line(linewidth = 1),
+      panel.grid.major.y = ggplot2::element_line(linewidth = 1)
     )
   }
 

diff --git a/R/utils.R b/R/utils.R
@@ -156,7 +156,7 @@ syn_test_data <- function() {
     rename(q1 = 2, q2 = 3)
 
   sd$adlb <- qntls %>%
-    left_join(sd$adlb, by = "PARAMCD") %>%
+    left_join(sd$adlb, by = "PARAMCD", multiple = "all") %>%
     group_by(USUBJID, PARAMCD, BASETYPE) %>%
     mutate(
       ANRIND = factor(
@@ -174,7 +174,11 @@ syn_test_data <- function() {
           TRUE ~ ""
         ),
         levels = c("", "LAST", "REPLICATED", "SINGLE")
-      )
+      ),
+      ONTRTFL = factor(case_when(
+        AVISIT %in% c("SCREENING", "BASELINE") ~ "N",
+        TRUE ~ "Y"
+      ))
     ) %>%
     ungroup() %>%
     mutate(

diff --git a/man/lbt07_1.Rd b/man/lbt07_1.Rd