Add lbt07

DESCRIPTION

@@ -79,6 +79,7 @@ Collate:
     'lbt01.R'
     'lbt04.R'
     'lbt05.R'
+    'lbt07.R'
     'mht01.R'
     'mng01.R'
     'package.R'

NAMESPACE

@@ -147,6 +147,11 @@ export(lbt05_1_lyt)
 export(lbt05_1_main)
 export(lbt05_1_post)
 export(lbt05_1_pre)
+export(lbt07_1)
+export(lbt07_1_lyt)
+export(lbt07_1_main)
+export(lbt07_1_post)
+export(lbt07_1_pre)
 export(main)
 export(mht01_1)
 export(mht01_1_lyt)

R/lbt07.R

@@ -0,0 +1,197 @@
+# lbt07_1 ----
+
+#' @describeIn lbt07_1 Main TLG function
+#'
+#' @inheritParams gen_args
+#' @param grade_var (`character`) `PARAM` and variables derived from the standard lab grade variable `ATOXGR`:
+#' * A grade direction variable (`GRADE_DIR`) is required in order to obtain
+#'   the correct denominators when building the layout as it is used to define row splitting.
+#' * A toxicity grade variable (e.g. `GRADE_ANL`) where all negative values from
+#'   `ATOXGR` are replaced by their absolute values.
+#' @param lbl_grade_var (`character`) label of the variables in `grade_var`. If `NULL`, uses the label
+#'   attribute of the columns selected in `grade_var`.
+#' @param ... not used.
+#'
+#' @details
+#'  * Split columns by arm, typically `ACTARM`.
+#'
+#' @note
+#'  * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"ATOXGR"`, `"AVISIT"`, `"ANL01FL"`,
+#'  `"ONTRTFL"`, `"WGRLOFL"`,`"WGRHIFL"`,and column specified by `armvar`.
+#'
+#' @export
+#'
+lbt07_1_main <- function(adam_db,
+                         armvar = "ACTARM",
+                         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)
+
+
+  lyt <- lbt07_1_lyt(
+    armvar = armvar,
+    grade_var = grade_var,
+    lbl_grade_var = lbl_grade_var,
+    deco = deco,
+    map = map,
+    ... = ...
+  )
+
+  tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)
+
+  tbl
+}
+
+#' @describeIn lbt07_1 Layout
+#'
+#' @inheritParams gen_args
+#'
+#' @param lbl_param (`character`) label of the `PARAM` variable.
+#' @param lbl_gradedir (`character`) label of the `GRADE_DIR` variable.
+#' @param map (`data.frame`) mapping of `PARAM`s to directions of abnormality.
+#' @param ... not used.
+#'
+#' @export
+#'
+lbt07_1_lyt <- function(armvar,
+                        lbl_gradedir,
+                        lbl_param,
+                        grade_var,
+                        lbl_grade_var,
+                        deco,
+                        map,
+                        ...) {
+  names(lbl_grade_var) <- grade_var
+
+  basic_table_deco(deco, show_colcount = TRUE) %>%
+    split_cols_by(armvar) %>%
+    split_rows_by(
+      "PARAM",
+      label_pos = "topleft",
+      split_label = lbl_grade_var[1]
+    ) %>%
+    summarize_num_patients(
+      var = "USUBJID",
+      required = "ATOXGR",
+      .stats = "unique_count"
+    ) %>%
+    split_rows_by(
+      "GRADE_DIR",
+      label_pos = "topleft",
+      split_label = lbl_grade_var[2],
+      split_fun = trim_levels_to_map(map)
+    ) %>%
+    count_abnormal_by_worst_grade(
+      var = "GRADE_ANL",
+      variables = list(id = "USUBJID", param = "PARAM", grade_dir = "GRADE_DIR"),
+      .formats = list(count_fraction = format_count_fraction_fixed_dp),
+      .indent_mods = 4L
+    ) %>%
+    append_topleft("    Highest NCI CTCAE Grade")
+}
+
+#' @describeIn lbt07_1 Preprocessing
+#'
+#' @inheritParams gen_args
+#' @param ... not used.
+#'
+#' @export
+#'
+lbt07_1_pre <- function(adam_db, ...) {
+  checkmate::assert_class(adam_db, "dm")
+
+  db <- adam_db %>%
+    dm_zoom_to("adlb") %>%
+    filter(
+      .data$ANL01FL == "Y",
+      !.data$AVISIT %in% c("SCREENING", "BASELINE"),
+      .data$ATOXGR != "<Missing>",
+      .data$ONTRTFL == "Y",
+      .data$WGRLOFL == "Y" | .data$WGRHIFL == "Y"
+    ) %>%
+    mutate(
+      GRADE_DIR = factor(
+        case_when(
+          ATOXGR %in% c("-1", "-2", "-3", "-4") ~ "LOW",
+          ATOXGR == "0" ~ "ZERO",
+          ATOXGR %in% c("1", "2", "3", "4") ~ "HIGH"
+        ),
+        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")
+      ),
+      PARAM = as.factor(.data$PARAM)
+    ) %>%
+    dm_update_zoomed()
+}
+
+#' @describeIn lbt07_1 Checks
+#'
+#' @inheritParams gen_args
+#' @param ... not used.
+#'
+lbt07_1_check <- function(adam_db,
+                          req_tables = c("adsl", "adlb"),
+                          armvar = "ACTARM",
+                          ...) {
+  assert_all_tablenames(adam_db, req_tables)
+
+  msg <- NULL
+
+  adlb_layout_col <- c("USUBJID", "ATOXGR", "AVISIT", "ANL01FL", "ONTRTFL", "WGRLOFL", "WGRHIFL")
+  adsl_layout_col <- c("USUBJID")
+
+  msg <- c(msg, check_all_colnames(adam_db$adlb, c(armvar, adlb_layout_col)))
+  msg <- c(msg, check_all_colnames(adam_db$adsl, c(adsl_layout_col)))
+
+  if (is.null(msg)) {
+    TRUE
+  } else {
+    stop(paste(msg, collapse = "\n  "))
+  }
+}
+
+
+#' @describeIn lbt07_1 Postprocessing
+#'
+#' @inheritParams gen_args
+#' @param ... not used.
+#'
+#' @export
+#'
+lbt07_1_post <- function(tlg, prune_0 = TRUE, ...) {
+  std_postprocess(tlg)
+}
+
+#' `LBT07` Table 1 (Default) Laboratory Test Results and Change from Baseline by Visit.
+#'
+#' The `LBT07` table provides an
+#' overview of the analysis values and its change from baseline of each respective arm over the course of the trial.
+#' @include chevron_tlg-S4class.R
+#' @export
+#'
+#' @examples
+#' run(lbt07_1, syn_data)
+lbt07_1 <- chevron_t(
+  main = lbt07_1_main,
+  preprocess = lbt07_1_pre,
+  postprocess = lbt07_1_post,
+  adam_datasets = c("adlb", "adsl")
+)

_pkgdown.yaml

@@ -67,6 +67,7 @@ reference:
       - lbt01_1
       - lbt04_1
       - lbt05_1
+      - lbt07_1
       - mht01_1
       - mng01_1
       - vst01_1