chevron coverage - 97.56%

Files
Source

# cmt01a ----

#' @describeIn cmt01a Default labels
#' @export
#'
cmt01_label <- c(
  unique = "Total number of {patient_label} with at least one treatment",
  nonunique = "Total number of treatments"
)

#' @describeIn cmt01a Main TLG function
#'
#' @inheritParams gen_args
#' @param row_split_var (`character`) the variable defining the medication category. By default `ATC2`.
#' @param medname_var (`string`) variable name of medical treatment name.
#' @param summary_labels (`list`) of summarize labels. See details.
#'
#' @details
#'  * Data should be filtered for concomitant medication. `(ATIREL == "CONCOMITANT")`.
#'  * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Sort by medication class alphabetically and within medication class by decreasing total number of patients with
#'  the specific medication.
#'  `summary_labels` is used to control the summary for each level. If "all" is used, then each split will have that
#'  summary statistic with the labels. One special case is "TOTAL", this is for the overall population.
#'
#' @note
#'  * `adam_db` object must contain an `adcm` table with the columns specified in `row_split_var` and `medname_var`
#' as well as `"CMSEQ"`.
#'
#' @export
#'
cmt01a_main <- function(adam_db,
                        arm_var = "ARM",
                        lbl_overall = NULL,
                        row_split_var = "ATC2",
                        medname_var = "CMDECOD",
                        summary_labels = setNames(
                          rep(list(cmt01_label), length(row_split_var) + 1L), c("TOTAL", row_split_var)
                        ),
                        ...) {
  assert_all_tablenames(adam_db, "adsl", "adcm")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_character(row_split_var, null.ok = TRUE)
  assert_list(summary_labels)
  assert_subset(names(summary_labels), c("all", "TOTAL", row_split_var))
  assert_subset(
    unique(unlist(lapply(summary_labels, names))),
    c("unique", "nonunique", "unique_count")
  )
  if ("all" %in% names(summary_labels)) {
    summary_labels <- lapply(
      c(TOTAL = "TOTAL", setNames(row_split_var, row_split_var)),
      function(x) {
        modify_character(summary_labels$all, summary_labels[[x]])
      }
    )
  }
  assert_valid_variable(adam_db$adcm, c(arm_var, row_split_var, medname_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adcm, c("USUBJID", "CMSEQ"), empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adcm, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_row_split <- var_labels_for(adam_db$adcm, row_split_var)
  lbl_medname_var <- var_labels_for(adam_db$adcm, medname_var)

  lyt <- occurrence_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    row_split_var = row_split_var,
    lbl_row_split = lbl_row_split,
    medname_var = medname_var,
    lbl_medname_var = lbl_medname_var,
    summary_labels = summary_labels,
    count_by = "CMSEQ"
  )

  tbl <- build_table(lyt, adam_db$adcm, alt_counts_df = adam_db$adsl)

  tbl
}

#' @describeIn cmt01a Preprocessing
#'
#' @inheritParams cmt01a_main
#'
#' @export
#'
cmt01a_pre <- function(adam_db, ...) {
  adam_db$adcm <- adam_db$adcm %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      CMDECOD = with_label(reformat(.data$CMDECOD, nocoding), "Other Treatment"),
      ATC2 = reformat(.data$ATC2, nocoding),
      CMSEQ = as.character(.data$CMSEQ)
    )
  adam_db
}

#' @describeIn cmt01a Postprocessing
#'
#' @inheritParams cmt01a_main
#' @inheritParams gen_args
#' @param sort_by_freq (`flag`) whether to sort medication class by frequency.
#'
#' @export
#'
cmt01a_post <- function(
    tlg, prune_0 = TRUE,
    sort_by_freq = FALSE, row_split_var = "ATC2",
    medname_var = "CMDECOD", ...) {
  if (sort_by_freq) {
    tlg <- tlg %>%
      tlg_sort_by_var(
        var = row_split_var,
        scorefun = cont_n_allcols
      )
  }
  tlg <- tlg %>%
    tlg_sort_by_var(
      var = c(row_split_var, medname_var),
      scorefun = score_occurrences
    )
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `CMT01A` Concomitant Medication by Medication Class and Preferred Name.
#'
#' A concomitant medication
#' table with the number of subjects and the total number of treatments by medication class.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#'
#' proc_data <- syn_data
#' proc_data$adcm <- proc_data$adcm %>%
#'   filter(ATIREL == "CONCOMITANT")
#'
#' run(cmt01a, proc_data)
cmt01a <- chevron_t(
  main = cmt01a_main,
  preprocess = cmt01a_pre,
  postprocess = cmt01a_post
)

#' @keywords internal
split_and_summ_num_patients <- function(lyt, var, label, stats, summarize_labels, split_indent, ...) {
  assert_string(var)
  assert_string(label)
  lyt <- lyt %>%
    split_rows_by(
      var,
      child_labels = "visible",
      nested = TRUE,
      split_fun = rtables::drop_split_levels,
      label_pos = "topleft",
      split_label = label,
      indent_mod = split_indent
    )
  if (length(stats) > 0) {
    lyt <- lyt %>%
      summarize_num_patients(
        var = "USUBJID",
        .stats = stats,
        .labels = setNames(summarize_labels, stats),
        ...
      )
  }
  lyt
}
#' @keywords internal
get_sort_path <- function(x) {
  assert_character(x, null.ok = TRUE)
  x2 <- as.character(rbind(x, rep("*", length(x))))
  x2[-length(x2)]
}
#' @keywords internal
tlg_sort_by_vars <- function(tlg, vars, scorefun = cont_n_allcols, ...) {
  purrr::reduce(
    .x = lapply(seq_len(length(vars)), function(i) vars[seq_len(i)]),
    .f = tlg_sort_by_var,
    .init = tlg,
    scorefun = scorefun,
    ...
  )
}
#' @keywords internal
tlg_sort_by_var <- function(tlg, var, scorefun = cont_n_allcols, ...) {
  assert_character(var)
  if (length(var) == 0) {
    return(tlg)
  }
  var_path <- get_sort_path(var)
  tlg %>%
    valid_sort_at_path(
      path = var_path,
      scorefun = scorefun,
      ...
    )
}
#' @keywords internal
valid_sort_at_path <- function(tt, path, scorefun, ...) {
  if (valid_row_path(tt, path)) {
    tryCatch(
      sort_at_path(tt, path, scorefun, ...),
      error = function(e) {
        tt
      }
    )
  } else {
    tt
  }
}
#' @keywords internal
valid_row_path <- function(tlg, row_path) {
  if (nrow(tlg) == 0) {
    return(TRUE)
  }
  rpaths <- row_paths(tlg)
  non_star <- which(row_path != "*") + 1
  rpaths_choice <- unique(lapply(rpaths, `[`, non_star))
  any(vapply(rpaths_choice, identical, FUN.VALUE = TRUE, y = row_path[non_star - 1]))
}

#' Count patients recursively
#' @param lyt (`PreDataTableLayouts`) `rtable` layout.
#' @param anl_vars Named (`list`) of analysis variables.
#' @param anl_lbls (`character`) of labels.
#' @param lbl_vars Named (`list`) of analysis labels.
#' @keywords internal
count_patients_recursive <- function(lyt, anl_vars, anl_lbls, lbl_vars) {
  assert_list(anl_vars, names = "unique", types = "character")
  assert_character(anl_lbls, min.chars = 1L, len = length(anl_vars))
  nms <- names(anl_vars)
  for (k in seq_len(length(anl_vars))) {
    lyt <- lyt %>%
      count_patients_with_flags(
        var = "USUBJID",
        flag_variables = setNames(lbl_vars[[k]], anl_vars[[k]]),
        denom = "N_col",
        var_labels = anl_lbls[k],
        show_labels = "visible",
        table_names = nms[k],
        .indent_mods = 0L
      )
  }
  lyt
}
#' @keywords internal
score_all_sum <- function(tt) {
  cleaf <- collect_leaves(tt)[[1]]
  if (NROW(cleaf) == 0) {
    stop("score_all_sum score function used at subtable [", obj_name(tt), "] that has no content.")
  }
  sum(sapply(row_values(cleaf), function(cv) cv[1]))
}
#' @keywords internal
summarize_row <- function(lyt, vars, afun, ...) {
  summarize_row_groups(lyt = lyt, var = vars, cfun = afun, ...)
}

#' Summary factor allowing NA
#' @param x (`factor`) input.
#' @param denom (`string`) denominator choice.
#' @param .N_row (`integer`) number of rows in row-split dataset.
#' @param .N_col (`integer`) number of rows in column-split dataset.
#' @param ... Not used
#' @keywords internal
s_summary_na <- function(x, labelstr, denom = c("n", "N_row", "N_col"), .N_row, .N_col, ...) { # nolint
  denom <- match.arg(denom)
  y <- list()
  y$n <- length(x)
  y$count <- as.list(table(x, useNA = "no"))
  dn <- switch(denom,
    n = length(x),
    N_row = .N_row,
    N_col = .N_col
  )
  y$count_fraction <- lapply(y$count, function(x) {
    c(x, ifelse(dn > 0, x / dn, 0))
  })
  y$n_blq <- sum(grepl("BLQ|LTR|<[1-9]", x))
  y
}
#' Summarize variables allow `NA`
#' @keywords internal
summarize_vars_allow_na <- function(
    lyt, vars, var_labels = vars,
    nested = TRUE, ..., show_labels = "default", table_names = vars,
    section_div = NA_character_, .stats = c("n", "count_fraction"),
    .formats = list(count_fraction = format_count_fraction_fixed_dp), .labels = NULL, .indent_mods = NULL, inclNAs = TRUE) { # nolint
  afun <- make_afun(s_summary_na, .stats, .formats, .labels, .indent_mods, .ungroup_stats = c("count_fraction"))
  analyze(
    lyt = lyt, vars = vars, var_labels = var_labels,
    afun = afun, nested = nested, extra_args = list(...),
    inclNAs = inclNAs, show_labels = show_labels, table_names = table_names,
    section_div = section_div
  )
}

#' Count or summarize by groups
#' @param lyt (`PreDataTableLayouts`) `rtable` layout.
#' @param var (`string`) of analysis variable.
#' @param level (`string`) level to be displayed.
#' @param detail_vars (`character`) of variables for detail information.
#' @keywords internal
count_or_summarize <- function(lyt, var, level, detail_vars, indent_mod = 0L, ...) {
  assert_string(level)
  if (is.null(detail_vars)) {
    lyt <- lyt %>%
      count_values(
        var,
        values = level,
        table_names = paste(var, level, sep = "_"),
        .formats = list(count_fraction = format_count_fraction_fixed_dp),
        .indent_mods = indent_mod,
        ...
      )
  } else {
    lyt <- lyt %>%
      split_rows_by(var, split_fun = keep_split_levels(level), indent_mod = indent_mod) %>%
      summarize_row_groups(
        format = format_count_fraction_fixed_dp
      ) %>%
      split_rows_by_recurive(detail_vars[-length(detail_vars)], split_fun = drop_split_levels) %>%
      summarize_vars(
        detail_vars[length(detail_vars)],
        .stats = "count_fraction",
        denom = "N_col",
        show_labels = "hidden",
        .formats = list(count_fraction = format_count_fraction_fixed_dp),
        ...
      )
  }
  lyt
}

#' Count or summarize by groups
#' @param lyt (`PreDataTableLayouts`) `rtable` layout.
#' @param row_split_var (`character`) variable to split rows by.
#' @param ... Further arguments for `split_rows_by`
#' @keywords internal
split_rows_by_recurive <- function(lyt, row_split_var, ...) {
  args <- list(...)
  for (i in seq_len(length(row_split_var))) {
    args_i <- lapply(args, obtain_value, index = i)
    lyt <- do_call(
      split_rows_by,
      c(
        list(
          lyt = lyt,
          row_split_var
        ),
        args_i
      )
    )
  }
  lyt
}

#' Obtain value from a vector
#' @keywords internal
obtain_value <- function(obj, index) {
  if (is.list(obj)) {
    return(obj[[index]])
  }
  if (is.vector(obj) && length(obj) >= index) {
    return(obj[index])
  }
  return(obj)
}

#' Get page by value
#' @keywords internal
get_page_by <- function(var, vars) {
  assert_character(vars, null.ok = TRUE)
  assert_character(var, null.ok = TRUE, max.len = 1L)
  ret <- rep(FALSE, length(vars))
  if (is.null(var) || length(var) == 0) {
    return(ret)
  }
  index <- match(var, vars)
  assert_int(index, na.ok = TRUE)
  if (is.na(index)) {
    return(ret)
  }
  ret[seq_len(index)] <- TRUE
  return(ret)
}

#' Proportion layout
#'
#' @inheritParams rspt01_main
#' @param lyt layout created by `rtables`
#'
#' @keywords internal
proportion_lyt <- function(lyt, arm_var, methods, strata, conf_level, odds_ratio = TRUE, rsp_var = "IS_RSP") {
  non_stratified <- length(strata) == 0L
  lyt <- lyt %>%
    estimate_proportion_diff(
      vars = rsp_var,
      show_labels = "visible",
      var_labels = if (non_stratified) "Unstratified Analysis" else "Stratified Analysis",
      conf_level = conf_level,
      method = if (non_stratified) {
        methods[["diff_conf_method"]] %||% "waldcc"
      } else {
        methods[["strat_diff_conf_method"]] %||% "cmh"
      },
      variables = list(strata = strata),
      table_names = if (non_stratified) "est_prop_diff" else "est_prop_diff_strat"
    ) %>%
    test_proportion_diff(
      vars = rsp_var,
      method = if (non_stratified) {
        methods[["diff_pval_method"]] %||% "chisq"
      } else {
        methods[["strat_diff_pval_method"]] %||% "cmh"
      },
      variables = list(strata = strata),
      table_names = if (non_stratified) "test_prop_diff" else "test_prop_diff_strat"
    )

  if (odds_ratio) {
    lyt <- lyt %>%
      estimate_odds_ratio(
        vars = rsp_var,
        variables = if (non_stratified) list(strata = strata, arm = arm_var),
        table_names = if (non_stratified) "est_or" else "est_or_strat"
      )
  }

  lyt
}

#' Helper function to add a row split if specified
#'
#' @param lyt (`PreDataTableLayouts`) object.
#' @param var (`string`) the name of the variable initiating a new row split.
#' @param lbl_var (`string`)the label of the variable `var`.
#'
#' @keywords internal
#'
#' @return `PreDataTableLayouts` object.
#'
ifneeded_split_row <- function(lyt, var, lbl_var) {
  if (is.null(var)) {
    lyt
  } else {
    split_rows_by(lyt, var,
      label_pos = "topleft",
      split_label = lbl_var
    )
  }
}

#' Helper function to add a column split if specified
#'
#' @param lyt (`rtables`) object.
#' @param var (`string`) the name of the variable initiating a new column split.
#' @param ... Additional arguments for `split_cols_by`.
#'
#' @keywords internal
#'
#' @return `rtables` object.
#'
ifneeded_split_col <- function(lyt, var, ...) {
  if (is.null(var)) {
    lyt
  } else {
    split_cols_by(
      lyt = lyt,
      var = var,
      ...
    )
  }
}

#' Create a Null Report
#' @rdname report_null
#' @aliases null_report
#' @param tlg (`TableTree`) object.
#' @param ... not used. Important to be used directly as post processing function.
#'
#' @export
#'
#' @return original `TableTree` or a null report if no observation are found in the table.
#'
report_null <- function(tlg, ...) {
  assert_true(is.null(tlg) || rtables::is_rtable(tlg))

  if (is.null(tlg) || nrow(tlg) == 0L) {
    return(null_report)
  }
  if (count_children(tlg) == 0) {
    return(null_report)
  }
  tlg
}

#' Count Children
#' @keywords internal
count_children <- function(x) {
  assert_true(rtables::is_rtable(x))
  if (is(x, "ElementaryTable")) {
    return(length(x@children))
  }
  sum(vapply(
    tree_children(x),
    count_children,
    FUN.VALUE = 0
  ))
}

#' @export
#' @rdname report_null
null_report <- rtables::rtable(
  header = "",
  rrow("", "Null Report: No observations met the reporting criteria for inclusion in this output.")
)

#' @export
#' @rdname report_null
null_listing <- rlistings::as_listing(
  df = data.frame(x = formatters::with_label(
    "Null Report: No observations met the reporting criteria for inclusion in this output.", ""
  ))
)

has_overall_col <- function(lbl_overall) {
  !is.null(lbl_overall) && !identical(lbl_overall, "")
}

ifneeded_add_overall_col <- function(lyt, lbl_overall) {
  if (has_overall_col(lbl_overall)) {
    add_overall_col(lyt, label = lbl_overall)
  } else {
    lyt
  }
}

#' Analyze skip baseline
#' @param x value to analyze
#' @param .var variable name.
#' @param .spl_context split context.
#' @param paramcdvar (`string`) name of parameter code.
#' @param visitvar (`string`) name of the visit variable.
#' @param skip Named (`character`) indicating the pairs to skip in analyze.
#' @param .stats (`character`) See `tern::summarize_variables`.
#' @param .label (`character`) See `tern::summarize_variables`.
#' @param .indent_mods (`integer`) See `tern::summarize_variables`.
#' @param .N_col (`int`) See `tern::summarize_variables`.
#' @param .N_row (`int`) See `tern::summarize_variables`.
#' @param ... additional arguments for `tern::a_summary`.
#' @inheritParams cfbt01_main
#' @keywords internal
afun_skip <- function(
    x, .var, .spl_context, paramcdvar, visitvar, skip,
    precision, .stats, .labels = NULL, .indent_mods = NULL, .N_col, .N_row, ...) { # nolint
  param_val <- .spl_context$value[which(.spl_context$split == paramcdvar)]
  # Identify context
  split_level <- .spl_context$value[which(.spl_context$split == visitvar)]
  pcs <- if (.var %in% names(skip) && split_level %in% skip[[.var]]) {
    NA
  } else {
    precision[[param_val]] %||% precision[["default"]] %||% 2
  }

  fmts <- lapply(.stats, summary_formats, pcs = pcs, FALSE)
  names(fmts) <- .stats
  fmts_na <- lapply(.stats, summary_formats, pcs = pcs, ne = TRUE)
  ret <- tern::a_summary(
    .stats = .stats, .formats = fmts, .labels = .labels, .indent_mods = .indent_mods,
    x = x, .var = .var, .spl_context = .spl_context, .N_col = .N_col, .N_row = .N_row, ...
  )
  for (i in seq_len(length(ret))) {
    attr(ret[[i]], "format_na_str") <- fmts_na[[i]]()
  }
  ret
}

summary_formats <- function(x, pcs, ne = FALSE) {
  assert_int(pcs, lower = 0, na.ok = TRUE)
  switch(x,
    n = h_format_dec(format = "%s", digits = pcs - pcs, ne = ne),
    min = ,
    max = ,
    sum = h_format_dec(format = "%s", digits = pcs, ne = ne),
    mean = ,
    sd = ,
    median = ,
    mad = ,
    iqr = ,
    cv = ,
    geom_mean = ,
    geom_cv = ,
    se = h_format_dec(format = "%s", digits = pcs + 1, ne = ne),
    mean_sd = ,
    mean_se = h_format_dec(format = "%s (%s)", digits = rep(pcs + 1, 2), ne = ne),
    mean_ci = ,
    mean_sei = ,
    median_ci = ,
    mean_sdi = h_format_dec(format = "(%s, %s)", digits = rep(pcs + 1, 2), ne = ne),
    mean_pval = h_format_dec(format = "%s", digits = 2, ne = ne),
    quantiles = h_format_dec(format = "(%s - %s)", digits = rep(pcs + 1, 2), ne = ne),
    range = h_format_dec(format = "%s - %s", digits = rep(pcs, 2), ne = ne),
    median_range = h_format_dec(format = "%s (%s - %s)", digits = c(pcs, pcs + 1, pcs + 1), ne = ne)
  )
}

split_fun_map <- function(map) {
  if (is.null(map)) {
    drop_split_levels
  } else {
    trim_levels_to_map(map = map)
  }
}

infer_mapping <- function(map_df, df) {
  assert_data_frame(df)
  vars <- colnames(map_df)
  assert_names(names(df), must.include = vars)
  for (x in vars) {
    if (!test_subset(map_df[[x]], lvls(df[[x]]))) {
      rlang::abort(
        paste0(
          "Provided map should only contain valid levels in dataset in variable ", x,
          ". Consider convert ", x, " to factor first and add",
          toString(setdiff(map_df[[x]], lvls(df[[x]]))), "levels to it."
        )
      )
    }
  }
  res <- df[vars] %>%
    unique() %>%
    arrange(across(everything())) %>%
    mutate(across(everything(), as.character))
  if (!is.null(map_df)) {
    dplyr::full_join(map_df, res, by = colnames(map_df))[vars]
  } else {
    res
  }
}


#' Occurrence Layout
#'
#' @inheritParams gen_args
#' @inheritParams cmt01a_main
#' @param lbl_medname_var (`string`) label for the variable defining the medication name.
#' @keywords internal
#'
occurrence_lyt <- function(arm_var,
                           lbl_overall,
                           row_split_var,
                           lbl_row_split,
                           medname_var,
                           lbl_medname_var,
                           summary_labels,
                           count_by) {
  split_indent <- vapply(c("TOTAL", row_split_var), function(x) {
    if (length(summary_labels[[x]]) > 0L) -1L else 0L
  }, FUN.VALUE = 0L)
  split_indent[1L] <- 0L
  lyt <- basic_table() %>%
    split_cols_by(var = arm_var) %>%
    add_colcounts() %>%
    ifneeded_add_overall_col(lbl_overall)
  if (length(summary_labels$TOTAL) > 0) {
    lyt <- lyt %>%
      analyze_num_patients(
        vars = "USUBJID",
        count_by = count_by,
        .stats = names(summary_labels$TOTAL),
        show_labels = "hidden",
        .labels = render_safe(summary_labels$TOTAL)
      )
  }
  for (k in seq_len(length(row_split_var))) {
    lyt <- split_and_summ_num_patients(
      lyt = lyt,
      count_by = count_by,
      var = row_split_var[k],
      label = lbl_row_split[k],
      split_indent = split_indent[k],
      stats = names(summary_labels[[row_split_var[k]]]),
      summarize_labels = render_safe(summary_labels[[row_split_var[k]]])
    )
  }
  lyt %>%
    count_occurrences(
      vars = medname_var,
      drop = length(row_split_var) > 0,
      .indent_mods = unname(tail(split_indent, 1L))
    ) %>%
    append_topleft(paste0(stringr::str_dup(" ", 2 * length(row_split_var)), lbl_medname_var))
}

# aet03 ----

#' @describeIn aet03 Main TLG function
#'
#' @inheritParams gen_args
#'
#' @details
#'  * Default Adverse Events by Greatest Intensity table.
#'  * Numbers represent absolute numbers of patients and fraction of `N`.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Sort by Body System or Organ Class (`SOC`) and Dictionary-Derived Term (`PT`).
#'
#' @note
#'  * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"`, `"AEDECOD"` and `"ASEV"`.
#'
#' @export
#'
aet03_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       ...) {
  assert_all_tablenames(adam_db, "adsl", "adae")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD", "ASEV"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")
  lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
  intensity_grade <- levels(adam_db$adae[["ASEV"]])

  lyt <- aet03_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_aebodsys = lbl_aebodsys,
    lbl_aedecod = lbl_aedecod,
    intensity_grade = intensity_grade
  )

  tbl <- build_table(lyt, df = adam_db$adae, alt_counts_df = adam_db$adsl)

  tbl
}

#' `aet03` Layout
#'
#' @inheritParams gen_args
#'
#' @param lbl_aebodsys (`string`) text label for `AEBODSYS`.
#' @param lbl_aedecod (`string`) text label for `AEDECOD`.
#' @param intensity_grade (`character`) describing the intensity levels present in the dataset.
#'
#' @keywords internal
#'
aet03_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_aebodsys,
                      lbl_aedecod,
                      intensity_grade) {
  all_grade_groups <- list("- Any Intensity -" = intensity_grade)

  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    count_occurrences_by_grade(
      var = "ASEV",
      grade_groups = all_grade_groups,
      .formats = c("count_fraction" = format_count_fraction_fixed_dp)
    ) %>%
    split_rows_by(
      "AEBODSYS",
      child_labels = "visible",
      nested = TRUE,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_aebodsys
    ) %>%
    summarize_occurrences_by_grade(
      var = "ASEV",
      grade_groups = all_grade_groups,
      .formats = c("count_fraction" = format_count_fraction_fixed_dp)
    ) %>%
    split_rows_by(
      "AEDECOD",
      child_labels = "visible",
      nested = TRUE,
      indent_mod = -1L,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_aedecod
    ) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = "unique",
      .labels = c("- Any Intensity -")
    ) %>%
    count_occurrences_by_grade(
      var = "ASEV",
      .indent_mods = -1L
    )
}

#' @describeIn aet03 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet03_pre <- function(adam_db, ...) {
  asev_lvls <- c("MILD", "MODERATE", "SEVERE")
  adam_db$adae <- adam_db$adae %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      AEBODSYS = reformat(.data$AEBODSYS, nocoding),
      AEDECOD = reformat(.data$AEDECOD, nocoding),
      ASEV = factor(.data$ASEV, levels = asev_lvls)
    ) %>%
    filter(!is.na(.data$ASEV))

  adam_db
}

#' @describeIn aet03 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet03_post <- function(tlg, prune_0 = TRUE, ...) {
  tlg <- tlg %>%
    tlg_sort_by_vars(
      c("AEBODSYS", "AEDECOD"),
      scorefun = cont_n_allcols
    )
  if (prune_0) tlg <- trim_rows(tlg)
  std_postprocess(tlg)
}

#' `AET03` Table 1 (Default) Advert Events by Greatest Intensity Table 1.
#'
#' An adverse events table categorized by System
#' Organ Class, Dictionary-Derived Term and Greatest intensity.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(aet03, syn_data)
aet03 <- chevron_t(
  main = aet03_main,
  preprocess = aet03_pre,
  postprocess = aet03_post
)

#' @include chevron_tlg-S4class.R

# run ----

#' Run the pipeline
#'
#' Execute the pre-processing, main and post-processing functions in a single run.
#'
#' @inheritParams gen_args
#' @param object (`chevron_tlg`) input.
#' @param auto_pre (`flag`) whether to perform the default pre processing step.
#' @param verbose (`flag`) whether to print argument information.
#' @param ... extra arguments to pass to the pre-processing, main and post-processing functions.
#' @param user_args (`list`) arguments from `...`.
#'
#' @name run
#' @export
setGeneric(
  "run",
  function(object, adam_db, auto_pre = TRUE, verbose = FALSE, ..., user_args = list(...)) standardGeneric("run")
)

#' Run the pipeline
#' @rdname run
#' @export
#' @examples
#' run(mng01, syn_data, auto_pre = TRUE, dataset = "adlb")
setMethod(
  f = "run",
  signature = "chevron_tlg",
  definition = function(object, adam_db, auto_pre = TRUE, verbose = FALSE, ..., user_args = list(...)) {
    assert_list(adam_db, types = "list")
    assert_flag(auto_pre)
    assert_flag(verbose)
    assert_list(user_args, names = "unique")
    if (verbose) {
      cl <- match.call()
      print_args(
        cl,
        user_args,
        args_ls(object, omit = c("...", "adam_db", "tlg")), auto_pre
      )
    }
    proc_data <- if (auto_pre) {
      list(adam_db = do_call(object@preprocess, c(list(adam_db), user_args)))
    } else {
      list(adam_db = adam_db)
    }

    res_tlg <- list(tlg = do_call(object@main, c(proc_data, user_args)))

    do_call(object@postprocess, c(res_tlg, user_args))
  }
)

#' Print Arguments
#' @keywords internal
print_args <- function(run_call, additional_args, args, auto_pre = TRUE) {
  assert_class(run_call, "call")
  assert_list(args)
  assert_flag(auto_pre)
  run_call[[1]] <- NULL
  run_call <- as.list(run_call)
  if (!is.null(additional_args)) {
    run_call <- c(run_call[c("object", "adam_db")], additional_args)
  } else {
    run_call[c("auto_pre", "verbose")] <- NULL
  }
  nms_args <- unique(unlist(lapply(args, names)))
  nms_call <- names(run_call)
  m <- pmatch(nms_call, nms_args)
  nms_call[!is.na(m)] <- nms_args[m[!is.na(m)]]
  names(run_call) <- nms_call
  cat(
    "Using template: ",
    if (is.name(run_call$object)) run_call$object else paste("object of class", class(run_call$object)),
    "\n"
  )
  cat(
    "Using data:     ",
    if (is.name(run_call$adam_db)) run_call$adam_db else paste("object of class", class(run_call$adam_db)),
    "\n"
  )
  if (auto_pre) {
    cat("\nPre args:\n")
    print_list(get_subset(args$preprocess, run_call))
  }
  cat("\nMain args:\n")
  print_list(get_subset(args$main, run_call))
  cat("\nPost args:\n")
  print_list(get_subset(args$postprocess, run_call))
  add_args <- run_call[
    !names(run_call) %in% c(names(args$main), names(args$postprocess), names(args$preprocess), "object", "adam_db")
  ]
  if (length(add_args) > 0) {
    cat("\nAdditional args:\n")
    print_list(add_args)
  }
  cat("\n\n")
}

#' Subset Arguments and Merge
#' @keywords internal
get_subset <- function(x, y) {
  utils::modifyList(
    x,
    y[names(y) %in% names(x)],
    keep.null = TRUE
  )
}

#' Print list
#' @keywords internal
print_list <- function(x, indent = 2L) {
  if (length(x) == 0) {
    cat(paste0(
      stringr::str_dup(" ", indent),
      "No mapped argument.\n"
    ))
    return()
  }
  k <- names(x)
  m_charx <- max(nchar(k), 1)
  for (k in names(x)) {
    cat(
      sprintf(
        paste0("%s%-", m_charx + 2, "s: %s\n"),
        stringr::str_dup(" ", indent), k,
        deparse_print(x[[k]], m_charx + indent + 2)
      )
    )
  }
}

#' Deparse print
#' @keywords internal
deparse_print <- function(x, indent, max_line = getOption("chevron.arg_max_line", 5L)) {
  assert_int(indent)
  assert_int(max_line, lower = 1L)
  ret <- deparse(x)
  sep <- paste0("\n", stringr::str_dup(" ", indent))
  if (length(ret) > max_line) {
    ret[max_line] <- sprintf("... (print of class <%s> truncated)", toString(class(x)))
    ret <- ret[seq_len(max_line)]
  }
  paste(ret, collapse = sep)
}

# args_ls ----

#' Get Arguments List
#'
#' @param x (`chevron_tlg`) input.
#' @param simplify (`flag`) whether to simplify the output, coalescing the values of the parameters. The order of
#'   priority for the value of the parameters is: `main`, `preprocess` and `postprocess`.
#' @param omit (`character`) the names of the argument to omit from the output.
#'
#' @rdname args_ls
#' @export
setGeneric("args_ls", function(x, simplify = FALSE, omit = NULL) standardGeneric("args_ls"))

#' @rdname args_ls
#' @export
setMethod(
  f = "args_ls",
  signature = "chevron_tlg",
  definition = function(x, simplify = FALSE, omit = NULL) {
    assert_flag(simplify)
    assert_character(omit, null.ok = TRUE)

    x_ls <- list(
      main = formals(x@main),
      preprocess = formals(x@preprocess),
      postprocess = formals(x@postprocess)
    )

    x_sel <- lapply(x_ls, function(y) y[!names(y) %in% omit])

    res <- if (simplify) {
      Reduce(fuse_sequentially, x_sel)
    } else {
      x_sel
    }

    res
  }
)

# main ----

#' Main
#'
#' retrieve or set `main` function.
#'
#' @param x (`chevron_tlg`) input.
#'
#' @aliases main
#' @export
setGeneric("main", function(x) standardGeneric("main"))

#' @rdname main
#' @export
setMethod(
  f = "main",
  signature = "chevron_tlg",
  definition = function(x) {
    x@main
  }
)

#' Set Main Function
#'
#' @param x (`chevron_tlg`) input.
#' @param value (`function`) returning a `tlg`. Typically one of the `_main` function of `chevron`.
#'
#' @rdname main
#' @export
setGeneric("main<-", function(x, value) standardGeneric("main<-"))

#' @rdname main
#' @export
setMethod(
  f = "main<-",
  signature = "chevron_tlg",
  definition = function(x, value) {
    x@main <- value
    validObject(x)
    x
  }
)

# preprocess ----

#' Pre process
#'
#' retrieve or set `preprocess` function.
#'
#' @param x (`chevron_tlg`) input.
#'
#' @aliases preprocess
#' @export
setGeneric("preprocess", function(x) standardGeneric("preprocess"))

#' @rdname preprocess
#' @export
setMethod(
  f = "preprocess",
  signature = "chevron_tlg",
  definition = function(x) {
    x@preprocess
  }
)

#' Set Preprocess Function
#'
#' @param x (`chevron_tlg`) input.
#' @param value  (`function`) returning a pre-processed `list` of `data.frames` amenable to `tlg` creation. Typically
#'   one of the `_pre` function of `chevron`.
#'
#' @rdname preprocess
#' @export
setGeneric("preprocess<-", function(x, value) standardGeneric("preprocess<-"))

#' @rdname preprocess
#' @export
setMethod(
  f = "preprocess<-",
  signature = "chevron_tlg",
  definition = function(x, value) {
    x@preprocess <- value
    validObject(x)
    x
  }
)

# postprocess ----

#' Post process
#'
#' retrieve or set `postprocess` function.
#'
#' @param x (`chevron_tlg`) input.
#'
#' @aliases postprocess
#' @export
setGeneric("postprocess", function(x) standardGeneric("postprocess"))

#' @rdname postprocess
#' @export
setMethod(
  f = "postprocess",
  signature = "chevron_tlg",
  definition = function(x) {
    x@postprocess
  }
)

#' Postprocess Assignment Function
#'
#' @param x (`chevron_tlg`) input.
#' @param value (`function`) returning a post-processed `tlg`.
#'
#' @rdname postprocess
#' @export
setGeneric("postprocess<-", function(x, value) standardGeneric("postprocess<-"))

#' @rdname postprocess
#' @export
setMethod(
  f = "postprocess<-",
  signature = "chevron_tlg",
  definition = function(x, value) {
    x@postprocess <- value
    validObject(x)
    x
  }
)

# script ----

#' Create Script for Parameters Assignment
#'
#' @param x (`chevron_tlg`) input.
#' @param adam_db (`string`) the name of the dataset.
#' @param details (`flag`) deprecated. Whether to show the code of all functions.
#' @param args (`string`) the name of argument list.
#'
#' @name script
#' @rdname script
NULL

## script_funs ----

#' Create Script for `TLG` Generation
#'
#' @rdname script
#' @export
setGeneric("script_funs", function(x, adam_db, args, details = FALSE) standardGeneric("script_funs"))

#' @rdname script
#' @export
#'
#' @examples
#' script_funs(aet04, adam_db = "syn_data", args = "args")
setMethod(
  f = "script_funs",
  signature = "chevron_tlg",
  definition = function(x, adam_db, args, details) {
    checkmate::assert_flag(details)
    checkmate::assert_string(adam_db)
    checkmate::assert_string(args)
    if (!missing(details)) lifecycle::deprecate_warn("0.2.2", "chevron::script_funs(details = )")
    tlg_name <- deparse(substitute(x))
    checkmate::assert_string(tlg_name, pattern = "^[a-zA-Z]+\\w+$")
    c(
      "# Edit Preprocessing Function.",
      glue::glue("preprocess({tlg_name}) <- "),
      deparse(preprocess(x), control = c("useSource")),
      "",
      "# Create TLG",
      glue::glue(
        "tlg_output <- run(object = {tlg_name}, adam_db = {adam_db}",
        ", verbose = TRUE, user_args = {args})"
      )
    )
  }
)

# assert_all_tablenames ----

#' Assert that all names are among names of a `list` of `data.frame`.
#'
#' @param db (`list` of `data.frame`) input to check for the presence of tables.
#' @param tab (`character`) the names of the tables to be checked.
#' @param null_ok (`flag`) can `x` be NULL.
#' @param qualifier (`string`) to be returned if the check fails.
#'
#' @export
#'
#' @examples
#' \dontrun{
#'
#' lsd <- list(
#'   mtcars = mtcars,
#'   iris = iris
#' )
#'
#' assert_all_tablenames(lsd, c("mtcars", "iris", "x"), qualifier = "first test:")
#' }
assert_all_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
  assert_list(db, types = "data.frame", names = "unique")
  assert_character(tab, null.ok = null_ok)
  assert_string(qualifier, null.ok = TRUE)

  diff <- setdiff(tab, names(db))

  if (length(diff) == 0) {
    invisible(NULL)
  } else {
    stop(
      paste(qualifier, "Expected table names:", toString(diff), "not in", deparse(substitute(db)))
    )
  }
}

# assert_one_tablenames ----

#' Assert that at least one name is among table names of a `list` of `data.frame`.
#'
#' @param db (`list` of `data.frame`) input to check for the presence or tables.
#' @param tab (`character`) the names of the tables to be checked.
#' @param null_ok (`flag`) can `x` be NULL.
#' @param qualifier (`string`) to be returned if the check fails.
#'
#' @keywords internal
#'
#' @examples
#' \dontrun{
#'
#' lsd <- list(
#'   mtcars = mtcars,
#'   iris = iris
#' )
#'
#' assert_one_tablenames(lsd, c("mtcars", "x", "y"), qualifier = "first test:")
#' }
assert_one_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
  assert_list(db, types = "data.frame", names = "unique")
  assert_character(tab, null.ok = null_ok)
  assert_string(qualifier, null.ok = TRUE)

  diff <- setdiff(tab, names(db))

  common <- intersect(tab, names(db))

  if (length(common) > 0) {
    invisible(NULL)
  } else {
    stop(
      paste(qualifier, "At least one of:", toString(tab), "is expected to be a table name of", deparse(substitute(db)))
    )
  }
}



# assert_single_value ----

#' Check variable only has one unique value.
#' @param x value vector.
#' @param label (`string`) label of input.
#' @export
assert_single_value <- function(x, label = deparse(substitute(x))) {
  unique_param_val <- unique(x)
  if (length(unique_param_val) > 1) {
    stop(
      quote_str(label),
      " has more than one values ",
      toString(unique_param_val),
      ", only one value is allowed."
    )
  }
}

# assert_valid_var ----

#' @title Check whether var is valid
#' @details
#' This function checks the variable values are valid or not.
#' @param x value of col_split variable
#' @param label (`string`) hints.
#' @param na_ok (`flag`) whether NA value is allowed
#' @param empty_ok (`flag`) whether length 0 value is allowed.
#' @param ... Further arguments to methods.
#' @export
assert_valid_var <- function(x, label, na_ok, empty_ok, ...) {
  UseMethod("assert_valid_var")
}
#' @rdname assert_valid_var
#' @export
#' @param min_chars (`integer`) the minimum length of the characters.
assert_valid_var.character <- function(
    x, label = deparse(substitute(x)),
    na_ok = FALSE, empty_ok = FALSE,
    min_chars = 1L, ...) {
  assert_character(
    x,
    min.chars = min_chars,
    min.len = as.integer(!empty_ok),
    any.missing = na_ok,
    .var.name = label,
    ...
  )
}

#' @rdname assert_valid_var
#' @export
assert_valid_var.factor <- function(
    x, label = deparse(substitute(x)),
    na_ok = FALSE, empty_ok = FALSE,
    min_chars = 1L, ...) {
  assert_character(
    levels(x),
    min.chars = min_chars,
    .var.name = paste("level of", label)
  )
  assert_factor(
    x,
    min.levels = as.integer(!empty_ok),
    any.missing = na_ok,
    .var.name = label,
    ...
  )
}

#' @rdname assert_valid_var
#' @export
assert_valid_var.logical <- function(x, label = deparse(substitute(x)), na_ok = TRUE, empty_ok = FALSE, ...) {
  assert_logical(
    x,
    min.len = as.integer(!empty_ok),
    any.missing = na_ok,
    .var.name = label,
    ...
  )
}
#' @rdname assert_valid_var
#' @param integerish (`flag`) whether the number should be treated as `integerish`.
#' @export
assert_valid_var.numeric <- function(
    x, label = deparse(substitute(x)),
    na_ok = TRUE, empty_ok = FALSE, integerish = FALSE, ...) {
  check_fun <- if (integerish) assert_integerish else assert_numeric
  check_fun(
    x,
    min.len = as.integer(!empty_ok),
    any.missing = na_ok,
    .var.name = label,
    ...
  )
}

#' @rdname assert_valid_var
#' @export
assert_valid_var.default <- function(x, label = deparse(substitute(x)), na_ok = FALSE, empty_ok = FALSE, ...) {
}

# assert_valid_variable ----

#' Check variables in a data frame are valid character or factor.
#' @param df (`data.frame`) input dataset.
#' @param vars (`character`) variables to check.
#' @param label (`string`) labels of the data frame.
#' @param types Named (`list`) of type of the input.
#' @param ... further arguments for `assert_valid_var`. Please note that different methods have different arguments
#' so if provided make sure the variables to check is of the same class.
#'
#' @export
assert_valid_variable <- function(df, vars, label = deparse(substitute(df)), types = NULL, ...) {
  assert_names(colnames(df), must.include = vars, what = "colnames")

  labels <- sprintf("%s$%s", label, vars)
  if (length(types) == 1 && is.null(names(types))) {
    types <- setNames(rep(types, length(vars)), vars)
  }
  if (!is.null(types)) {
    vars_to_check <- which(vars %in% names(types))
    mapply(
      assert_valid_type,
      df[vars[vars_to_check]],
      types = types[vars_to_check],
      label = labels[vars_to_check]
    )
  }
  collection <- makeAssertCollection()
  mapply(assert_valid_var, df[vars], labels, MoreArgs = list(..., add = collection), SIMPLIFY = FALSE)
  reportAssertions(collection)
}

# assert_valid_type ----

#' Check variable is of correct type
#' @param x Object to check the type.
#' @param types (`character`) possible types to check.
#' @param label (`string`) label.
assert_valid_type <- function(x, types, label = deparse(substitute(x))) {
  if (!any(vapply(types, is, object = x, FUN.VALUE = TRUE))) {
    abort(
      paste0(
        quote_str(label),
        " is not of type ",
        toString(types)
      )
    )
  }
}

# assert_valid_var_pair ----

#' Check variables are of same levels
#' @param df1 (`data.frame`) input.
#' @param df2 (`data.frame`) input.
#' @param var (`string`) variable to check.
#' @param lab1 (`string`) label hint for `df1`.
#' @param lab2 (`string`) label hint for `df2`.
assert_valid_var_pair <- function(df1, df2, var, lab1 = deparse(substitute(df1)), lab2 = deparse(substitute(df2))) {
  assert_data_frame(df1)
  assert_data_frame(df2)
  assert_string(var)
  lvl_x <- lvls(df1[[var]])
  lvl_y <- lvls(df2[[var]])
  if (!identical(lvl_x, lvl_y)) {
    abort(
      paste0(
        quote_str(lab1), " and ",
        quote_str(lab2), " should contain the same levels in variable ",
        quote_str(var), "!"
      )
    )
  }
}

# fstg02 ----

#' @describeIn fstg02 Main TLG Function
#'
#' @details
#'  * No overall value.
#'  * Keep zero count rows by default.
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#' @param arm_var (`string`) the arm variable name used for group splitting.
#' @param subgroups (`character`) the subgroups variable name to list baseline risk factors.
#' @param strata_var (`character`) required if stratified analysis is performed.
#' @param stat_var (`character`) the names of statistics to be reported in `tabulate_survival_subgroups`.
#' @param max_colwidth (`int`) maximum width of columns. Stratification label longer than this will be truncated.
#' @param ... Further arguments passed to `g_forest` and `extract_rsp_subgroups` (a wrapper for
#'  `h_odds_ratio_subgroups_df` and `h_proportion_subgroups_df`). For details, see the documentation in `tern`.
#'  Commonly used arguments include `col_symbol_size`, `col`, `vline`, `groups_lists`, `conf_level`,
#'  `method`, `label_all`, etc.
#'
#' @note
#'  * `adam_db` object must contain the table specified by `dataset` with `"PARAMCD"`, `"ARM"`,
#'  `"AVAL"`, `"AVALU"`, `"CNSR"`, and the columns specified by `subgroups` which is denoted as
#'  `c("SEX", "AGEGR1", "RACE")` by default.
#'  * If the plot is too large to be rendered in the output, please refer to `FSTG01`.
#'
#' @return a `gTree` object.
#'
#' @export
#'
fstg02_main <- function(adam_db,
                        dataset = "adtte",
                        arm_var = "ARM",
                        subgroups = c("SEX", "AGEGR1", "RACE"),
                        strata_var = NULL,
                        stat_var = c("n_tot", "n", "median", "hr", "ci"),
                        max_colwidth = 10,
                        ...) {
  assert_all_tablenames(adam_db, c("adsl", dataset))
  df_lbl <- paste0("adam_db$", dataset)
  assert_string(arm_var)
  assert_int(max_colwidth)
  assert_character(subgroups, null.ok = TRUE)
  assert_character(strata_var, null.ok = TRUE)
  assert_character(stat_var, null.ok = TRUE)
  assert_valid_variable(adam_db[[dataset]], arm_var, types = list("factor"), n.levels = 2, label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], c("USUBJID", "PARAMCD", "AVALU"),
    types = list(c("character", "factor")),
    label = df_lbl
  )
  assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], "IS_EVENT", types = list("logical"), label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], c(subgroups, strata_var),
    types = list(c("factor")), na_ok = TRUE,
    label = df_lbl
  )
  assert_single_value(adam_db[[dataset]]$PARAMCD, label = df_lbl)
  assert_single_value(adam_db[[dataset]]$AVALU, label = df_lbl)

  timeunit <- unique(adam_db[[dataset]]$AVALU)

  variables <- list(
    arm = arm_var,
    tte = "AVAL",
    is_event = "IS_EVENT",
    subgroups = subgroups,
    strata_var = strata_var
  )

  df <- execute_with_args(extract_survival_subgroups,
    variables = variables,
    data = adam_db[[dataset]],
    ...
  )
  df$survtime$subgroup <- stringr::str_trunc(df$survtime$subgroup, max_colwidth)
  df$hr$subgroup <- stringr::str_trunc(df$hr$subgroup, max_colwidth)
  result <- basic_table() %>%
    tabulate_survival_subgroups(df, vars = stat_var, time_unit = timeunit)
  cw <- pmin(propose_column_widths(result), max_colwidth + 2)
  final_width <- stringWidth(strrep("x", cw))
  execute_with_args(
    g_forest,
    tbl = result,
    ...,
    width_row_names = final_width[1],
    width_columns = final_width[-1],
    draw = FALSE
  )
}

#' @describeIn fstg02 Preprocessing
#'
#' @inheritParams fstg02_main
#'
#' @export
#'
fstg02_pre <- function(adam_db, ...) {
  adam_db$adtte <- adam_db$adtte %>%
    mutate(
      ARM = droplevels(.data$ARM),
      AVAL = convert_to_month(.data$AVAL, .data$AVALU),
      AVALU = "MONTHS",
      IS_EVENT = .data$CNSR == 0
    )
  adam_db
}

# `fstg02` Pipeline ----

#' `FSTG02` Subgroup Analysis of Survival Duration.
#'
#' The template produces the subgroup analysis of survival duration graphic.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' proc_data <- log_filter(
#'   syn_data,
#'   PARAMCD == "OS" & ARM %in% c("A: Drug X", "B: Placebo"), "adtte"
#' )
#' run(fstg02, proc_data,
#'   subgroups = c("SEX", "AGEGR1", "RACE"),
#'   conf_level = 0.90, dataset = "adtte"
#' )
fstg02 <- chevron_g(
  main = fstg02_main,
  preproces = fstg02_pre
)

# lbt14 ----

#' @describeIn lbt14 Main TLG function
#'
#' @inheritParams gen_args
#' @param gr_missing (`string`) how missing baseline grades should be handled. Defaults to `"incl"` to include the
#'   `"Missing"`
#' level. Other options are `"excl"` to exclude patients with missing baseline grades and `"gr_0"` to convert missing
#' baseline grades to grade 0.
#' @param direction (`string`) one of `"high"` or `"low"` indicating which shift direction should be detailed.
#'
#' @details
#'  * This table follows ADaMIG v1.1.
#'  * Only the worst grade recorded for each patient is included in the table.
#'  * If no missing baseline lab results, the "Missing" level of `BTOXGR` is excluded.
#'  * Grading takes value from -4 to 4, negative value means the abnormality direction is low,
#'  positive value means the abnormality direction is high.
#'  * Grades 0, 1, 2, 3, and 4 are counted as `"Not Low"` when `direction = "low"`. Conversely, when `direction =
#'  "high"`, Grades 0, -1, -2, -3, and -4 are counted as `"Not High".
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm, typically `ACTARM`.
#'
#' @note
#'   * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"PARAM"`, `"BTOXGR"`, `"ATOXGR"`,
#'   and the column specified by `arm_var`.
#'
#' @export
#'
lbt14_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       gr_missing = "incl",
                       page_var = "PARAMCD",
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adlb"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_choice(gr_missing, c("incl", "excl", "gr_0"))
  assert_subset(page_var, "PARAMCD")
  assert_valid_variable(adam_db$adlb, c("ATOXGR", "BTOXGR"), types = list("factor"), na_ok = TRUE)
  assert_valid_variable(adam_db$adlb, c("PARAMCD", "PARAM"), types = list(c("character", "factor")), na_ok = FALSE)
  assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_param <- var_labels_for(adam_db$adlb, "PARAM")
  lbl_btoxgr <- var_labels_for(adam_db$adlb, "BTOXGR")

  lyt <- lbt14_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_param = lbl_param,
    lbl_btoxgr = lbl_btoxgr,
    page_var = page_var
  )

  tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)

  tbl
}

#' `lbt14` Layout
#'
#' @inheritParams lbt14_main
#'
#' @keywords internal
#'
lbt14_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_param,
                      lbl_btoxgr,
                      page_var) {
  page_by <- !is.null(page_var)
  label_pos <- ifelse(page_by, "hidden", "topleft")
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by(
      var = "PARAMCD",
      labels_var = "PARAM",
      split_fun = drop_split_levels,
      label_pos = label_pos,
      split_label = lbl_param,
      page_by = page_by
    ) %>%
    split_rows_by(
      "BTOXGR",
      label_pos = "topleft",
      split_label = lbl_btoxgr
    ) %>%
    summarize_num_patients(var = "USUBJID", .stats = c("unique_count"), unique_count_suffix = FALSE) %>%
    count_occurrences_by_grade("ATOXGR", denom = "n", drop = FALSE, .indent_mods = 3L) %>%
    append_topleft(paste0(stringr::str_dup(" ", 2L * (5L - page_by)), "Post-baseline NCI-CTCAE Grade"))
}

#' @describeIn lbt14 Preprocessing
#'
#' @inheritParams gen_args
#' @inheritParams lbt14_main
#'
#' @export
#'
lbt14_pre <- function(adam_db,
                      gr_missing = "incl",
                      direction = "low",
                      ...) {
  assert_choice(gr_missing, c("incl", "excl", "gr_0"))
  assert_choice(direction, c("low", "high"))

  if (direction == "high") {
    adam_db$adlb <- adam_db$adlb %>%
      filter(.data$WGRHIFL == "Y") %>%
      h_adsl_adlb_merge_using_worst_flag(
        adsl = adam_db$adsl,
        worst_flag = c("WGRHIFL" = "Y")
      )
  } else {
    adam_db$adlb <- adam_db$adlb %>%
      filter(.data$WGRLOFL == "Y") %>%
      h_adsl_adlb_merge_using_worst_flag(
        adsl = adam_db$adsl,
        worst_flag = c("WGRLOFL" = "Y")
      )
  }

  grade_rule <- get_grade_rule(direction, gr_missing)
  adam_db$adlb <- adam_db$adlb %>%
    mutate(
      across(all_of(c("BTOXGR", "ATOXGR")), ~ reformat(.x, grade_rule))
    )

  adam_db
}

#' @describeIn lbt14 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt14_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) tlg <- tlg %>% trim_rows()
  std_postprocess(tlg)
}

#' `LBT14` Laboratory Test Results Shift Table – Highest `NCI-CTCAE` Grade Post-Baseline by
#' Baseline Grade (Low or High Direction).
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(lbt14, syn_data)
lbt14 <- chevron_t(
  main = lbt14_main,
  preprocess = lbt14_pre,
  postprocess = lbt14_post
)

# as we use NSE
globalVariables(c(".", ":="))

#' Retrieve labels for certain variables
#'
#' @param df (`data.frame`) containing columns with label attribute.
#' @param vars (`character`) variable names in `df`.
#'
#' @details
#' The labels will be returned if the column has `label` attribute, otherwise the column name will be returned.
#' Any values between brackets {} will be replaced with `dunlin::render_safe`.
#' @export
var_labels_for <- function(df, vars) {
  assert_names(colnames(df), must.include = vars, what = "colnames")
  render_safe(unname(formatters::var_labels(df, fill = TRUE)[vars]))
}

#' Prune table up to an `ElementaryTable`
#'
#' Avoid returning `NULL` when the `table` is empty.
#'
#' @param tlg (`TableTree`) object.
#'
#' @return pruned `TableTree`.
#'
smart_prune <- function(tlg) {
  res <- prune_table(tlg)

  if (is.null(res)) {
    res <- build_table(rtables::basic_table(), df = data.frame())
    col_info(res) <- col_info(tlg)
  }

  res
}

#' Standard post processing
#'
#' @param tlg (`TableTree`) object.
#' @param ind (`integer`) the indentation of the table.
#' @param ... not used at the moment.
#'
#' @note Standard post processing includes:
#' * `NULL` report creation if necessary
#' * indentation
#'
#' @return a post-processed `tlg`.
#'
#' @keywords internal
#'
std_postprocess <- function(tlg, ind = 2L, ...) {
  assert_int(ind, lower = 0L)

  res <- report_null(tlg)
  table_inset(res) <- ind

  res
}

# Special formats ----

#' Decimal formatting
#'
#' @param digits (`integer`) number of digits.
#' @param format (`string`) describing how the numbers should be formatted following the `sprintf` syntax.
#' @param ne (`flag`) indicator whether to use "NE" to replace the actual value.
#'
#' @return `function` formatting numbers with the defined format.
#'
#' @export
#'
#' @examples
#' fun <- h_format_dec(c(1, 1), "%s - %s")
#' fun(c(123, 567.89))
#'
h_format_dec <- function(digits, format, ne = FALSE) {
  assert_integerish(digits, lower = 0)
  assert_string(format)
  if (any(is.na(digits))) {
    function(x, ...) {
      ""
    }
  } else {
    if (ne) {
      ret <- function(x, ...) {
        do_call(sprintf, c(list(fmt = format), rep("NE", length(digits))))
      }
      return(ret)
    }
    digit_string <- paste0("%", ifelse(is.na(digits), "", paste0(".", digits)), "f")
    new_format <- do_call(sprintf, c(list(fmt = format), digit_string))
    formatters::sprintf_format(new_format)
  }
}

#' Fuse list elements
#'
#' @param x (`list`) to fuse.
#' @param y (`list`) to fuse. Elements with names already existing in `x` are discarded.
#'
#' @keywords internal
#'
fuse_sequentially <- function(x, y) {
  if (missing(y)) {
    return(x)
  }

  names_x <- names(x)
  sel_names_y <- setdiff(names(y), names_x)

  c(x, y[sel_names_y])
}

#' List of `grob` object
#' @param ... (`grob`) objects
#' @export
grob_list <- function(...) {
  ret <- list(...)
  assert_list(ret, types = c("grob"))
  structure(
    ret,
    class = c("grob_list", "list")
  )
}

#' List of `gg` object
#' @param ... (`ggplot`) objects
#' @export
gg_list <- function(...) {
  ret <- list(...)
  assert_list(ret, types = c("ggplot"))
  structure(
    ret,
    class = c("gg_list", "list")
  )
}

#' @export
droplevels.character <- function(x, ...) {
  x
}

#' Obtain levels from vector
#' @param x (`character`) or (`factor`) object to obtain levels.
#' @details
#' For factors, the levels will be returned. For characters, the sorted unique values will be returned.
#' @export
lvls <- function(x) {
  UseMethod("lvls")
}
#' @export
lvls.default <- function(x) {
  NULL
}
#' @export
lvls.character <- function(x) {
  sort(unique(x))
}
#' @export
lvls.factor <- function(x) {
  levels(x)
}

#' @keywords internal
quote_str <- function(x) {
  assert_string(x)
  paste0("`", x, "`")
}

#' @keywords internal
modify_default_args <- function(fun, ...) {
  ret <- fun
  formals(ret) <- utils::modifyList(formals(fun), list(...), keep.null = TRUE)
  return(ret)
}

#' Execute function with given arguments
#' @details If the function has `...`, this function will not pass other arguments to `...`.
#' Only named arguments are passed.
#' @keywords internal
execute_with_args <- function(fun, ...) {
  args <- list(...)
  do_call(fun, args[intersect(names(args), formalArgs(fun))])
}

#' Execute a function call
#' @keywords internal
do_call <- function(what, args) {
  arg_names <- names(args)
  if (is.null(arg_names)) {
    arg_names <- sprintf("var_%s", seq_along(args))
  } else if (any(arg_names == "")) {
    arg_names_random <- sprintf("var_%s", seq_along(args))
    arg_names[arg_names == ""] <- arg_names_random[arg_names == ""]
  }
  args_env <- as.environment(setNames(args, arg_names))
  parent.env(args_env) <- parent.frame()
  new_args <- lapply(arg_names, as.symbol)
  names(new_args) <- names(args)
  do.call(what, new_args, envir = args_env)
}

#' Modify character
#' @keywords internal
modify_character <- function(x, y) {
  assert_character(x, names = "unique", null.ok = TRUE)
  assert_character(y, names = "unique", null.ok = TRUE)
  c(y, x)[unique(c(names(y), names(x)))]
}

#' Helper function to convert to months if needed
#' @param x (`numeric`) time.
#' @param unit (`character`) or (`factor`) time unit.
#'
#' @return A `numeric` vector with the time in months.
#'
#' @export
convert_to_month <- function(x, unit) {
  assert_multi_class(unit, c("character", "factor"))
  assert_numeric(x, len = length(unit))

  unit <- toupper(unit)
  diff <- setdiff(unique(unit), c("DAYS", "MONTHS", "YEARS"))
  if (length(diff) > 0) {
    rlang::warn(
      paste0(
        "Time unit ", toString(diff), " not covered. No unit conversion applied."
      )
    )
  }

  case_when(
    unit == "DAYS" ~ x / 30.4375,
    unit == "MONTHS" ~ x,
    unit == "YEARS" ~ x * 12,
    TRUE ~ x
  )
}

# rspt01 ----

#' @describeIn rspt01 Main TLG function
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#' @param ref_group (`string`) The name of the reference group, the value should
#'  be identical to the values in `arm_var`, if not specified, it will by default
#'  use the first level or value of `arm_var`.
#' @param odds_ratio (`flag`) should the odds ratio be calculated, default is `TRUE`
#' @param perform_analysis (`string`) option to display statistical comparisons using stratified analyses,
#'  or unstratified analyses, or both, e.g. `c("unstrat", "strat")`. Only unstratified will be displayed by default
#' @param strata (`string`) stratification factors, e.g. `strata = c("STRATA1", "STRATA2")`, by default as NULL
#' @param conf_level (`numeric`) the level of confidence interval, default is 0.95.
#' @param methods (`list`) a named list, use a named list to control, for example:
#' `methods = list(prop_conf_method = "wald",
#'                diff_conf_method = "wald",
#'                strat_diff_conf_method = "ha",
#'                diff_pval_method = "fisher",
#'                strat_diff_pval_method = "schouten")`
#' `prop_conf_method` controls the methods of calculating proportion confidence interval,
#' `diff_conf_method` controls the methods of calculating unstratified difference confidence interval,
#' `strat_diff_conf_method` controls the methods of calculating stratified difference confidence interval,
#' `diff_pval_method` controls the methods of calculating unstratified p-value for odds ratio,
#' `strat_diff_pval_method` controls the methods of calculating stratified p-value for odds ratio,
#' see more details in `tern`
#'
#' @details
#' * No overall value.
#'
#' @export
#'
rspt01_main <- function(adam_db,
                        dataset = "adrs",
                        arm_var = "ARM",
                        ref_group = NULL,
                        odds_ratio = TRUE,
                        perform_analysis = "unstrat",
                        strata = NULL,
                        conf_level = 0.95,
                        methods = list(),
                        ...) {
  assert_string(dataset)
  assert_all_tablenames(adam_db, "adsl", dataset)
  assert_string(arm_var)
  assert_string(ref_group, null.ok = TRUE)
  assert_flag(odds_ratio)
  assert_subset(perform_analysis, c("unstrat", "strat"))
  assert_character(
    strata,
    null.ok = !"strat" %in% perform_analysis,
    min.len = as.integer(!"strat" %in% perform_analysis)
  )
  df_label <- sprintf("adam_db$%s", dataset)
  assert_valid_variable(
    adam_db$adsl, c("USUBJID", arm_var),
    types = list(c("character", "factor"))
  )
  assert_valid_variable(
    adam_db[[dataset]], c("USUBJID", arm_var, "RSP_LAB"),
    types = list(c("character", "factor")), label = df_label
  )
  assert_valid_variable(adam_db[[dataset]], "IS_RSP", types = list("logical"), label = df_label)
  assert_valid_variable(
    adam_db[[dataset]], c("PARAMCD", "PARAM"),
    types = list(c("character", "factor")), label = df_label
  )
  assert_single_value(adam_db[[dataset]]$PARAMCD, label = sprintf("adam_db$%s$PARAMCD", dataset))
  assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)
  assert_subset(ref_group, lvls(adam_db[[dataset]][[arm_var]]))

  ref_group <- ref_group %||% lvls(adam_db[[dataset]][[arm_var]])[1]

  lyt <- rspt01_lyt(
    arm_var = arm_var,
    rsp_var = "IS_RSP",
    ref_group = ref_group,
    odds_ratio = odds_ratio,
    perform_analysis = perform_analysis,
    strata = strata,
    conf_level = conf_level,
    methods = methods
  )

  tbl <- build_table(lyt, adam_db[[dataset]], alt_counts_df = adam_db$adsl)

  tbl
}

#' `rspt01` Layout
#'
#' @inheritParams gen_args
#'
#' @keywords internal
#'
rspt01_lyt <- function(arm_var,
                       rsp_var,
                       ref_group,
                       odds_ratio,
                       perform_analysis,
                       strata,
                       conf_level,
                       methods) {
  lyt01 <- basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var, ref_group = ref_group) %>%
    estimate_proportion(
      vars = rsp_var,
      conf_level = conf_level,
      method = methods[["prop_conf_method"]] %||% "waldcc",
      table_names = "est_prop"
    )

  for (perform in perform_analysis) {
    lyt01 <- lyt01 %>%
      proportion_lyt(
        arm_var = arm_var,
        odds_ratio = odds_ratio,
        strata = if (perform == "strat") strata else NULL,
        conf_level = conf_level,
        methods = methods,
        rsp_var = rsp_var
      )
  }

  lyt <- lyt01 %>%
    estimate_multinomial_response(
      var = "RSP_LAB",
      conf_level = conf_level,
      method = methods[["prop_conf_method"]] %||% "waldcc"
    )

  lyt
}

#' @describeIn rspt01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
rspt01_pre <- function(adam_db, ...) {
  adam_db$adrs <- adam_db$adrs %>%
    mutate(RSP_LAB = tern::d_onco_rsp_label(.data$AVALC)) %>%
    mutate(IS_RSP = .data$AVALC %in% c("CR", "PR"))
  adam_db
}

#' @describeIn rspt01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
rspt01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `RSPT01` Binary Outcomes Summary
#'
#' `RSPT01` template may be used to summarize any binary outcome or response variable at
#' a single time point. Typical application for oncology
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' proc_data <- log_filter(syn_data, PARAMCD == "BESRSPI", "adrs")
#'
#' run(rspt01, proc_data)
#'
#' run(rspt01, proc_data,
#'   odds_ratio = FALSE, perform_analysis = c("unstrat", "strat"),
#'   strata = c("STRATA1", "STRATA2"), methods = list(diff_pval_method = "fisher")
#' )
rspt01 <- chevron_t(
  main = rspt01_main,
  preprocess = rspt01_pre,
  postprocess = rspt01_post
)

# dtht01 ----

#' @describeIn dtht01 Main TLG function
#'
#' @inheritParams gen_args
#' @param time_since_last_dose (`flag`) should the time to event information be displayed.
#' @param other_category (`flag`) should the breakdown of the `OTHER` category be displayed.
#'
#' @details
#'  * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Does not include a total column by default.
#'
#' @note
#' * `adam_db` object must contain an `adsl` table with the columns `"DTHFL"`, `"DTHCAT"` as well as `LDDTHGR1` if
#' `time_since_last_dose` is `TRUE`.
#'
#' @export
dtht01_main <- function(adam_db,
                        arm_var = "ACTARM",
                        lbl_overall = NULL,
                        other_category = FALSE,
                        time_since_last_dose = FALSE,
                        ...) {
  assert_all_tablenames(adam_db, "adsl")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_flag(other_category)
  assert_flag(time_since_last_dose, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list("character", "factor"))
  assert_valid_variable(
    adam_db$adsl,
    "DTHFL",
    types = list("character", "factor"), na_ok = TRUE, min_chars = 0L
  )

  lbl_overall <- render_safe(lbl_overall)
  other_var <- if (other_category) "DTHCAUS"
  dose_death_var <- if (time_since_last_dose) "LDDTHGR1"

  assert_valid_variable(
    adam_db$adsl,
    c("DTHCAT", other_var, dose_death_var),
    types = list("character", "factor"), na_ok = TRUE, min_chars = 1L
  )

  if (other_category) {
    death_cause <- lvls(adam_db$adsl$DTHCAT)
    if (length(death_cause) == 0L) {
      stop("other_category specified but could not find any level in `DTHCAT`!")
    }
    other_level <- death_cause[length(death_cause)]
    if (toupper(other_level) != "OTHER") {
      warning(
        "You included detailed information for Other, however the last level of ",
        " `adam_db$adsl$DTHCAT` looks like not `Other`.",
        call. = FALSE
      )
    }
  }

  lyt <- dtht01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    death_flag = "DTHFL",
    death_var = "DTHCAT",
    other_level = other_level,
    other_var = other_var,
    dose_death_var = dose_death_var
  )

  adsl <- adam_db$adsl %>%
    mutate(TOTAL = "Primary Cause of Death")

  build_table(lyt, adsl)
}

#' `dtht01` Layout
#'
#' @inheritParams dtht01_main
#' @param death_flag (`string`) variable name of death flag.
#' @param detah_var (`string`) variable name of death category.
#' @param other_level (`string`) `"Other"` level in death category.
#' @param other_var (`string`) variable name of death cause under `"Other"`.
#' @param dose_death_var (`string`) variable name of the days from last dose.
#'
#' @keywords internal
#'
dtht01_lyt <- function(arm_var,
                       lbl_overall,
                       death_flag,
                       death_var,
                       other_level,
                       other_var,
                       dose_death_var) {
  if (is.null(dose_death_var) && is.null(other_var)) {
    lyt_block_fun <- analyze
  } else {
    lyt_block_fun <- summarize_row
  }
  lyt <- basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    count_values(
      death_flag,
      values = "Y",
      .labels = c(count_fraction = "Total number of deaths"),
      .formats = c(count_fraction = format_count_fraction_fixed_dp)
    ) %>%
    split_rows_by("TOTAL", child_labels = "visible", label_pos = "hidden", split_fun = drop_split_levels) %>%
    lyt_block_fun(
      death_var,
      make_afun(
        s_summary_na,
        .stats = c("n", "count_fraction"), .ungroup_stats = "count_fraction",
        .formats = list(n = "xx", count_fraction = format_count_fraction_fixed_dp)
      ),
      indent_mod = 0L
    )
  if (!is.null(other_var)) {
    lyt <- lyt %>%
      split_rows_by(death_var, split_fun = keep_split_levels(other_level), child_labels = "hidden") %>%
      summarize_vars(other_var, .stats = "count_fraction", denom = "N_row")
  }
  if (!is.null(dose_death_var)) {
    lyt <- lyt %>%
      summarize_vars_allow_na(
        vars = dose_death_var,
        var_labels = "Days from last drug administration",
        .formats = list(count_fraction = format_count_fraction_fixed_dp),
        show_labels = "visible",
        nested = FALSE,
        inclNAs = FALSE
      ) %>%
      split_rows_by(
        dose_death_var,
        split_fun = drop_split_levels,
        split_label = "Primary cause by days from last study drug administration",
        label_pos = "visible",
        nested = FALSE
      ) %>%
      summarize_vars_allow_na(
        death_var,
        .formats = list(count_fraction = format_count_fraction_fixed_dp)
      )
  }

  lyt
}

#' @describeIn dtht01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
dtht01_pre <- function(adam_db, ...) {
  death_format <- rule(
    "Adverse Event" = "ADVERSE EVENT",
    "Progressive Disease" = "PROGRESSIVE DISEASE",
    "Other" = "OTHER"
  )

  adam_db$adsl <- adam_db$adsl %>%
    mutate(
      DTHCAT = reformat(.data$DTHCAT, death_format)
    )

  adam_db
}

#' @describeIn dtht01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
dtht01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `DTHT01` Table 1 (Default) Death Table.
#'
#'  A description of the causes of death optionally with the breakdown of the
#' `OTHER` category and/or post-study reporting of death.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(dtht01, syn_data)
#'
#' run(dtht01, syn_data, other_category = TRUE, time_since_last_dose = TRUE)
dtht01 <- chevron_t(
  main = dtht01_main,
  preprocess = dtht01_pre,
  postprocess = dtht01_post
)

# aet02 ----

#' @describeIn aet02 Default labels
#' @export
#'
aet02_label <- c(
  unique = "Total number of {patient_label} with at least one adverse event",
  nonunique = "Total number of events"
)

#' @describeIn aet02 Main TLG function
#'
#' @inheritParams gen_args
#' @param summary_labels (`list`) of summarize labels. See details.
#'
#' @details
#'  * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.
#'  * Missing values in `AEBODSYS`, and `AEDECOD` are labeled by `No Coding Available`.
#'  `summary_labels` is used to control the summary for each level. If "all" is used, then each split will have that
#'  summary statistic with the labels. One special case is "TOTAL", this is for the overall population.
#'
#' @note
#'  * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"` and `"AEDECOD"`.
#'
#' @export
#'
aet02_main <- function(adam_db,
                       arm_var = "ACTARM",
                       row_split_var = "AEBODSYS",
                       lbl_overall = NULL,
                       summary_labels = list(
                         all = aet02_label,
                         TOTAL = c(nonunique = "Overall total number of events")
                       ),
                       ...) {
  assert_all_tablenames(adam_db, "adsl", "adae")
  assert_string(arm_var)
  assert_character(row_split_var, null.ok = TRUE)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, c(arm_var, row_split_var, "AEDECOD"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
  assert_list(summary_labels, null.ok = TRUE)
  assert_subset(names(summary_labels), c("all", "TOTAL", row_split_var))
  assert_subset(
    unique(unlist(lapply(summary_labels, names))),
    c("unique", "nonunique", "unique_count")
  )
  if ("all" %in% names(summary_labels)) {
    summary_labels <- lapply(
      c(TOTAL = "TOTAL", setNames(row_split_var, row_split_var)),
      function(x) {
        modify_character(summary_labels$all, summary_labels[[x]])
      }
    )
  }

  lbl_overall <- render_safe(lbl_overall)
  lbl_row_split <- var_labels_for(adam_db$adae, row_split_var)
  lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")

  lyt <- occurrence_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    row_split_var = row_split_var,
    lbl_row_split = lbl_row_split,
    medname_var = "AEDECOD",
    lbl_medname_var = lbl_aedecod,
    summary_labels = summary_labels,
    count_by = NULL
  )

  tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)

  tbl
}

#' @describeIn aet02 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet02_pre <- function(adam_db, row_split_var = "AEBODSYS", ...) {
  adam_db$adae <- adam_db$adae %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(AEDECOD = reformat(.data$AEDECOD, nocoding)) %>%
    mutate(across(all_of(row_split_var), ~ reformat(.x, nocoding)))

  adam_db
}

#' @describeIn aet02 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet02_post <- function(tlg, row_split_var = "AEBODSYS", prune_0 = TRUE, ...) {
  tlg <- tlg %>%
    tlg_sort_by_vars(row_split_var, cont_n_allcols) %>%
    valid_sort_at_path(
      path = c(get_sort_path(c(row_split_var, "AEDECOD"))),
      scorefun = score_occurrences
    )
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `AET02` Table 1 (Default) Adverse Events by System Organ Class and Preferred Term Table 1
#'
#' The `AET02` table provides an overview of the number of subjects experiencing adverse events and the number of advert
#' events categorized by Body System and Dictionary-Derived Term.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(aet02, syn_data)
aet02 <- chevron_t(
  main = aet02_main,
  preprocess = aet02_pre,
  postprocess = aet02_post
)

# aet04 ----

#' @describeIn aet04 Main TLG function
#'
#' @inheritParams gen_args
#' @param grade_groups (`list`) putting in correspondence toxicity grades and labels.
#'
#' @details
#'  * Numbers represent absolute numbers of patients and fraction of `N`, or absolute number of event when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Events with missing grading values are excluded.
#'  * Split columns by arm, typically `ACTARM`.
#'  * Does not include a total column by default.
#'  * Sort Body System or Organ Class and Dictionary-Derived Term by highest overall frequencies. Analysis Toxicity
#'  Grade is sorted by severity.
#'
#' @note
#'  * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"`, `"AEDECOD"` and `"ATOXGR"`.
#'
#' @export
#'
aet04_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       grade_groups = NULL,
                       ...) {
  assert_all_tablenames(adam_db, "adsl", "adae")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_list(grade_groups, types = "character", null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, "ATOXGR", na_ok = TRUE, types = list("factor"))
  assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")
  lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")

  if (is.null(grade_groups)) {
    grade_groups <- list(
      "Grade 1-2" = c("1", "2"),
      "Grade 3-4" = c("3", "4"),
      "Grade 5" = c("5")
    )
  }

  lyt <- aet04_lyt(
    arm_var = arm_var,
    total_var = "TOTAL_VAR",
    lbl_overall = lbl_overall,
    lbl_aebodsys = lbl_aebodsys,
    lbl_aedecod = lbl_aedecod,
    grade_groups = grade_groups
  )

  adam_db$adae$TOTAL_VAR <- "- Any adverse events - "

  tbl <- build_table(lyt, df = adam_db$adae, alt_counts_df = adam_db$adsl)

  tbl
}

#' `aet04` Layout
#'
#' @inheritParams aet04_main
#'
#' @param total_var (`string`) variable to create summary of all variables.
#' @param lbl_aebodsys (`string`) text label for `AEBODSYS`.
#' @param lbl_aedecod (`string`) text label for `AEDECOD`.
#' @param grade_groups (`list`) putting in correspondence toxicity grades and labels.
#'
#' @keywords internal
#'
aet04_lyt <- function(arm_var,
                      total_var,
                      lbl_overall,
                      lbl_aebodsys,
                      lbl_aedecod,
                      grade_groups) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by(
      var = total_var,
      label_pos = "hidden",
      child_labels = "visible",
      indent_mod = -1L
    ) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = "unique",
      .labels = "- Any Grade -",
      .indent_mods = 7L
    ) %>%
    count_occurrences_by_grade(
      var = "ATOXGR",
      grade_groups = grade_groups,
      .indent_mods = 6L
    ) %>%
    split_rows_by(
      "AEBODSYS",
      child_labels = "visible",
      nested = FALSE,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_aebodsys
    ) %>%
    split_rows_by(
      "AEDECOD",
      child_labels = "visible",
      split_fun = add_overall_level("- Overall -", trim = TRUE),
      label_pos = "topleft",
      split_label = lbl_aedecod
    ) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = "unique",
      .labels = "- Any Grade -",
      .indent_mods = 6L
    ) %>%
    count_occurrences_by_grade(
      var = "ATOXGR",
      grade_groups = grade_groups,
      .indent_mods = 5L
    ) %>%
    append_topleft("                            Grade")
}

#' @describeIn aet04 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet04_pre <- function(adam_db, ...) {
  atoxgr_lvls <- c("1", "2", "3", "4", "5")
  adam_db$adae <- adam_db$adae %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      AEBODSYS = reformat(.data$AEBODSYS, nocoding),
      AEDECOD = reformat(.data$AEDECOD, nocoding),
      ATOXGR = factor(.data$ATOXGR, levels = atoxgr_lvls)
    )
  adam_db
}

#' @describeIn aet04 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet04_post <- function(tlg, prune_0 = TRUE, ...) {
  tlg <- tlg %>%
    tlg_sort_by_vars(c("AEBODSYS", "AEDECOD"), score_all_sum, decreasing = TRUE)
  if (prune_0) tlg <- trim_rows(tlg)
  std_postprocess(tlg)
}

#' `AET04` Table 1 (Default) Adverse Events by Highest `NCI` `CTACAE` `AE` Grade Table 1.
#'
#' The `AET04` table provides an
#' overview of adverse event with the highest `NCI` `CTCAE` grade per individual.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' grade_groups <- list(
#'   "Grade 1-2" = c("1", "2"),
#'   "Grade 3-4" = c("3", "4"),
#'   "Grade 5" = c("5")
#' )
#' proc_data <- dunlin::log_filter(syn_data, AEBODSYS == "cl A.1", "adae")
#' run(aet04, proc_data, grade_groups = grade_groups)
aet04 <- chevron_t(
  main = aet04_main,
  preprocess = aet04_pre,
  postprocess = aet04_post
)

# lbt04 ----

#' @describeIn lbt04 Main TLG function
#'
#' @inheritParams gen_args
#' @param analysis_abn_var (`string`) column describing anomaly magnitude
#' @param baseline_abn_var (`string`) column describing anomaly at baseline.
#'
#' @details
#'  * Only count LOW or HIGH values.
#'  * Lab test results with missing `analysis_abn_var` values are excluded.
#'  * Split columns by arm, typically `ACTARM`.
#'  * Does not include a total column by default.
#'
#' @note
#'  * `adam_db` object must contain an `adlb` table with columns `"PARCAT1"`, `"PARCAT2"`, `"PARAM"`, `"ANRIND"`,
#'  and column specified by `arm_var`.
#'
#' @export
#'
lbt04_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       analysis_abn_var = "ANRIND",
                       baseline_abn_var = "BNRIND",
                       row_split_var = "PARCAT1",
                       page_var = tail(row_split_var, 1L),
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adlb"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_string(analysis_abn_var)
  assert_string(baseline_abn_var)
  assert_string(row_split_var)
  assert_valid_variable(
    adam_db$adlb, c("PARAMCD", "PARAM", row_split_var),
    types = list("characater", "factor")
  )
  assert_subset(page_var, row_split_var)
  assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
  assert_valid_variable(
    adam_db$adlb,
    baseline_abn_var,
    types = list(c("character", "factor")),
    na_ok = TRUE, empty_ok = TRUE, min_chars = 0L
  )
  assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_param <- var_labels_for(adam_db$adlb, "PARAM")
  lbl_abn_var <- var_labels_for(adam_db$adlb, analysis_abn_var)
  row_split_lbl <- var_labels_for(adam_db$adlb, row_split_var)

  lyt <- lbt04_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_param = lbl_param,
    lbl_abn_var = lbl_abn_var,
    var_parcat = "PARCAT1",
    var_param = "PARAM",
    row_split_var = row_split_var,
    row_split_lbl = row_split_lbl,
    analysis_abn_var = analysis_abn_var,
    variables = list(id = "USUBJID", baseline = baseline_abn_var),
    page_var = page_var
  )

  tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)

  tbl
}

#' `lbt04` Layout
#'
#' @inheritParams gen_args
#'
#' @param lbl_param (`string`) label of the `PARAM` variable.
#' @param lbl_abn_var (`string`) label of the `analysis_abn_var` variable.
#' @param variables (`list`) see [tern::count_abnormal]
#'
#' @keywords internal
#'
lbt04_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_param,
                      lbl_abn_var,
                      var_parcat,
                      var_param,
                      row_split_var,
                      row_split_lbl,
                      analysis_abn_var,
                      variables,
                      page_var) {
  page_by <- get_page_by(page_var, row_split_var)
  label_pos <- ifelse(page_by, "hidden", "topleft")

  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by_recurive(
      row_split_var,
      split_label = row_split_lbl,
      label_pos = label_pos,
      page_by = page_by
    ) %>%
    split_rows_by(
      "PARAMCD",
      labels_var = "PARAM",
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_param,
      indent_mod = 0L
    ) %>%
    count_abnormal(
      var = analysis_abn_var,
      abnormal = list(Low = c("LOW", "LOW LOW"), High = c("HIGH", "HIGH HIGH")),
      exclude_base_abn = TRUE,
      variables = variables,
      .formats = list(fraction = format_fraction_fixed_dp)
    ) %>%
    append_topleft(paste("   ", lbl_abn_var))
}

#' @describeIn lbt04 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt04_pre <- function(adam_db, ...) {
  adam_db$adlb <- adam_db$adlb %>%
    filter(
      .data$ONTRTFL == "Y",
      .data$PARCAT2 == "SI",
      !is.na(.data$ANRIND)
    ) %>%
    mutate(
      PARAM = with_label(.data$PARAM, "Laboratory Test"),
      ANRIND = with_label(.data$ANRIND, "Direction of Abnormality")
    ) %>%
    mutate(
      ANRIND = reformat(
        .data$ANRIND,
        rule(
          "HIGH HIGH" = "HIGH HIGH",
          "HIGH" = "HIGH",
          "LOW" = "LOW",
          "LOW LOW" = "LOW LOW",
          "NORMAL" = "NORMAL"
        ),
        .to_NA = NULL
      )
    )

  adam_db
}

#' @describeIn lbt04 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt04_post <- function(tlg, ...) {
  std_postprocess(tlg)
}

#' `LBT04` Laboratory Abnormalities Not Present at Baseline Table.
#'
#' The `LBT04` table provides an
#' overview of laboratory abnormalities not present at baseline.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(lbt04, syn_data)
lbt04 <- chevron_t(
  main = lbt04_main,
  preprocess = lbt04_pre,
  postprocess = lbt04_post
)

# egt02_1 ----

#' @describeIn egt02_1 Main TLG function
#'
#' @inheritParams gen_args
#' @param exclude_base_abn (`flag`) whether baseline abnormality should be excluded.
#'
#' @details
#'   * Only count LOW or HIGH values.
#'   * Results of "LOW LOW" are treated as the same as "LOW", and "HIGH HIGH" the same as "HIGH".
#'   * Does not include a total column by default.
#'   * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.
#'
#' @note
#'   * `adam_db` object must contain an `adeg` table with the `"PARAM"`, `"ANRIND"` and `"BNRIND"` columns.
#'
#' @export
#'
egt02_1_main <- function(adam_db,
                         arm_var = "ACTARM",
                         lbl_overall = NULL,
                         exclude_base_abn = FALSE,
                         ...) {
  assert_all_tablenames(adam_db, c("adsl", "adeg"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_flag(exclude_base_abn)
  assert_valid_variable(adam_db$adeg, c("PARAM"), types = list(c("character", "factor")), na_ok = FALSE)
  assert_valid_variable(adam_db$adeg, c("ANRIND", "BNRIND"), types = list(c("character", "factor")), na_ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)
  assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))

  lbl_overall <- render_safe(lbl_overall)

  lyt <- egt02_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_vs_assessment = "Assessment",
    lbl_vs_abnormality = "Abnormality",
    exclude_base_abn = exclude_base_abn
  )

  tbl <- build_table(lyt, adam_db$adeg, alt_counts_df = adam_db$adsl)

  tbl
}

#' `egt02` Layout
#'
#' @inheritParams gen_args
#' @param lbl_vs_assessment (`string`) the label of the assessment variable.
#' @param lbl_vs_abnormality (`string`) the label of the abnormality variable.
#' @param exclude_base_abn (`flag`) whether to exclude subjects with baseline abnormality from numerator and
#'   denominator.
#'
#' @keywords internal
#'
egt02_lyt <- function(arm_var = "ACTARM",
                      lbl_overall,
                      lbl_vs_assessment = "Assessment",
                      lbl_vs_abnormality = "Abnormality",
                      exclude_base_abn) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by("PARAM", split_fun = drop_split_levels, label_pos = "topleft", split_label = lbl_vs_assessment) %>%
    count_abnormal(
      "ANRIND",
      abnormal = list(Low = "LOW", High = "HIGH"),
      variables = list(id = "USUBJID", baseline = "BNRIND"),
      exclude_base_abn = exclude_base_abn
    ) %>%
    append_topleft(paste0(" ", lbl_vs_abnormality))
}

#' @describeIn egt02_1 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
egt02_pre <- function(adam_db, ...) {
  assert_all_tablenames(adam_db, c("adsl", "adeg"))
  adam_db$adeg <- adam_db$adeg %>%
    mutate(ANRIND = factor(.data$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))) %>%
    filter(!is.na(.data$ANRIND)) %>%
    filter(.data$ONTRTFL == "Y")

  adam_db
}

#' @describeIn egt02_1 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
egt02_post <- function(tlg, ...) {
  std_postprocess(tlg)
}

#' `EGT02` ECG Abnormalities Table.
#'
#' ECG Parameters outside Normal Limits Regardless of Abnormality at Baseline Table.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(egt02_1, syn_data)
egt02_1 <- chevron_t(
  main = egt02_1_main,
  preprocess = egt02_pre,
  postprocess = egt02_post
)

# egt02_2 ----

#' @describeIn egt02_2 Main TLG function
#'
#' @inherit egt02_1_main
#'
#' @export
#'
egt02_2_main <- modify_default_args(egt02_1_main, exclude_base_abn = TRUE)

#' `EGT02_2` ECG Abnormalities Table.
#'
#' ECG Parameters outside Normal Limits Among Patients without Abnormality at Baseline Table.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(egt02_2, syn_data)
egt02_2 <- chevron_t(
  main = egt02_2_main,
  preprocess = egt02_pre,
  postprocess = egt02_post
)

# lbt06 ----

#' @describeIn lbt06 Main TLG function
#'
#' @inheritParams gen_args
#' @param arm_var (`string`) the arm variable used for arm splitting.
#'
#' @details
#'  * Only count `"LOW"` or `"HIGH"` values for `ANRIND` and `BNRIND`.
#'  * Lab test results with missing `ANRIND` values are excluded.
#'  * Split columns by arm, typically `ACTARM`.
#'  * Keep zero count rows by default.
#'
#' @note
#'  * `adam_db` object must contain an `adlb` table with columns `"AVISIT"`, `"ANRIND"`, `"BNRIND"`,
#'  `"ONTRTFL"`, and `"PARCAT2"`, and column specified by `arm_var`.
#'
#' @export
#'
lbt06_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       page_var = "PARAMCD",
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adlb"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_subset(page_var, "PARAMCD")
  assert_valid_variable(adam_db$adlb, c(arm_var, "PARAMCD", "PARAM", "AVISIT"), types = list("characater", "factor"))
  assert_valid_variable(adam_db$adlb, c("ANRIND", "BNRIND"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_param <- var_labels_for(adam_db$adlb, "PARAM")
  lbl_visit <- var_labels_for(adam_db$adlb, "AVISIT")
  lbl_anrind <- var_labels_for(adam_db$adlb, "ANRIND")
  lbl_bnrind <- var_labels_for(adam_db$adlb, "BNRIND")

  lyt <- lbt06_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_param = lbl_param,
    lbl_visit = lbl_visit,
    lbl_anrind = lbl_anrind,
    lbl_bnrind = lbl_bnrind,
    visitvar = "AVISIT",
    anrind_var = "ANRIND",
    bnrind_var = "BNRIND",
    page_var = page_var
  )

  tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)

  tbl
}

#' `lbt06` Layout
#'
#' @inheritParams gen_args
#'
#' @param lbl_param (`string`) text label of the `PARAM` variable.
#' @param lbl_visit (`string`) text label of the `AVISIT` variable.
#' @param lbl_anrind (`string`) text label of the `ANRIND` variable.
#' @param lbl_bnrind (`string`) text label of the `BNRIND` variable.
#' @param param (`string`) the variable for parameter code.
#' @param anrind_var (`string`) the variable for analysis reference range indicator.
#' @param bnrind_var (`string`) the variable for baseline reference range indicator.
#'
#' @keywords internal
#'
lbt06_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_param,
                      lbl_visit,
                      lbl_anrind,
                      lbl_bnrind,
                      visitvar,
                      anrind_var,
                      bnrind_var,
                      page_var) {
  page_by <- !is.null(page_var)
  label_pos <- ifelse(page_by, "hidden", "topleft")
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by(
      var = "PARAMCD",
      labels_var = "PARAM",
      split_fun = drop_split_levels,
      label_pos = label_pos,
      split_label = lbl_param,
      page_by = page_by
    ) %>%
    split_rows_by(
      var = visitvar,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_visit
    ) %>%
    count_abnormal_by_baseline(
      var = anrind_var,
      abnormal = c(Low = "LOW", High = "HIGH"),
      variables = list(id = "USUBJID", baseline = bnrind_var),
      .indent_mods = 4L
    ) %>%
    append_topleft(paste0(stringr::str_dup(" ", 2L * (2 - page_by)), lbl_anrind)) %>%
    append_topleft(paste0(stringr::str_dup(" ", 2L * (7 - page_by)), lbl_bnrind))
}

#' @describeIn lbt06 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt06_pre <- function(adam_db, ...) {
  missing_rule <- rule("<Missing>" = c("", NA, "<Missing>"))

  adam_db$adlb <- adam_db$adlb %>%
    filter(
      .data$ONTRTFL == "Y",
      .data$PARCAT2 == "SI"
    ) %>%
    mutate(
      across(all_of(c("ANRIND", "BNRIND")), ~ reformat(.x, .env$missing_rule)),
      AVISIT = reorder(.data$AVISIT, .data$AVISITN),
      AVISIT = with_label(.data$AVISIT, "Visit"),
      ANRIND = with_label(.data$ANRIND, "Abnormality at Visit"),
      BNRIND = with_label(.data$BNRIND, "Baseline Status")
    )

  adam_db
}

#' @describeIn lbt06 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt06_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `LBT06` Table 1 (Default) Laboratory Abnormalities by Visit and Baseline Status Table 1.
#'
#' The `LBT06` table produces the standard laboratory abnormalities by visit and
#' baseline status summary.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(lbt06, syn_data)
lbt06 <- chevron_t(
  main = lbt06_main,
  preprocess = lbt06_pre,
  postprocess = lbt06_post
)

# aet01 ----

#' @describeIn aet01 Main TLG function
#'
#' @inheritParams gen_args
#' @param anl_vars Named (`list`) of (`character`) variables the safety variables to be summarized.
#' @param anl_lbls (`character`) of analysis labels.
#'
#' @details
#'  * Does not remove rows with zero counts by default.
#'
#' @note
#'  * `adam_db` object must contain an `adsl` table with the `"DTHFL"` and `"DCSREAS"` columns.
#'  * `adam_db` object must contain an `adae` table with the columns passed to `anl_vars`.
#'
#' @export
#'
aet01_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       anl_vars = list(
                         safety_var = c(
                           "FATAL", "SER", "SERWD", "SERDSM",
                           "RELSER", "WD", "DSM", "REL", "RELWD", "RELDSM", "SEV"
                         )
                       ),
                       anl_lbls = "Total number of {patient_label} with at least one",
                       ...) {
  assert_all_tablenames(adam_db, "adsl", "adae")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_list(anl_vars, types = "character", names = "unique")
  assert_character(anl_lbls, min.chars = 1L)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("DTHFL", "DCSREAS"), types = list(c("character", "factor")), min_chars = 0L)
  assert_valid_variable(adam_db$adae, c(arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, unlist(anl_vars), types = list("logical"), na_ok = TRUE, empty_ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  anl_lbls <- render_safe(anl_lbls)
  if (length(anl_lbls) == 1) {
    anl_lbls <- rep(anl_lbls, length(anl_vars))
  }
  lbl_vars <- lapply(
    anl_vars,
    var_labels_for,
    df = adam_db$adae
  )

  lyts <- aet01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    anl_vars = anl_vars,
    anl_lbls = anl_lbls,
    lbl_vars = lbl_vars
  )

  rbind(
    build_table(lyts$ae1, adam_db$adae, alt_counts_df = adam_db$adsl),
    build_table(lyts$adsl, adam_db$adsl, alt_counts_df = adam_db$adsl),
    build_table(lyts$ae2, adam_db$adae, alt_counts_df = adam_db$adsl)
  )
}

#' `aet01` Layout
#'
#' @inheritParams aet01_main
#' @param anl_vars Named (`list`) of analysis variables.
#' @param anl_lbls (`character`) of labels.
#' @param lbl_vars Named (`list`) of analysis labels.
#' @keywords internal
#'
aet01_lyt <- function(arm_var,
                      lbl_overall,
                      anl_vars,
                      anl_lbls,
                      lbl_vars) {
  lyt_base <- basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall)
  lyt_ae1 <- lyt_base %>%
    analyze_num_patients(
      vars = "USUBJID",
      .stats = c("unique", "nonunique"),
      .labels = c(
        unique = render_safe("Total number of {patient_label} with at least one AE"),
        nonunique = "Total number of AEs"
      ),
      .formats = list(unique = format_count_fraction_fixed_dp, nonunique = "xx"),
      show_labels = "hidden"
    )
  lyt_adsl <- lyt_base %>%
    count_patients_with_event(
      "USUBJID",
      filters = c("DTHFL" = "Y"),
      denom = "N_col",
      .labels = c(count_fraction = "Total number of deaths"),
      table_names = "TotDeath"
    ) %>%
    count_patients_with_event(
      "USUBJID",
      filters = c("DCSREAS" = "ADVERSE EVENT"),
      denom = "N_col",
      .labels = c(count_fraction = render_safe("Total number of {patient_label} withdrawn from study due to an AE")),
      table_names = "TotWithdrawal"
    )

  lyt_ae2 <- lyt_base %>%
    count_patients_recursive(
      anl_vars = anl_vars,
      anl_lbls = anl_lbls,
      lbl_vars = lbl_vars
    )
  return(list(ae1 = lyt_ae1, ae2 = lyt_ae2, adsl = lyt_adsl))
}

#' @describeIn aet01 Preprocessing
#'
#' @inheritParams aet01_main
#'
#' @export
#'
aet01_pre <- function(adam_db, ...) {
  adam_db$adae <- adam_db$adae %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      FATAL = with_label(.data$AESDTH == "Y", "AE with fatal outcome"),
      SER = with_label(.data$AESER == "Y", "Serious AE"),
      SEV = with_label(.data$ASEV == "SEVERE", "Severe AE (at greatest intensity)"),
      REL = with_label(.data$AREL == "Y", "Related AE"),
      WD = with_label(.data$AEACN == "DRUG WITHDRAWN", "AE leading to withdrawal from treatment"),
      DSM = with_label(
        .data$AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED"),
        "AE leading to dose modification/interruption"
      ),
      SERWD = with_label(.data$SER & .data$WD, "Serious AE leading to withdrawal from treatment"),
      SERDSM = with_label(.data$SER & .data$DSM, "Serious AE leading to dose modification/interruption"),
      RELSER = with_label(.data$SER & .data$REL, "Related Serious AE"),
      RELWD = with_label(.data$REL & .data$WD, "Related AE leading to withdrawal from treatment"),
      RELDSM = with_label(.data$REL & .data$DSM, "Related AE leading to dose modification/interruption"),
      CTC35 = with_label(.data$ATOXGR %in% c("3", "4", "5"), "Grade 3-5 AE"),
      CTC45 = with_label(.data$ATOXGR %in% c("4", "5"), "Grade 4/5 AE")
    )

  adam_db$adsl <- adam_db$adsl %>%
    mutate(DCSREAS = reformat(.data$DCSREAS, missing_rule))

  adam_db
}

#' @describeIn aet01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet01_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `AET01` Table 1 (Default) Overview of Deaths and Adverse Events Summary Table 1.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(aet01, syn_data, arm_var = "ARM")
aet01 <- chevron_t(
  main = aet01_main,
  preprocess = aet01_pre,
  postprocess = aet01_post
)

# egt05_qtcat ----

#' @describeIn egt05_qtcat Main TLG function
#'
#' @inheritParams gen_args
#' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in `adeg`
#'   table of `adam_db` is used as name.
#'
#' @details
#'  * The `Value at Visit` column, displays the categories of the specific `"PARAMCD"` value for patients.
#'  * The `Change from Baseline` column, displays the categories of the specific `"PARAMCD"` value
#'  change from baseline for patients.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm, typically `"ACTARM"`.
#'  * Does not include a total column by default.
#'  * Sorted based on factor level; by chronological time point given by `"AVISIT"`
#'  or user-defined visit incorporating `"ATPT"`.
#'  Re-level to customize order.
#'  * Please note that it is preferable to convert `summaryvars` to factor.
#'
#' @note
#'  * `adam_db` object must contain an `adeg` table with column specified in `visitvar`.
#'  For `summaryvars`, please make sure `AVALCAT1` and `CHGCAT1` columns existed in input data sets.
#'
#' @export
#'
egt05_qtcat_main <- function(adam_db,
                             arm_var = "ACTARM",
                             lbl_overall = NULL,
                             summaryvars = c("AVALCAT1", "CHGCAT1"),
                             row_split_var = NULL,
                             visitvar = "AVISIT",
                             page_var = NULL,
                             ...) {
  assert_all_tablenames(adam_db, c("adsl", "adeg"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_character(summaryvars)
  assert_character(row_split_var, null.ok = TRUE)
  assert_string(visitvar)
  assert_string(page_var, null.ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)
  assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adeg, c("PARAM", "PARAMCD"), types = list(c("character", "factor")), na_ok = FALSE)
  assert_valid_variable(adam_db$adeg, visitvar, types = list("character", "factor"))
  assert_disjunct(row_split_var, c("PARAMCD", "PARAM", visitvar))
  assert_valid_variable(adam_db$adeg, summaryvars, types = list(c("factor", "character")), na_ok = TRUE)
  assert_subset(page_var, c(row_split_var, "PARAMCD"))

  lbl_overall <- render_safe(lbl_overall)
  lbl_avisit <- var_labels_for(adam_db$adeg, visitvar)
  lbl_param <- var_labels_for(adam_db$adeg, "PARAM")
  summaryvars_lbls <- var_labels_for(adam_db$adeg, summaryvars) # Value at visit / change from baseline
  row_split_lbl <- var_labels_for(adam_db$adeg, row_split_var)

  lyt <- egt05_qtcat_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_avisit = lbl_avisit,
    lbl_param = lbl_param,
    lbl_cat = "Category",
    summaryvars = summaryvars,
    summaryvars_lbls = summaryvars_lbls,
    row_split_var = row_split_var,
    row_split_lbl = row_split_lbl,
    visitvar = visitvar,
    page_var = page_var
  )

  build_table(
    lyt,
    df = adam_db$adeg,
    alt_counts_df = adam_db$adsl
  )
}

#' `EGT05_QTCAT` Layout
#'
#' @inheritParams gen_args
#'
#' @param lbl_avisit (`string`) label of the `visitvar` variable.
#' @param lbl_param (`string`) label of the `PARAM` variable.
#' @param lbl_cat (`string`) label of the Category of `summaryvars` variable. Default as `Category`.
#' @param summaryvars (`character`) the variables to be analyzed. `AVALCAT1` and `CHGCAT1` by default.
#' @param summaryvars_lbls (`character`) the label of the variables to be analyzed.
#' @param visitvar (`string`) typically `"AVISIT"` or user-defined visit incorporating `"ATPT"`.
#'
#' @keywords internal
#'
egt05_qtcat_lyt <- function(arm_var,
                            lbl_overall,
                            lbl_avisit,
                            lbl_param,
                            lbl_cat,
                            summaryvars,
                            summaryvars_lbls,
                            row_split_var,
                            row_split_lbl,
                            visitvar,
                            page_var) {
  page_by <- get_page_by(page_var, c(row_split_var, "PARAMCD"))
  label_pos <- ifelse(page_by, "hidden", "topleft")
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by_recurive(
      row_split_var,
      split_label = row_split_lbl,
      label_pos = head(label_pos, -1L), page_by = head(page_by, -1L)
    ) %>%
    split_rows_by(
      var = "PARAMCD",
      labels_var = "PARAM",
      split_fun = drop_split_levels,
      label_pos = tail(label_pos, 1L),
      split_label = lbl_param,
      page_by = tail(page_by, 1L)
    ) %>%
    split_rows_by(
      visitvar,
      split_fun = drop_split_levels,
      split_label = lbl_avisit,
      label_pos = "topleft"
    ) %>%
    summarize_vars_allow_na(
      vars = summaryvars,
      var_labels = summaryvars_lbls,
      inclNAs = FALSE
    ) %>%
    append_topleft(paste0(stringr::str_dup(" ", sum(!page_by) * 2 + 2), lbl_cat))
}

#' @describeIn egt05_qtcat Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
egt05_qtcat_pre <- function(adam_db, ...) {
  adam_db$adeg <- adam_db$adeg %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      AVALCAT1 = reformat(.data$AVALCAT1, empty_rule),
      CHGCAT1 = reformat(.data$CHGCAT1, empty_rule),
      AVISIT = reorder(.data$AVISIT, .data$AVISITN),
      AVISIT = with_label(.data$AVISIT, "Analysis Visit")
    )
  adam_db
}

#' @describeIn egt05_qtcat Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
egt05_qtcat_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) tlg <- smart_prune(tlg)
  std_postprocess(tlg)
}

#' `EGT05_QTCAT` ECG Actual Values and Changes from Baseline by Visit Table.
#'
#' The `EGT05_QTCAT` table summarizes several electrocardiogram parameters and their evolution
#' throughout the study.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(egt05_qtcat, syn_data)
egt05_qtcat <- chevron_t(
  main = egt05_qtcat_main,
  preprocess = egt05_qtcat_pre,
  postprocess = egt05_qtcat_post
)

# aet05 ----

#' @describeIn aet05 Main TLG function
#'
#' @inheritParams gen_args
#' @param arm_var (`string`) the arm variable used for arm splitting.
#' @param ... Further arguments passed to `tern::control_incidence_rate()`.
#'
#' @details
#'  * Total patient-years at risk is the sum over all patients of the time intervals (in years).
#'  * Split columns by arm, typically `ACTARM`.
#'  * Split rows by parameter code.
#'  * `AVAL` is patient-years at risk.
#'  * `n_events` is the number of adverse events observed.
#'  * The table allows confidence level to be adjusted, default is 95%.
#'  * Keep zero count rows by default.
#'
#' @note
#'  * `adam_db` object must contain an `adaette` table with the columns `"PARAMCD"`, `"PARAM"`, `"AVAL"`, and `"CNSR"`.
#'
#' @export
#'
aet05_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adaette"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adaette, c("USUBJID", arm_var, "PARAMCD", "PARAM"),
    types = list(c("character", "factor"))
  )
  assert_valid_variable(adam_db$adaette, "AVAL", types = list("numeric"), lower = 0, na_ok = TRUE)
  assert_valid_variable(adam_db$adaette, "n_events", types = list("numeric"), integerish = TRUE, lower = 0L)
  assert_valid_var_pair(adam_db$adsl, adam_db$adaette, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  control <- execute_with_args(control_incidence_rate, ...)

  lyt <- aet05_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    param_label = "PARAM",
    vars = "AVAL",
    n_events = "n_events",
    control = control
  )

  tbl <- build_table(lyt, adam_db$adaette, alt_counts_df = adam_db$adsl)

  tbl
}

#' `aet05` Layout
#'
#' @inheritParams gen_args
#' @param param_label (`string`) variable for parameter code.
#' @param vars (`string`) variable for the primary analysis variable to be iterated over.
#' @param n_events (`string`) variable to count the number of events observed.
#' @param control (`list`) parameters for estimation details, specified by using the helper function
#' control_incidence_rate().
#'
#' @keywords internal
#'
aet05_lyt <- function(arm_var,
                      lbl_overall,
                      param_label,
                      vars,
                      n_events,
                      control) {
  lyt <- basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by(param_label, split_fun = drop_split_levels) %>%
    estimate_incidence_rate(
      vars = vars,
      n_events = n_events,
      control = control
    )
}

#' @describeIn aet05 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet05_pre <- function(adam_db, ...) {
  adam_db$adaette <- adam_db$adaette %>%
    filter(grepl("AETTE", .data$PARAMCD)) %>%
    mutate(
      n_events = as.integer(.data$CNSR == 0)
    )

  adam_db
}

#' @describeIn aet05 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet05_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `AET05` Table 1 (Default) Adverse Event Rate Adjusted for Patient-Years at Risk - First Occurrence.
#'
#' The `AET05` table produces the standard adverse event rate adjusted for patient-years at risk summary
#' considering first occurrence.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' proc_data <- log_filter(syn_data, PARAMCD == "AETTE1", "adaette")
#'
#' run(aet05, proc_data)
#'
#' run(aet05, proc_data, conf_level = 0.90, conf_type = "exact")
aet05 <- chevron_t(
  main = aet05_main,
  preprocess = aet05_pre,
  postprocess = aet05_post,
  adam_datasets = c("adsl", "adaette")
)

# mng01 ----

#' @describeIn mng01 Main TLG Function
#'
#' @details
#'  * No overall value.
#'  * Preprocessing filters for `ANL01FL` in the selected data set.
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#' @param x_var (`string`) the name of a column in the `dataset` to represent on the x-axis.
#' @param y_var (`string`) the name of the variable to be represented on the y-axis.
#' @param y_name (`string`) the variable name for `y`. Used for plot's subtitle.
#' @param y_unit (`string`) the name of the variable with the units of `y`. Used for plot's subtitle. if `NULL`, only
#'   `y_name` is displayed as subtitle.
#' @param center_fun (`string`) the function to compute the estimate value.
#' @param interval_fun (`string`) the function defining the crossbar range.
#' @param show_table (`flag`) should the summary statistic table be displayed.
#' @param show_n (`flag`) should the number of observation be displayed int the table.
#' @param jitter (`numeric`) the width of spread for data points on the x-axis; a number from 0 (no `jitter`) to 1 (high
#'   `jitter`), with a default of 0.3 (slight `jitter`).
#' @param show_h_grid (`flag`) should horizontal grid be displayed.
#' @param show_v_grid (`flag`) should vertical grid be displayed.
#' @param legend_pos (`string`) the position of the legend.
#' @param line_col (`character`) describing the colors to use for the lines or a named `character` associating values of
#'   `arm_var` with color names.
#'
#' @note
#'  * `adam_db` object must contain the table specified by `dataset` with the columns specified by `x_var`, `y_var`,
#'  `y_name`, `y_unit` and `arm_var`.
#'
#' @return a list of `ggplot` objects.
#'
#' @export
#'
mng01_main <- function(adam_db,
                       dataset = "adlb",
                       x_var = "AVISIT",
                       y_var = "AVAL",
                       y_name = "PARAM",
                       y_unit = NULL,
                       arm_var = "ACTARM",
                       center_fun = "mean",
                       interval_fun = "mean_ci",
                       show_table = TRUE,
                       jitter = 0.3,
                       show_n = TRUE,
                       show_h_grid = TRUE,
                       show_v_grid = FALSE,
                       legend_pos = "top",
                       line_col = nestcolor::color_palette(),
                       ...) {
  assert_all_tablenames(adam_db, c(dataset, "adsl"))
  assert_character(x_var)
  assert_string(y_var)
  assert_string(y_name)
  assert_string(y_unit, null.ok = TRUE)
  assert_string(arm_var)
  assert_string(center_fun)
  assert_string(interval_fun)
  assert_names(center_fun, subset.of = c("mean", "median"))
  assert_choice(interval_fun, c("mean_ci", "mean_sei", "mean_sdi", "median_ci", "quantiles", "range"))
  assert_flag(show_table)
  assert_number(jitter, lower = 0, upper = 1)
  assert_flag(show_n)
  assert_flag(show_h_grid)
  assert_flag(show_v_grid)
  assert_choice(legend_pos, c("top", "bottom", "right", "left"))
  assert_character(line_col, null.ok = TRUE)
  assert_valid_variable(adam_db[[dataset]], x_var)
  assert_valid_variable(adam_db[[dataset]], y_var, types = list(c("numeric")))
  assert_valid_variable(adam_db[[dataset]], y_unit, types = list(c("character", "factor")))
  assert_valid_variable(adam_db[[dataset]], arm_var, types = list(c("character", "factor")), na_ok = FALSE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db[[dataset]], "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)

  df <- adam_db[[dataset]]
  line_col <- unlist(line_col)

  data_ls <- split(df, df$PARAM, drop = TRUE)
  x_var <- paste(x_var, collapse = "_")

  whiskers_fun <- switch(interval_fun,
    "mean_ci" = c("mean_ci_lwr", "mean_ci_upr"),
    "mean_sei" = c("mean_sei_lwr", "mean_sei_upr"),
    "mean_sdi" = c("mean_sdi_lwr", "mean_sdi_upr"),
    "median_ci" = c("median_ci_lwr", "median_ci_upr"),
    "quantiles" = c("quantiles_0.25", "quantile_0.75"),
    "range" = c("min", "max")
  )

  y_unit <- if (is.null(y_unit)) NA else y_unit
  variables <- c(
    x = x_var,
    y = y_var,
    strata = arm_var,
    paramcd = y_name,
    y_unit = y_unit
  )

  n_func <- if (show_n) "n" else NULL

  table <- if (show_table) c(n_func, center_fun, interval_fun) else NULL

  ggtheme <- ggplot2::theme_bw() +
    ggplot2::theme(legend.position = legend_pos) +
    ggplot2::theme(axis.title.x = ggplot2::element_blank())

  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(linewidth = 1))
  }

  ggtheme <- if (!show_h_grid) {
    ggtheme + ggplot2::theme(
      panel.grid.minor.y = ggplot2::element_blank(),
      panel.grid.major.y = ggplot2::element_blank()
    )
  } else {
    ggtheme + ggplot2::theme(
      panel.grid.minor.y = ggplot2::element_line(linewidth = 1),
      panel.grid.major.y = ggplot2::element_line(linewidth = 1)
    )
  }

  if (!is.null(names(line_col))) {
    color_lvl <- sort(unique(df[[arm_var]]))
    col <- line_col[as.character(color_lvl)]

    if (anyNA(col)) {
      missing_col <- setdiff(color_lvl, names(col))
      stop(paste("Missing color matching for", toString(missing_col)))
    }

    col <- unname(col)
  } else {
    col <- line_col
  }

  ret <- lapply(
    data_ls,
    tern::g_lineplot,
    alt_count = adam_db[["adsl"]],
    variables = variables,
    mid = center_fun,
    interval = interval_fun,
    whiskers = whiskers_fun,
    position = ggplot2::position_dodge(width = jitter),
    title = NULL,
    table = table,
    ggtheme = ggtheme,
    col = col,
    subtitle_add_unit = !is.na(y_unit)
  )
  do_call(gg_list, ret)
}

#' @describeIn mng01 Preprocessing
#'
#' @inheritParams mng01_main
#'
#' @export
#'
mng01_pre <- function(adam_db, dataset, x_var = "AVISIT", ...) {
  adam_db[[dataset]] <- adam_db[[dataset]] %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      AVISIT = reorder(.data$AVISIT, .data$AVISITN),
      AVISIT = with_label(.data$AVISIT, "Visit")
    )

  dunlin::ls_unite(adam_db, dataset, cols = x_var, sep = "_")
}

# `mng01` Pipeline ----

#' `MNG01` Mean Plot Graph.
#'
#' Overview of a summary statistics across time and arm for a selected data set.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' col <- c(
#'   "A: Drug X" = "black",
#'   "B: Placebo" = "blue",
#'   "C: Combination" = "gray"
#' )
#'
#' run(mng01, syn_data, dataset = "adlb", x_var = c("AVISIT", "AVISITN"), line_col = col)
mng01 <- chevron_g(
  main = mng01_main,
  preproces = mng01_pre
)

# vst02_1 ----

#' @describeIn vst02_1 Main TLG function
#'
#' @inheritParams gen_args
#' @param exclude_base_abn (`flag`) whether baseline abnormality should be excluded.
#'
#' @details
#'   * Only count LOW or HIGH values.
#'   * Results of "LOW LOW" are treated as the same as "LOW", and "HIGH HIGH" the same as "HIGH".
#'   * Does not include a total column by default.
#'   * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.
#'
#' @note
#'   * `adam_db` object must contain an `advs` table with the `"PARAM"`, `"ANRIND"` and `"BNRIND"` columns.
#'
#' @export
#'
vst02_1_main <- function(adam_db,
                         arm_var = "ACTARM",
                         lbl_overall = NULL,
                         exclude_base_abn = FALSE,
                         ...) {
  assert_all_tablenames(adam_db, "adsl", "advs")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_flag(exclude_base_abn)
  assert_valid_variable(adam_db$advs, c(arm_var, "PARAM", "ANRIND", "BNRIND"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$advs, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$advs, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_vs_assessment <- var_labels_for(adam_db$advs, "PARAM")
  lbl_vs_abnormality <- var_labels_for(adam_db$advs, "ANRIND")

  lyt <- vst02_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    exclude_base_abn = exclude_base_abn,
    lbl_vs_assessment = lbl_vs_assessment,
    lbl_vs_abnormality = lbl_vs_abnormality
  )

  tbl <- build_table(lyt, adam_db$advs, alt_counts_df = adam_db$adsl)

  tbl
}

#' `vst02_1` Layout
#'
#' @inheritParams gen_args
#' @param lbl_vs_assessment (`string`) the label of the assessment variable.
#' @param lbl_vs_abnormality (`string`) the label of the abnormality variable.
#' @param exclude_base_abn (`flag`) whether to exclude subjects with baseline abnormality from numerator and
#'   denominator.
#'
#' @keywords internal
#'
vst02_lyt <- function(arm_var,
                      lbl_overall,
                      exclude_base_abn,
                      lbl_vs_assessment,
                      lbl_vs_abnormality) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by("PARAM", split_fun = drop_split_levels, label_pos = "topleft", split_label = lbl_vs_assessment) %>%
    count_abnormal(
      "ANRIND",
      abnormal = list(Low = "LOW", High = "HIGH"),
      variables = list(id = "USUBJID", baseline = "BNRIND"),
      exclude_base_abn = exclude_base_abn
    ) %>%
    append_topleft(paste0(" ", lbl_vs_abnormality))
}

#' @describeIn vst02_1 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
vst02_pre <- function(adam_db, ...) {
  high_low_format <- rule(
    HIGH = c("HIGH HIGH", "HIGH"),
    LOW = c("LOW LOW", "LOW")
  )

  adam_db$advs <- adam_db$advs %>%
    filter(.data$ONTRTFL == "Y") %>%
    mutate(
      PARAM = with_label(.data$PARAM, "Assessment"),
      ANRIND = with_label(reformat(.data$ANRIND, high_low_format), "Abnormality"),
      BNRIND = reformat(.data$BNRIND, high_low_format)
    )

  adam_db
}

#' @describeIn vst02_1 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
vst02_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `VST02` Vital Sign Abnormalities Table.
#'
#' Vital Sign Parameters outside Normal Limits Regardless of Abnormality at Baseline.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(vst02_1, syn_data)
vst02_1 <- chevron_t(
  main = vst02_1_main,
  preprocess = vst02_pre,
  postprocess = vst02_post
)

# vst02_2 ----

#' @describeIn vst02_2 Main TLG function
#'
#' @inherit vst02_1_main
#'
#' @export
#'
vst02_2_main <- modify_default_args(vst02_1_main, exclude_base_abn = TRUE)
#' `VST02` Vital Sign Abnormalities Table.
#'
#' Vital Sign Parameters outside Normal Limits Among Patients without Abnormality at Baseline.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(vst02_2, syn_data)
vst02_2 <- chevron_t(
  main = vst02_2_main,
  preprocess = vst02_pre,
  postprocess = vst02_post
)

# egt03 ----
#' @describeIn egt03 Main TLG function
#'
#' @param arm_var (`character`) the arm variables used for row split, typically `"ACTARMCD"`.
#' @param summaryvar (`character`) variables to be analyzed, typically `"BNRIND"`. Labels of the corresponding columns
#'   are used as subtitles.
#' @param splitvar (`character`) variables to be analyzed, typically `"ANRIND"`. Labels of the corresponding columns are
#'   used as subtitles.
#'
#' @details
#'  * `ADEG` data are subsetted to contain only "POST-BASELINE MINIMUM"/"POST-BASELINE MAXIMUM" visit
#'  according to the preprocessing.
#'  * Percentages are based on the total number of patients in a treatment group.
#'  * Split columns by Analysis Reference Range Indicator, typically `ANRIND`.
#'  * Does not include a total column by default.
#'  * Sorted  based on factor level.
#'
#' @note
#'  * `adam_db` object must contain an `adeg` table with a `"ACTARMCD"` column as well as columns specified in
#'  `summaryvar` and `splitvar`.
#'
#' @export
#'
egt03_main <- function(adam_db,
                       arm_var = "ACTARMCD",
                       summaryvar = "BNRIND",
                       splitvar = "ANRIND",
                       visitvar = "AVISIT",
                       page_var = "PARAMCD",
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adeg"))
  assert_string(arm_var)
  assert_string(summaryvar)
  assert_string(splitvar)
  assert_string(visitvar)
  assert_string(page_var, null.ok = TRUE)
  assert_subset(page_var, "PARAMCD")
  assert_valid_variable(adam_db$adeg, summaryvar, types = list("character", "factor"))
  assert_valid_variable(adam_db$adeg, c("PARAMCD", "PARAM", splitvar), types = list("character", "factor"))
  assert_single_value(adam_db$adeg[[visitvar]])
  assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)
  assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_single_value(adam_db$adeg$PARAMCD)

  lbl_armvar <- var_labels_for(adam_db$adeg, arm_var)
  lbl_summaryvars <- var_labels_for(adam_db$adeg, summaryvar)
  lbl_splitvar <- var_labels_for(adam_db$adeg, splitvar)
  lbl_param <- var_labels_for(adam_db$adeg, "PARAM")

  lyt <- egt03_lyt(
    arm_var = arm_var,
    splitvar = splitvar,
    summaryvar = summaryvar,
    lbl_armvar = lbl_armvar,
    lbl_summaryvars = lbl_summaryvars,
    lbl_param = lbl_param,
    page_var = page_var
  )
  adam_db$adeg$SPLIT_LABEL <- factor(rep(lbl_splitvar, nrow(adam_db$adeg)), levels = lbl_splitvar)

  tbl <- build_table(
    lyt,
    df = adam_db$adeg
  )

  tbl
}

#' `egt03` Layout
#'
#' @inheritParams gen_args
#' @inheritParams egt03_main
#'
#' @param lbl_armvar (`string`) label of the `arm_var` variable.
#' @param lbl_summaryvars (`string`) label of the `summaryvar` variable.
#'
#' @keywords internal
#'
egt03_lyt <- function(arm_var,
                      splitvar,
                      summaryvar,
                      lbl_armvar,
                      lbl_summaryvars,
                      lbl_param,
                      page_var) {
  page_by <- !is.null(page_var)
  indent <- 2L
  space <- stringr::str_dup(" ", indent * (1L + !page_by))
  lbl_summaryvars <- paste0(space, lbl_summaryvars)

  basic_table(show_colcounts = FALSE) %>%
    split_cols_by("SPLIT_LABEL") %>%
    split_cols_by(splitvar) %>%
    split_rows_by(
      "PARAMCD",
      labels_var = "PARAM",
      page_by = page_by,
      split_fun = drop_split_levels,
      split_label = lbl_param,
      label_pos = if (page_by) "hidden" else "topleft"
    ) %>%
    split_rows_by(arm_var,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_armvar
    ) %>%
    add_rowcounts() %>%
    summarize_vars(summaryvar, denom = "N_row", .stats = "count_fraction") %>%
    append_topleft(lbl_summaryvars)
}

#' @describeIn egt03 Preprocessing
#'
#' @inheritParams gen_args
#' @inheritParams egt03_main
#'
#' @export
#'
egt03_pre <- function(adam_db, ...) {
  adam_db$adeg <- adam_db$adeg %>%
    filter(
      .data$AVISIT == "POST-BASELINE MINIMUM"
    ) %>%
    mutate(BNRIND = factor(
      .data$BNRIND,
      levels = c("LOW", "NORMAL", "HIGH", "Missing"),
      labels = c("LOW", "NORMAL", "HIGH", "Missing")
    )) %>%
    mutate(ANRIND = factor(
      .data$ANRIND,
      levels = c("LOW", "NORMAL", "HIGH", "Missing"),
      labels = c("LOW", "NORMAL", "HIGH", "Missing")
    )) %>%
    mutate(
      BNRIND = with_label(.data$BNRIND, "Baseline Reference Range Indicator"),
      ANRIND = with_label(.data$ANRIND, "Minimum Post-Baseline Assessment")
    )

  adam_db
}

#' @describeIn egt03 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
egt03_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) tlg <- smart_prune(tlg)

  std_postprocess(tlg)
}

#' `EGT03` Shift Table of ECG Interval Data - Baseline versus Minimum or Maximum Post-Baseline
#'
#' The `EGT03` Table entries provide the number of patients by baseline assessment and minimum or maximum post-baseline
#' assessment. Percentages are based on the total number of patients in a treatment group. Baseline is the patient's
#' last observation prior to initiation of study drug.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dunlin)
#'
#' proc_data <- log_filter(syn_data, PARAMCD == "HR", "adeg")
#' run(egt03, proc_data)
egt03 <- chevron_t(
  main = egt03_main,
  preprocess = egt03_pre,
  postprocess = egt03_post
)

# ael01_nollt ----

#' @describeIn ael01_nollt Main TLG function
#'
#' @inheritParams gen_args
#' @param dataset (`character`) the name of a table in the `adam_db` object.
#' @param default_formatting (`list`) the default format of the listing columns. See [`rlistings::as_listing`].
#' @param col_formatting (`list`) the format of specific listing columns. See [`rlistings::as_listing`].
#'
#' @details
#'  * Removes duplicate rows.
#'  * By default, uses dataset `adae`, sorting by key columns `AEBODSYS` and `AEDECOD`.
#'  * If using with a dataset other than `adae`, be sure to specify the desired labels for variables in
#'    `key_cols` and `disp_cols`, and pre-process missing data.
#'
#' @note
#'  * `adam_db` object must contain the `dataset` table with columns specified by `key_cols` and `disp_cols`.
#'
#' @export
#'
ael01_nollt_main <- function(adam_db,
                             dataset = "adae",
                             key_cols = c("AEBODSYS", "AEDECOD"),
                             disp_cols = "AETERM",
                             default_formatting = list(
                               all = formatters::fmt_config(align = "left"),
                               numeric = formatters::fmt_config(align = "center")
                             ),
                             col_formatting = NULL,
                             ...) {
  assert_all_tablenames(adam_db, dataset)
  assert_valid_variable(adam_db[[dataset]], c(key_cols, disp_cols), label = paste0("adam_db$", dataset))
  assert_list(default_formatting)
  assert_list(col_formatting, null.ok = TRUE)

  as_listing(
    adam_db[[dataset]],
    key_cols = key_cols,
    disp_cols = disp_cols,
    default_formatting = default_formatting,
    col_formatting = col_formatting
  )
}

#' @describeIn ael01_nollt Preprocessing
#'
#' @inheritParams ael01_nollt_main
#'
#' @export
#'
ael01_nollt_pre <- function(adam_db,
                            dataset = "adae",
                            key_cols = c("AEBODSYS", "AEDECOD"),
                            disp_cols = "AETERM",
                            ...) {
  adam_db[[dataset]] <- adam_db[[dataset]] %>%
    select(all_of(c(key_cols, disp_cols))) %>%
    distinct() %>%
    mutate(
      across(all_of(c(key_cols, disp_cols)), ~ reformat(.x, nocoding))
    ) %>%
    arrange(pick(all_of(c(key_cols, disp_cols))))

  adam_db
}

#' @describeIn ael01_nollt Postprocessing
#'
#' @inheritParams gen_args
#'
ael01_nollt_post <- function(tlg, ...) {
  if (nrow(tlg) == 0) tlg <- null_report

  tlg
}

#' `AEL01_NOLLT` Listing 1 (Default) Glossary of Preferred Terms and Investigator-Specified Terms.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(ael01_nollt, syn_data)
ael01_nollt <- chevron_l(
  main = ael01_nollt_main,
  preprocess = ael01_nollt_pre,
  postprocess = ael01_nollt_post
)

# mht01 ----

#' @describeIn mht01 Main TLG function
#'
#' @inheritParams gen_args
#'
#' @details
#'  * Numbers represent absolute numbers of patients and fraction of `N`, or absolute number of event when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Order by body system alphabetically and within body system and medical condition by decreasing total number of
#'  patients with the specific condition.
#'
#' @note
#'   * `adam_db` object must contain an `admh` table with columns `"MHBODSYS"` and `"MHDECOD"`.
#'
#' @export
#'
mht01_main <- function(adam_db,
                       arm_var = "ARM",
                       lbl_overall = NULL,
                       ...) {
  assert_all_tablenames(adam_db, c("admh", "adsl"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_valid_variable(adam_db$admh, c("MHBODSYS", "MHDECOD"), types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_variable(adam_db$admh, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$admh, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_mhbodsys <- var_labels_for(adam_db$admh, "MHBODSYS")
  lbl_mhdecod <- var_labels_for(adam_db$admh, "MHDECOD")

  lyt <- mht01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_mhbodsys = lbl_mhbodsys,
    lbl_mhdecod = lbl_mhdecod
  )

  tbl <- build_table(lyt, adam_db$admh, alt_counts_df = adam_db$adsl)

  tbl
}

#' `mht01` Layout
#'
#' @inheritParams gen_args
#' @inheritParams mht01_main
#' @param lbl_mhbodsys (`string`) label associated with `"MHBODSYS"`.
#' @param lbl_mhdecod (`string`) label associated with `"MHDECOD"`.
#'
#' @keywords internal
#'
mht01_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_mhbodsys,
                      lbl_mhdecod) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = c("unique", "nonunique"),
      .labels = c(
        unique = render_safe("Total number of {patient_label} with at least one condition"),
        nonunique = render_safe("Total number of conditions")
      )
    ) %>%
    split_rows_by(
      "MHBODSYS",
      child_labels = "visible",
      labels_var = "MHBODSYS",
      nested = FALSE,
      indent_mod = -1L,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_mhbodsys
    ) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = c("unique", "nonunique"),
      .labels = c(
        unique = render_safe("Total number of {patient_label} with at least one condition"),
        nonunique = "Total number of conditions"
      )
    ) %>%
    count_occurrences(
      vars = "MHDECOD",
      .indent_mods = -1L
    ) %>%
    append_topleft(paste0("  ", lbl_mhdecod))
}

#' @describeIn mht01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
mht01_pre <- function(adam_db, ...) {
  adam_db$admh <- adam_db$admh %>%
    filter(.data$ANL01FL == "Y")

  adam_db$admh <- adam_db$admh %>%
    mutate(
      across(all_of(c("MHBODSYS", "MHDECOD")), ~ reformat(.x, nocoding))
    ) %>%
    mutate(
      MHBODSYS = with_label(.data$MHBODSYS, "MedDRA System Organ Class"),
      MHDECOD = with_label(.data$MHDECOD, "MedDRA Preferred Term")
    )

  adam_db
}

#' @describeIn mht01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
mht01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }

  tbl_sorted <- tlg %>%
    sort_at_path(
      path = c("MHBODSYS", "*", "MHDECOD"),
      scorefun = score_occurrences
    )

  std_postprocess(tbl_sorted)
}

#' `MHT01` Medical History Table.
#'
#' The `MHT01` table provides an overview of the subjects medical
#' history by SOC and Preferred Term.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(mht01, syn_data)
mht01 <- chevron_t(
  main = mht01_main,
  preprocess = mht01_pre,
  postprocess = mht01_post
)

# ext01 ----

#' @describeIn ext01 Main TLG function
#'
#' @inheritParams gen_args
#' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in `adex`
#'   table of `adam_db` is used as label.
#' @param map (`data.frame`) of mapping for split rows.
#'
#' @details
#'  * Default Exposure table
#'  * The `n` row provides the number of non-missing values. The percentages for categorical variables is based on `n`.
#'  The percentages for `Total number of patients with at least one dose modification` are based on the number of
#'  patients in the corresponding analysis population given by `N`.
#'  * Split columns by arm, typically `ACTARM`.
#'  * Does not include a total column by default.
#'  * Sorted by alphabetic order of the `PARAM` value. Transform to factor and re-level for custom order.
#'  * `ANL01FL` is not relevant subset.
#'
#' @note
#'   * `adam_db` object must contain an `adex` table with columns specified in `summaryvars`.
#'
#' @export
#'
ext01_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       summaryvars = "AVAL",
                       row_split_var = "PARCAT2",
                       page_var = NULL,
                       map = NULL,
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adex"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_character(summaryvars)
  assert_character(row_split_var, null.ok = TRUE)
  assert_string(page_var, null.ok = TRUE)
  assert_data_frame(map, null.ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$adex, arm_var)
  assert_valid_variable(adam_db$adex, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adex, summaryvars, empty_ok = TRUE, na_ok = TRUE)
  assert_valid_variable(
    adam_db$adex, c(row_split_var, "PARAMCD", "PARAM"),
    types = list(c("character", "factor")), empty_ok = TRUE
  )
  assert_valid_variable(adam_db$adex, colnames(map), types = list(c("character", "factor")))
  if (!is.null(map)) {
    map <- infer_mapping(map, adam_db$adex)
  }
  assert_subset(page_var, c(row_split_var))

  lbl_overall <- render_safe(lbl_overall)
  summaryvars_lbls <- var_labels_for(adam_db$adex, summaryvars)
  row_split_lbl <- var_labels_for(adam_db$adex, row_split_var)

  lyt <- ext01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    summaryvars = summaryvars,
    summaryvars_lbls = summaryvars_lbls,
    row_split_var = row_split_var,
    row_split_lbl = row_split_lbl,
    page_var = page_var,
    map = map
  )

  tbl <- build_table(lyt, adam_db$adex, adam_db$adsl)

  tbl
}

#' `ext01` Layout
#'
#' @inheritParams gen_args
#'
#' @param summaryvars (`character`) the name of the variable to be analyzed. By default `"AVAL"`.
#' @param summaryvars_lbls (`character`) the label associated with the analyzed variable.
#'
#' @keywords internal
#'
ext01_lyt <- function(arm_var,
                      lbl_overall,
                      summaryvars,
                      summaryvars_lbls,
                      row_split_var,
                      row_split_lbl,
                      page_var,
                      map) {
  page_by <- get_page_by(page_var, c(row_split_var))
  label_pos <- ifelse(page_by, "hidden", "topleft")
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by_recurive(
      row_split_var,
      split_label = row_split_lbl, label_pos = label_pos, page_by = page_by
    ) %>%
    split_rows_by(
      "PARAMCD",
      labels_var = "PARAM",
      split_fun = split_fun_map(map)
    ) %>%
    summarize_vars(
      vars = summaryvars,
      var_labels = summaryvars_lbls,
      show_labels = "hidden",
      .formats = list(count_fraction = format_count_fraction_fixed_dp)
    )
}

#' @describeIn ext01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
ext01_pre <- function(adam_db,
                      ...) {
  adam_db$adex <- adam_db$adex %>%
    filter(.data$PARCAT1 == "OVERALL") %>%
    filter(.data$PARAMCD %in% c("TDURD", "TDOSE"))

  adam_db
}

#' @describeIn ext01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
ext01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) tlg <- smart_prune(tlg)
  std_postprocess(tlg)
}

#' `EXT01` Exposure Summary Table.
#'
#' The `EXT01` table provides an overview of the of the exposure of the
#' patients in terms of Total dose administered or missed, and treatment duration.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(ext01, syn_data)
#'
#' run(ext01, syn_data, summaryvars = c("AVAL", "AVALCAT1"), prune_0 = FALSE)
#'
#' levels(syn_data$adex$AVALCAT1) <- c(levels(syn_data$adex$AVALCAT1), "12 months")
#' map <- data.frame(
#'   PARAMCD = "TDURD",
#'   AVALCAT1 = c("< 1 month", "1 to <3 months", ">=6 months", "3 to <6 months", "12 months")
#' )
#' run(ext01, syn_data, summaryvars = c("AVAL", "AVALCAT1"), prune_0 = FALSE, map = map)
ext01 <- chevron_t(
  main = ext01_main,
  preprocess = ext01_pre,
  postprocess = ext01_post
)

# pdt02 ----

#' @describeIn pdt02 Main TLG function
#'
#' @inheritParams gen_args
#' @param dvreas_var (`string`) the variable defining the reason for deviation. By default `DVREAS`.
#' @param dvterm_var (`string`) the variable defining the protocol deviation term. By default `DVTERM`.
#'
#' @details
#'  * Data should be filtered for major protocol deviations related to epidemic/pandemic.
#'  `(AEPRELFL == "Y" & DVCAT == "MAJOR")`.
#'  * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Sort by deviation reason alphabetically and within deviation reason by decreasing total number of patients with
#'  the specific deviation term.
#'
#' @note
#'  * `adam_db` object must contain an `addv` table with the columns specified in `dvreas_var` and `dvterm_var`.
#'
#' @export
#'
pdt02_main <- function(adam_db,
                       arm_var = "ARM",
                       lbl_overall = NULL,
                       dvreas_var = "DVREAS",
                       dvterm_var = "DVTERM",
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "addv"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_string(dvreas_var)
  assert_string(dvterm_var)
  assert_valid_variable(adam_db$addv, c(dvreas_var, dvterm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$addv, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$addv, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_dvreas_var <- var_labels_for(adam_db$addv, dvreas_var)
  lbl_dvterm_var <- var_labels_for(adam_db$addv, dvterm_var)

  lyt <- pdt02_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_dvreas_var = lbl_dvreas_var,
    lbl_dvterm_var = lbl_dvterm_var,
    dvreas_var = dvreas_var,
    dvterm_var = dvterm_var
  )

  tbl <- build_table(lyt, adam_db$addv, alt_counts_df = adam_db$adsl)

  tbl
}

#' `pdt02` Layout
#'
#' @inheritParams gen_args
#' @inheritParams pdt02_main
#' @param lbl_dvreas_var (`string`) label for the variable defining the reason for deviation.
#' @param lbl_dvterm_var (`string`) label for the variable defining the protocol deviation term.
#'
#' @keywords internal
#'
pdt02_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_dvreas_var,
                      lbl_dvterm_var,
                      dvreas_var,
                      dvterm_var) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    analyze_num_patients(
      vars = "USUBJID",
      .stats = c("unique", "nonunique"),
      .labels = c(
        unique = render_safe(
          "Total number of {patient_label} with at least one major protocol deviation related to epidemic/pandemic"
        ),
        nonunique = "Total number of major protocol deviations related to epidemic/pandemic"
      )
    ) %>%
    split_rows_by(
      dvreas_var,
      nested = FALSE,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_dvreas_var
    ) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = "unique",
      .labels = NULL
    ) %>%
    count_occurrences(
      vars = dvterm_var,
      id = "USUBJID"
    ) %>%
    append_topleft(paste(" ", lbl_dvterm_var))
}

#' @describeIn pdt02 Preprocessing
#'
#' @inheritParams pdt02_main
#'
#' @export
#'
pdt02_pre <- function(adam_db,
                      ...) {
  adam_db$addv <- adam_db$addv %>%
    mutate(across(all_of(c("DVCAT", "AEPRELFL")), ~ reformat(.x, missing_rule))) %>%
    filter(.data$DVCAT == "MAJOR" & .data$AEPRELFL == "Y") %>%
    mutate(across(all_of(c("DVREAS", "DVTERM")), ~ reformat(.x, nocoding))) %>%
    mutate(
      DVREAS = with_label(.data$DVREAS, "Primary Reason"),
      DVTERM = with_label(.data$DVTERM, "Description")
    )

  adam_db
}

#' @describeIn pdt02 Postprocessing
#'
#' @inheritParams pdt02_main
#' @inheritParams gen_args
#'
#' @export
#'
pdt02_post <- function(tlg, prune_0 = TRUE, dvreas_var = "DVREAS", dvterm_var = "DVTERM", ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }

  tbl_sorted <- tlg %>%
    sort_at_path(
      path = c(dvreas_var, "*", dvterm_var),
      scorefun = score_occurrences
    )

  std_postprocess(tbl_sorted)
}

#' `pdt02` Major Protocol Deviations Related to Epidemic/Pandemic Table.
#'
#' A major protocol deviations
#' table with the number of subjects and the total number of Major Protocol Deviations Related
#' to Epidemic/Pandemic sorted alphabetically and deviations name sorted by frequencies.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(pdt02, syn_data)
pdt02 <- chevron_t(
  main = pdt02_main,
  preprocess = pdt02_pre,
  postprocess = pdt02_post
)

# lbt07 ----

#' @describeIn lbt07 Main TLG function
#'
#' @inheritParams gen_args
#' @param param_var (`string`) the name of the column storing the parameters name.
#' @param grad_dir_var  (`string`) the name of the column storing the grade direction variable which  is required in
#'   order to obtain the correct denominators when building the layout as it is used to define row splitting.
#' @param grad_anl_var (`string`)  the name of the column storing toxicity grade variable where all negative values from
#'   `ATOXGR` are replaced by their absolute values.
#'
#' @details
#'  * Split columns by arm, typically `ACTARM`.
#'
#' @note
#'  * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"ATOXGR"`,
#'  `"ONTRTFL"` and column specified by `arm_var`.
#'
#' @export
#'
lbt07_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       param_var = "PARAM",
                       grad_dir_var = "GRADE_DIR",
                       grad_anl_var = "GRADE_ANL",
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adlb"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_string(param_var)
  assert_string(grad_dir_var)
  assert_string(grad_anl_var)
  assert_valid_variable(
    adam_db$adlb, c("ATOXGR", param_var, grad_dir_var, grad_anl_var),
    types = list(c("character", "factor"))
  )
  assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_param_var <- var_labels_for(adam_db$adlb, param_var)
  lbl_grad_dir_var <- var_labels_for(adam_db$adlb, grad_dir_var)

  map <- expand.grid(
    PARAM = levels(adam_db$adlb[[param_var]]),
    GRADE_DIR = c("LOW", "HIGH"),
    GRADE_ANL = as.character(1:4),
    stringsAsFactors = FALSE
  ) %>%
    arrange(.data$PARAM, desc(.data$GRADE_DIR), .data$GRADE_ANL)

  names(map) <- c(param_var, grad_dir_var, grad_anl_var)

  lyt <- lbt07_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_param_var = lbl_param_var,
    lbl_grad_dir_var = lbl_grad_dir_var,
    param_var = param_var,
    grad_dir_var = grad_dir_var,
    grad_anl_var = grad_anl_var,
    map = map
  )

  tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)

  tbl
}

#' `lbt07` Layout
#'
#' @inheritParams gen_args
#' @inheritParams lbt07_main
#'
#' @param lbl_param_var (`string`) label of the `param_var` variable.
#' @param lbl_grad_dir_var (`string`) label for the `grad_dir_var` variable.
#' @param map (`data.frame`) mapping of `PARAM`s to directions of abnormality.
#'
#' @keywords internal
#'
lbt07_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_param_var,
                      lbl_grad_dir_var,
                      param_var,
                      grad_dir_var,
                      grad_anl_var,
                      map) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by(
      param_var,
      label_pos = "topleft",
      split_label = lbl_param_var
    ) %>%
    summarize_num_patients(
      var = "USUBJID",
      required = "ATOXGR",
      .stats = "unique_count"
    ) %>%
    split_rows_by(
      grad_dir_var,
      label_pos = "topleft",
      split_label = lbl_grad_dir_var,
      split_fun = trim_levels_to_map(map)
    ) %>%
    count_abnormal_by_worst_grade(
      var = grad_anl_var,
      variables = list(id = "USUBJID", param = param_var, grade_dir = grad_dir_var),
      .formats = list(count_fraction = tern::format_count_fraction_fixed_dp),
      .indent_mods = 4L
    ) %>%
    append_topleft("            Highest NCI CTCAE Grade")
}

#' @describeIn lbt07 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt07_pre <- function(adam_db, ...) {
  adam_db$adlb <- adam_db$adlb %>%
    mutate(
      ATOXGR = reformat(.data$ATOXGR, missing_rule)
    ) %>%
    filter(
      .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") & .data$WGRLOFL == "Y" ~ "LOW",
          ATOXGR == "0" ~ "ZERO",
          ATOXGR %in% c("1", "2", "3", "4") & .data$WGRHIFL == "Y" ~ "HIGH",
          TRUE ~ "NONE"
        ),
        levels = c("LOW", "ZERO", "HIGH", "NONE")
      ),
      GRADE_ANL = factor(.data$ATOXGR, levels = c(-4:4), labels = abs(c(-4:4))),
      PARAM = as.factor(trimws(stringr::str_remove_all(.data$PARAM, "\\(.+?\\)")))
    )

  adam_db$adlb <- adam_db$adlb %>%
    mutate(
      PARAM = with_label(.data$PARAM, "Parameter"),
      GRADE_DIR = with_label(.data$GRADE_DIR, "Direction of Abnormality"),
      GRADE_ANL = with_label(.data$GRADE_ANL, "Toxicity Grade")
    )

  adam_db
}

#' @describeIn lbt07 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt07_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  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, syn_data)
lbt07 <- chevron_t(
  main = lbt07_main,
  preprocess = lbt07_pre,
  postprocess = lbt07_post
)

# dst01 ----

#' @describeIn dst01 Main TLG function
#'
#' @inheritParams gen_args
#' @param arm_var (`string`) variable. Usually one of `ARM`, `ACTARM`, `TRT01A`, or `TRT01A`.
#' @param study_status_var (`string`) variable used to define patient status. Default is `EOSSTT`, however can also be a
#'   variable name with the pattern `EOPxxSTT` where `xx` must be substituted by 2 digits referring to the analysis
#'   period.
#' @param detail_vars Named (`list`) of grouped display of `study_status_var`. The names must be subset of unique levels
#' of `study_status_var`.
#' @param trt_status_var (`string`) variable of treatment status.
#' @details
#'  * Default patient disposition table summarizing the reasons for patients withdrawal.
#'  * Numbers represent absolute numbers of patients and fraction of `N`.
#'  * Remove zero-count rows.
#'  * Split columns by arm.
#'  * Include a total column by default.
#'  * Sort withdrawal reasons by alphabetic order.
#'
#' @note
#'  * `adam_db` object must contain an `adsl` table with the columns specified by `status_var` and `disc_reason_var`.
#'
#' @export
#'
dst01_main <- function(adam_db,
                       arm_var = "ARM",
                       lbl_overall = "All {Patient_label}",
                       study_status_var = "EOSSTT",
                       detail_vars = list(
                         Discontinued = c("DCSREAS")
                       ),
                       trt_status_var = NULL,
                       ...) {
  assert_all_tablenames(adam_db, "adsl")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_string(study_status_var)
  assert_list(detail_vars, types = "character", names = "unique")
  assert_string(trt_status_var, null.ok = TRUE)
  assert_valid_variable(
    adam_db$adsl,
    arm_var,
    types = list(c("character", "factor")), na_ok = TRUE
  )
  assert_valid_variable(
    adam_db$adsl, study_status_var,
    types = list(c("character", "factor")), na_ok = TRUE,
    empty_ok = FALSE, min_chars = 1L
  )
  status_var_lvls <- lvls(adam_db$adsl[[study_status_var]])
  assert_subset(names(detail_vars), choices = status_var_lvls)
  assert_valid_variable(
    adam_db$adsl,
    unlist(detail_vars),
    types = list(c("character", "factor")),
    na_ok = TRUE,
    empty_ok = TRUE,
    min_chars = 0L
  )
  assert_valid_variable(
    adam_db$adsl, trt_status_var,
    types = list(c("character", "factor")), na_ok = TRUE,
    empty_ok = TRUE, min_chars = 0L
  )

  lbl_overall <- render_safe(lbl_overall)
  detail_vars <- setNames(detail_vars[status_var_lvls], status_var_lvls)

  lyt <- dst01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    study_status_var = study_status_var,
    detail_vars = detail_vars,
    trt_status_var = trt_status_var
  )
  build_table(lyt, adam_db$adsl)
}

#' `dst01` Layout
#'
#' @inheritParams dst01_main
#' @param study_status_var (`string`) variable used to define patient status. Default is `EOSSTT`, however can also be a
#'   variable name with the pattern `EOPxxSTT` where `xx` must be substituted by 2 digits referring to the analysis
#'   period.
#' @param detail_vars Named (`list`) of grouped display of `study_status_var`.
#'
#' @keywords internal
#'
dst01_lyt <- function(arm_var,
                      lbl_overall,
                      study_status_var,
                      detail_vars,
                      trt_status_var) {
  lyt <- basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall)
  for (n in names(detail_vars)) {
    lyt <- lyt %>%
      count_or_summarize(study_status_var, n, detail_vars[[n]])
  }
  if (!is.null(trt_status_var)) {
    lyt <- lyt %>%
      summarize_vars(
        trt_status_var,
        .stats = "count_fraction",
        denom = "N_col",
        .formats = list(count_fraction = format_count_fraction_fixed_dp),
        show_labels = "hidden",
        nested = FALSE
      )
  }

  lyt
}

#' @describeIn dst01 Preprocessing
#'
#' @inheritParams dst01_main
#'
#' @export
#'
dst01_pre <- function(adam_db,
                      ...) {
  study_status_format <- rule(
    "Completed" = "COMPLETED",
    "Ongoing" = "ONGOING",
    "Discontinued" = "DISCONTINUED"
  )
  trt_status_format <- rule(
    "Completed Treatment" = "COMPLETED",
    "Ongoing Treatment" = "ONGOING",
    "Discontinued Treatment" = "DISCONTINUED"
  )
  dcsreas_grp_format <- rule(
    "Safety" = c("ADVERSE EVENT", "DEATH"),
    "Non-Safety" = c(
      "WITHDRAWAL BY SUBJECT", "LACK OF EFFICACY", "PROTOCOL VIOLATION",
      "WITHDRAWAL BY PARENT/GUARDIAN", "PHYSICIAN DECISION"
    )
  )
  adam_db$adsl <- adam_db$adsl %>%
    mutate(
      EOSSTT = reformat(.data$EOSSTT, study_status_format),
      EOTSTT = reformat(.data$EOTSTT, trt_status_format),
      DCSREASGP = reformat(.data$DCSREAS, dcsreas_grp_format),
      DCSREAS = reformat(.data$DCSREAS, empty_rule),
      STDONS = factor(
        case_when(
          EOTSTT == "Ongoing Treatment" & EOSSTT == "Ongoing" ~ "Alive: Ongoing",
          EOTSTT != "Ongoing Treatment" & EOSSTT == "Ongoing" ~ "Alive: In Follow-up",
          TRUE ~ NA_character_
        ),
        levels = c("Alive: Ongoing", "Alive: In Follow-up")
      )
    )
  adam_db
}

#' @describeIn dst01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
dst01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- tlg %>%
      smart_prune()
  }
  std_postprocess(tlg)
}

#' DST01 Table 1 (Default) Patient Disposition Table 1.
#'
#' The DST01 Disposition Table provides an overview of patients
#' study completion. For patients who discontinued the study a reason is provided.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(dst01, syn_data, detail_vars = list(Ongoing = "STDONS"))
#'
#' run(dst01, syn_data, detail_vars = list(Discontinued = "DCSREAS", Ongoing = "STDONS"))
#'
#' run(
#'   dst01, syn_data,
#'   detail_vars = list(
#'     Discontinued = c("DCSREASGP", "DCSREAS"),
#'     Ongoing = "STDONS"
#'   )
#' )
dst01 <- chevron_t(
  main = dst01_main,
  preprocess = dst01_pre,
  postprocess = dst01_post
)

# rmpt01 ----

#' @describeIn rmpt01 Main TLG function
#'
#' @inheritParams gen_args
#' @param summaryvars (`string`) variables to be analyzed. The label attribute of the corresponding columns in `adex`
#'   table of `adam_db` is used as label.
#' @param show_tot (`flag`) whether to display the cumulative total.
#' @param row_split_var (`string`) the name of the column that containing variable to split exposure by.
#' @param col_split_var (`string`) additional column splitting variable.
#' @param overall_col_lbl (`string`) name of the overall column. If `NULL`, no overall level is added.
#'
#' @details
#'   * Person time is the sum of exposure across all patients.
#'   * Summary statistics are by default based on the number of patients in the corresponding `N` row
#'   (number of non-missing values).
#'   * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.
#'
#' @note
#'   * `adam_db` object must contain an `adex` table with `"AVAL"` and the columns specified by `summaryvars`.
#'
#' @export
#'
rmpt01_main <- function(adam_db,
                        summaryvars = "AVALCAT1",
                        show_tot = TRUE,
                        row_split_var = NULL,
                        col_split_var = NULL,
                        overall_col_lbl = NULL,
                        ...) {
  assert_all_tablenames(adam_db, c("adsl", "adex"))
  assert_string(summaryvars)
  assert_flag(show_tot)
  assert_string(row_split_var, null.ok = TRUE)
  assert_string(col_split_var, null.ok = TRUE)
  assert_string(overall_col_lbl, null.ok = TRUE)
  assert_valid_variable(adam_db$adex, summaryvars, types = list(c("factor", "character")), empty_ok = FALSE)
  assert_valid_variable(adam_db$adex, "AVAL", types = list("numeric"))
  assert_valid_variable(adam_db$adex, row_split_var, types = list(c("factor", "numeric")), empty_ok = TRUE)
  assert_valid_variable(adam_db$adex, col_split_var, types = list(c("factor", "character")))
  assert_valid_variable(adam_db$adex, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))

  lbl_summaryvars <- var_labels_for(adam_db$adex, summaryvars)

  lyt <- rmpt01_lyt(
    summaryvars = summaryvars,
    lbl_summaryvars = lbl_summaryvars,
    show_tot = show_tot,
    row_split_var = row_split_var,
    col_split_var = col_split_var,
    overall_col_lbl = overall_col_lbl
  )

  build_table(lyt, adam_db$adex, alt_counts_df = adam_db$adsl)
}

#' `rmpt01` Layout
#'
#' @inheritParams gen_args
#' @inheritParams rmpt01_main
#' @param lbl_summaryvars (`character`) label associated with the analyzed variables.
#'
#' @keywords internal
#'
rmpt01_lyt <- function(summaryvars,
                       lbl_summaryvars,
                       show_tot,
                       row_split_var,
                       col_split_var,
                       overall_col_lbl) {
  lyt <- basic_table(show_colcounts = TRUE) %>%
    ifneeded_split_col(
      col_split_var,
      split_fun = if (!is.null(overall_col_lbl)) add_overall_level("ALL", overall_col_lbl)
    ) %>%
    split_cols_by_multivar(
      vars = c("AVAL", "AVAL"),
      varlabels = c(n_patients = render_safe("{Patient_label}"), sum_exposure = "Person time"),
      extra_args = list(.stats = c("n_patients", "sum_exposure"))
    ) %>%
    analyze_patients_exposure_in_cols(
      var = summaryvars,
      col_split = FALSE,
      add_total_level = show_tot,
      custom_label = render_safe("Total {patient_label} number/person time")
    )

  if (!is.null(row_split_var)) {
    lyt %>%
      split_rows_by(row_split_var) %>%
      analyze_patients_exposure_in_cols(
        .indent_mods = -1L,
        var = summaryvars,
        col_split = FALSE,
        add_total_level = show_tot,
        custom_label = render_safe("Total {patient_label} number/person time")
      ) %>%
      append_topleft(c("", lbl_summaryvars))
  } else {
    lyt %>%
      append_topleft(c("", lbl_summaryvars))
  }
}

#' @describeIn rmpt01 Preprocessing
#'
#' @inheritParams gen_args
#' @inheritParams rmpt01_main
#'
#' @export
#'
rmpt01_pre <- function(adam_db,
                       summaryvars = "AVALCAT1",
                       ...) {
  adam_db$adex <- adam_db$adex %>%
    filter(.data$PARAMCD == "TDURD")

  adam_db$adex$AVALCAT1 <- droplevels(adam_db$adex$AVALCAT1)

  adam_db$adex <- adam_db$adex %>%
    mutate(
      AVALCAT1 = with_label(.data$AVALCAT1, "Duration of exposure")
    )

  adam_db$adex[[summaryvars]] <- reformat(adam_db$adex[[summaryvars]], missing_rule)
  if (!"<Missing>" %in% adam_db$adex[[summaryvars]] && summaryvars %in% colnames(adam_db$adex)) {
    adam_db$adex[[summaryvars]] <- forcats::fct_drop(adam_db$adex[[summaryvars]], only = "<Missing>")
  }

  adam_db
}

#' @describeIn rmpt01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
rmpt01_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `RMPT01`Duration of Exposure for Risk Management Plan Table.
#'
#' The `RMPT01` table provides an overview of duration of exposure.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(rmpt01, syn_data, col_split_var = "SEX")
rmpt01 <- chevron_t(
  main = rmpt01_main,
  preprocess = rmpt01_pre,
  postprocess = rmpt01_post
)

# dmt01 ----

#' @describeIn dmt01 Main TLG function
#'
#' @inheritParams gen_args
#' @param summaryvars (`character`) variables summarized in demographic table. The label attribute of the corresponding
#'   column in `adsl` table of `adam_db` is used as label.
#'
#' @details
#'  * Information from `ADSUB` are generally included into `ADSL` before analysis.
#'  * Default demographic and characteristics table
#'  * If not specified otherwise, numbers represent absolute numbers of patients and fraction of `N`
#'  * Remove zero-count rows
#'  * Split columns by arm (planned or actual / code or description)
#'  * Include a total column by default
#'
#' @note
#'  * `adam_db` object must contain an `adsl` table with the columns specified in `summaryvars`.
#'
#' @export
#'
dmt01_main <- function(adam_db,
                       arm_var = "ARM",
                       lbl_overall = "All {Patient_label}",
                       summaryvars = c(
                         "AAGE",
                         "AGEGR1",
                         "SEX",
                         "ETHNIC",
                         "RACE"
                       ),
                       ...) {
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_character(summaryvars, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, summaryvars, na_ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))

  lbl_overall <- render_safe(lbl_overall)
  summaryvars_lbls <- var_labels_for(adam_db$adsl, summaryvars)

  lyt <- dmt01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    summaryvars = summaryvars,
    summaryvars_lbls = summaryvars_lbls
  )

  tbl <- build_table(lyt, adam_db$adsl)

  tbl
}

#' `dmt01` Layout
#' @param summaryvars_lbls (`character`) labels corresponding to the analyzed variables.
#'
#' @inheritParams gen_args
#'
#' @keywords internal
#'
dmt01_lyt <- function(arm_var,
                      lbl_overall,
                      summaryvars,
                      summaryvars_lbls) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    summarize_vars(
      vars = summaryvars,
      var_labels = summaryvars_lbls,
      .formats = list(count_fraction = format_count_fraction_fixed_dp)
    )
}

#' @describeIn dmt01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
dmt01_pre <- function(adam_db, ...) {
  adam_db$adsl <- adam_db$adsl %>%
    mutate(SEX = reformat(.data$SEX, rule(Male = "M", Female = "F")))
  adam_db
}

#' @describeIn dmt01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
dmt01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `DMT01` Table 1 (Default) Demographics and Baseline Characteristics Table 1.
#'
#' For each variable, summary statistics are
#' by default based on the number of patients in the corresponding `n` row.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(dmt01, syn_data)
dmt01 <- chevron_t(
  main = dmt01_main,
  preprocess = dmt01_pre,
  postprocess = dmt01_post
)

# aet10 ----

#' @describeIn aet10 Main TLG function
#'
#' @inheritParams gen_args
#'
#' @details
#'  * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.
#'  * Missing values in `AEDECOD` are labeled by `No Coding Available`.
#'
#' @note
#'  * `adam_db` object must contain an `adae` table with the columns `"AEDECOD"`.
#'
#' @export
#'
aet10_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       ...) {
  assert_all_tablenames(adam_db, "adsl", "adae")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")

  lyt <- aet10_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_aedecod = lbl_aedecod
  )

  tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)

  tbl
}

#' `aet10` Layout
#'
#' @inheritParams gen_args
#' @param lbl_aedecod (`character`) text label for `AEDECOD`.
#'
#' @keywords internal
#'
aet10_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_aedecod) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    count_occurrences(
      vars = "AEDECOD",
      .indent_mods = -1L
    ) %>%
    append_topleft(paste0("\n", lbl_aedecod))
}

#' @describeIn aet10 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet10_pre <- function(adam_db, ...) {
  adam_db$adae <- adam_db$adae %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(AEDECOD = reformat(.data$AEDECOD, nocoding))
  return(adam_db)
}

#' @describeIn aet10 Postprocessing
#'
#' @inheritParams gen_args
#' @param atleast given cut-off in numeric format, default is `0.05`
#'
#' @export
#'
aet10_post <- function(tlg, atleast = 0.05, ...) {
  assert_number(atleast, lower = 0, upper = 1)
  tbl_sorted <- tlg %>%
    sort_at_path(
      path = c("AEDECOD"),
      scorefun = score_occurrences
    )

  tlg_prune <- prune_table(
    tt = tbl_sorted,
    prune_func = keep_rows(
      has_fraction_in_any_col(
        atleast = atleast
      )
    )
  )

  std_postprocess(tlg_prune)
}

#' `AET10` Table 1 (Default) Most Common (xx%) Adverse Events Preferred Terms Table 1
#'
#' The `AET10` table Include Adverse Events occurring with user-specified threshold X% in at least
#'  one of the treatment groups. Standard table summarized by preferred term (PT).
#' Order the data by total column frequency from most to least frequently reported PT (regardless of SOC).
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(aet10, syn_data)
aet10 <- chevron_t(
  main = aet10_main,
  preprocess = aet10_pre,
  postprocess = aet10_post
)

# kmg01 ----

#' @describeIn kmg01 Main TLG Function
#'
#' @details
#'  * No overall value.
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#' @param strat (`character`) the variable name of stratification variables.
#' @param ... Further arguments passed to `g_km` and `control_coxph`. For details, see
#' the documentation in `tern`.
#' Commonly used arguments include `col`, `pval_method`, `ties`, `conf_level`, `conf_type`,
#' `annot_coxph`, `annot_stats`, etc.
#'
#' @note
#'  * `adam_db` object must contain the table specified by `dataset` with the columns specified by  `arm_var`.
#'
#' @return a `gTree` object.
#' @export
kmg01_main <- function(adam_db,
                       dataset = "adtte",
                       arm_var = "ARM",
                       strat = NULL,
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", dataset))
  df_lbl <- paste0("adam_db$", dataset)
  assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], "IS_EVENT", types = list("logical"), label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], strat, types = list(c("character", "factor")), label = df_lbl)
  assert_valid_variable(
    adam_db[[dataset]],
    c("PARAMCD", arm_var),
    types = list(c("character", "factor")),
    na_ok = FALSE,
    label = df_lbl
  )
  assert_single_value(adam_db[[dataset]]$PARAMCD, label = paste0(df_lbl, "$PARAMCD"))
  assert_valid_variable(adam_db[[dataset]], "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
  variables <- list(tte = "AVAL", is_event = "IS_EVENT", arm = arm_var, strat = strat)
  control_cox <- execute_with_args(control_coxph, ...)
  control_surv <- execute_with_args(control_surv_timepoint, ...)
  execute_with_args(
    g_km,
    df = adam_db[[dataset]],
    variables = variables,
    control_surv = control_surv,
    control_coxph_pw = control_cox,
    ...,
    draw = FALSE
  )
}

#' @describeIn kmg01 Preprocessing
#'
#' @inheritParams kmg01_main
#'
#' @export
kmg01_pre <- function(adam_db, dataset = "adtte", ...) {
  adam_db[[dataset]] <- adam_db[[dataset]] %>%
    mutate(IS_EVENT = .data$CNSR == 0)

  adam_db
}

# `kmg01` Pipeline ----

#' `KMG01` Kaplan-Meier Plot 1.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' col <- c(
#'   "A: Drug X" = "black",
#'   "B: Placebo" = "blue",
#'   "C: Combination" = "gray"
#' )
#'
#' syn_data2 <- log_filter(syn_data, PARAMCD == "OS", "adtte")
#' run(kmg01, syn_data2, dataset = "adtte", line_col = col)
#'
#' syn_data3 <- log_filter(syn_data, PARAMCD == "AEREPTTE", "adaette")
#' run(kmg01, syn_data3, dataset = "adaette")
kmg01 <- chevron_g(
  main = kmg01_main,
  preproces = kmg01_pre
)

# aet01_aesi ----

#' @describeIn aet01_aesi Main TLG function
#'
#' @inheritParams gen_args
#' @param aesi_vars (`character`) the `AESI` variables to be included in the summary. Defaults to `NA`.
#' @param grade_groups (`list`) the grade groups to be displayed.
#' @details
#'  * Does not remove rows with zero counts by default.
#'
#' @note
#'  * `adam_db` object must contain an `adae` table with columns `"AEOUT"`, `"AEACN"`, `"AECONTRT"`, `"AESER"`,
#'  `"AREL"`, and the column specified by `arm_var`.
#'  * `aesi_vars` may contain any/all of the following variables to display: `"ALLRESWD"`, `"ALLRESDSM"`,
#'  `"ALLRESCONTRT"`, `"NOTRESWD"`, `"NOTRESDSM"`, `"NOTRESCONTRT"`, `"SERWD"`, `"SERDSM"`, `"SERCONTRT"`,
#'  `"RELWD"`, `"RELDSM"`, `"RELCONTRT"`, `"RELSER"`.
#'  * `aesi_vars` variable prefixes are defined as follows:
#'    * `"ALLRES"` = "all non-fatal adverse events resolved"
#'    * `"NOTRES"` = "at least one unresolved or ongoing non-fatal adverse event"
#'    * `"SER"` = "serious adverse event"
#'    * `"REL"` = "related adverse event"
#'  * `aesi_vars` variable suffixes are defined as follows:
#'    * `"WD"` = "patients with study drug withdrawn"
#'    * `"DSM"` = "patients with dose modified/interrupted"
#'    * `"CONTRT"` = "patients with treatment received"
#'  * Several `aesi_vars` can be added to the table at once:
#'    * `aesi_vars = "ALL"` will include all possible `aesi_vars`.
#'    * Including `"ALL_XXX"` in `aesi_vars` where `XXX` is one of the prefixes listed above will include all
#'    `aesi_vars` with that prefix.
#'
#' @export
#'
aet01_aesi_main <- function(adam_db,
                            arm_var = "ACTARM",
                            lbl_overall = NULL,
                            aesi_vars = NULL,
                            grade_groups = NULL,
                            ...) {
  assert_all_tablenames(adam_db, "adsl", "adae")
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_character(aesi_vars, null.ok = TRUE)
  assert_list(grade_groups, null.ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var))
  assert_valid_variable(adam_db$adae, c(arm_var))
  assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)

  if (is.null(grade_groups)) {
    grade_groups <- list(
      "Grade 1" = "1",
      "Grade 2" = "2",
      "Grade 3" = "3",
      "Grade 4" = "4",
      "Grade 5 (fatal outcome)" = "5"
    )
  }
  all_aesi_vars <- get_aesi_vars(aesi_vars)
  assert_valid_variable(adam_db$adae, c(all_aesi_vars), empty_ok = TRUE, na_ok = TRUE, types = list("logical"))

  lbl_overall <- render_safe(lbl_overall)
  lbl_aesi_vars <- var_labels_for(adam_db$adae, all_aesi_vars)

  lyt <- aet01_aesi_lyt(
    arm_var = arm_var,
    aesi_vars = all_aesi_vars,
    lbl_overall = lbl_overall,
    lbl_aesi_vars = lbl_aesi_vars,
    grade_groups = grade_groups
  )

  tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)

  tbl
}

#' `aet01_aesi` Layout
#'
#' @inheritParams gen_args
#' @param lbl_aesi_vars (`character`) the labels of the `AESI` variables to be summarized.
#'
#' @keywords internal
#'
aet01_aesi_lyt <- function(arm_var,
                           aesi_vars,
                           lbl_overall,
                           lbl_aesi_vars,
                           grade_groups) {
  names(lbl_aesi_vars) <- aesi_vars
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    count_patients_with_event(
      vars = "USUBJID",
      filters = c("ANL01FL" = "Y"),
      denom = "N_col",
      .labels = c(count_fraction = render_safe("Total number of {patient_label} with at least one AE"))
    ) %>%
    count_values(
      "ANL01FL",
      values = "Y",
      .stats = "count",
      .labels = c(count = "Total number of AEs"),
      table_names = "total_aes"
    ) %>%
    count_occurrences_by_grade(
      var = "ATOXGR",
      var_labels = render_safe("Total number of {patient_label} with at least one AE by worst grade"),
      show_labels = "visible",
      grade_groups = grade_groups
    ) %>%
    count_patients_with_flags(
      "USUBJID",
      flag_variables = lbl_aesi_vars,
      denom = "N_col"
    )
}

#' @describeIn aet01_aesi Preprocessing
#'
#' @inheritParams aet01_aesi_main
#'
#' @export
#'
aet01_aesi_pre <- function(adam_db,
                           ...) {
  assert_all_tablenames(adam_db, c("adsl", "adae"))

  adam_db$adae <- adam_db$adae %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      NOT_RESOLVED = with_label(
        .data$AEOUT %in% c("NOT RECOVERED/NOT RESOLVED", "RECOVERING/RESOLVING", "UNKNOWN"),
        "Total number of {patient_label} with at least one unresolved or ongoing non-fatal AE"
      ),
      ALL_RESOLVED = with_label(
        !.data$AEOUT %in% "FATAL" & !.data$NOT_RESOLVED,
        "Total number of {patient_label} with all non-fatal AEs resolved"
      ),
      WD = with_label(
        .data$AEACN %in% "DRUG WITHDRAWN", "Total number of {patient_label} with study drug withdrawn due to AE"
      ),
      DSM = with_label(
        .data$AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED"),
        "Total number of {patient_label} with dose modified/interrupted due to AE"
      ),
      CONTRT = with_label(
        .data$AECONTRT %in% "Y", "Total number of {patient_label} with treatment received for AE"
      ),
      SER = with_label(
        .data$AESER %in% "Y", "Total number of {patient_label} with at least one serious AE"
      ),
      REL = with_label(
        .data$AREL %in% "Y", "Total number of {patient_label} with at least one related AE"
      ),
      ALLRESWD = with_label(
        .data$WD & .data$ALL_RESOLVED, "  No. of {patient_label} with study drug withdrawn due to resolved AE"
      ),
      ALLRESDSM = with_label(
        .data$DSM & .data$ALL_RESOLVED, "  No. of {patient_label} with dose modified/interrupted due to resolved AE"
      ),
      ALLRESCONTRT = with_label(
        .data$CONTRT & .data$ALL_RESOLVED, "  No. of {patient_label} with treatment received for resolved AE"
      ),
      NOTRESWD = with_label(
        .data$WD & .data$NOT_RESOLVED,
        "  No. of {patient_label} with study drug withdrawn due to unresolved or ongoing AE"
      ),
      NOTRESDSM = with_label(
        .data$DSM & .data$NOT_RESOLVED,
        "  No. of {patient_label} with dose modified/interrupted due to unresolved or ongoing AE"
      ),
      NOTRESCONTRT = with_label(
        .data$CONTRT & .data$NOT_RESOLVED,
        "  No. of {patient_label} with treatment received for unresolved/ongoing AE"
      ),
      SERWD = with_label(
        .data$SER & .data$WD, "  No. of {patient_label} with study drug withdrawn due to serious AE"
      ),
      SERDSM = with_label(
        .data$SER & .data$DSM, "  No. of {patient_label} with dose modified/interrupted due to serious AE"
      ),
      SERCONTRT = with_label(
        .data$SER & .data$CONTRT, "  No. of {patient_label} with treatment received for serious AE"
      ),
      RELWD = with_label(
        .data$REL & .data$WD, "  No. of {patient_label} with study drug withdrawn due to related AE"
      ),
      RELDSM = with_label(
        .data$REL & .data$DSM, "  No. of {patient_label} with dose modified/interrupted due to related AE"
      ),
      RELCONTRT = with_label(
        .data$REL & .data$CONTRT, "  No. of {patient_label} with treatment received for related AE"
      ),
      RELSER = with_label(
        .data$REL & .data$SER, "  No. of {patient_label} with serious, related AE"
      )
    ) %>%
    mutate(
      ATOXGR = factor(.data$ATOXGR, levels = 1:5)
    )

  adam_db
}

#' @describeIn aet01_aesi Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet01_aesi_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `AET01_AESI` Table 1 (Default) Adverse Event of Special Interest Summary Table.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(aet01_aesi, syn_data)
aet01_aesi <- chevron_t(
  main = aet01_aesi_main,
  preprocess = aet01_aesi_pre,
  postprocess = aet01_aesi_post
)

#' @keywords internal
get_aesi_vars <- function(aesi_vars) {
  if ("ALL" %in% aesi_vars) aesi_vars <- c("ALL_ALLRES", "ALL_NOTRES", "ALL_SER", "ALL_REL")
  if (any(grepl("^ALL_", aesi_vars))) {
    aesi <- c(grep("^ALL_", aesi_vars, value = TRUE, invert = TRUE), sapply(
      c("WD", "DSM", "CONTRT"),
      function(x) sub("^(ALL_)(.*)", paste0("\\2", x), grep("^ALL_", aesi_vars, value = TRUE))
    ))
    if ("ALL_REL" %in% aesi_vars) aesi <- c(aesi, "RELSER")
  } else {
    aesi <- aesi_vars
  }
  all_aesi_vars <- c(
    "WD", "DSM", "CONTRT", "ALL_RESOLVED", grep("^ALLRES", aesi, value = TRUE),
    "NOT_RESOLVED", grep("^NOTRES", aesi, value = TRUE), "SER", grep("^SER", aesi, value = TRUE),
    "REL", grep("^REL", aesi, value = TRUE)
  )
  return(all_aesi_vars)
}

# coxt01 ----

#' @describeIn coxt01 Main TLG function
#'
#' @inheritParams gen_args
#' @param arm_var (`string`) the arm variable used for arm splitting.
#' @param time_var (`string`) the time variable in a Cox proportional hazards regression model.
#' @param event_var (`string`) the event variable in a Cox proportional hazards regression model.
#' @param covariates (`character`) will be fitted and the corresponding effect will be estimated.
#' @param strata (`character`) will be fitted for the stratified analysis.
#' @param lbl_vars (`string`) text label for the a Cox regression model variables.
#' @param multivar (`flag`) indicator of whether multivariate cox regression is conducted.
#' @param ... Further arguments passed to `tern::control_coxreg()`.
#'
#' @details
#'  * The reference arm will always the first level of `arm_var`. Please change the level if you want to
#'  change the reference arms.
#'  * The table allows confidence level to be adjusted, default is two-sided 95%.
#'  * The stratified analysis is with DISCRETE tie handling (equivalent to `tern::control_coxreg(ties = "exact")` in R).
#'  * Model includes treatment plus specified covariate(s) as factor(s) or numeric(s),
#'  with `"SEX"`, `"RACE"` and `"AAGE"` as default candidates.
#'  * The selection of the covariates and whether or not there is a selection process
#'  (vs. a fixed, pre-specified list) needs to be pre-specified.
#'  * For pairwise comparisons using the hazard ratio, the value for the control group is the denominator.
#'  * Keep zero-count rows unless overridden with `prune_0 = TRUE`.
#'
#' @note
#'   * `adam_db` object must contain an `adtte` table with `"PARAMCD"`, `"ARM"`,
#'   `"AVAL"`, `"CNSR`, and the columns specified by `"covariates"` which is denoted as
#'   `c("SEX", "RACE", "AAGE")` by default.
#'
#' @export
#'
coxt01_main <- function(adam_db,
                        arm_var = "ARM",
                        time_var = "AVAL",
                        event_var = "EVENT",
                        covariates = c("SEX", "RACE", "AAGE"),
                        strata = NULL,
                        lbl_vars = "Effect/Covariate Included in the Model",
                        multivar = FALSE,
                        ...) {
  assert_all_tablenames(adam_db, "adtte")
  assert_string(arm_var)
  assert_string(time_var)
  assert_string(event_var)
  assert_character(covariates, null.ok = TRUE)
  assert_character(strata, null.ok = TRUE)
  assert_flag(multivar)
  assert_valid_variable(adam_db$adtte, arm_var, types = list("factor"), n.levels = if (!multivar) 2L)
  assert_valid_variable(adam_db$adtte, c("USUBJID", arm_var, "PARAMCD"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adtte, strata, types = list(c("factor", "integer", "character")), na_ok = TRUE)
  assert_valid_variable(adam_db$adtte, covariates, na_ok = TRUE)
  assert_valid_variable(adam_db$adtte, event_var, types = list("numeric"), integerish = TRUE, lower = 0L, upper = 1L)
  assert_valid_variable(adam_db$adtte, time_var, types = list("numeric"), lower = 0)
  assert_single_value(adam_db$adtte$PARAMCD)
  control <- execute_with_args(control_coxreg, ...)

  variables <- list(
    time = time_var,
    event = event_var,
    arm = arm_var,
    covariates = covariates,
    strata = strata
  )

  lyt <- coxt01_lyt(
    variables = variables,
    col_split = if (!multivar) "COL_LABEL",
    lbl_vars = lbl_vars,
    multivar = multivar,
    control = control,
    ...
  )

  col_split <- "Treatment Effect Adjusted for Covariate"
  adam_db$adtte$COL_LABEL <- factor(rep(col_split, nrow(adam_db$adtte)), levels = col_split)

  tbl <- build_table(lyt, adam_db$adtte)

  tbl
}

#' `COXT01` Layout
#'
#' @inheritParams coxt01_main
#' @param variables (`list`) list of variables in a Cox proportional hazards regression model.
#'
#' @keywords internal
#'
coxt01_lyt <- function(variables,
                       col_split,
                       lbl_vars,
                       control,
                       multivar,
                       ...) {
  lyt <- basic_table() %>%
    ifneeded_split_col(col_split)
  lyt <- execute_with_args(
    summarize_coxreg,
    lyt = lyt, variables = variables, control = control, multivar = multivar, ...
  )
  lyt %>%
    append_topleft(lbl_vars)
}

#' @describeIn coxt01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
coxt01_pre <- function(adam_db, ...) {
  adam_db$adtte <- adam_db$adtte %>%
    mutate(EVENT = 1 - .data$CNSR)

  adam_db
}

#' @describeIn coxt01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
coxt01_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `COXT01` (Default) Cox Regression Model Table.
#'
#' Cox models are the most commonly used methods to estimate the magnitude of the effect in survival analyses.
#' It assumes proportional hazards; that is, it assumes that the ratio of the hazards
#' of the two groups (e.g. two arms) is constant over time.
#' This ratio is referred to as the "hazard ratio" and is one of the most commonly reported metrics
#' to describe the effect size in survival analysis.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dunlin)
#'
#' proc_data <- log_filter(syn_data, PARAMCD == "CRSD", "adtte")
#' proc_data <- log_filter(proc_data, ARMCD != "ARM C", "adsl")
#' proc_data$adtte$ARM <- droplevels(proc_data$adtte$ARM)
#' run(coxt01, proc_data)
#'
#' run(coxt01, proc_data, covariates = c("SEX", "AAGE"), strata = c("RACE"), conf_level = 0.90)
coxt01 <- chevron_t(
  main = coxt01_main,
  preprocess = coxt01_pre,
  postprocess = coxt01_post
)

# fstg01 ----

#' @describeIn fstg01 Main TLG Function
#'
#' @details
#'  * No overall value.
#'  * Keep zero count rows by default.
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#' @param arm_var (`string`) the arm variable name used for group splitting.
#' @param rsp_var (`string`) the response variable name to flag whether each subject is a binary response or not.
#' @param subgroups (`character`) the subgroups variable name to list baseline risk factors.
#' @param strata_var (`character`) required if stratified analysis is performed.
#' @param stat_var (`character`) the names of statistics to be reported in `tabulate_rsp_subgroups`.
#' @param max_colwidth (`int`) maximum width of columns. Stratification label longer than this will be truncated.
#' @param ... Further arguments passed to `g_forest` and `extract_rsp_subgroups` (a wrapper for
#'  `h_odds_ratio_subgroups_df` and `h_proportion_subgroups_df`). For details, see the documentation in `tern`.
#'  Commonly used arguments include `col_symbol_size`, `col`, `vline`, `groups_lists`, `conf_level`,
#'  `method`, `label_all`, etc.
#'
#' @note
#'  * `adam_db` object must contain the table specified by `dataset` with `"PARAMCD"`, `"ARM"`,
#'  `"AVALC"`, and the columns specified by `subgroups` which is denoted as
#'  `c("SEX", "AGEGR1", "RACE")` by default.
#'  * If the plot is too large to be rendered in the output, please provide `width_row_names`,
#'  `width_columns` and `width_forest` manually to make it fit. See `g_forest` for more details.
#'
#' @return a `gTree` object.
#'
#' @export
#'
fstg01_main <- function(adam_db,
                        dataset = "adrs",
                        arm_var = "ARM",
                        rsp_var = "IS_RSP",
                        subgroups = c("SEX", "AGEGR1", "RACE"),
                        strata_var = NULL,
                        stat_var = c("n_tot", "n", "n_rsp", "prop", "or", "ci"),
                        max_colwidth = 12,
                        ...) {
  assert_all_tablenames(adam_db, c("adsl", dataset))
  df_lbl <- paste0("adam_db$", dataset)
  assert_string(arm_var)
  assert_string(rsp_var)
  assert_int(max_colwidth)
  assert_character(subgroups, null.ok = TRUE)
  assert_character(strata_var, null.ok = TRUE)
  assert_character(stat_var, null.ok = TRUE)
  assert_valid_variable(adam_db[[dataset]], arm_var, types = list("factor"), n.levels = 2, label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], c("USUBJID", "PARAMCD"),
    types = list(c("character", "factor")),
    label = df_lbl
  )
  assert_valid_variable(adam_db[[dataset]], rsp_var, types = list("logical"), label = df_lbl)
  assert_valid_variable(adam_db[[dataset]], c(subgroups, strata_var),
    types = list(c("factor")), na_ok = TRUE,
    label = df_lbl
  )
  assert_single_value(adam_db[[dataset]]$PARAMCD, label = df_lbl)

  variables <- list(
    arm = arm_var,
    rsp = rsp_var,
    subgroups = subgroups,
    strata_var = strata_var
  )

  df <- execute_with_args(extract_rsp_subgroups,
    variables = variables,
    data = adam_db[[dataset]],
    ...
  )
  df$prop$subgroup <- stringr::str_trunc(df$prop$subgroup, max_colwidth)
  df$or$subgroup <- stringr::str_trunc(df$or$subgroup, max_colwidth)
  result <- basic_table() %>%
    tabulate_rsp_subgroups(df, vars = stat_var)
  cw <- pmin(propose_column_widths(result), max_colwidth + 2)
  final_width <- stringWidth(strrep("x", cw))
  execute_with_args(
    g_forest,
    tbl = result,
    ...,
    width_row_names = final_width[1],
    width_columns = final_width[-1],
    draw = FALSE
  )
}

#' @describeIn fstg01 Preprocessing
#'
#' @inheritParams fstg01_main
#'
#' @export
#'
fstg01_pre <- function(adam_db, ...) {
  adam_db$adrs <- adam_db$adrs %>%
    mutate(
      ARM = droplevels(.data$ARM),
      IS_RSP = .data$AVALC %in% c("CR", "PR")
    )

  adam_db
}

# `fstg01` Pipeline ----

#' `FSTG01` Subgroup Analysis of Best Overall Response.
#'
#' The template produces the subgroup analysis of best overall response graphic.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' proc_data <- log_filter(
#'   syn_data,
#'   PARAMCD == "BESRSPI" & ARM %in% c("A: Drug X", "B: Placebo"), "adrs"
#' )
#' run(fstg01, proc_data,
#'   subgroups = c("SEX", "AGEGR1", "RACE"),
#'   conf_level = 0.90, dataset = "adrs"
#' )
fstg01 <- chevron_g(
  main = fstg01_main,
  preproces = fstg01_pre
)

# pdt01 ----

#' @describeIn pdt01 Main TLG function
#'
#' @inheritParams gen_args
#' @param dvcode_var (`string`) the variable defining the protocol deviation coded term. By default `DVDECOD`.
#' @param dvterm_var (`string`) the variable defining the protocol deviation term. By default `DVTERM`.
#'
#' @details
#'  * Data should be filtered for major protocol deviations. `(DVCAT == "MAJOR")`.
#'  * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm.
#'  * Does not include a total column by default.
#'  * Sort by medication class alphabetically and within medication class by decreasing total number of patients with
#'  the specific medication.
#'
#' @note
#'  * `adam_db` object must contain an `addv` table with the columns specified in `dvcode_var` and `dvterm_var` as well
#'  as `"DVSEQ"`.
#'
#' @export
#'
pdt01_main <- function(adam_db,
                       arm_var = "ARM",
                       lbl_overall = NULL,
                       dvcode_var = "DVDECOD",
                       dvterm_var = "DVTERM",
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "addv"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_string(dvcode_var)
  assert_string(dvterm_var)
  assert_valid_variable(adam_db$addv, c(dvcode_var, dvterm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$addv, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_var_pair(adam_db$adsl, adam_db$addv, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_dvcode_var <- var_labels_for(adam_db$addv, dvcode_var)
  lbl_dvterm_var <- var_labels_for(adam_db$addv, dvterm_var)

  lyt <- pdt01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    dvcode_var = dvcode_var,
    lbl_dvcode_var = lbl_dvcode_var,
    dvterm_var = dvterm_var,
    lbl_dvterm_var = lbl_dvterm_var
  )

  tbl <- build_table(lyt, adam_db$addv, alt_counts_df = adam_db$adsl)

  tbl
}

#' `pdt01` Layout
#'
#' @inheritParams gen_args
#' @inheritParams pdt01_main
#' @param lbl_dvcode_var (`string`) label for the variable defining the protocol deviation coded term.
#' @param lbl_dvterm_var (`string`) label for the variable defining the protocol deviation term.
#'
#' @keywords internal
#'
pdt01_lyt <- function(arm_var,
                      lbl_overall,
                      dvcode_var,
                      lbl_dvcode_var,
                      dvterm_var,
                      lbl_dvterm_var) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(var = arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    summarize_num_patients(
      var = "USUBJID",
      .stats = c("unique", "nonunique"),
      .labels = c(
        unique = render_safe("Total number of {patient_label} with at least one major protocol deviation"),
        nonunique = "Total number of major protocol deviations"
      ),
      .formats = list(unique = format_count_fraction_fixed_dp)
    ) %>%
    split_rows_by(
      dvcode_var,
      child_labels = "visible",
      nested = FALSE,
      indent_mod = -1L,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_dvterm_var
    ) %>%
    count_occurrences(vars = dvterm_var) %>%
    append_topleft(paste0("  Description"))
}

#' @describeIn pdt01 Preprocessing
#'
#' @inheritParams pdt01_main
#'
#' @export
#'
pdt01_pre <- function(adam_db, ...) {
  adam_db$addv <- adam_db$addv %>%
    mutate(across(all_of(c("DVDECOD", "DVTERM")), ~ reformat(.x, nocoding))) %>%
    mutate(
      DVDECOD = with_label(.data$DVDECOD, "Protocol Deviation Coded Term"),
      DVTERM = with_label(.data$DVTERM, "Category")
    )

  adam_db
}

#' @describeIn pdt01 Postprocessing
#'
#' @inheritParams pdt01_main
#' @inheritParams gen_args
#'
#' @export
#'
pdt01_post <- function(tlg, prune_0 = TRUE, dvcode_var = "DVDECOD", dvterm_var = "DVTERM", ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }

  tbl_sorted <- tlg %>%
    sort_at_path(
      path = c(dvcode_var, "*", dvterm_var),
      scorefun = score_occurrences
    )

  std_postprocess(tbl_sorted)
}

#' `pdt01` Major Protocol Deviations Table.
#'
#' A major protocol deviations
#' table with the number of subjects and the total number of treatments by medication class sorted alphabetically and
#' medication name sorted by frequencies.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#'
#' proc_data <- syn_data
#' proc_data$addv <- proc_data$addv %>%
#'   filter(DVCAT == "MAJOR")
#'
#' run(pdt01, proc_data)
pdt01 <- chevron_t(
  main = pdt01_main,
  preprocess = pdt01_pre,
  postprocess = pdt01_post
)

#' No Coding Available rule
#' @export
nocoding <- rule("No Coding Available" = c("", NA))
#' Missing rule
#' @export
missing_rule <- rule("<Missing>" = c("", NA))
#' Empty rule
#' @export
empty_rule <- rule(.to_NA = "")
#' Get grade rule
#' @param direction (`string`) of abnormality direction.
#' @param missing (`string`) method to deal with missing
#' @export
get_grade_rule <- function(direction = "high", missing = "incl") {
  rule_arg <- list()
  if (direction == "high") {
    rule_arg[["Not High"]] <- c("0", "-1", "-2", "-3", "-4")
    rule_arg[as.character(1:4)] <- as.character(1:4)
  } else {
    rule_arg[["Not Low"]] <- c("0", "1", "2", "3", "4")
    rule_arg[as.character(1:4)] <- as.character(-1:-4)
  }
  if (missing == "incl") {
    rule_arg$Missing <- c(NA, "", "<Missing>")
  } else if (missing == "gr_0") {
    rule_arg[[1]] <- c(rule_arg[[1]], NA, "")
  }
  rule(.lst = rule_arg)
}

# ttet01 ----

#' @describeIn ttet01 Main TLG function
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#' @param ref_group (`string`) The name of the reference group, the value should
#'  be identical to the values in `arm_var`, if not specified, it will by default
#'  use the first level or value of `arm_var`.
#' @param summarize_event (`flag`) should the event description be displayed, default is TRUE
#' @param perform_analysis (`string`) option to display statistical comparisons using stratified analyses,
#'  or unstratified analyses, or both, e.g. `c("unstrat", "strat")`. Only unstratified will be displayed by default
#' @param strata (`string`) stratification factors, e.g. `strata = c("STRATA1", "STRATA2")`, by default as NULL
#' @param ... Further arguments passed to `control_surv_time()`, `control_coxph()`, `control_survtp()`, and
#'  `surv_timepoint()`. For details, see the documentation in `tern`. Commonly used arguments include `pval_method`,
#'  `conf_level`, `conf_type`, `quantiles`, `ties`, `timepoint`, `method`, etc.
#'
#' @details
#' * No overall value.
#'
#' @export
#'
ttet01_main <- function(adam_db,
                        dataset = "adtte",
                        arm_var = "ARM",
                        ref_group = NULL,
                        summarize_event = TRUE,
                        perform_analysis = "unstrat",
                        strata = NULL,
                        ...) {
  assert_string(dataset)
  assert_all_tablenames(adam_db, "adsl", dataset)
  assert_string(arm_var)
  assert_string(ref_group, null.ok = TRUE)
  assert_flag(summarize_event)
  assert_subset(perform_analysis, c("unstrat", "strat"))
  assert_character(
    strata,
    null.ok = !"strat" %in% perform_analysis,
    min.len = as.integer(!"strat" %in% perform_analysis)
  )
  anl <- adam_db[[dataset]]
  assert_single_value(anl$PARAMCD, label = sprintf("adam_db$%s$PARAMCD", dataset))
  df_label <- sprintf("adam_db$%s", dataset)
  assert_valid_variable(adam_db[[dataset]], c("IS_EVENT", "IS_NOT_EVENT"), types = list("logical"), label = df_label)
  assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_label)
  assert_valid_variable(
    adam_db[[dataset]], c("USUBJID", arm_var, "EVNT1", "EVNTDESC", "AVALU"),
    types = list(c("character", "factor")), label = df_label
  )
  assert_subset(ref_group, lvls(adam_db[[dataset]][[arm_var]]))
  ref_group <- ref_group %||% lvls(anl[[arm_var]])[1]
  assert_single_value(anl$AVALU, label = sprintf("adam_db$%s$AVALU", dataset))

  timeunit <- unique(anl[["AVALU"]])
  event_lvls <- lvls(anl$EVNT1)

  control_survt <- execute_with_args(control_surv_time, ...)
  control_cox_ph <- execute_with_args(control_coxph, ...)
  control_survtp <- execute_with_args(control_surv_timepoint, ...)

  lyt <- ttet01_lyt(
    arm_var = arm_var,
    ref_group = ref_group,
    summarize_event = summarize_event,
    perform_analysis = perform_analysis,
    strata = strata,
    timeunit = timeunit,
    event_lvls = event_lvls,
    control_survt = control_survt,
    control_cox_ph = control_cox_ph,
    control_survtp = control_survtp,
    ...
  )

  tbl <- build_table(lyt, anl)

  tbl
}

#' `ttet01` Layout
#'
#' @inheritParams gen_args
#' @param timeunit (`string`) time unit get from `AVALU`, by default is `"Months"`
#'
#' @keywords internal
#'
ttet01_lyt <- function(arm_var,
                       ref_group,
                       summarize_event,
                       perform_analysis,
                       strata,
                       timeunit,
                       event_lvls,
                       control_survt,
                       control_cox_ph,
                       control_survtp,
                       ...) {
  lyt01 <- basic_table(show_colcounts = TRUE) %>%
    split_cols_by(
      var = arm_var, ref_group = ref_group
    ) %>%
    summarize_vars(
      vars = "IS_EVENT",
      .stats = "count_fraction",
      .labels = c(count_fraction = event_lvls[1])
    )

  if (summarize_event) {
    lyt01 <- lyt01 %>%
      split_rows_by(
        "EVNT1",
        split_label = "Earliest contributing event",
        split_fun = keep_split_levels(event_lvls[1]),
        label_pos = "visible",
        child_labels = "hidden",
        indent_mod = 1L,
      ) %>%
      summarize_vars("EVNTDESC", split_fun = drop_split_levels, .stats = "count_fraction")
  }

  lyt01 <- lyt01 %>%
    summarize_vars(
      vars = "IS_NOT_EVENT",
      .stats = "count_fraction",
      .labels = c(count_fraction = event_lvls[2]),
      nested = FALSE,
      show_labels = "hidden"
    ) %>%
    surv_time(
      vars = "AVAL",
      var_labels = paste0("Time to Event (", timeunit, ")"),
      is_event = "IS_EVENT",
      control = control_survt,
      table_names = "time_to_event"
    )

  for (perform in perform_analysis) {
    lyt01 <- lyt01 %>%
      coxph_pairwise(
        vars = "AVAL",
        is_event = "IS_EVENT",
        var_labels = if (perform == "strat") "Stratified Analysis" else "Unstratified Analysis",
        strat = if (perform == "strat") strata else NULL,
        control = control_cox_ph,
        table_names = if (perform == "strat") "coxph_stratified" else "coxph_unstratified"
      )
  }

  lyt <- lyt01 %>%
    surv_timepoint(
      vars = "AVAL",
      var_labels = timeunit,
      is_event = "IS_EVENT",
      control = control_survtp,
      .labels = c("pt_at_risk" = render_safe("{Patient_label} remaining at risk")),
      ...
    )

  lyt
}

#' @describeIn ttet01 Preprocessing
#'
#' @inheritParams gen_args
#' @param dataset (`string`) the name of a table in the `adam_db` object.
#'
#' @export
#'
ttet01_pre <- function(adam_db, dataset = "adtte",
                       ...) {
  adam_db[[dataset]] <- adam_db[[dataset]] %>%
    mutate(
      AVAL = convert_to_month(.data$AVAL, .data$AVALU),
      AVALU = "MONTHS",
      IS_EVENT = .data$CNSR == 0,
      IS_NOT_EVENT = .data$CNSR == 1,
      EVNT1 = factor(
        case_when(
          IS_EVENT == TRUE ~ render_safe("{Patient_label} with event (%)"),
          IS_EVENT == FALSE ~ render_safe("{Patient_label} without event (%)")
        ),
        levels = render_safe(c("{Patient_label} with event (%)", "{Patient_label} without event (%)"))
      ),
      EVNTDESC = factor(.data$EVNTDESC)
    )

  adam_db
}

#' @describeIn ttet01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
ttet01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `TTET01` Binary Outcomes Summary
#'
#' `TTET01` template may be used to summarize any binary outcome or response variable at
#' a single time point. Typical application for oncology
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' proc_data <- log_filter(syn_data, PARAMCD == "PFS", "adtte")
#' run(ttet01, proc_data)
#'
#' run(ttet01, proc_data,
#'   summarize_event = FALSE, perform_analysis = c("unstrat", "strat"),
#'   strata = c("STRATA1", "STRATA2"),
#'   conf_type = "log-log",
#'   time_point = c(6, 12),
#'   method = "both"
#' )
ttet01 <- chevron_t(
  main = ttet01_main,
  preprocess = ttet01_pre,
  postprocess = ttet01_post
)

# lbt05 ----

#' @describeIn lbt05 Main TLG function
#'
#' @inheritParams gen_args
#'
#' @details
#'  * Does not remove rows with zero counts by default.
#'  * Lab test results with missing `AVAL` values are excluded.
#'  * Split columns by arm, typically `ACTARM`.
#'
#' @note
#'  * `adam_db` object must contain an `adlb` table with columns `"ONTRTFL"`, `"PARCAT2"`, `"PARAM"`, `"ANRIND"`,
#'  `"AVALCAT1"`, and column specified by `arm_var`.
#'
#' @export
#'
lbt05_main <- function(adam_db,
                       arm_var = "ACTARM",
                       lbl_overall = NULL,
                       ...) {
  assert_all_tablenames(adam_db, c("adsl", "adlb"))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_valid_variable(adam_db$adlb, c("PARAM", "AVALCAT1", "ABN_DIR"), types = list(c("character", "factor")))
  assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
  assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)

  lbl_overall <- render_safe(lbl_overall)
  lbl_anrind <- var_labels_for(adam_db$adlb, "ABN_DIR")
  lbl_param <- var_labels_for(adam_db$adlb, "PARAM")

  map <- expand.grid(
    PARAM = levels(adam_db$adlb$PARAM),
    ABN_DIR = c("Low", "High"),
    stringsAsFactors = FALSE
  ) %>%
    arrange(.data$PARAM, desc(.data$ABN_DIR))

  lyt <- lbt05_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_param = lbl_param,
    lbl_anrind = lbl_anrind,
    map = map
  )

  tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)

  tbl
}

#' `lbt05` Layout
#'
#' @inheritParams gen_args
#'
#' @param lbl_param (`string`) label of the `PARAM` variable.
#' @param lbl_anrind (`string`) label of the `ANRIND` variable.
#' @param map (`data.frame`) mapping of `PARAM`s to directions of abnormality.
#'
#' @keywords internal
#'
lbt05_lyt <- function(arm_var,
                      lbl_overall,
                      lbl_param,
                      lbl_anrind,
                      map) {
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var) %>%
    ifneeded_add_overall_col(lbl_overall) %>%
    split_rows_by(
      "PARAM",
      label_pos = "topleft",
      split_label = lbl_param
    ) %>%
    summarize_num_patients(var = "USUBJID", .stats = "unique_count") %>%
    split_rows_by("ABN_DIR", split_fun = trim_levels_to_map(map)) %>%
    count_abnormal_by_marked(
      var = "AVALCAT1",
      variables = list(id = "USUBJID", param = "PARAM", direction = "ABN_DIR"),
      .formats = c("count_fraction" = format_count_fraction_fixed_dp)
    ) %>%
    append_topleft(paste("   ", lbl_anrind))
}

#' @describeIn lbt05 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt05_pre <- function(adam_db, ...) {
  adam_db$adlb <- adam_db$adlb %>%
    filter(
      .data$ONTRTFL == "Y",
      .data$PARCAT2 == "LS",
      !is.na(.data$AVAL)
    ) %>%
    mutate(ABN_DIR = factor(case_when(
      ANRIND == "LOW LOW" ~ "Low",
      ANRIND == "HIGH HIGH" ~ "High",
      TRUE ~ ""
    ), levels = c("Low", "High"))) %>%
    mutate(
      ABN_DIR = with_label(.data$ABN_DIR, "Direction of Abnormality"),
      PARAM = with_label(.data$PARAM, "Laboratory Test")
    ) %>%
    mutate(
      across(all_of(c("AVALCAT1", "ABN_DIR")), ~ reformat(.x, .env$missing_rule))
    )

  adam_db
}

#' @describeIn lbt05 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt05_post <- function(tlg, prune_0 = FALSE, ...) {
  if (prune_0) {
    has_lbl <- function(lbl) CombinationFunction(function(tr) obj_label(tr) == lbl)
    tlg <- prune_table(tlg, keep_rows(has_lbl("Any Abnormality")))

    if (is.null(prune_table(tlg))) {
      tlg <- build_table(rtables::basic_table(), df = data.frame())
      col_info(tlg) <- col_info(tlg)
    }
  }

  std_postprocess(tlg)
}

#' `LBT05` Table 1 (Default) Laboratory Abnormalities with Single and Replicated Marked.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(lbt05, syn_data)
lbt05 <- chevron_t(
  main = lbt05_main,
  preprocess = lbt05_pre,
  postprocess = lbt05_post
)

#' Check that all names are among column names
#'
#' @param df (`data.frame`)
#' @param x (`character`) the names of the columns to be checked.
#' @param null_ok (`flag`) can `x` be NULL.
#' @param qualifier (`string`) to be returned if the check fails.
#'
#' @keywords internal
#'
#' @examples
#' \dontrun{
#' check_all_colnames(mtcars, c("x", "y"))
#' }
check_all_colnames <- function(df, x, null_ok = TRUE, qualifier = NULL) {
  assert_data_frame(df)
  assert_character(x, null.ok = null_ok)
  assert_string(qualifier, null.ok = TRUE)

  diff <- setdiff(x, colnames(df))

  if (length(diff) == 0) {
    invisible(NULL)
  } else {
    paste(qualifier, "Expected column names:", toString(diff), "not in", deparse(substitute(df)))
  }
}

#' Check that at least one name is among column names
#'
#' @param df (`data.frame`)
#' @param x (`character`) the names of the columns to be checked.
#' @param null_ok (`flag`) can `x` be NULL.
#' @param qualifier (`string`) to be returned if the check fails.
#'
#' @keywords internal
#'
#' @examples
#' \dontrun{
#' check_all_colnames(mtcars, c("x", "y"))
#' }
check_one_colnames <- function(df, x, null_ok = TRUE, qualifier = NULL) {
  assert_data_frame(df)
  assert_character(x, null.ok = null_ok)
  assert_string(qualifier, null.ok = TRUE)

  common <- intersect(x, colnames(df))

  if (length(common) > 0) {
    invisible(NULL)
  } else {
    paste(qualifier, "At least one of:", toString(x), "is expected to be a column name of", deparse(substitute(df)))
  }
}

#' @include utils.R

# Chevron_tlg ----

#' `chevron_tlg` class
#'
#' The `chevron_tlg` class associates a `preprocess` function, a main `tlg` function and `AdAM` tables names and
#' optionally a `postprocess` function.
#'
#' @slot main (`function`) returning a `tlg`. Typically one of the `*_main` function from `chevron`.
#' @slot preprocess (`function`) returning a pre-processed `list` of `data.frames` amenable to `tlg` creation. Typically
#'   one of the `*_pre` function from `chevron`.
#' @slot postprocess (`function`) returning a post-processed `tlg`.
#'
#' @format NULL
#'
#' @note To ensure the correct execution of the workflow additional validation criteria are:
#' * the first argument of the `main` function must be `adam_db`, the input `list` of `data.frames` to pre-process. The
#' `...` argument is mandatory.
#' * the first argument of the `preprocess` function must be `adam_db`, the input `list` of `data.frames` to create
#' `tlg` output. The `...` argument is mandatory.
#' * the first argument of the `postprocess` function must be `tlg`, the input `TableTree` object to post-process. The
#' `...` argument is mandatory.
#'
#' @name chevron_tlg-class
#' @exportClass chevron_tlg
.chevron_tlg <- setClass(
  "chevron_tlg",
  contains = "VIRTUAL",
  slots = c(
    main = "function",
    preprocess = "function",
    postprocess = "function"
  )
)

# Validation ----

methods::setValidity("chevron_tlg", function(object) {
  coll <- makeAssertCollection()
  assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)
  assert_function(object@main, args = "...", add = coll)
  assert_function(object@preprocess, args = c("adam_db"), ordered = TRUE, add = coll)
  assert_function(object@preprocess, args = "...", add = coll)
  assert_function(object@postprocess, args = c("tlg"), ordered = TRUE, add = coll)
  assert_function(object@postprocess, args = "...", add = coll)
  reportAssertions(coll)
})

# Subclasses ----

## chevron_t ----

#' `chevron_t`
#'
#' `chevron_t`, a subclass of [chevron::chevron_tlg-class] with specific validation criteria to handle table creation
#'
#' @aliases chevron_table
#' @rdname chevron_tlg-class
#' @exportClass chevron_t
.chevron_t <- setClass(
  "chevron_t",
  contains = "chevron_tlg"
)

methods::setValidity("chevron_t", function(object) {
  coll <- makeAssertCollection()
  assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)
  reportAssertions(coll)
})

## chevron_l ----

#' `chevron_l`
#'
#' `chevron_l`, a subclass of [chevron::chevron_tlg-class] with specific validation criteria to handle listing creation
#'
#' @aliases chevron_listing
#' @rdname chevron_tlg-class
#' @exportClass chevron_l
.chevron_l <- setClass(
  "chevron_l",
  contains = "chevron_tlg"
)

methods::setValidity("chevron_l", function(object) {
  coll <- makeAssertCollection()
  assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)
  reportAssertions(coll)
})

## chevron_g ----

#' `chevron_g`
#'
#' `chevron_g`, a subclass of [chevron::chevron_tlg-class] with specific validation criteria to handle graph creation
#'
#' @aliases chevron_graph
#' @rdname chevron_tlg-class
#' @exportClass chevron_g
.chevron_g <- setClass(
  "chevron_g",
  contains = "chevron_tlg"
)

methods::setValidity("chevron_g", function(object) {
  coll <- makeAssertCollection()
  assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)
  reportAssertions(coll)
})


# Sub Constructor ----

#' `chevron_t` constructor
#'
#' @rdname chevron_tlg-class
#'
#' @inheritParams gen_args
#' @param ... not used
#'
#' @export
#'
#' @examples
#' chevron_t_obj <- chevron_t()
#' chevron_t_obj <- chevron_t(postprocess = function(tlg, indent, ...) {
#'   rtables::table_inset(tlg) <- indent
#'   tlg
#' })
#'
chevron_t <- function(main = function(adam_db, ...) build_table(basic_table(), adam_db[[1]]),
                      preprocess = function(adam_db, ...) adam_db,
                      postprocess = report_null,
                      ...) {
  res <- .chevron_t(
    main = main,
    preprocess = preprocess,
    postprocess = postprocess
  )

  res
}

#' `chevron_l` constructor
#'
#' @rdname chevron_tlg-class
#'
#' @inheritParams gen_args
#' @param ... not used
#'
#' @export
#'
#' @examples
#' chevron_l_obj <- chevron_l()
#'
chevron_l <- function(main = function(adam_db, ...) data.frame(),
                      preprocess = function(adam_db, ...) adam_db,
                      postprocess = function(tlg, ...) tlg,
                      ...) {
  res <- .chevron_l(
    main = main,
    preprocess = preprocess,
    postprocess = postprocess
  )

  res
}

#' `chevron_g` constructor
#'
#' @rdname chevron_tlg-class
#' @param ... not used
#'
#' @inheritParams gen_args
#'
#' @export
#'
#' @examples
#' chevron_g_obj <- chevron_g()
#' chevron_g_obj <- chevron_g(
#'   postprocess = function(tlg, title, ...) tlg + ggplot2::labs(main = title)
#' )
#'
chevron_g <- function(main = function(adam_db, ...) ggplot2::ggplot(),
                      preprocess = function(adam_db, ...) adam_db,
                      postprocess = function(tlg, ...) tlg,
                      ...) {
  res <- .chevron_g(
    main = main,
    preprocess = preprocess,
    postprocess = postprocess
  )

  res
}

# cfbt01 ----

#' @describeIn cfbt01 Main TLG function
#'
#' @inheritParams gen_args
#' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in
#'   table of `adam_db` is used as label.
#' @param visitvar (`string`) typically one of `"AVISIT"` or user-defined visit incorporating `"ATPT"`.
#' @param precision (named `list` of `integer`) where names are values found in the `PARAMCD` column and the the values
#'   indicate the number of digits in statistics. If `default` is set, and parameter precision not specified,
#'   the value for `default` will be used.
#' @param .stats (`character`) statistics names, see `tern::summarize_vars()`.
#' @param skip Named (`list`) of visit values that need to be inhibited.
#' @param ... additional arguments like `.indent_mods`, `.labels`.
#'
#' @details
#'  * The `Analysis Value` column, displays the number of patients, the mean, standard deviation, median and range of
#'  the analysis value for each visit.
#'  * The `Change from Baseline` column, displays the number of patient and the mean, standard deviation,
#'  median and range of changes relative to the baseline.
#'  * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
#'  * Split columns by arm, typically `ACTARM`.
#'  * Does not include a total column by default.
#'  * Sorted  based on factor level; first by `PARAM` labels in alphabetic order then by chronological time point given
#'  by `AVISIT`. Re-level to customize order
#'
#' @note
#'   * `adam_db` object must contain table named as `dataset` with the columns specified in `summaryvars`.
#'
#' @export
#'
cfbt01_main <- function(adam_db,
                        dataset,
                        arm_var = "ACTARM",
                        lbl_overall = NULL,
                        row_split_var = NULL,
                        summaryvars = c("AVAL", "CHG"),
                        visitvar = "AVISIT",
                        precision = list(default = 2L),
                        page_var = "PARAMCD",
                        .stats = c("n", "mean_sd", "median", "range"),
                        skip = list(CHG = "BASELINE"),
                        ...) {
  assert_all_tablenames(adam_db, c("adsl", dataset))
  assert_string(arm_var)
  assert_string(lbl_overall, null.ok = TRUE)
  assert_character(summaryvars, max.len = 2L, min.len = 1L)
  assert_character(row_split_var, null.ok = TRUE)
  assert_disjunct(row_split_var, c("PARAMCD", "PARAM", visitvar))
  assert_string(visitvar)
  assert_string(page_var, null.ok = TRUE)
  assert_subset(page_var, c(row_split_var, "PARAMCD"))
  df_lbl <- paste0("adam_db$", dataset)
  assert_valid_variable(adam_db[[dataset]], c(summaryvars), types = list("numeric"), empty_ok = TRUE, label = df_lbl)
  assert_valid_variable(
    adam_db[[dataset]], c(visitvar, row_split_var, "PARAM", "PARAMCD"),
    types = list(c("character", "factor")), label = df_lbl
  )
  assert_valid_variable(
    adam_db[[dataset]], "USUBJID",
    types = list(c("character", "factor")), empty_ok = TRUE, label = df_lbl
  )
  assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))
  assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)
  assert_list(precision, types = "integerish", names = "unique")

  vapply(precision, assert_int, FUN.VALUE = numeric(1), lower = 0)
  all_stats <- c(
    "n", "sum", "mean", "sd", "se", "mean_sd", "mean_se", "mean_ci", "mean_sei",
    "mean_sdi", "mean_pval", "median", "mad", "median_ci", "quantiles", "iqr", "range",
    "cv", "min", "max", "median_range", "geom_mean", "geom_cv"
  )
  assert_subset(.stats, all_stats)

  lbl_overall <- lbl_overall <- render_safe(lbl_overall)
  lbl_avisit <- var_labels_for(adam_db[[dataset]], visitvar)
  lbl_param <- var_labels_for(adam_db[[dataset]], "PARAM")

  summaryvars_lbls <- var_labels_for(adam_db[[dataset]], summaryvars)
  row_split_lbl <- var_labels_for(adam_db[[dataset]], row_split_var)

  lyt <- cfbt01_lyt(
    arm_var = arm_var,
    lbl_overall = lbl_overall,
    lbl_avisit = lbl_avisit,
    lbl_param = lbl_param,
    summaryvars = summaryvars,
    summaryvars_lbls = summaryvars_lbls,
    row_split_var = row_split_var,
    row_split_lbl = row_split_lbl,
    visitvar = visitvar,
    precision = precision,
    .stats = .stats,
    page_var = page_var,
    skip = skip,
    ...
  )

  tbl <- build_table(
    lyt,
    df = adam_db[[dataset]],
    alt_counts_df = adam_db$adsl
  )

  tbl
}

#' `cfbt01` Layout
#'
#' @inheritParams gen_args
#' @inheritParams cfbt01_main
#'
#' @param lbl_avisit (`string`) label of the `visitvar` variable.
#' @param lbl_param (`string`) label of the `PARAM` variable.
#' @param summaryvars (`character`) the variables to be analyzed. For this table, `AVAL` and `CHG` by default.
#' @param summaryvars_lbls (`character`) the label of the variables to be analyzed.
#' @param row_split_lbl (`character`) label of further row splits.
#' @param visitvar (`string`) typically one of `"AVISIT"` or user-defined visit incorporating `"ATPT"`.
#'
#' @keywords internal
#'
cfbt01_lyt <- function(arm_var,
                       lbl_overall,
                       lbl_avisit,
                       lbl_param,
                       summaryvars,
                       summaryvars_lbls,
                       row_split_var,
                       row_split_lbl,
                       visitvar,
                       precision,
                       page_var,
                       .stats,
                       skip,
                       ...) {
  page_by <- get_page_by(page_var, c(row_split_var, "PARAMCD"))
  label_pos <- ifelse(page_by, "hidden", "topleft")
  basic_table(show_colcounts = TRUE) %>%
    split_cols_by(arm_var, split_fun = if (!is.null(lbl_overall)) add_overall_level(lbl_overall, first = FALSE)) %>%
    split_rows_by_recurive(
      row_split_var,
      split_label = row_split_lbl,
      label_pos = head(label_pos, -1L), page_by = head(page_by, -1L)
    ) %>%
    split_rows_by(
      var = "PARAMCD",
      labels_var = "PARAM",
      split_fun = drop_split_levels,
      label_pos = tail(label_pos, 1L),
      split_label = lbl_param,
      page_by = tail(page_by, 1L)
    ) %>%
    split_rows_by(
      visitvar,
      split_fun = drop_split_levels,
      label_pos = "topleft",
      split_label = lbl_avisit
    ) %>%
    split_cols_by_multivar(
      vars = summaryvars,
      varlabels = summaryvars_lbls,
      nested = TRUE
    ) %>%
    analyze_colvars(
      afun = afun_skip,
      extra_args = list(
        visitvar = visitvar,
        paramcdvar = "PARAMCD",
        skip = skip,
        precision = precision,
        .stats = .stats,
        ...
      )
    )
}

#' @describeIn cfbt01 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
cfbt01_pre <- function(adam_db, dataset, ...) {
  adam_db[[dataset]] <- adam_db[[dataset]] %>%
    filter(.data$ANL01FL == "Y") %>%
    mutate(
      AVISIT = reorder(.data$AVISIT, .data$AVISITN),
      AVISIT = with_label(.data$AVISIT, "Analysis Visit"),
      AVAL = with_label(.data$AVAL, "Value at Visit"),
      CHG = with_label(.data$CHG, "Change from \nBaseline")
    )

  adam_db
}

#' @describeIn cfbt01 Postprocessing
#'
#' @inheritParams gen_args
#'
#' @export
cfbt01_post <- function(tlg, prune_0 = TRUE, ...) {
  if (prune_0) {
    tlg <- smart_prune(tlg)
  }
  std_postprocess(tlg)
}

#' `CFBT01` Change from Baseline By Visit Table.
#'
#' The `CFBT01` table provides an
#' overview of the actual values and its change from baseline of each respective arm
#' over the course of the trial.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dunlin)
#'
#' proc_data <- log_filter(
#'   syn_data,
#'   PARAMCD %in% c("DIABP", "SYSBP"), "advs"
#' )
#' run(cfbt01, proc_data, dataset = "advs")
cfbt01 <- chevron_t(
  main = cfbt01_main,
  preprocess = cfbt01_pre,
  postprocess = cfbt01_post
)

# lbt15 ----

#' @describeIn lbt15 Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
lbt15_pre <- function(adam_db, ...) {
  format <- rule(
    "LOW" = c("-3", "-4"),
    "MODERATE/NORMAL" = c("-2", "-1", "0", "1", "2"),
    "HIGH" = c("3", "4"),
    .to_NA = NULL
  )

  adam_db$adlb <- adam_db$adlb %>%
    filter(
      .data$ONTRTFL == "Y",
      .data$PARCAT2 == "SI"
    ) %>%
    mutate(
      PARAM = with_label(.data$PARAM, "Laboratory Test"),
      ANRIND = with_label(.data$ANRIND, "Direction of Abnormality")
    ) %>%
    mutate(
      ANRIND = reformat(.data$ATOXGR, .env$format),
      BNRIND = reformat(.data$BTOXGR, .env$format)
    )

  adam_db
}

#' `LBT15` Laboratory Test Shifts to `NCI-CTCAE` Grade 3-4 Post-Baseline Table.
#' @source `lbt04.R`
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' run(lbt15, syn_data)
lbt15 <- chevron_t(
  main = lbt04_main,
  preprocess = lbt15_pre,
  postprocess = lbt04_post
)

# aet05_all ----

#' @describeIn aet05_all Preprocessing
#'
#' @inheritParams gen_args
#'
#' @export
#'
aet05_all_pre <- function(adam_db, ...) {
  anl_tte <- adam_db$adaette %>%
    filter(.data$PARAMCD == "AEREPTTE") %>%
    select(all_of(c("USUBJID", "AVAL")))

  adam_db$adaette <- adam_db$adaette %>%
    filter(grepl("TOT", .data$PARAMCD)) %>%
    mutate(
      n_events = as.integer(.data$AVAL)
    ) %>%
    select(-c("AVAL")) %>%
    left_join(anl_tte, by = c("USUBJID"))

  adam_db
}

#' `AET05_ALL` Table 1 (Default) Adverse Event Rate Adjusted for Patient-Years at Risk - All Occurrences.
#'
#' The `AET05_ALL` table produces the standard adverse event rate adjusted for patient-years at risk summary
#' considering all occurrences.
#'
#' @include chevron_tlg-S4class.R
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dunlin)
#'
#' proc_data <- log_filter(syn_data, PARAMCD == "AETOT1" | PARAMCD == "AEREPTTE", "adaette")
#'
#' run(aet05_all, proc_data)
#'
#' run(aet05_all, proc_data, conf_level = 0.90, conf_type = "exact")
aet05_all <- chevron_t(
  main = aet05_main,
  preprocess = aet05_all_pre,
  postprocess = aet05_post,
  adam_datasets = c("adsl", "adaette")
)

1		# cmt01a ----
2
3		#' @describeIn cmt01a Default labels
4		#' @export
5		#'
6		cmt01_label <- c(
7		unique = "Total number of {patient_label} with at least one treatment",
8		nonunique = "Total number of treatments"
9		)
10
11		#' @describeIn cmt01a Main TLG function
12		#'
13		#' @inheritParams gen_args
14		#' @param row_split_var (`character`) the variable defining the medication category. By default `ATC2`.
15		#' @param medname_var (`string`) variable name of medical treatment name.
16		#' @param summary_labels (`list`) of summarize labels. See details.
17		#'
18		#' @details
19		#' * Data should be filtered for concomitant medication. `(ATIREL == "CONCOMITANT")`.
20		#' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
21		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
22		#' * Split columns by arm.
23		#' * Does not include a total column by default.
24		#' * Sort by medication class alphabetically and within medication class by decreasing total number of patients with
25		#' the specific medication.
26		#' `summary_labels` is used to control the summary for each level. If "all" is used, then each split will have that
27		#' summary statistic with the labels. One special case is "TOTAL", this is for the overall population.
28		#'
29		#' @note
30		#' * `adam_db` object must contain an `adcm` table with the columns specified in `row_split_var` and `medname_var`
31		#' as well as `"CMSEQ"`.
32		#'
33		#' @export
34		#'
35		cmt01a_main <- function(adam_db,
36		arm_var = "ARM",
37		lbl_overall = NULL,
38		row_split_var = "ATC2",
39		medname_var = "CMDECOD",
40		summary_labels = setNames(
41		rep(list(cmt01_label), length(row_split_var) + 1L), c("TOTAL", row_split_var)
42		),
43		...) {
44	3x	assert_all_tablenames(adam_db, "adsl", "adcm")
45	3x	assert_string(arm_var)
46	3x	assert_string(lbl_overall, null.ok = TRUE)
47	3x	assert_character(row_split_var, null.ok = TRUE)
48	3x	assert_list(summary_labels)
49	3x	assert_subset(names(summary_labels), c("all", "TOTAL", row_split_var))
50	3x	assert_subset(
51	3x	unique(unlist(lapply(summary_labels, names))),
52	3x	c("unique", "nonunique", "unique_count")
53		)
54	3x	if ("all" %in% names(summary_labels)) {
55	!	summary_labels <- lapply(
56	!	c(TOTAL = "TOTAL", setNames(row_split_var, row_split_var)),
57	!	function(x) {
58	!	modify_character(summary_labels$all, summary_labels[[x]])
59		}
60		)
61		}
62	3x	assert_valid_variable(adam_db$adcm, c(arm_var, row_split_var, medname_var), types = list(c("character", "factor")))
63	3x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
64	3x	assert_valid_variable(adam_db$adcm, c("USUBJID", "CMSEQ"), empty_ok = TRUE, types = list(c("character", "factor")))
65	3x	assert_valid_var_pair(adam_db$adsl, adam_db$adcm, arm_var)
66
67	3x	lbl_overall <- render_safe(lbl_overall)
68	3x	lbl_row_split <- var_labels_for(adam_db$adcm, row_split_var)
69	3x	lbl_medname_var <- var_labels_for(adam_db$adcm, medname_var)
70
71	3x	lyt <- occurrence_lyt(
72	3x	arm_var = arm_var,
73	3x	lbl_overall = lbl_overall,
74	3x	row_split_var = row_split_var,
75	3x	lbl_row_split = lbl_row_split,
76	3x	medname_var = medname_var,
77	3x	lbl_medname_var = lbl_medname_var,
78	3x	summary_labels = summary_labels,
79	3x	count_by = "CMSEQ"
80		)
81
82	3x	tbl <- build_table(lyt, adam_db$adcm, alt_counts_df = adam_db$adsl)
83
84	3x	tbl
85		}
86
87		#' @describeIn cmt01a Preprocessing
88		#'
89		#' @inheritParams cmt01a_main
90		#'
91		#' @export
92		#'
93		cmt01a_pre <- function(adam_db, ...) {
94	3x	adam_db$adcm <- adam_db$adcm %>%
95	3x	filter(.data$ANL01FL == "Y") %>%
96	3x	mutate(
97	3x	CMDECOD = with_label(reformat(.data$CMDECOD, nocoding), "Other Treatment"),
98	3x	ATC2 = reformat(.data$ATC2, nocoding),
99	3x	CMSEQ = as.character(.data$CMSEQ)
100		)
101	3x	adam_db
102		}
103
104		#' @describeIn cmt01a Postprocessing
105		#'
106		#' @inheritParams cmt01a_main
107		#' @inheritParams gen_args
108		#' @param sort_by_freq (`flag`) whether to sort medication class by frequency.
109		#'
110		#' @export
111		#'
112		cmt01a_post <- function(
113		tlg, prune_0 = TRUE,
114		sort_by_freq = FALSE, row_split_var = "ATC2",
115		medname_var = "CMDECOD", ...) {
116	3x	if (sort_by_freq) {
117	1x	tlg <- tlg %>%
118	1x	tlg_sort_by_var(
119	1x	var = row_split_var,
120	1x	scorefun = cont_n_allcols
121		)
122		}
123	3x	tlg <- tlg %>%
124	3x	tlg_sort_by_var(
125	3x	var = c(row_split_var, medname_var),
126	3x	scorefun = score_occurrences
127		)
128	3x	if (prune_0) {
129	3x	tlg <- smart_prune(tlg)
130		}
131	3x	std_postprocess(tlg)
132		}
133
134		#' `CMT01A` Concomitant Medication by Medication Class and Preferred Name.
135		#'
136		#' A concomitant medication
137		#' table with the number of subjects and the total number of treatments by medication class.
138		#'
139		#' @include chevron_tlg-S4class.R
140		#' @export
141		#'
142		#' @examples
143		#' library(dplyr)
144		#'
145		#' proc_data <- syn_data
146		#' proc_data$adcm <- proc_data$adcm %>%
147		#' filter(ATIREL == "CONCOMITANT")
148		#'
149		#' run(cmt01a, proc_data)
150		cmt01a <- chevron_t(
151		main = cmt01a_main,
152		preprocess = cmt01a_pre,
153		postprocess = cmt01a_post
154		)

1		# aet03 ----
2
3		#' @describeIn aet03 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#'
7		#' @details
8		#' * Default Adverse Events by Greatest Intensity table.
9		#' * Numbers represent absolute numbers of patients and fraction of `N`.
10		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
11		#' * Split columns by arm.
12		#' * Does not include a total column by default.
13		#' * Sort by Body System or Organ Class (`SOC`) and Dictionary-Derived Term (`PT`).
14		#'
15		#' @note
16		#' * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"`, `"AEDECOD"` and `"ASEV"`.
17		#'
18		#' @export
19		#'
20		aet03_main <- function(adam_db,
21		arm_var = "ACTARM",
22		lbl_overall = NULL,
23		...) {
24	1x	assert_all_tablenames(adam_db, "adsl", "adae")
25	1x	assert_string(arm_var)
26	1x	assert_string(lbl_overall, null.ok = TRUE)
27	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
28	1x	assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD", "ASEV"), types = list(c("character", "factor")))
29	1x	assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
30	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
31
32	1x	lbl_overall <- render_safe(lbl_overall)
33	1x	lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")
34	1x	lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
35	1x	intensity_grade <- levels(adam_db$adae[["ASEV"]])
36
37	1x	lyt <- aet03_lyt(
38	1x	arm_var = arm_var,
39	1x	lbl_overall = lbl_overall,
40	1x	lbl_aebodsys = lbl_aebodsys,
41	1x	lbl_aedecod = lbl_aedecod,
42	1x	intensity_grade = intensity_grade
43		)
44
45	1x	tbl <- build_table(lyt, df = adam_db$adae, alt_counts_df = adam_db$adsl)
46
47	1x	tbl
48		}
49
50		#' `aet03` Layout
51		#'
52		#' @inheritParams gen_args
53		#'
54		#' @param lbl_aebodsys (`string`) text label for `AEBODSYS`.
55		#' @param lbl_aedecod (`string`) text label for `AEDECOD`.
56		#' @param intensity_grade (`character`) describing the intensity levels present in the dataset.
57		#'
58		#' @keywords internal
59		#'
60		aet03_lyt <- function(arm_var,
61		lbl_overall,
62		lbl_aebodsys,
63		lbl_aedecod,
64		intensity_grade) {
65	4x	all_grade_groups <- list("- Any Intensity -" = intensity_grade)
66
67	4x	basic_table(show_colcounts = TRUE) %>%
68	4x	split_cols_by(var = arm_var) %>%
69	4x	ifneeded_add_overall_col(lbl_overall) %>%
70	4x	count_occurrences_by_grade(
71	4x	var = "ASEV",
72	4x	grade_groups = all_grade_groups,
73	4x	.formats = c("count_fraction" = format_count_fraction_fixed_dp)
74		) %>%
75	4x	split_rows_by(
76	4x	"AEBODSYS",
77	4x	child_labels = "visible",
78	4x	nested = TRUE,
79	4x	split_fun = drop_split_levels,
80	4x	label_pos = "topleft",
81	4x	split_label = lbl_aebodsys
82		) %>%
83	4x	summarize_occurrences_by_grade(
84	4x	var = "ASEV",
85	4x	grade_groups = all_grade_groups,
86	4x	.formats = c("count_fraction" = format_count_fraction_fixed_dp)
87		) %>%
88	4x	split_rows_by(
89	4x	"AEDECOD",
90	4x	child_labels = "visible",
91	4x	nested = TRUE,
92	4x	indent_mod = -1L,
93	4x	split_fun = drop_split_levels,
94	4x	label_pos = "topleft",
95	4x	split_label = lbl_aedecod
96		) %>%
97	4x	summarize_num_patients(
98	4x	var = "USUBJID",
99	4x	.stats = "unique",
100	4x	.labels = c("- Any Intensity -")
101		) %>%
102	4x	count_occurrences_by_grade(
103	4x	var = "ASEV",
104	4x	.indent_mods = -1L
105		)
106		}
107
108		#' @describeIn aet03 Preprocessing
109		#'
110		#' @inheritParams gen_args
111		#'
112		#' @export
113		#'
114		aet03_pre <- function(adam_db, ...) {
115	1x	asev_lvls <- c("MILD", "MODERATE", "SEVERE")
116	1x	adam_db$adae <- adam_db$adae %>%
117	1x	filter(.data$ANL01FL == "Y") %>%
118	1x	mutate(
119	1x	AEBODSYS = reformat(.data$AEBODSYS, nocoding),
120	1x	AEDECOD = reformat(.data$AEDECOD, nocoding),
121	1x	ASEV = factor(.data$ASEV, levels = asev_lvls)
122		) %>%
123	1x	filter(!is.na(.data$ASEV))
124
125	1x	adam_db
126		}
127
128		#' @describeIn aet03 Postprocessing
129		#'
130		#' @inheritParams gen_args
131		#'
132		#' @export
133		#'
134		aet03_post <- function(tlg, prune_0 = TRUE, ...) {
135	1x	tlg <- tlg %>%
136	1x	tlg_sort_by_vars(
137	1x	c("AEBODSYS", "AEDECOD"),
138	1x	scorefun = cont_n_allcols
139		)
140	1x	if (prune_0) tlg <- trim_rows(tlg)
141	1x	std_postprocess(tlg)
142		}
143
144		#' `AET03` Table 1 (Default) Advert Events by Greatest Intensity Table 1.
145		#'
146		#' An adverse events table categorized by System
147		#' Organ Class, Dictionary-Derived Term and Greatest intensity.
148		#'
149		#' @include chevron_tlg-S4class.R
150		#' @export
151		#'
152		#' @examples
153		#' run(aet03, syn_data)
154		aet03 <- chevron_t(
155		main = aet03_main,
156		preprocess = aet03_pre,
157		postprocess = aet03_post
158		)

1		# fstg02 ----
2
3		#' @describeIn fstg02 Main TLG Function
4		#'
5		#' @details
6		#' * No overall value.
7		#' * Keep zero count rows by default.
8		#'
9		#' @inheritParams gen_args
10		#' @param dataset (`string`) the name of a table in the `adam_db` object.
11		#' @param arm_var (`string`) the arm variable name used for group splitting.
12		#' @param subgroups (`character`) the subgroups variable name to list baseline risk factors.
13		#' @param strata_var (`character`) required if stratified analysis is performed.
14		#' @param stat_var (`character`) the names of statistics to be reported in `tabulate_survival_subgroups`.
15		#' @param max_colwidth (`int`) maximum width of columns. Stratification label longer than this will be truncated.
16		#' @param ... Further arguments passed to `g_forest` and `extract_rsp_subgroups` (a wrapper for
17		#' `h_odds_ratio_subgroups_df` and `h_proportion_subgroups_df`). For details, see the documentation in `tern`.
18		#' Commonly used arguments include `col_symbol_size`, `col`, `vline`, `groups_lists`, `conf_level`,
19		#' `method`, `label_all`, etc.
20		#'
21		#' @note
22		#' * `adam_db` object must contain the table specified by `dataset` with `"PARAMCD"`, `"ARM"`,
23		#' `"AVAL"`, `"AVALU"`, `"CNSR"`, and the columns specified by `subgroups` which is denoted as
24		#' `c("SEX", "AGEGR1", "RACE")` by default.
25		#' * If the plot is too large to be rendered in the output, please refer to `FSTG01`.
26		#'
27		#' @return a `gTree` object.
28		#'
29		#' @export
30		#'
31		fstg02_main <- function(adam_db,
32		dataset = "adtte",
33		arm_var = "ARM",
34		subgroups = c("SEX", "AGEGR1", "RACE"),
35		strata_var = NULL,
36		stat_var = c("n_tot", "n", "median", "hr", "ci"),
37		max_colwidth = 10,
38		...) {
39	1x	assert_all_tablenames(adam_db, c("adsl", dataset))
40	1x	df_lbl <- paste0("adam_db$", dataset)
41	1x	assert_string(arm_var)
42	1x	assert_int(max_colwidth)
43	1x	assert_character(subgroups, null.ok = TRUE)
44	1x	assert_character(strata_var, null.ok = TRUE)
45	1x	assert_character(stat_var, null.ok = TRUE)
46	1x	assert_valid_variable(adam_db[[dataset]], arm_var, types = list("factor"), n.levels = 2, label = df_lbl)
47	1x	assert_valid_variable(adam_db[[dataset]], c("USUBJID", "PARAMCD", "AVALU"),
48	1x	types = list(c("character", "factor")),
49	1x	label = df_lbl
50		)
51	1x	assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_lbl)
52	1x	assert_valid_variable(adam_db[[dataset]], "IS_EVENT", types = list("logical"), label = df_lbl)
53	1x	assert_valid_variable(adam_db[[dataset]], c(subgroups, strata_var),
54	1x	types = list(c("factor")), na_ok = TRUE,
55	1x	label = df_lbl
56		)
57	1x	assert_single_value(adam_db[[dataset]]$PARAMCD, label = df_lbl)
58	1x	assert_single_value(adam_db[[dataset]]$AVALU, label = df_lbl)
59
60	1x	timeunit <- unique(adam_db[[dataset]]$AVALU)
61
62	1x	variables <- list(
63	1x	arm = arm_var,
64	1x	tte = "AVAL",
65	1x	is_event = "IS_EVENT",
66	1x	subgroups = subgroups,
67	1x	strata_var = strata_var
68		)
69
70	1x	df <- execute_with_args(extract_survival_subgroups,
71	1x	variables = variables,
72	1x	data = adam_db[[dataset]],
73		...
74		)
75	1x	df$survtime$subgroup <- stringr::str_trunc(df$survtime$subgroup, max_colwidth)
76	1x	df$hr$subgroup <- stringr::str_trunc(df$hr$subgroup, max_colwidth)
77	1x	result <- basic_table() %>%
78	1x	tabulate_survival_subgroups(df, vars = stat_var, time_unit = timeunit)
79	1x	cw <- pmin(propose_column_widths(result), max_colwidth + 2)
80	1x	final_width <- stringWidth(strrep("x", cw))
81	1x	execute_with_args(
82	1x	g_forest,
83	1x	tbl = result,
84		...,
85	1x	width_row_names = final_width[1],
86	1x	width_columns = final_width[-1],
87	1x	draw = FALSE
88		)
89		}
90
91		#' @describeIn fstg02 Preprocessing
92		#'
93		#' @inheritParams fstg02_main
94		#'
95		#' @export
96		#'
97		fstg02_pre <- function(adam_db, ...) {
98	1x	adam_db$adtte <- adam_db$adtte %>%
99	1x	mutate(
100	1x	ARM = droplevels(.data$ARM),
101	1x	AVAL = convert_to_month(.data$AVAL, .data$AVALU),
102	1x	AVALU = "MONTHS",
103	1x	IS_EVENT = .data$CNSR == 0
104		)
105	1x	adam_db
106		}
107
108		# `fstg02` Pipeline ----
109
110		#' `FSTG02` Subgroup Analysis of Survival Duration.
111		#'
112		#' The template produces the subgroup analysis of survival duration graphic.
113		#'
114		#' @include chevron_tlg-S4class.R
115		#' @export
116		#'
117		#' @examples
118		#' library(dplyr)
119		#' library(dunlin)
120		#'
121		#' proc_data <- log_filter(
122		#' syn_data,
123		#' PARAMCD == "OS" & ARM %in% c("A: Drug X", "B: Placebo"), "adtte"
124		#' )
125		#' run(fstg02, proc_data,
126		#' subgroups = c("SEX", "AGEGR1", "RACE"),
127		#' conf_level = 0.90, dataset = "adtte"
128		#' )
129		fstg02 <- chevron_g(
130		main = fstg02_main,
131		preproces = fstg02_pre
132		)

1		# lbt14 ----
2
3		#' @describeIn lbt14 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param gr_missing (`string`) how missing baseline grades should be handled. Defaults to `"incl"` to include the
7		#' `"Missing"`
8		#' level. Other options are `"excl"` to exclude patients with missing baseline grades and `"gr_0"` to convert missing
9		#' baseline grades to grade 0.
10		#' @param direction (`string`) one of `"high"` or `"low"` indicating which shift direction should be detailed.
11		#'
12		#' @details
13		#' * This table follows ADaMIG v1.1.
14		#' * Only the worst grade recorded for each patient is included in the table.
15		#' * If no missing baseline lab results, the "Missing" level of `BTOXGR` is excluded.
16		#' * Grading takes value from -4 to 4, negative value means the abnormality direction is low,
17		#' positive value means the abnormality direction is high.
18		#' * Grades 0, 1, 2, 3, and 4 are counted as `"Not Low"` when `direction = "low"`. Conversely, when `direction =
19		#' "high"`, Grades 0, -1, -2, -3, and -4 are counted as `"Not High".
20		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
21		#' * Split columns by arm, typically `ACTARM`.
22		#'
23		#' @note
24		#' * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"PARAM"`, `"BTOXGR"`, `"ATOXGR"`,
25		#' and the column specified by `arm_var`.
26		#'
27		#' @export
28		#'
29		lbt14_main <- function(adam_db,
30		arm_var = "ACTARM",
31		lbl_overall = NULL,
32		gr_missing = "incl",
33		page_var = "PARAMCD",
34		...) {
35	4x	assert_all_tablenames(adam_db, c("adsl", "adlb"))
36	4x	assert_string(arm_var)
37	4x	assert_string(lbl_overall, null.ok = TRUE)
38	4x	assert_choice(gr_missing, c("incl", "excl", "gr_0"))
39	4x	assert_subset(page_var, "PARAMCD")
40	4x	assert_valid_variable(adam_db$adlb, c("ATOXGR", "BTOXGR"), types = list("factor"), na_ok = TRUE)
41	4x	assert_valid_variable(adam_db$adlb, c("PARAMCD", "PARAM"), types = list(c("character", "factor")), na_ok = FALSE)
42	4x	assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
43	4x	assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
44	4x	assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)
45
46	4x	lbl_overall <- render_safe(lbl_overall)
47	4x	lbl_param <- var_labels_for(adam_db$adlb, "PARAM")
48	4x	lbl_btoxgr <- var_labels_for(adam_db$adlb, "BTOXGR")
49
50	4x	lyt <- lbt14_lyt(
51	4x	arm_var = arm_var,
52	4x	lbl_overall = lbl_overall,
53	4x	lbl_param = lbl_param,
54	4x	lbl_btoxgr = lbl_btoxgr,
55	4x	page_var = page_var
56		)
57
58	4x	tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)
59
60	4x	tbl
61		}
62
63		#' `lbt14` Layout
64		#'
65		#' @inheritParams lbt14_main
66		#'
67		#' @keywords internal
68		#'
69		lbt14_lyt <- function(arm_var,
70		lbl_overall,
71		lbl_param,
72		lbl_btoxgr,
73		page_var) {
74	14x	page_by <- !is.null(page_var)
75	14x	label_pos <- ifelse(page_by, "hidden", "topleft")
76	14x	basic_table(show_colcounts = TRUE) %>%
77	14x	split_cols_by(arm_var) %>%
78	14x	ifneeded_add_overall_col(lbl_overall) %>%
79	14x	split_rows_by(
80	14x	var = "PARAMCD",
81	14x	labels_var = "PARAM",
82	14x	split_fun = drop_split_levels,
83	14x	label_pos = label_pos,
84	14x	split_label = lbl_param,
85	14x	page_by = page_by
86		) %>%
87	14x	split_rows_by(
88	14x	"BTOXGR",
89	14x	label_pos = "topleft",
90	14x	split_label = lbl_btoxgr
91		) %>%
92	14x	summarize_num_patients(var = "USUBJID", .stats = c("unique_count"), unique_count_suffix = FALSE) %>%
93	14x	count_occurrences_by_grade("ATOXGR", denom = "n", drop = FALSE, .indent_mods = 3L) %>%
94	14x	append_topleft(paste0(stringr::str_dup(" ", 2L * (5L - page_by)), "Post-baseline NCI-CTCAE Grade"))
95		}
96
97		#' @describeIn lbt14 Preprocessing
98		#'
99		#' @inheritParams gen_args
100		#' @inheritParams lbt14_main
101		#'
102		#' @export
103		#'
104		lbt14_pre <- function(adam_db,
105		gr_missing = "incl",
106		direction = "low",
107		...) {
108	4x	assert_choice(gr_missing, c("incl", "excl", "gr_0"))
109	4x	assert_choice(direction, c("low", "high"))
110
111	4x	if (direction == "high") {
112	1x	adam_db$adlb <- adam_db$adlb %>%
113	1x	filter(.data$WGRHIFL == "Y") %>%
114	1x	h_adsl_adlb_merge_using_worst_flag(
115	1x	adsl = adam_db$adsl,
116	1x	worst_flag = c("WGRHIFL" = "Y")
117		)
118		} else {
119	3x	adam_db$adlb <- adam_db$adlb %>%
120	3x	filter(.data$WGRLOFL == "Y") %>%
121	3x	h_adsl_adlb_merge_using_worst_flag(
122	3x	adsl = adam_db$adsl,
123	3x	worst_flag = c("WGRLOFL" = "Y")
124		)
125		}
126
127	4x	grade_rule <- get_grade_rule(direction, gr_missing)
128	4x	adam_db$adlb <- adam_db$adlb %>%
129	4x	mutate(
130	4x	across(all_of(c("BTOXGR", "ATOXGR")), ~ reformat(.x, grade_rule))
131		)
132
133	4x	adam_db
134		}
135
136		#' @describeIn lbt14 Postprocessing
137		#'
138		#' @inheritParams gen_args
139		#'
140		#' @export
141		#'
142		lbt14_post <- function(tlg, prune_0 = TRUE, ...) {
143	4x	if (prune_0) tlg <- tlg %>% trim_rows()
144	4x	std_postprocess(tlg)
145		}
146
147		#' `LBT14` Laboratory Test Results Shift Table – Highest `NCI-CTCAE` Grade Post-Baseline by
148		#' Baseline Grade (Low or High Direction).
149		#'
150		#' @include chevron_tlg-S4class.R
151		#' @export
152		#'
153		#' @examples
154		#' run(lbt14, syn_data)
155		lbt14 <- chevron_t(
156		main = lbt14_main,
157		preprocess = lbt14_pre,
158		postprocess = lbt14_post
159		)

1		# rspt01 ----
2
3		#' @describeIn rspt01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param dataset (`string`) the name of a table in the `adam_db` object.
7		#' @param ref_group (`string`) The name of the reference group, the value should
8		#' be identical to the values in `arm_var`, if not specified, it will by default
9		#' use the first level or value of `arm_var`.
10		#' @param odds_ratio (`flag`) should the odds ratio be calculated, default is `TRUE`
11		#' @param perform_analysis (`string`) option to display statistical comparisons using stratified analyses,
12		#' or unstratified analyses, or both, e.g. `c("unstrat", "strat")`. Only unstratified will be displayed by default
13		#' @param strata (`string`) stratification factors, e.g. `strata = c("STRATA1", "STRATA2")`, by default as NULL
14		#' @param conf_level (`numeric`) the level of confidence interval, default is 0.95.
15		#' @param methods (`list`) a named list, use a named list to control, for example:
16		#' `methods = list(prop_conf_method = "wald",
17		#' diff_conf_method = "wald",
18		#' strat_diff_conf_method = "ha",
19		#' diff_pval_method = "fisher",
20		#' strat_diff_pval_method = "schouten")`
21		#' `prop_conf_method` controls the methods of calculating proportion confidence interval,
22		#' `diff_conf_method` controls the methods of calculating unstratified difference confidence interval,
23		#' `strat_diff_conf_method` controls the methods of calculating stratified difference confidence interval,
24		#' `diff_pval_method` controls the methods of calculating unstratified p-value for odds ratio,
25		#' `strat_diff_pval_method` controls the methods of calculating stratified p-value for odds ratio,
26		#' see more details in `tern`
27		#'
28		#' @details
29		#' * No overall value.
30		#'
31		#' @export
32		#'
33		rspt01_main <- function(adam_db,
34		dataset = "adrs",
35		arm_var = "ARM",
36		ref_group = NULL,
37		odds_ratio = TRUE,
38		perform_analysis = "unstrat",
39		strata = NULL,
40		conf_level = 0.95,
41		methods = list(),
42		...) {
43	1x	assert_string(dataset)
44	1x	assert_all_tablenames(adam_db, "adsl", dataset)
45	1x	assert_string(arm_var)
46	1x	assert_string(ref_group, null.ok = TRUE)
47	1x	assert_flag(odds_ratio)
48	1x	assert_subset(perform_analysis, c("unstrat", "strat"))
49	1x	assert_character(
50	1x	strata,
51	1x	null.ok = !"strat" %in% perform_analysis,
52	1x	min.len = as.integer(!"strat" %in% perform_analysis)
53		)
54	1x	df_label <- sprintf("adam_db$%s", dataset)
55	1x	assert_valid_variable(
56	1x	adam_db$adsl, c("USUBJID", arm_var),
57	1x	types = list(c("character", "factor"))
58		)
59	1x	assert_valid_variable(
60	1x	adam_db[[dataset]], c("USUBJID", arm_var, "RSP_LAB"),
61	1x	types = list(c("character", "factor")), label = df_label
62		)
63	1x	assert_valid_variable(adam_db[[dataset]], "IS_RSP", types = list("logical"), label = df_label)
64	1x	assert_valid_variable(
65	1x	adam_db[[dataset]], c("PARAMCD", "PARAM"),
66	1x	types = list(c("character", "factor")), label = df_label
67		)
68	1x	assert_single_value(adam_db[[dataset]]$PARAMCD, label = sprintf("adam_db$%s$PARAMCD", dataset))
69	1x	assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)
70	1x	assert_subset(ref_group, lvls(adam_db[[dataset]][[arm_var]]))
71
72	1x	ref_group <- ref_group %\|\|% lvls(adam_db[[dataset]][[arm_var]])[1]
73
74	1x	lyt <- rspt01_lyt(
75	1x	arm_var = arm_var,
76	1x	rsp_var = "IS_RSP",
77	1x	ref_group = ref_group,
78	1x	odds_ratio = odds_ratio,
79	1x	perform_analysis = perform_analysis,
80	1x	strata = strata,
81	1x	conf_level = conf_level,
82	1x	methods = methods
83		)
84
85	1x	tbl <- build_table(lyt, adam_db[[dataset]], alt_counts_df = adam_db$adsl)
86
87	1x	tbl
88		}
89
90		#' `rspt01` Layout
91		#'
92		#' @inheritParams gen_args
93		#'
94		#' @keywords internal
95		#'
96		rspt01_lyt <- function(arm_var,
97		rsp_var,
98		ref_group,
99		odds_ratio,
100		perform_analysis,
101		strata,
102		conf_level,
103		methods) {
104	7x	lyt01 <- basic_table(show_colcounts = TRUE) %>%
105	7x	split_cols_by(var = arm_var, ref_group = ref_group) %>%
106	7x	estimate_proportion(
107	7x	vars = rsp_var,
108	7x	conf_level = conf_level,
109	7x	method = methods[["prop_conf_method"]] %\|\|% "waldcc",
110	7x	table_names = "est_prop"
111		)
112
113	7x	for (perform in perform_analysis) {
114	8x	lyt01 <- lyt01 %>%
115	8x	proportion_lyt(
116	8x	arm_var = arm_var,
117	8x	odds_ratio = odds_ratio,
118	8x	strata = if (perform == "strat") strata else NULL,
119	8x	conf_level = conf_level,
120	8x	methods = methods,
121	8x	rsp_var = rsp_var
122		)
123		}
124
125	7x	lyt <- lyt01 %>%
126	7x	estimate_multinomial_response(
127	7x	var = "RSP_LAB",
128	7x	conf_level = conf_level,
129	7x	method = methods[["prop_conf_method"]] %\|\|% "waldcc"
130		)
131
132	7x	lyt
133		}
134
135		#' @describeIn rspt01 Preprocessing
136		#'
137		#' @inheritParams gen_args
138		#'
139		#' @export
140		#'
141		rspt01_pre <- function(adam_db, ...) {
142	1x	adam_db$adrs <- adam_db$adrs %>%
143	1x	mutate(RSP_LAB = tern::d_onco_rsp_label(.data$AVALC)) %>%
144	1x	mutate(IS_RSP = .data$AVALC %in% c("CR", "PR"))
145	1x	adam_db
146		}
147
148		#' @describeIn rspt01 Postprocessing
149		#'
150		#' @inheritParams gen_args
151		#'
152		#' @export
153		#'
154		rspt01_post <- function(tlg, prune_0 = TRUE, ...) {
155	!	if (prune_0) {
156	!	tlg <- smart_prune(tlg)
157		}
158	!	std_postprocess(tlg)
159		}
160
161		#' `RSPT01` Binary Outcomes Summary
162		#'
163		#' `RSPT01` template may be used to summarize any binary outcome or response variable at
164		#' a single time point. Typical application for oncology
165		#'
166		#' @include chevron_tlg-S4class.R
167		#' @export
168		#'
169		#' @examples
170		#' library(dplyr)
171		#' library(dunlin)
172		#'
173		#' proc_data <- log_filter(syn_data, PARAMCD == "BESRSPI", "adrs")
174		#'
175		#' run(rspt01, proc_data)
176		#'
177		#' run(rspt01, proc_data,
178		#' odds_ratio = FALSE, perform_analysis = c("unstrat", "strat"),
179		#' strata = c("STRATA1", "STRATA2"), methods = list(diff_pval_method = "fisher")
180		#' )
181		rspt01 <- chevron_t(
182		main = rspt01_main,
183		preprocess = rspt01_pre,
184		postprocess = rspt01_post
185		)

1		#' @keywords internal
2		split_and_summ_num_patients <- function(lyt, var, label, stats, summarize_labels, split_indent, ...) {
3	13x	assert_string(var)
4	13x	assert_string(label)
5	13x	lyt <- lyt %>%
6	13x	split_rows_by(
7	13x	var,
8	13x	child_labels = "visible",
9	13x	nested = TRUE,
10	13x	split_fun = rtables::drop_split_levels,
11	13x	label_pos = "topleft",
12	13x	split_label = label,
13	13x	indent_mod = split_indent
14		)
15	13x	if (length(stats) > 0) {
16	13x	lyt <- lyt %>%
17	13x	summarize_num_patients(
18	13x	var = "USUBJID",
19	13x	.stats = stats,
20	13x	.labels = setNames(summarize_labels, stats),
21		...
22		)
23		}
24	13x	lyt
25		}
26		#' @keywords internal
27		get_sort_path <- function(x) {
28	46x	assert_character(x, null.ok = TRUE)
29	46x	x2 <- as.character(rbind(x, rep("*", length(x))))
30	46x	x2[-length(x2)]
31		}
32		#' @keywords internal
33		tlg_sort_by_vars <- function(tlg, vars, scorefun = cont_n_allcols, ...) {
34	18x	purrr::reduce(
35	18x	.x = lapply(seq_len(length(vars)), function(i) vars[seq_len(i)]),
36	18x	.f = tlg_sort_by_var,
37	18x	.init = tlg,
38	18x	scorefun = scorefun,
39		...
40		)
41		}
42		#' @keywords internal
43		tlg_sort_by_var <- function(tlg, var, scorefun = cont_n_allcols, ...) {
44	38x	assert_character(var)
45	38x	if (length(var) == 0) {
46	!	return(tlg)
47		}
48	38x	var_path <- get_sort_path(var)
49	38x	tlg %>%
50	38x	valid_sort_at_path(
51	38x	path = var_path,
52	38x	scorefun = scorefun,
53		...
54		)
55		}
56		#' @keywords internal
57		valid_sort_at_path <- function(tt, path, scorefun, ...) {
58	46x	if (valid_row_path(tt, path)) {
59	39x	tryCatch(
60	39x	sort_at_path(tt, path, scorefun, ...),
61	39x	error = function(e) {
62	!	tt
63		}
64		)
65		} else {
66	7x	tt
67		}
68		}
69		#' @keywords internal
70		valid_row_path <- function(tlg, row_path) {
71	46x	if (nrow(tlg) == 0) {
72	2x	return(TRUE)
73		}
74	44x	rpaths <- row_paths(tlg)
75	44x	non_star <- which(row_path != "*") + 1
76	44x	rpaths_choice <- unique(lapply(rpaths, `[`, non_star))
77	44x	any(vapply(rpaths_choice, identical, FUN.VALUE = TRUE, y = row_path[non_star - 1]))
78		}
79
80		#' Count patients recursively
81		#' @param lyt (`PreDataTableLayouts`) `rtable` layout.
82		#' @param anl_vars Named (`list`) of analysis variables.
83		#' @param anl_lbls (`character`) of labels.
84		#' @param lbl_vars Named (`list`) of analysis labels.
85		#' @keywords internal
86		count_patients_recursive <- function(lyt, anl_vars, anl_lbls, lbl_vars) {
87	6x	assert_list(anl_vars, names = "unique", types = "character")
88	6x	assert_character(anl_lbls, min.chars = 1L, len = length(anl_vars))
89	6x	nms <- names(anl_vars)
90	6x	for (k in seq_len(length(anl_vars))) {
91	7x	lyt <- lyt %>%
92	7x	count_patients_with_flags(
93	7x	var = "USUBJID",
94	7x	flag_variables = setNames(lbl_vars[[k]], anl_vars[[k]]),
95	7x	denom = "N_col",
96	7x	var_labels = anl_lbls[k],
97	7x	show_labels = "visible",
98	7x	table_names = nms[k],
99	7x	.indent_mods = 0L
100		)
101		}
102	6x	lyt
103		}
104		#' @keywords internal
105		score_all_sum <- function(tt) {
106	102x	cleaf <- collect_leaves(tt)[[1]]
107	102x	if (NROW(cleaf) == 0) {
108	!	stop("score_all_sum score function used at subtable [", obj_name(tt), "] that has no content.")
109		}
110	102x	sum(sapply(row_values(cleaf), function(cv) cv[1]))
111		}
112		#' @keywords internal
113		summarize_row <- function(lyt, vars, afun, ...) {
114	2x	summarize_row_groups(lyt = lyt, var = vars, cfun = afun, ...)
115		}
116
117		#' Summary factor allowing NA
118		#' @param x (`factor`) input.
119		#' @param denom (`string`) denominator choice.
120		#' @param .N_row (`integer`) number of rows in row-split dataset.
121		#' @param .N_col (`integer`) number of rows in column-split dataset.
122		#' @param ... Not used
123		#' @keywords internal
124		s_summary_na <- function(x, labelstr, denom = c("n", "N_row", "N_col"), .N_row, .N_col, ...) { # nolint
125	210x	denom <- match.arg(denom)
126	210x	y <- list()
127	210x	y$n <- length(x)
128	210x	y$count <- as.list(table(x, useNA = "no"))
129	210x	dn <- switch(denom,
130	210x	n = length(x),
131	210x	N_row = .N_row,
132	210x	N_col = .N_col
133		)
134	210x	y$count_fraction <- lapply(y$count, function(x) {
135	714x	c(x, ifelse(dn > 0, x / dn, 0))
136		})
137	210x	y$n_blq <- sum(grepl("BLQ\|LTR\|<[1-9]", x))
138	210x	y
139		}
140		#' Summarize variables allow `NA`
141		#' @keywords internal
142		summarize_vars_allow_na <- function(
143		lyt, vars, var_labels = vars,
144		nested = TRUE, ..., show_labels = "default", table_names = vars,
145		section_div = NA_character_, .stats = c("n", "count_fraction"),
146		.formats = list(count_fraction = format_count_fraction_fixed_dp), .labels = NULL, .indent_mods = NULL, inclNAs = TRUE) { # nolint
147	7x	afun <- make_afun(s_summary_na, .stats, .formats, .labels, .indent_mods, .ungroup_stats = c("count_fraction"))
148	7x	analyze(
149	7x	lyt = lyt, vars = vars, var_labels = var_labels,
150	7x	afun = afun, nested = nested, extra_args = list(...),
151	7x	inclNAs = inclNAs, show_labels = show_labels, table_names = table_names,
152	7x	section_div = section_div
153		)
154		}
155
156		#' Count or summarize by groups
157		#' @param lyt (`PreDataTableLayouts`) `rtable` layout.
158		#' @param var (`string`) of analysis variable.
159		#' @param level (`string`) level to be displayed.
160		#' @param detail_vars (`character`) of variables for detail information.
161		#' @keywords internal
162		count_or_summarize <- function(lyt, var, level, detail_vars, indent_mod = 0L, ...) {
163	27x	assert_string(level)
164	27x	if (is.null(detail_vars)) {
165	20x	lyt <- lyt %>%
166	20x	count_values(
167	20x	var,
168	20x	values = level,
169	20x	table_names = paste(var, level, sep = "_"),
170	20x	.formats = list(count_fraction = format_count_fraction_fixed_dp),
171	20x	.indent_mods = indent_mod,
172		...
173		)
174		} else {
175	7x	lyt <- lyt %>%
176	7x	split_rows_by(var, split_fun = keep_split_levels(level), indent_mod = indent_mod) %>%
177	7x	summarize_row_groups(
178	7x	format = format_count_fraction_fixed_dp
179		) %>%
180	7x	split_rows_by_recurive(detail_vars[-length(detail_vars)], split_fun = drop_split_levels) %>%
181	7x	summarize_vars(
182	7x	detail_vars[length(detail_vars)],
183	7x	.stats = "count_fraction",
184	7x	denom = "N_col",
185	7x	show_labels = "hidden",
186	7x	.formats = list(count_fraction = format_count_fraction_fixed_dp),
187		...
188		)
189		}
190	27x	lyt
191		}
192
193		#' Count or summarize by groups
194		#' @param lyt (`PreDataTableLayouts`) `rtable` layout.
195		#' @param row_split_var (`character`) variable to split rows by.
196		#' @param ... Further arguments for `split_rows_by`
197		#' @keywords internal
198		split_rows_by_recurive <- function(lyt, row_split_var, ...) {
199	41x	args <- list(...)
200	41x	for (i in seq_len(length(row_split_var))) {
201	22x	args_i <- lapply(args, obtain_value, index = i)
202	22x	lyt <- do_call(
203	22x	split_rows_by,
204	22x	c(
205	22x	list(
206	22x	lyt = lyt,
207	22x	row_split_var
208		),
209	22x	args_i
210		)
211		)
212		}
213	41x	lyt
214		}
215
216		#' Obtain value from a vector
217		#' @keywords internal
218		obtain_value <- function(obj, index) {
219	62x	if (is.list(obj)) {
220	!	return(obj[[index]])
221		}
222	62x	if (is.vector(obj) && length(obj) >= index) {
223	60x	return(obj[index])
224		}
225	2x	return(obj)
226		}
227
228		#' Get page by value
229		#' @keywords internal
230		get_page_by <- function(var, vars) {
231	34x	assert_character(vars, null.ok = TRUE)
232	34x	assert_character(var, null.ok = TRUE, max.len = 1L)
233	34x	ret <- rep(FALSE, length(vars))
234	34x	if (is.null(var) \|\| length(var) == 0) {
235	15x	return(ret)
236		}
237	19x	index <- match(var, vars)
238	19x	assert_int(index, na.ok = TRUE)
239	19x	if (is.na(index)) {
240	!	return(ret)
241		}
242	19x	ret[seq_len(index)] <- TRUE
243	19x	return(ret)
244		}
245
246		#' Proportion layout
247		#'
248		#' @inheritParams rspt01_main
249		#' @param lyt layout created by `rtables`
250		#'
251		#' @keywords internal
252		proportion_lyt <- function(lyt, arm_var, methods, strata, conf_level, odds_ratio = TRUE, rsp_var = "IS_RSP") {
253	8x	non_stratified <- length(strata) == 0L
254	8x	lyt <- lyt %>%
255	8x	estimate_proportion_diff(
256	8x	vars = rsp_var,
257	8x	show_labels = "visible",
258	8x	var_labels = if (non_stratified) "Unstratified Analysis" else "Stratified Analysis",
259	8x	conf_level = conf_level,
260	8x	method = if (non_stratified) {
261	6x	methods[["diff_conf_method"]] %\|\|% "waldcc"
262		} else {
263	2x	methods[["strat_diff_conf_method"]] %\|\|% "cmh"
264		},
265	8x	variables = list(strata = strata),
266	8x	table_names = if (non_stratified) "est_prop_diff" else "est_prop_diff_strat"
267		) %>%
268	8x	test_proportion_diff(
269	8x	vars = rsp_var,
270	8x	method = if (non_stratified) {
271	6x	methods[["diff_pval_method"]] %\|\|% "chisq"
272		} else {
273	2x	methods[["strat_diff_pval_method"]] %\|\|% "cmh"
274		},
275	8x	variables = list(strata = strata),
276	8x	table_names = if (non_stratified) "test_prop_diff" else "test_prop_diff_strat"
277		)
278
279	8x	if (odds_ratio) {
280	4x	lyt <- lyt %>%
281	4x	estimate_odds_ratio(
282	4x	vars = rsp_var,
283	4x	variables = if (non_stratified) list(strata = strata, arm = arm_var),
284	4x	table_names = if (non_stratified) "est_or" else "est_or_strat"
285		)
286		}
287
288	8x	lyt
289		}
290
291		#' Helper function to add a row split if specified
292		#'
293		#' @param lyt (`PreDataTableLayouts`) object.
294		#' @param var (`string`) the name of the variable initiating a new row split.
295		#' @param lbl_var (`string`)the label of the variable `var`.
296		#'
297		#' @keywords internal
298		#'
299		#' @return `PreDataTableLayouts` object.
300		#'
301		ifneeded_split_row <- function(lyt, var, lbl_var) {
302	2x	if (is.null(var)) {
303	1x	lyt
304		} else {
305	1x	split_rows_by(lyt, var,
306	1x	label_pos = "topleft",
307	1x	split_label = lbl_var
308		)
309		}
310		}
311
312		#' Helper function to add a column split if specified
313		#'
314		#' @param lyt (`rtables`) object.
315		#' @param var (`string`) the name of the variable initiating a new column split.
316		#' @param ... Additional arguments for `split_cols_by`.
317		#'
318		#' @keywords internal
319		#'
320		#' @return `rtables` object.
321		#'
322		ifneeded_split_col <- function(lyt, var, ...) {
323	16x	if (is.null(var)) {
324	11x	lyt
325		} else {
326	5x	split_cols_by(
327	5x	lyt = lyt,
328	5x	var = var,
329		...
330		)
331		}
332		}
333
334		#' Create a Null Report
335		#' @rdname report_null
336		#' @aliases null_report
337		#' @param tlg (`TableTree`) object.
338		#' @param ... not used. Important to be used directly as post processing function.
339		#'
340		#' @export
341		#'
342		#' @return original `TableTree` or a null report if no observation are found in the table.
343		#'
344		report_null <- function(tlg, ...) {
345	167x	assert_true(is.null(tlg) \|\| rtables::is_rtable(tlg))
346
347	167x	if (is.null(tlg) \|\| nrow(tlg) == 0L) {
348	25x	return(null_report)
349		}
350	142x	if (count_children(tlg) == 0) {
351	1x	return(null_report)
352		}
353	141x	tlg
354		}
355
356		#' Count Children
357		#' @keywords internal
358		count_children <- function(x) {
359	2540x	assert_true(rtables::is_rtable(x))
360	2540x	if (is(x, "ElementaryTable")) {
361	1069x	return(length(x@children))
362		}
363	1471x	sum(vapply(
364	1471x	tree_children(x),
365	1471x	count_children,
366	1471x	FUN.VALUE = 0
367		))
368		}
369
370		#' @export
371		#' @rdname report_null
372		null_report <- rtables::rtable(
373		header = "",
374		rrow("", "Null Report: No observations met the reporting criteria for inclusion in this output.")
375		)
376
377		#' @export
378		#' @rdname report_null
379		null_listing <- rlistings::as_listing(
380		df = data.frame(x = formatters::with_label(
381		"Null Report: No observations met the reporting criteria for inclusion in this output.", ""
382		))
383		)
384
385		has_overall_col <- function(lbl_overall) {
386	128x	!is.null(lbl_overall) && !identical(lbl_overall, "")
387		}
388
389		ifneeded_add_overall_col <- function(lyt, lbl_overall) {
390	128x	if (has_overall_col(lbl_overall)) {
391	14x	add_overall_col(lyt, label = lbl_overall)
392		} else {
393	114x	lyt
394		}
395		}
396
397		#' Analyze skip baseline
398		#' @param x value to analyze
399		#' @param .var variable name.
400		#' @param .spl_context split context.
401		#' @param paramcdvar (`string`) name of parameter code.
402		#' @param visitvar (`string`) name of the visit variable.
403		#' @param skip Named (`character`) indicating the pairs to skip in analyze.
404		#' @param .stats (`character`) See `tern::summarize_variables`.
405		#' @param .label (`character`) See `tern::summarize_variables`.
406		#' @param .indent_mods (`integer`) See `tern::summarize_variables`.
407		#' @param .N_col (`int`) See `tern::summarize_variables`.
408		#' @param .N_row (`int`) See `tern::summarize_variables`.
409		#' @param ... additional arguments for `tern::a_summary`.
410		#' @inheritParams cfbt01_main
411		#' @keywords internal
412		afun_skip <- function(
413		x, .var, .spl_context, paramcdvar, visitvar, skip,
414		precision, .stats, .labels = NULL, .indent_mods = NULL, .N_col, .N_row, ...) { # nolint
415	1452x	param_val <- .spl_context$value[which(.spl_context$split == paramcdvar)]
416		# Identify context
417	1452x	split_level <- .spl_context$value[which(.spl_context$split == visitvar)]
418	1452x	pcs <- if (.var %in% names(skip) && split_level %in% skip[[.var]]) {
419	1452x	NA
420		} else {
421	1341x	precision[[param_val]] %\|\|% precision[["default"]] %\|\|% 2
422		}
423
424	1452x	fmts <- lapply(.stats, summary_formats, pcs = pcs, FALSE)
425	1452x	names(fmts) <- .stats
426	1452x	fmts_na <- lapply(.stats, summary_formats, pcs = pcs, ne = TRUE)
427	1452x	ret <- tern::a_summary(
428	1452x	.stats = .stats, .formats = fmts, .labels = .labels, .indent_mods = .indent_mods,
429	1452x	x = x, .var = .var, .spl_context = .spl_context, .N_col = .N_col, .N_row = .N_row, ...
430		)
431	1452x	for (i in seq_len(length(ret))) {
432	5808x	attr(ret[[i]], "format_na_str") <- fmts_na[[i]]()
433		}
434	1452x	ret
435		}
436
437		summary_formats <- function(x, pcs, ne = FALSE) {
438	11616x	assert_int(pcs, lower = 0, na.ok = TRUE)
439	11616x	switch(x,
440	2904x	n = h_format_dec(format = "%s", digits = pcs - pcs, ne = ne),
441		min = ,
442		max = ,
443	!	sum = h_format_dec(format = "%s", digits = pcs, ne = ne),
444		mean = ,
445		sd = ,
446		median = ,
447		mad = ,
448		iqr = ,
449		cv = ,
450		geom_mean = ,
451		geom_cv = ,
452	2904x	se = h_format_dec(format = "%s", digits = pcs + 1, ne = ne),
453		mean_sd = ,
454	2904x	mean_se = h_format_dec(format = "%s (%s)", digits = rep(pcs + 1, 2), ne = ne),
455		mean_ci = ,
456		mean_sei = ,
457		median_ci = ,
458	!	mean_sdi = h_format_dec(format = "(%s, %s)", digits = rep(pcs + 1, 2), ne = ne),
459	!	mean_pval = h_format_dec(format = "%s", digits = 2, ne = ne),
460	!	quantiles = h_format_dec(format = "(%s - %s)", digits = rep(pcs + 1, 2), ne = ne),
461	2904x	range = h_format_dec(format = "%s - %s", digits = rep(pcs, 2), ne = ne),
462	!	median_range = h_format_dec(format = "%s (%s - %s)", digits = c(pcs, pcs + 1, pcs + 1), ne = ne)
463		)
464		}
465
466		split_fun_map <- function(map) {
467	9x	if (is.null(map)) {
468	6x	drop_split_levels
469		} else {
470	3x	trim_levels_to_map(map = map)
471		}
472		}
473
474		infer_mapping <- function(map_df, df) {
475	3x	assert_data_frame(df)
476	3x	vars <- colnames(map_df)
477	3x	assert_names(names(df), must.include = vars)
478	3x	for (x in vars) {
479	7x	if (!test_subset(map_df[[x]], lvls(df[[x]]))) {
480	!	rlang::abort(
481	!	paste0(
482	!	"Provided map should only contain valid levels in dataset in variable ", x,
483	!	". Consider convert ", x, " to factor first and add",
484	!	toString(setdiff(map_df[[x]], lvls(df[[x]]))), "levels to it."
485		)
486		)
487		}
488		}
489	3x	res <- df[vars] %>%
490	3x	unique() %>%
491	3x	arrange(across(everything())) %>%
492	3x	mutate(across(everything(), as.character))
493	3x	if (!is.null(map_df)) {
494	3x	dplyr::full_join(map_df, res, by = colnames(map_df))[vars]
495		} else {
496	!	res
497		}
498		}
499
500
501		#' Occurrence Layout
502		#'
503		#' @inheritParams gen_args
504		#' @inheritParams cmt01a_main
505		#' @param lbl_medname_var (`string`) label for the variable defining the medication name.
506		#' @keywords internal
507		#'
508		occurrence_lyt <- function(arm_var,
509		lbl_overall,
510		row_split_var,
511		lbl_row_split,
512		medname_var,
513		lbl_medname_var,
514		summary_labels,
515		count_by) {
516	17x	split_indent <- vapply(c("TOTAL", row_split_var), function(x) {
517	!	if (length(summary_labels[[x]]) > 0L) -1L else 0L
518	17x	}, FUN.VALUE = 0L)
519	17x	split_indent[1L] <- 0L
520	17x	lyt <- basic_table() %>%
521	17x	split_cols_by(var = arm_var) %>%
522	17x	add_colcounts() %>%
523	17x	ifneeded_add_overall_col(lbl_overall)
524	17x	if (length(summary_labels$TOTAL) > 0) {
525	17x	lyt <- lyt %>%
526	17x	analyze_num_patients(
527	17x	vars = "USUBJID",
528	17x	count_by = count_by,
529	17x	.stats = names(summary_labels$TOTAL),
530	17x	show_labels = "hidden",
531	17x	.labels = render_safe(summary_labels$TOTAL)
532		)
533		}
534	17x	for (k in seq_len(length(row_split_var))) {
535	13x	lyt <- split_and_summ_num_patients(
536	13x	lyt = lyt,
537	13x	count_by = count_by,
538	13x	var = row_split_var[k],
539	13x	label = lbl_row_split[k],
540	13x	split_indent = split_indent[k],
541	13x	stats = names(summary_labels[[row_split_var[k]]]),
542	13x	summarize_labels = render_safe(summary_labels[[row_split_var[k]]])
543		)
544		}
545	17x	lyt %>%
546	17x	count_occurrences(
547	17x	vars = medname_var,
548	17x	drop = length(row_split_var) > 0,
549	17x	.indent_mods = unname(tail(split_indent, 1L))
550		) %>%
551	17x	append_topleft(paste0(stringr::str_dup(" ", 2 * length(row_split_var)), lbl_medname_var))
552		}

1		#' @include chevron_tlg-S4class.R
2
3		# run ----
4
5		#' Run the pipeline
6		#'
7		#' Execute the pre-processing, main and post-processing functions in a single run.
8		#'
9		#' @inheritParams gen_args
10		#' @param object (`chevron_tlg`) input.
11		#' @param auto_pre (`flag`) whether to perform the default pre processing step.
12		#' @param verbose (`flag`) whether to print argument information.
13		#' @param ... extra arguments to pass to the pre-processing, main and post-processing functions.
14		#' @param user_args (`list`) arguments from `...`.
15		#'
16		#' @name run
17		#' @export
18		setGeneric(
19		"run",
20	169x	function(object, adam_db, auto_pre = TRUE, verbose = FALSE, ..., user_args = list(...)) standardGeneric("run")
21		)
22
23		#' Run the pipeline
24		#' @rdname run
25		#' @export
26		#' @examples
27		#' run(mng01, syn_data, auto_pre = TRUE, dataset = "adlb")
28		setMethod(
29		f = "run",
30		signature = "chevron_tlg",
31		definition = function(object, adam_db, auto_pre = TRUE, verbose = FALSE, ..., user_args = list(...)) {
32	169x	assert_list(adam_db, types = "list")
33	169x	assert_flag(auto_pre)
34	169x	assert_flag(verbose)
35	169x	assert_list(user_args, names = "unique")
36	169x	if (verbose) {
37	4x	cl <- match.call()
38	4x	print_args(
39	4x	cl,
40	4x	user_args,
41	4x	args_ls(object, omit = c("...", "adam_db", "tlg")), auto_pre
42		)
43		}
44	169x	proc_data <- if (auto_pre) {
45	168x	list(adam_db = do_call(object@preprocess, c(list(adam_db), user_args)))
46		} else {
47	1x	list(adam_db = adam_db)
48		}
49
50	158x	res_tlg <- list(tlg = do_call(object@main, c(proc_data, user_args)))
51
52	148x	do_call(object@postprocess, c(res_tlg, user_args))
53		}
54		)
55
56		#' Print Arguments
57		#' @keywords internal
58		print_args <- function(run_call, additional_args, args, auto_pre = TRUE) {
59	4x	assert_class(run_call, "call")
60	4x	assert_list(args)
61	4x	assert_flag(auto_pre)
62	4x	run_call[[1]] <- NULL
63	4x	run_call <- as.list(run_call)
64	4x	if (!is.null(additional_args)) {
65	4x	run_call <- c(run_call[c("object", "adam_db")], additional_args)
66		} else {
67	!	run_call[c("auto_pre", "verbose")] <- NULL
68		}
69	4x	nms_args <- unique(unlist(lapply(args, names)))
70	4x	nms_call <- names(run_call)
71	4x	m <- pmatch(nms_call, nms_args)
72	4x	nms_call[!is.na(m)] <- nms_args[m[!is.na(m)]]
73	4x	names(run_call) <- nms_call
74	4x	cat(
75	4x	"Using template: ",
76	4x	if (is.name(run_call$object)) run_call$object else paste("object of class", class(run_call$object)),
77	4x	"\n"
78		)
79	4x	cat(
80	4x	"Using data: ",
81	4x	if (is.name(run_call$adam_db)) run_call$adam_db else paste("object of class", class(run_call$adam_db)),
82	4x	"\n"
83		)
84	4x	if (auto_pre) {
85	4x	cat("\nPre args:\n")
86	4x	print_list(get_subset(args$preprocess, run_call))
87		}
88	4x	cat("\nMain args:\n")
89	4x	print_list(get_subset(args$main, run_call))
90	4x	cat("\nPost args:\n")
91	4x	print_list(get_subset(args$postprocess, run_call))
92	4x	add_args <- run_call[
93	4x	!names(run_call) %in% c(names(args$main), names(args$postprocess), names(args$preprocess), "object", "adam_db")
94		]
95	4x	if (length(add_args) > 0) {
96	1x	cat("\nAdditional args:\n")
97	1x	print_list(add_args)
98		}
99	4x	cat("\n\n")
100		}
101
102		#' Subset Arguments and Merge
103		#' @keywords internal
104		get_subset <- function(x, y) {
105	12x	utils::modifyList(
106	12x	x,
107	12x	y[names(y) %in% names(x)],
108	12x	keep.null = TRUE
109		)
110		}
111
112		#' Print list
113		#' @keywords internal
114		print_list <- function(x, indent = 2L) {
115	15x	if (length(x) == 0) {
116	2x	cat(paste0(
117	2x	stringr::str_dup(" ", indent),
118	2x	"No mapped argument.\n"
119		))
120	2x	return()
121		}
122	13x	k <- names(x)
123	13x	m_charx <- max(nchar(k), 1)
124	13x	for (k in names(x)) {
125	29x	cat(
126	29x	sprintf(
127	29x	paste0("%s%-", m_charx + 2, "s: %s\n"),
128	29x	stringr::str_dup(" ", indent), k,
129	29x	deparse_print(x[[k]], m_charx + indent + 2)
130		)
131		)
132		}
133		}
134
135		#' Deparse print
136		#' @keywords internal
137		deparse_print <- function(x, indent, max_line = getOption("chevron.arg_max_line", 5L)) {
138	29x	assert_int(indent)
139	29x	assert_int(max_line, lower = 1L)
140	29x	ret <- deparse(x)
141	29x	sep <- paste0("\n", stringr::str_dup(" ", indent))
142	29x	if (length(ret) > max_line) {
143	1x	ret[max_line] <- sprintf("... (print of class <%s> truncated)", toString(class(x)))
144	1x	ret <- ret[seq_len(max_line)]
145		}
146	29x	paste(ret, collapse = sep)
147		}
148
149		# args_ls ----
150
151		#' Get Arguments List
152		#'
153		#' @param x (`chevron_tlg`) input.
154		#' @param simplify (`flag`) whether to simplify the output, coalescing the values of the parameters. The order of
155		#' priority for the value of the parameters is: `main`, `preprocess` and `postprocess`.
156		#' @param omit (`character`) the names of the argument to omit from the output.
157		#'
158		#' @rdname args_ls
159		#' @export
160	7x	setGeneric("args_ls", function(x, simplify = FALSE, omit = NULL) standardGeneric("args_ls"))
161
162		#' @rdname args_ls
163		#' @export
164		setMethod(
165		f = "args_ls",
166		signature = "chevron_tlg",
167		definition = function(x, simplify = FALSE, omit = NULL) {
168	7x	assert_flag(simplify)
169	7x	assert_character(omit, null.ok = TRUE)
170
171	7x	x_ls <- list(
172	7x	main = formals(x@main),
173	7x	preprocess = formals(x@preprocess),
174	7x	postprocess = formals(x@postprocess)
175		)
176
177	7x	x_sel <- lapply(x_ls, function(y) y[!names(y) %in% omit])
178
179	7x	res <- if (simplify) {
180	2x	Reduce(fuse_sequentially, x_sel)
181		} else {
182	5x	x_sel
183		}
184
185	7x	res
186		}
187		)
188
189		# main ----
190
191		#' Main
192		#'
193		#' retrieve or set `main` function.
194		#'
195		#' @param x (`chevron_tlg`) input.
196		#'
197		#' @aliases main
198		#' @export
199	!	setGeneric("main", function(x) standardGeneric("main"))
200
201		#' @rdname main
202		#' @export
203		setMethod(
204		f = "main",
205		signature = "chevron_tlg",
206		definition = function(x) {
207	!	x@main
208		}
209		)
210
211		#' Set Main Function
212		#'
213		#' @param x (`chevron_tlg`) input.
214		#' @param value (`function`) returning a `tlg`. Typically one of the `_main` function of `chevron`.
215		#'
216		#' @rdname main
217		#' @export
218	2x	setGeneric("main<-", function(x, value) standardGeneric("main<-"))
219
220		#' @rdname main
221		#' @export
222		setMethod(
223		f = "main<-",
224		signature = "chevron_tlg",
225		definition = function(x, value) {
226	2x	x@main <- value
227	2x	validObject(x)
228	1x	x
229		}
230		)
231
232		# preprocess ----
233
234		#' Pre process
235		#'
236		#' retrieve or set `preprocess` function.
237		#'
238		#' @param x (`chevron_tlg`) input.
239		#'
240		#' @aliases preprocess
241		#' @export
242	2x	setGeneric("preprocess", function(x) standardGeneric("preprocess"))
243
244		#' @rdname preprocess
245		#' @export
246		setMethod(
247		f = "preprocess",
248		signature = "chevron_tlg",
249		definition = function(x) {
250	2x	x@preprocess
251		}
252		)
253
254		#' Set Preprocess Function
255		#'
256		#' @param x (`chevron_tlg`) input.
257		#' @param value (`function`) returning a pre-processed `list` of `data.frames` amenable to `tlg` creation. Typically
258		#' one of the `_pre` function of `chevron`.
259		#'
260		#' @rdname preprocess
261		#' @export
262	4x	setGeneric("preprocess<-", function(x, value) standardGeneric("preprocess<-"))
263
264		#' @rdname preprocess
265		#' @export
266		setMethod(
267		f = "preprocess<-",
268		signature = "chevron_tlg",
269		definition = function(x, value) {
270	4x	x@preprocess <- value
271	4x	validObject(x)
272	3x	x
273		}
274		)
275
276		# postprocess ----
277
278		#' Post process
279		#'
280		#' retrieve or set `postprocess` function.
281		#'
282		#' @param x (`chevron_tlg`) input.
283		#'
284		#' @aliases postprocess
285		#' @export
286	1x	setGeneric("postprocess", function(x) standardGeneric("postprocess"))
287
288		#' @rdname postprocess
289		#' @export
290		setMethod(
291		f = "postprocess",
292		signature = "chevron_tlg",
293		definition = function(x) {
294	1x	x@postprocess
295		}
296		)
297
298		#' Postprocess Assignment Function
299		#'
300		#' @param x (`chevron_tlg`) input.
301		#' @param value (`function`) returning a post-processed `tlg`.
302		#'
303		#' @rdname postprocess
304		#' @export
305	2x	setGeneric("postprocess<-", function(x, value) standardGeneric("postprocess<-"))
306
307		#' @rdname postprocess
308		#' @export
309		setMethod(
310		f = "postprocess<-",
311		signature = "chevron_tlg",
312		definition = function(x, value) {
313	2x	x@postprocess <- value
314	2x	validObject(x)
315	1x	x
316		}
317		)
318
319		# script ----
320
321		#' Create Script for Parameters Assignment
322		#'
323		#' @param x (`chevron_tlg`) input.
324		#' @param adam_db (`string`) the name of the dataset.
325		#' @param details (`flag`) deprecated. Whether to show the code of all functions.
326		#' @param args (`string`) the name of argument list.
327		#'
328		#' @name script
329		#' @rdname script
330		NULL
331
332		## script_funs ----
333
334		#' Create Script for `TLG` Generation
335		#'
336		#' @rdname script
337		#' @export
338	2x	setGeneric("script_funs", function(x, adam_db, args, details = FALSE) standardGeneric("script_funs"))
339
340		#' @rdname script
341		#' @export
342		#'
343		#' @examples
344		#' script_funs(aet04, adam_db = "syn_data", args = "args")
345		setMethod(
346		f = "script_funs",
347		signature = "chevron_tlg",
348		definition = function(x, adam_db, args, details) {
349	2x	checkmate::assert_flag(details)
350	2x	checkmate::assert_string(adam_db)
351	2x	checkmate::assert_string(args)
352	!	if (!missing(details)) lifecycle::deprecate_warn("0.2.2", "chevron::script_funs(details = )")
353	2x	tlg_name <- deparse(substitute(x))
354	2x	checkmate::assert_string(tlg_name, pattern = "^[a-zA-Z]+\\w+$")
355	2x	c(
356	2x	"# Edit Preprocessing Function.",
357	2x	glue::glue("preprocess({tlg_name}) <- "),
358	2x	deparse(preprocess(x), control = c("useSource")),
359		"",
360	2x	"# Create TLG",
361	2x	glue::glue(
362	2x	"tlg_output <- run(object = {tlg_name}, adam_db = {adam_db}",
363	2x	", verbose = TRUE, user_args = {args})"
364		)
365		)
366		}
367		)

1		# assert_all_tablenames ----
2
3		#' Assert that all names are among names of a `list` of `data.frame`.
4		#'
5		#' @param db (`list` of `data.frame`) input to check for the presence of tables.
6		#' @param tab (`character`) the names of the tables to be checked.
7		#' @param null_ok (`flag`) can `x` be NULL.
8		#' @param qualifier (`string`) to be returned if the check fails.
9		#'
10		#' @export
11		#'
12		#' @examples
13		#' \dontrun{
14		#'
15		#' lsd <- list(
16		#' mtcars = mtcars,
17		#' iris = iris
18		#' )
19		#'
20		#' assert_all_tablenames(lsd, c("mtcars", "iris", "x"), qualifier = "first test:")
21		#' }
22		assert_all_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
23	223x	assert_list(db, types = "data.frame", names = "unique")
24	223x	assert_character(tab, null.ok = null_ok)
25	223x	assert_string(qualifier, null.ok = TRUE)
26
27	223x	diff <- setdiff(tab, names(db))
28
29	223x	if (length(diff) == 0) {
30	221x	invisible(NULL)
31		} else {
32	2x	stop(
33	2x	paste(qualifier, "Expected table names:", toString(diff), "not in", deparse(substitute(db)))
34		)
35		}
36		}
37
38		# assert_one_tablenames ----
39
40		#' Assert that at least one name is among table names of a `list` of `data.frame`.
41		#'
42		#' @param db (`list` of `data.frame`) input to check for the presence or tables.
43		#' @param tab (`character`) the names of the tables to be checked.
44		#' @param null_ok (`flag`) can `x` be NULL.
45		#' @param qualifier (`string`) to be returned if the check fails.
46		#'
47		#' @keywords internal
48		#'
49		#' @examples
50		#' \dontrun{
51		#'
52		#' lsd <- list(
53		#' mtcars = mtcars,
54		#' iris = iris
55		#' )
56		#'
57		#' assert_one_tablenames(lsd, c("mtcars", "x", "y"), qualifier = "first test:")
58		#' }
59		assert_one_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {
60	4x	assert_list(db, types = "data.frame", names = "unique")
61	4x	assert_character(tab, null.ok = null_ok)
62	4x	assert_string(qualifier, null.ok = TRUE)
63
64	4x	diff <- setdiff(tab, names(db))
65
66	4x	common <- intersect(tab, names(db))
67
68	4x	if (length(common) > 0) {
69	2x	invisible(NULL)
70		} else {
71	2x	stop(
72	2x	paste(qualifier, "At least one of:", toString(tab), "is expected to be a table name of", deparse(substitute(db)))
73		)
74		}
75		}
76
77
78
79		# assert_single_value ----
80
81		#' Check variable only has one unique value.
82		#' @param x value vector.
83		#' @param label (`string`) label of input.
84		#' @export
85		assert_single_value <- function(x, label = deparse(substitute(x))) {
86	53x	unique_param_val <- unique(x)
87	53x	if (length(unique_param_val) > 1) {
88	!	stop(
89	!	quote_str(label),
90	!	" has more than one values ",
91	!	toString(unique_param_val),
92	!	", only one value is allowed."
93		)
94		}
95		}
96
97		# assert_valid_var ----
98
99		#' @title Check whether var is valid
100		#' @details
101		#' This function checks the variable values are valid or not.
102		#' @param x value of col_split variable
103		#' @param label (`string`) hints.
104		#' @param na_ok (`flag`) whether NA value is allowed
105		#' @param empty_ok (`flag`) whether length 0 value is allowed.
106		#' @param ... Further arguments to methods.
107		#' @export
108		assert_valid_var <- function(x, label, na_ok, empty_ok, ...) {
109	1404x	UseMethod("assert_valid_var")
110		}
111		#' @rdname assert_valid_var
112		#' @export
113		#' @param min_chars (`integer`) the minimum length of the characters.
114		assert_valid_var.character <- function(
115		x, label = deparse(substitute(x)),
116		na_ok = FALSE, empty_ok = FALSE,
117		min_chars = 1L, ...) {
118	345x	assert_character(
119	345x	x,
120	345x	min.chars = min_chars,
121	345x	min.len = as.integer(!empty_ok),
122	345x	any.missing = na_ok,
123	345x	.var.name = label,
124		...
125		)
126		}
127
128		#' @rdname assert_valid_var
129		#' @export
130		assert_valid_var.factor <- function(
131		x, label = deparse(substitute(x)),
132		na_ok = FALSE, empty_ok = FALSE,
133		min_chars = 1L, ...) {
134	807x	assert_character(
135	807x	levels(x),
136	807x	min.chars = min_chars,
137	807x	.var.name = paste("level of", label)
138		)
139	806x	assert_factor(
140	806x	x,
141	806x	min.levels = as.integer(!empty_ok),
142	806x	any.missing = na_ok,
143	806x	.var.name = label,
144		...
145		)
146		}
147
148		#' @rdname assert_valid_var
149		#' @export
150		assert_valid_var.logical <- function(x, label = deparse(substitute(x)), na_ok = TRUE, empty_ok = FALSE, ...) {
151	143x	assert_logical(
152	143x	x,
153	143x	min.len = as.integer(!empty_ok),
154	143x	any.missing = na_ok,
155	143x	.var.name = label,
156		...
157		)
158		}
159		#' @rdname assert_valid_var
160		#' @param integerish (`flag`) whether the number should be treated as `integerish`.
161		#' @export
162		assert_valid_var.numeric <- function(
163		x, label = deparse(substitute(x)),
164		na_ok = TRUE, empty_ok = FALSE, integerish = FALSE, ...) {
165	109x	check_fun <- if (integerish) assert_integerish else assert_numeric
166	109x	check_fun(
167	109x	x,
168	109x	min.len = as.integer(!empty_ok),
169	109x	any.missing = na_ok,
170	109x	.var.name = label,
171		...
172		)
173		}
174
175		#' @rdname assert_valid_var
176		#' @export
177		assert_valid_var.default <- function(x, label = deparse(substitute(x)), na_ok = FALSE, empty_ok = FALSE, ...) {
178		}
179
180		# assert_valid_variable ----
181
182		#' Check variables in a data frame are valid character or factor.
183		#' @param df (`data.frame`) input dataset.
184		#' @param vars (`character`) variables to check.
185		#' @param label (`string`) labels of the data frame.
186		#' @param types Named (`list`) of type of the input.
187		#' @param ... further arguments for `assert_valid_var`. Please note that different methods have different arguments
188		#' so if provided make sure the variables to check is of the same class.
189		#'
190		#' @export
191		assert_valid_variable <- function(df, vars, label = deparse(substitute(df)), types = NULL, ...) {
192	840x	assert_names(colnames(df), must.include = vars, what = "colnames")
193
194	834x	labels <- sprintf("%s$%s", label, vars)
195	834x	if (length(types) == 1 && is.null(names(types))) {
196	747x	types <- setNames(rep(types, length(vars)), vars)
197		}
198	834x	if (!is.null(types)) {
199	787x	vars_to_check <- which(vars %in% names(types))
200	787x	mapply(
201	787x	assert_valid_type,
202	787x	df[vars[vars_to_check]],
203	787x	types = types[vars_to_check],
204	787x	label = labels[vars_to_check]
205		)
206		}
207	832x	collection <- makeAssertCollection()
208	832x	mapply(assert_valid_var, df[vars], labels, MoreArgs = list(..., add = collection), SIMPLIFY = FALSE)
209	832x	reportAssertions(collection)
210		}
211
212		# assert_valid_type ----
213
214		#' Check variable is of correct type
215		#' @param x Object to check the type.
216		#' @param types (`character`) possible types to check.
217		#' @param label (`string`) label.
218		assert_valid_type <- function(x, types, label = deparse(substitute(x))) {
219	1210x	if (!any(vapply(types, is, object = x, FUN.VALUE = TRUE))) {
220	2x	abort(
221	2x	paste0(
222	2x	quote_str(label),
223	2x	" is not of type ",
224	2x	toString(types)
225		)
226		)
227		}
228		}
229
230		# assert_valid_var_pair ----
231
232		#' Check variables are of same levels
233		#' @param df1 (`data.frame`) input.
234		#' @param df2 (`data.frame`) input.
235		#' @param var (`string`) variable to check.
236		#' @param lab1 (`string`) label hint for `df1`.
237		#' @param lab2 (`string`) label hint for `df2`.
238		assert_valid_var_pair <- function(df1, df2, var, lab1 = deparse(substitute(df1)), lab2 = deparse(substitute(df2))) {
239	146x	assert_data_frame(df1)
240	146x	assert_data_frame(df2)
241	146x	assert_string(var)
242	146x	lvl_x <- lvls(df1[[var]])
243	146x	lvl_y <- lvls(df2[[var]])
244	146x	if (!identical(lvl_x, lvl_y)) {
245	3x	abort(
246	3x	paste0(
247	3x	quote_str(lab1), " and ",
248	3x	quote_str(lab2), " should contain the same levels in variable ",
249	3x	quote_str(var), "!"
250		)
251		)
252		}
253		}

1		# as we use NSE
2		globalVariables(c(".", ":="))
3
4		#' Retrieve labels for certain variables
5		#'
6		#' @param df (`data.frame`) containing columns with label attribute.
7		#' @param vars (`character`) variable names in `df`.
8		#'
9		#' @details
10		#' The labels will be returned if the column has `label` attribute, otherwise the column name will be returned.
11		#' Any values between brackets {} will be replaced with `dunlin::render_safe`.
12		#' @export
13		var_labels_for <- function(df, vars) {
14	296x	assert_names(colnames(df), must.include = vars, what = "colnames")
15	296x	render_safe(unname(formatters::var_labels(df, fill = TRUE)[vars]))
16		}
17
18		#' Prune table up to an `ElementaryTable`
19		#'
20		#' Avoid returning `NULL` when the `table` is empty.
21		#'
22		#' @param tlg (`TableTree`) object.
23		#'
24		#' @return pruned `TableTree`.
25		#'
26		smart_prune <- function(tlg) {
27	82x	res <- prune_table(tlg)
28
29	82x	if (is.null(res)) {
30	19x	res <- build_table(rtables::basic_table(), df = data.frame())
31	19x	col_info(res) <- col_info(tlg)
32		}
33
34	82x	res
35		}
36
37		#' Standard post processing
38		#'
39		#' @param tlg (`TableTree`) object.
40		#' @param ind (`integer`) the indentation of the table.
41		#' @param ... not used at the moment.
42		#'
43		#' @note Standard post processing includes:
44		#' * `NULL` report creation if necessary
45		#' * indentation
46		#'
47		#' @return a post-processed `tlg`.
48		#'
49		#' @keywords internal
50		#'
51		std_postprocess <- function(tlg, ind = 2L, ...) {
52	167x	assert_int(ind, lower = 0L)
53
54	167x	res <- report_null(tlg)
55	167x	table_inset(res) <- ind
56
57	167x	res
58		}
59
60		# Special formats ----
61
62		#' Decimal formatting
63		#'
64		#' @param digits (`integer`) number of digits.
65		#' @param format (`string`) describing how the numbers should be formatted following the `sprintf` syntax.
66		#' @param ne (`flag`) indicator whether to use "NE" to replace the actual value.
67		#'
68		#' @return `function` formatting numbers with the defined format.
69		#'
70		#' @export
71		#'
72		#' @examples
73		#' fun <- h_format_dec(c(1, 1), "%s - %s")
74		#' fun(c(123, 567.89))
75		#'
76		h_format_dec <- function(digits, format, ne = FALSE) {
77	11625x	assert_integerish(digits, lower = 0)
78	11625x	assert_string(format)
79	11625x	if (any(is.na(digits))) {
80	889x	function(x, ...) {
81		""
82		}
83		} else {
84	10736x	if (ne) {
85	5364x	ret <- function(x, ...) {
86	5364x	do_call(sprintf, c(list(fmt = format), rep("NE", length(digits))))
87		}
88	5364x	return(ret)
89		}
90	5372x	digit_string <- paste0("%", ifelse(is.na(digits), "", paste0(".", digits)), "f")
91	5372x	new_format <- do_call(sprintf, c(list(fmt = format), digit_string))
92	5372x	formatters::sprintf_format(new_format)
93		}
94		}
95
96		#' Fuse list elements
97		#'
98		#' @param x (`list`) to fuse.
99		#' @param y (`list`) to fuse. Elements with names already existing in `x` are discarded.
100		#'
101		#' @keywords internal
102		#'
103		fuse_sequentially <- function(x, y) {
104	6x	if (missing(y)) {
105	1x	return(x)
106		}
107
108	5x	names_x <- names(x)
109	5x	sel_names_y <- setdiff(names(y), names_x)
110
111	5x	c(x, y[sel_names_y])
112		}
113
114		#' List of `grob` object
115		#' @param ... (`grob`) objects
116		#' @export
117		grob_list <- function(...) {
118	1x	ret <- list(...)
119	1x	assert_list(ret, types = c("grob"))
120	1x	structure(
121	1x	ret,
122	1x	class = c("grob_list", "list")
123		)
124		}
125
126		#' List of `gg` object
127		#' @param ... (`ggplot`) objects
128		#' @export
129		gg_list <- function(...) {
130	7x	ret <- list(...)
131	7x	assert_list(ret, types = c("ggplot"))
132	7x	structure(
133	7x	ret,
134	7x	class = c("gg_list", "list")
135		)
136		}
137
138		#' @export
139		droplevels.character <- function(x, ...) {
140	1x	x
141		}
142
143		#' Obtain levels from vector
144		#' @param x (`character`) or (`factor`) object to obtain levels.
145		#' @details
146		#' For factors, the levels will be returned. For characters, the sorted unique values will be returned.
147		#' @export
148		lvls <- function(x) {
149	328x	UseMethod("lvls")
150		}
151		#' @export
152		lvls.default <- function(x) {
153	1x	NULL
154		}
155		#' @export
156		lvls.character <- function(x) {
157	8x	sort(unique(x))
158		}
159		#' @export
160		lvls.factor <- function(x) {
161	319x	levels(x)
162		}
163
164		#' @keywords internal
165		quote_str <- function(x) {
166	13x	assert_string(x)
167	12x	paste0("`", x, "`")
168		}
169
170		#' @keywords internal
171		modify_default_args <- function(fun, ...) {
172	1x	ret <- fun
173	1x	formals(ret) <- utils::modifyList(formals(fun), list(...), keep.null = TRUE)
174	1x	return(ret)
175		}
176
177		#' Execute function with given arguments
178		#' @details If the function has `...`, this function will not pass other arguments to `...`.
179		#' Only named arguments are passed.
180		#' @keywords internal
181		execute_with_args <- function(fun, ...) {
182	78x	args <- list(...)
183	78x	do_call(fun, args[intersect(names(args), formalArgs(fun))])
184		}
185
186		#' Execute a function call
187		#' @keywords internal
188		do_call <- function(what, args) {
189	11320x	arg_names <- names(args)
190	11320x	if (is.null(arg_names)) {
191	105x	arg_names <- sprintf("var_%s", seq_along(args))
192	11215x	} else if (any(arg_names == "")) {
193	10838x	arg_names_random <- sprintf("var_%s", seq_along(args))
194	10838x	arg_names[arg_names == ""] <- arg_names_random[arg_names == ""]
195		}
196	11320x	args_env <- as.environment(setNames(args, arg_names))
197	11320x	parent.env(args_env) <- parent.frame()
198	11320x	new_args <- lapply(arg_names, as.symbol)
199	11320x	names(new_args) <- names(args)
200	11320x	do.call(what, new_args, envir = args_env)
201		}
202
203		#' Modify character
204		#' @keywords internal
205		modify_character <- function(x, y) {
206	16x	assert_character(x, names = "unique", null.ok = TRUE)
207	16x	assert_character(y, names = "unique", null.ok = TRUE)
208	16x	c(y, x)[unique(c(names(y), names(x)))]
209		}
210
211		#' Helper function to convert to months if needed
212		#' @param x (`numeric`) time.
213		#' @param unit (`character`) or (`factor`) time unit.
214		#'
215		#' @return A `numeric` vector with the time in months.
216		#'
217		#' @export
218		convert_to_month <- function(x, unit) {
219	16x	assert_multi_class(unit, c("character", "factor"))
220	16x	assert_numeric(x, len = length(unit))
221
222	16x	unit <- toupper(unit)
223	16x	diff <- setdiff(unique(unit), c("DAYS", "MONTHS", "YEARS"))
224	16x	if (length(diff) > 0) {
225	2x	rlang::warn(
226	2x	paste0(
227	2x	"Time unit ", toString(diff), " not covered. No unit conversion applied."
228		)
229		)
230		}
231
232	16x	case_when(
233	16x	unit == "DAYS" ~ x / 30.4375,
234	16x	unit == "MONTHS" ~ x,
235	16x	unit == "YEARS" ~ x * 12,
236	16x	TRUE ~ x
237		)
238		}

1		# dtht01 ----
2
3		#' @describeIn dtht01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param time_since_last_dose (`flag`) should the time to event information be displayed.
7		#' @param other_category (`flag`) should the breakdown of the `OTHER` category be displayed.
8		#'
9		#' @details
10		#' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
11		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
12		#' * Does not include a total column by default.
13		#'
14		#' @note
15		#' * `adam_db` object must contain an `adsl` table with the columns `"DTHFL"`, `"DTHCAT"` as well as `LDDTHGR1` if
16		#' `time_since_last_dose` is `TRUE`.
17		#'
18		#' @export
19		dtht01_main <- function(adam_db,
20		arm_var = "ACTARM",
21		lbl_overall = NULL,
22		other_category = FALSE,
23		time_since_last_dose = FALSE,
24		...) {
25	2x	assert_all_tablenames(adam_db, "adsl")
26	2x	assert_string(arm_var)
27	2x	assert_string(lbl_overall, null.ok = TRUE)
28	2x	assert_flag(other_category)
29	2x	assert_flag(time_since_last_dose, null.ok = TRUE)
30	2x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list("character", "factor"))
31	2x	assert_valid_variable(
32	2x	adam_db$adsl,
33	2x	"DTHFL",
34	2x	types = list("character", "factor"), na_ok = TRUE, min_chars = 0L
35		)
36
37	2x	lbl_overall <- render_safe(lbl_overall)
38	2x	other_var <- if (other_category) "DTHCAUS"
39	2x	dose_death_var <- if (time_since_last_dose) "LDDTHGR1"
40
41	2x	assert_valid_variable(
42	2x	adam_db$adsl,
43	2x	c("DTHCAT", other_var, dose_death_var),
44	2x	types = list("character", "factor"), na_ok = TRUE, min_chars = 1L
45		)
46
47	2x	if (other_category) {
48	1x	death_cause <- lvls(adam_db$adsl$DTHCAT)
49	1x	if (length(death_cause) == 0L) {
50	!	stop("other_category specified but could not find any level in `DTHCAT`!")
51		}
52	1x	other_level <- death_cause[length(death_cause)]
53	1x	if (toupper(other_level) != "OTHER") {
54	!	warning(
55	!	"You included detailed information for Other, however the last level of ",
56	!	" `adam_db$adsl$DTHCAT` looks like not `Other`.",
57	!	call. = FALSE
58		)
59		}
60		}
61
62	2x	lyt <- dtht01_lyt(
63	2x	arm_var = arm_var,
64	2x	lbl_overall = lbl_overall,
65	2x	death_flag = "DTHFL",
66	2x	death_var = "DTHCAT",
67	2x	other_level = other_level,
68	2x	other_var = other_var,
69	2x	dose_death_var = dose_death_var
70		)
71
72	2x	adsl <- adam_db$adsl %>%
73	2x	mutate(TOTAL = "Primary Cause of Death")
74
75	2x	build_table(lyt, adsl)
76		}
77
78		#' `dtht01` Layout
79		#'
80		#' @inheritParams dtht01_main
81		#' @param death_flag (`string`) variable name of death flag.
82		#' @param detah_var (`string`) variable name of death category.
83		#' @param other_level (`string`) `"Other"` level in death category.
84		#' @param other_var (`string`) variable name of death cause under `"Other"`.
85		#' @param dose_death_var (`string`) variable name of the days from last dose.
86		#'
87		#' @keywords internal
88		#'
89		dtht01_lyt <- function(arm_var,
90		lbl_overall,
91		death_flag,
92		death_var,
93		other_level,
94		other_var,
95		dose_death_var) {
96	5x	if (is.null(dose_death_var) && is.null(other_var)) {
97	3x	lyt_block_fun <- analyze
98		} else {
99	2x	lyt_block_fun <- summarize_row
100		}
101	5x	lyt <- basic_table(show_colcounts = TRUE) %>%
102	5x	split_cols_by(arm_var) %>%
103	5x	ifneeded_add_overall_col(lbl_overall) %>%
104	5x	count_values(
105	5x	death_flag,
106	5x	values = "Y",
107	5x	.labels = c(count_fraction = "Total number of deaths"),
108	5x	.formats = c(count_fraction = format_count_fraction_fixed_dp)
109		) %>%
110	5x	split_rows_by("TOTAL", child_labels = "visible", label_pos = "hidden", split_fun = drop_split_levels) %>%
111	5x	lyt_block_fun(
112	5x	death_var,
113	5x	make_afun(
114	5x	s_summary_na,
115	5x	.stats = c("n", "count_fraction"), .ungroup_stats = "count_fraction",
116	5x	.formats = list(n = "xx", count_fraction = format_count_fraction_fixed_dp)
117		),
118	5x	indent_mod = 0L
119		)
120	5x	if (!is.null(other_var)) {
121	2x	lyt <- lyt %>%
122	2x	split_rows_by(death_var, split_fun = keep_split_levels(other_level), child_labels = "hidden") %>%
123	2x	summarize_vars(other_var, .stats = "count_fraction", denom = "N_row")
124		}
125	5x	if (!is.null(dose_death_var)) {
126	2x	lyt <- lyt %>%
127	2x	summarize_vars_allow_na(
128	2x	vars = dose_death_var,
129	2x	var_labels = "Days from last drug administration",
130	2x	.formats = list(count_fraction = format_count_fraction_fixed_dp),
131	2x	show_labels = "visible",
132	2x	nested = FALSE,
133	2x	inclNAs = FALSE
134		) %>%
135	2x	split_rows_by(
136	2x	dose_death_var,
137	2x	split_fun = drop_split_levels,
138	2x	split_label = "Primary cause by days from last study drug administration",
139	2x	label_pos = "visible",
140	2x	nested = FALSE
141		) %>%
142	2x	summarize_vars_allow_na(
143	2x	death_var,
144	2x	.formats = list(count_fraction = format_count_fraction_fixed_dp)
145		)
146		}
147
148	5x	lyt
149		}
150
151		#' @describeIn dtht01 Preprocessing
152		#'
153		#' @inheritParams gen_args
154		#'
155		#' @export
156		#'
157		dtht01_pre <- function(adam_db, ...) {
158	2x	death_format <- rule(
159	2x	"Adverse Event" = "ADVERSE EVENT",
160	2x	"Progressive Disease" = "PROGRESSIVE DISEASE",
161	2x	"Other" = "OTHER"
162		)
163
164	2x	adam_db$adsl <- adam_db$adsl %>%
165	2x	mutate(
166	2x	DTHCAT = reformat(.data$DTHCAT, death_format)
167		)
168
169	2x	adam_db
170		}
171
172		#' @describeIn dtht01 Postprocessing
173		#'
174		#' @inheritParams gen_args
175		#'
176		#' @export
177		#'
178		dtht01_post <- function(tlg, prune_0 = TRUE, ...) {
179	2x	if (prune_0) {
180	2x	tlg <- smart_prune(tlg)
181		}
182	2x	std_postprocess(tlg)
183		}
184
185		#' `DTHT01` Table 1 (Default) Death Table.
186		#'
187		#' A description of the causes of death optionally with the breakdown of the
188		#' `OTHER` category and/or post-study reporting of death.
189		#'
190		#' @include chevron_tlg-S4class.R
191		#' @export
192		#'
193		#' @examples
194		#' run(dtht01, syn_data)
195		#'
196		#' run(dtht01, syn_data, other_category = TRUE, time_since_last_dose = TRUE)
197		dtht01 <- chevron_t(
198		main = dtht01_main,
199		preprocess = dtht01_pre,
200		postprocess = dtht01_post
201		)

1		# aet02 ----
2
3		#' @describeIn aet02 Default labels
4		#' @export
5		#'
6		aet02_label <- c(
7		unique = "Total number of {patient_label} with at least one adverse event",
8		nonunique = "Total number of events"
9		)
10
11		#' @describeIn aet02 Main TLG function
12		#'
13		#' @inheritParams gen_args
14		#' @param summary_labels (`list`) of summarize labels. See details.
15		#'
16		#' @details
17		#' * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.
18		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
19		#' * Split columns by arm.
20		#' * Does not include a total column by default.
21		#' * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.
22		#' * Missing values in `AEBODSYS`, and `AEDECOD` are labeled by `No Coding Available`.
23		#' `summary_labels` is used to control the summary for each level. If "all" is used, then each split will have that
24		#' summary statistic with the labels. One special case is "TOTAL", this is for the overall population.
25		#'
26		#' @note
27		#' * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"` and `"AEDECOD"`.
28		#'
29		#' @export
30		#'
31		aet02_main <- function(adam_db,
32		arm_var = "ACTARM",
33		row_split_var = "AEBODSYS",
34		lbl_overall = NULL,
35		summary_labels = list(
36		all = aet02_label,
37		TOTAL = c(nonunique = "Overall total number of events")
38		),
39		...) {
40	1x	assert_all_tablenames(adam_db, "adsl", "adae")
41	1x	assert_string(arm_var)
42	1x	assert_character(row_split_var, null.ok = TRUE)
43	1x	assert_string(lbl_overall, null.ok = TRUE)
44	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
45	1x	assert_valid_variable(adam_db$adae, c(arm_var, row_split_var, "AEDECOD"), types = list(c("character", "factor")))
46	1x	assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
47	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
48	1x	assert_list(summary_labels, null.ok = TRUE)
49	1x	assert_subset(names(summary_labels), c("all", "TOTAL", row_split_var))
50	1x	assert_subset(
51	1x	unique(unlist(lapply(summary_labels, names))),
52	1x	c("unique", "nonunique", "unique_count")
53		)
54	1x	if ("all" %in% names(summary_labels)) {
55	1x	summary_labels <- lapply(
56	1x	c(TOTAL = "TOTAL", setNames(row_split_var, row_split_var)),
57	1x	function(x) {
58	2x	modify_character(summary_labels$all, summary_labels[[x]])
59		}
60		)
61		}
62
63	1x	lbl_overall <- render_safe(lbl_overall)
64	1x	lbl_row_split <- var_labels_for(adam_db$adae, row_split_var)
65	1x	lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
66
67	1x	lyt <- occurrence_lyt(
68	1x	arm_var = arm_var,
69	1x	lbl_overall = lbl_overall,
70	1x	row_split_var = row_split_var,
71	1x	lbl_row_split = lbl_row_split,
72	1x	medname_var = "AEDECOD",
73	1x	lbl_medname_var = lbl_aedecod,
74	1x	summary_labels = summary_labels,
75	1x	count_by = NULL
76		)
77
78	1x	tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)
79
80	1x	tbl
81		}
82
83		#' @describeIn aet02 Preprocessing
84		#'
85		#' @inheritParams gen_args
86		#'
87		#' @export
88		#'
89		aet02_pre <- function(adam_db, row_split_var = "AEBODSYS", ...) {
90	1x	adam_db$adae <- adam_db$adae %>%
91	1x	filter(.data$ANL01FL == "Y") %>%
92	1x	mutate(AEDECOD = reformat(.data$AEDECOD, nocoding)) %>%
93	1x	mutate(across(all_of(row_split_var), ~ reformat(.x, nocoding)))
94
95	1x	adam_db
96		}
97
98		#' @describeIn aet02 Postprocessing
99		#'
100		#' @inheritParams gen_args
101		#'
102		#' @export
103		#'
104		aet02_post <- function(tlg, row_split_var = "AEBODSYS", prune_0 = TRUE, ...) {
105	1x	tlg <- tlg %>%
106	1x	tlg_sort_by_vars(row_split_var, cont_n_allcols) %>%
107	1x	valid_sort_at_path(
108	1x	path = c(get_sort_path(c(row_split_var, "AEDECOD"))),
109	1x	scorefun = score_occurrences
110		)
111	1x	if (prune_0) {
112	1x	tlg <- smart_prune(tlg)
113		}
114	1x	std_postprocess(tlg)
115		}
116
117		#' `AET02` Table 1 (Default) Adverse Events by System Organ Class and Preferred Term Table 1
118		#'
119		#' The `AET02` table provides an overview of the number of subjects experiencing adverse events and the number of advert
120		#' events categorized by Body System and Dictionary-Derived Term.
121		#'
122		#' @include chevron_tlg-S4class.R
123		#' @export
124		#'
125		#' @examples
126		#' run(aet02, syn_data)
127		aet02 <- chevron_t(
128		main = aet02_main,
129		preprocess = aet02_pre,
130		postprocess = aet02_post
131		)

1		# aet04 ----
2
3		#' @describeIn aet04 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param grade_groups (`list`) putting in correspondence toxicity grades and labels.
7		#'
8		#' @details
9		#' * Numbers represent absolute numbers of patients and fraction of `N`, or absolute number of event when specified.
10		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
11		#' * Events with missing grading values are excluded.
12		#' * Split columns by arm, typically `ACTARM`.
13		#' * Does not include a total column by default.
14		#' * Sort Body System or Organ Class and Dictionary-Derived Term by highest overall frequencies. Analysis Toxicity
15		#' Grade is sorted by severity.
16		#'
17		#' @note
18		#' * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"`, `"AEDECOD"` and `"ATOXGR"`.
19		#'
20		#' @export
21		#'
22		aet04_main <- function(adam_db,
23		arm_var = "ACTARM",
24		lbl_overall = NULL,
25		grade_groups = NULL,
26		...) {
27	1x	assert_all_tablenames(adam_db, "adsl", "adae")
28	1x	assert_string(arm_var)
29	1x	assert_string(lbl_overall, null.ok = TRUE)
30	1x	assert_list(grade_groups, types = "character", null.ok = TRUE)
31	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
32	1x	assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))
33	1x	assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
34	1x	assert_valid_variable(adam_db$adae, "ATOXGR", na_ok = TRUE, types = list("factor"))
35	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
36
37	1x	lbl_overall <- render_safe(lbl_overall)
38	1x	lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")
39	1x	lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
40
41	1x	if (is.null(grade_groups)) {
42	1x	grade_groups <- list(
43	1x	"Grade 1-2" = c("1", "2"),
44	1x	"Grade 3-4" = c("3", "4"),
45	1x	"Grade 5" = c("5")
46		)
47		}
48
49	1x	lyt <- aet04_lyt(
50	1x	arm_var = arm_var,
51	1x	total_var = "TOTAL_VAR",
52	1x	lbl_overall = lbl_overall,
53	1x	lbl_aebodsys = lbl_aebodsys,
54	1x	lbl_aedecod = lbl_aedecod,
55	1x	grade_groups = grade_groups
56		)
57
58	1x	adam_db$adae$TOTAL_VAR <- "- Any adverse events - "
59
60	1x	tbl <- build_table(lyt, df = adam_db$adae, alt_counts_df = adam_db$adsl)
61
62	1x	tbl
63		}
64
65		#' `aet04` Layout
66		#'
67		#' @inheritParams aet04_main
68		#'
69		#' @param total_var (`string`) variable to create summary of all variables.
70		#' @param lbl_aebodsys (`string`) text label for `AEBODSYS`.
71		#' @param lbl_aedecod (`string`) text label for `AEDECOD`.
72		#' @param grade_groups (`list`) putting in correspondence toxicity grades and labels.
73		#'
74		#' @keywords internal
75		#'
76		aet04_lyt <- function(arm_var,
77		total_var,
78		lbl_overall,
79		lbl_aebodsys,
80		lbl_aedecod,
81		grade_groups) {
82	6x	basic_table(show_colcounts = TRUE) %>%
83	6x	split_cols_by(var = arm_var) %>%
84	6x	ifneeded_add_overall_col(lbl_overall) %>%
85	6x	split_rows_by(
86	6x	var = total_var,
87	6x	label_pos = "hidden",
88	6x	child_labels = "visible",
89	6x	indent_mod = -1L
90		) %>%
91	6x	summarize_num_patients(
92	6x	var = "USUBJID",
93	6x	.stats = "unique",
94	6x	.labels = "- Any Grade -",
95	6x	.indent_mods = 7L
96		) %>%
97	6x	count_occurrences_by_grade(
98	6x	var = "ATOXGR",
99	6x	grade_groups = grade_groups,
100	6x	.indent_mods = 6L
101		) %>%
102	6x	split_rows_by(
103	6x	"AEBODSYS",
104	6x	child_labels = "visible",
105	6x	nested = FALSE,
106	6x	split_fun = drop_split_levels,
107	6x	label_pos = "topleft",
108	6x	split_label = lbl_aebodsys
109		) %>%
110	6x	split_rows_by(
111	6x	"AEDECOD",
112	6x	child_labels = "visible",
113	6x	split_fun = add_overall_level("- Overall -", trim = TRUE),
114	6x	label_pos = "topleft",
115	6x	split_label = lbl_aedecod
116		) %>%
117	6x	summarize_num_patients(
118	6x	var = "USUBJID",
119	6x	.stats = "unique",
120	6x	.labels = "- Any Grade -",
121	6x	.indent_mods = 6L
122		) %>%
123	6x	count_occurrences_by_grade(
124	6x	var = "ATOXGR",
125	6x	grade_groups = grade_groups,
126	6x	.indent_mods = 5L
127		) %>%
128	6x	append_topleft(" Grade")
129		}
130
131		#' @describeIn aet04 Preprocessing
132		#'
133		#' @inheritParams gen_args
134		#'
135		#' @export
136		#'
137		aet04_pre <- function(adam_db, ...) {
138	1x	atoxgr_lvls <- c("1", "2", "3", "4", "5")
139	1x	adam_db$adae <- adam_db$adae %>%
140	1x	filter(.data$ANL01FL == "Y") %>%
141	1x	mutate(
142	1x	AEBODSYS = reformat(.data$AEBODSYS, nocoding),
143	1x	AEDECOD = reformat(.data$AEDECOD, nocoding),
144	1x	ATOXGR = factor(.data$ATOXGR, levels = atoxgr_lvls)
145		)
146	1x	adam_db
147		}
148
149		#' @describeIn aet04 Postprocessing
150		#'
151		#' @inheritParams gen_args
152		#'
153		#' @export
154		#'
155		aet04_post <- function(tlg, prune_0 = TRUE, ...) {
156	1x	tlg <- tlg %>%
157	1x	tlg_sort_by_vars(c("AEBODSYS", "AEDECOD"), score_all_sum, decreasing = TRUE)
158	1x	if (prune_0) tlg <- trim_rows(tlg)
159	1x	std_postprocess(tlg)
160		}
161
162		#' `AET04` Table 1 (Default) Adverse Events by Highest `NCI` `CTACAE` `AE` Grade Table 1.
163		#'
164		#' The `AET04` table provides an
165		#' overview of adverse event with the highest `NCI` `CTCAE` grade per individual.
166		#'
167		#' @include chevron_tlg-S4class.R
168		#' @export
169		#'
170		#' @examples
171		#' grade_groups <- list(
172		#' "Grade 1-2" = c("1", "2"),
173		#' "Grade 3-4" = c("3", "4"),
174		#' "Grade 5" = c("5")
175		#' )
176		#' proc_data <- dunlin::log_filter(syn_data, AEBODSYS == "cl A.1", "adae")
177		#' run(aet04, proc_data, grade_groups = grade_groups)
178		aet04 <- chevron_t(
179		main = aet04_main,
180		preprocess = aet04_pre,
181		postprocess = aet04_post
182		)

1		# lbt04 ----
2
3		#' @describeIn lbt04 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param analysis_abn_var (`string`) column describing anomaly magnitude
7		#' @param baseline_abn_var (`string`) column describing anomaly at baseline.
8		#'
9		#' @details
10		#' * Only count LOW or HIGH values.
11		#' * Lab test results with missing `analysis_abn_var` values are excluded.
12		#' * Split columns by arm, typically `ACTARM`.
13		#' * Does not include a total column by default.
14		#'
15		#' @note
16		#' * `adam_db` object must contain an `adlb` table with columns `"PARCAT1"`, `"PARCAT2"`, `"PARAM"`, `"ANRIND"`,
17		#' and column specified by `arm_var`.
18		#'
19		#' @export
20		#'
21		lbt04_main <- function(adam_db,
22		arm_var = "ACTARM",
23		lbl_overall = NULL,
24		analysis_abn_var = "ANRIND",
25		baseline_abn_var = "BNRIND",
26		row_split_var = "PARCAT1",
27		page_var = tail(row_split_var, 1L),
28		...) {
29	2x	assert_all_tablenames(adam_db, c("adsl", "adlb"))
30	2x	assert_string(arm_var)
31	2x	assert_string(lbl_overall, null.ok = TRUE)
32	2x	assert_string(analysis_abn_var)
33	2x	assert_string(baseline_abn_var)
34	2x	assert_string(row_split_var)
35	2x	assert_valid_variable(
36	2x	adam_db$adlb, c("PARAMCD", "PARAM", row_split_var),
37	2x	types = list("characater", "factor")
38		)
39	2x	assert_subset(page_var, row_split_var)
40	2x	assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
41	2x	assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
42	2x	assert_valid_variable(
43	2x	adam_db$adlb,
44	2x	baseline_abn_var,
45	2x	types = list(c("character", "factor")),
46	2x	na_ok = TRUE, empty_ok = TRUE, min_chars = 0L
47		)
48	2x	assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)
49
50	2x	lbl_overall <- render_safe(lbl_overall)
51	2x	lbl_param <- var_labels_for(adam_db$adlb, "PARAM")
52	2x	lbl_abn_var <- var_labels_for(adam_db$adlb, analysis_abn_var)
53	2x	row_split_lbl <- var_labels_for(adam_db$adlb, row_split_var)
54
55	2x	lyt <- lbt04_lyt(
56	2x	arm_var = arm_var,
57	2x	lbl_overall = lbl_overall,
58	2x	lbl_param = lbl_param,
59	2x	lbl_abn_var = lbl_abn_var,
60	2x	var_parcat = "PARCAT1",
61	2x	var_param = "PARAM",
62	2x	row_split_var = row_split_var,
63	2x	row_split_lbl = row_split_lbl,
64	2x	analysis_abn_var = analysis_abn_var,
65	2x	variables = list(id = "USUBJID", baseline = baseline_abn_var),
66	2x	page_var = page_var
67		)
68
69	2x	tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)
70
71	2x	tbl
72		}
73
74		#' `lbt04` Layout
75		#'
76		#' @inheritParams gen_args
77		#'
78		#' @param lbl_param (`string`) label of the `PARAM` variable.
79		#' @param lbl_abn_var (`string`) label of the `analysis_abn_var` variable.
80		#' @param variables (`list`) see [tern::count_abnormal]
81		#'
82		#' @keywords internal
83		#'
84		lbt04_lyt <- function(arm_var,
85		lbl_overall,
86		lbl_param,
87		lbl_abn_var,
88		var_parcat,
89		var_param,
90		row_split_var,
91		row_split_lbl,
92		analysis_abn_var,
93		variables,
94		page_var) {
95	10x	page_by <- get_page_by(page_var, row_split_var)
96	10x	label_pos <- ifelse(page_by, "hidden", "topleft")
97
98	10x	basic_table(show_colcounts = TRUE) %>%
99	10x	split_cols_by(arm_var) %>%
100	10x	ifneeded_add_overall_col(lbl_overall) %>%
101	10x	split_rows_by_recurive(
102	10x	row_split_var,
103	10x	split_label = row_split_lbl,
104	10x	label_pos = label_pos,
105	10x	page_by = page_by
106		) %>%
107	10x	split_rows_by(
108	10x	"PARAMCD",
109	10x	labels_var = "PARAM",
110	10x	split_fun = drop_split_levels,
111	10x	label_pos = "topleft",
112	10x	split_label = lbl_param,
113	10x	indent_mod = 0L
114		) %>%
115	10x	count_abnormal(
116	10x	var = analysis_abn_var,
117	10x	abnormal = list(Low = c("LOW", "LOW LOW"), High = c("HIGH", "HIGH HIGH")),
118	10x	exclude_base_abn = TRUE,
119	10x	variables = variables,
120	10x	.formats = list(fraction = format_fraction_fixed_dp)
121		) %>%
122	10x	append_topleft(paste(" ", lbl_abn_var))
123		}
124
125		#' @describeIn lbt04 Preprocessing
126		#'
127		#' @inheritParams gen_args
128		#'
129		#' @export
130		#'
131		lbt04_pre <- function(adam_db, ...) {
132	1x	adam_db$adlb <- adam_db$adlb %>%
133	1x	filter(
134	1x	.data$ONTRTFL == "Y",
135	1x	.data$PARCAT2 == "SI",
136	1x	!is.na(.data$ANRIND)
137		) %>%
138	1x	mutate(
139	1x	PARAM = with_label(.data$PARAM, "Laboratory Test"),
140	1x	ANRIND = with_label(.data$ANRIND, "Direction of Abnormality")
141		) %>%
142	1x	mutate(
143	1x	ANRIND = reformat(
144	1x	.data$ANRIND,
145	1x	rule(
146	1x	"HIGH HIGH" = "HIGH HIGH",
147	1x	"HIGH" = "HIGH",
148	1x	"LOW" = "LOW",
149	1x	"LOW LOW" = "LOW LOW",
150	1x	"NORMAL" = "NORMAL"
151		),
152	1x	.to_NA = NULL
153		)
154		)
155
156	1x	adam_db
157		}
158
159		#' @describeIn lbt04 Postprocessing
160		#'
161		#' @inheritParams gen_args
162		#'
163		#' @export
164		#'
165		lbt04_post <- function(tlg, ...) {
166	2x	std_postprocess(tlg)
167		}
168
169		#' `LBT04` Laboratory Abnormalities Not Present at Baseline Table.
170		#'
171		#' The `LBT04` table provides an
172		#' overview of laboratory abnormalities not present at baseline.
173		#'
174		#' @include chevron_tlg-S4class.R
175		#' @export
176		#'
177		#' @examples
178		#' run(lbt04, syn_data)
179		lbt04 <- chevron_t(
180		main = lbt04_main,
181		preprocess = lbt04_pre,
182		postprocess = lbt04_post
183		)

1		# egt02_1 ----
2
3		#' @describeIn egt02_1 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param exclude_base_abn (`flag`) whether baseline abnormality should be excluded.
7		#'
8		#' @details
9		#' * Only count LOW or HIGH values.
10		#' * Results of "LOW LOW" are treated as the same as "LOW", and "HIGH HIGH" the same as "HIGH".
11		#' * Does not include a total column by default.
12		#' * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.
13		#'
14		#' @note
15		#' * `adam_db` object must contain an `adeg` table with the `"PARAM"`, `"ANRIND"` and `"BNRIND"` columns.
16		#'
17		#' @export
18		#'
19		egt02_1_main <- function(adam_db,
20		arm_var = "ACTARM",
21		lbl_overall = NULL,
22		exclude_base_abn = FALSE,
23		...) {
24	2x	assert_all_tablenames(adam_db, c("adsl", "adeg"))
25	2x	assert_string(arm_var)
26	2x	assert_string(lbl_overall, null.ok = TRUE)
27	2x	assert_flag(exclude_base_abn)
28	2x	assert_valid_variable(adam_db$adeg, c("PARAM"), types = list(c("character", "factor")), na_ok = FALSE)
29	2x	assert_valid_variable(adam_db$adeg, c("ANRIND", "BNRIND"), types = list(c("character", "factor")), na_ok = TRUE)
30	2x	assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)
31	2x	assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
32	2x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
33
34	2x	lbl_overall <- render_safe(lbl_overall)
35
36	2x	lyt <- egt02_lyt(
37	2x	arm_var = arm_var,
38	2x	lbl_overall = lbl_overall,
39	2x	lbl_vs_assessment = "Assessment",
40	2x	lbl_vs_abnormality = "Abnormality",
41	2x	exclude_base_abn = exclude_base_abn
42		)
43
44	2x	tbl <- build_table(lyt, adam_db$adeg, alt_counts_df = adam_db$adsl)
45
46	2x	tbl
47		}
48
49		#' `egt02` Layout
50		#'
51		#' @inheritParams gen_args
52		#' @param lbl_vs_assessment (`string`) the label of the assessment variable.
53		#' @param lbl_vs_abnormality (`string`) the label of the abnormality variable.
54		#' @param exclude_base_abn (`flag`) whether to exclude subjects with baseline abnormality from numerator and
55		#' denominator.
56		#'
57		#' @keywords internal
58		#'
59		egt02_lyt <- function(arm_var = "ACTARM",
60		lbl_overall,
61		lbl_vs_assessment = "Assessment",
62		lbl_vs_abnormality = "Abnormality",
63		exclude_base_abn) {
64	4x	basic_table(show_colcounts = TRUE) %>%
65	4x	split_cols_by(var = arm_var) %>%
66	4x	ifneeded_add_overall_col(lbl_overall) %>%
67	4x	split_rows_by("PARAM", split_fun = drop_split_levels, label_pos = "topleft", split_label = lbl_vs_assessment) %>%
68	4x	count_abnormal(
69	4x	"ANRIND",
70	4x	abnormal = list(Low = "LOW", High = "HIGH"),
71	4x	variables = list(id = "USUBJID", baseline = "BNRIND"),
72	4x	exclude_base_abn = exclude_base_abn
73		) %>%
74	4x	append_topleft(paste0(" ", lbl_vs_abnormality))
75		}
76
77		#' @describeIn egt02_1 Preprocessing
78		#'
79		#' @inheritParams gen_args
80		#'
81		#' @export
82		#'
83		egt02_pre <- function(adam_db, ...) {
84	2x	assert_all_tablenames(adam_db, c("adsl", "adeg"))
85	2x	adam_db$adeg <- adam_db$adeg %>%
86	2x	mutate(ANRIND = factor(.data$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))) %>%
87	2x	filter(!is.na(.data$ANRIND)) %>%
88	2x	filter(.data$ONTRTFL == "Y")
89
90	2x	adam_db
91		}
92
93		#' @describeIn egt02_1 Postprocessing
94		#'
95		#' @inheritParams gen_args
96		#'
97		#' @export
98		#'
99		egt02_post <- function(tlg, ...) {
100	2x	std_postprocess(tlg)
101		}
102
103		#' `EGT02` ECG Abnormalities Table.
104		#'
105		#' ECG Parameters outside Normal Limits Regardless of Abnormality at Baseline Table.
106		#'
107		#' @include chevron_tlg-S4class.R
108		#' @export
109		#'
110		#' @examples
111		#' run(egt02_1, syn_data)
112		egt02_1 <- chevron_t(
113		main = egt02_1_main,
114		preprocess = egt02_pre,
115		postprocess = egt02_post
116		)
117
118		# egt02_2 ----
119
120		#' @describeIn egt02_2 Main TLG function
121		#'
122		#' @inherit egt02_1_main
123		#'
124		#' @export
125		#'
126		egt02_2_main <- modify_default_args(egt02_1_main, exclude_base_abn = TRUE)
127
128		#' `EGT02_2` ECG Abnormalities Table.
129		#'
130		#' ECG Parameters outside Normal Limits Among Patients without Abnormality at Baseline Table.
131		#'
132		#' @include chevron_tlg-S4class.R
133		#' @export
134		#'
135		#' @examples
136		#' run(egt02_2, syn_data)
137		egt02_2 <- chevron_t(
138		main = egt02_2_main,
139		preprocess = egt02_pre,
140		postprocess = egt02_post
141		)

1		# lbt06 ----
2
3		#' @describeIn lbt06 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param arm_var (`string`) the arm variable used for arm splitting.
7		#'
8		#' @details
9		#' * Only count `"LOW"` or `"HIGH"` values for `ANRIND` and `BNRIND`.
10		#' * Lab test results with missing `ANRIND` values are excluded.
11		#' * Split columns by arm, typically `ACTARM`.
12		#' * Keep zero count rows by default.
13		#'
14		#' @note
15		#' * `adam_db` object must contain an `adlb` table with columns `"AVISIT"`, `"ANRIND"`, `"BNRIND"`,
16		#' `"ONTRTFL"`, and `"PARCAT2"`, and column specified by `arm_var`.
17		#'
18		#' @export
19		#'
20		lbt06_main <- function(adam_db,
21		arm_var = "ACTARM",
22		lbl_overall = NULL,
23		page_var = "PARAMCD",
24		...) {
25	2x	assert_all_tablenames(adam_db, c("adsl", "adlb"))
26	2x	assert_string(arm_var)
27	2x	assert_string(lbl_overall, null.ok = TRUE)
28	2x	assert_subset(page_var, "PARAMCD")
29	2x	assert_valid_variable(adam_db$adlb, c(arm_var, "PARAMCD", "PARAM", "AVISIT"), types = list("characater", "factor"))
30	2x	assert_valid_variable(adam_db$adlb, c("ANRIND", "BNRIND"), types = list(c("character", "factor")))
31	2x	assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")))
32	2x	assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
33	2x	assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)
34
35	2x	lbl_overall <- render_safe(lbl_overall)
36	2x	lbl_param <- var_labels_for(adam_db$adlb, "PARAM")
37	2x	lbl_visit <- var_labels_for(adam_db$adlb, "AVISIT")
38	2x	lbl_anrind <- var_labels_for(adam_db$adlb, "ANRIND")
39	2x	lbl_bnrind <- var_labels_for(adam_db$adlb, "BNRIND")
40
41	2x	lyt <- lbt06_lyt(
42	2x	arm_var = arm_var,
43	2x	lbl_overall = lbl_overall,
44	2x	lbl_param = lbl_param,
45	2x	lbl_visit = lbl_visit,
46	2x	lbl_anrind = lbl_anrind,
47	2x	lbl_bnrind = lbl_bnrind,
48	2x	visitvar = "AVISIT",
49	2x	anrind_var = "ANRIND",
50	2x	bnrind_var = "BNRIND",
51	2x	page_var = page_var
52		)
53
54	2x	tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)
55
56	2x	tbl
57		}
58
59		#' `lbt06` Layout
60		#'
61		#' @inheritParams gen_args
62		#'
63		#' @param lbl_param (`string`) text label of the `PARAM` variable.
64		#' @param lbl_visit (`string`) text label of the `AVISIT` variable.
65		#' @param lbl_anrind (`string`) text label of the `ANRIND` variable.
66		#' @param lbl_bnrind (`string`) text label of the `BNRIND` variable.
67		#' @param param (`string`) the variable for parameter code.
68		#' @param anrind_var (`string`) the variable for analysis reference range indicator.
69		#' @param bnrind_var (`string`) the variable for baseline reference range indicator.
70		#'
71		#' @keywords internal
72		#'
73		lbt06_lyt <- function(arm_var,
74		lbl_overall,
75		lbl_param,
76		lbl_visit,
77		lbl_anrind,
78		lbl_bnrind,
79		visitvar,
80		anrind_var,
81		bnrind_var,
82		page_var) {
83	2x	page_by <- !is.null(page_var)
84	2x	label_pos <- ifelse(page_by, "hidden", "topleft")
85	2x	basic_table(show_colcounts = TRUE) %>%
86	2x	split_cols_by(arm_var) %>%
87	2x	ifneeded_add_overall_col(lbl_overall) %>%
88	2x	split_rows_by(
89	2x	var = "PARAMCD",
90	2x	labels_var = "PARAM",
91	2x	split_fun = drop_split_levels,
92	2x	label_pos = label_pos,
93	2x	split_label = lbl_param,
94	2x	page_by = page_by
95		) %>%
96	2x	split_rows_by(
97	2x	var = visitvar,
98	2x	split_fun = drop_split_levels,
99	2x	label_pos = "topleft",
100	2x	split_label = lbl_visit
101		) %>%
102	2x	count_abnormal_by_baseline(
103	2x	var = anrind_var,
104	2x	abnormal = c(Low = "LOW", High = "HIGH"),
105	2x	variables = list(id = "USUBJID", baseline = bnrind_var),
106	2x	.indent_mods = 4L
107		) %>%
108	2x	append_topleft(paste0(stringr::str_dup(" ", 2L * (2 - page_by)), lbl_anrind)) %>%
109	2x	append_topleft(paste0(stringr::str_dup(" ", 2L * (7 - page_by)), lbl_bnrind))
110		}
111
112		#' @describeIn lbt06 Preprocessing
113		#'
114		#' @inheritParams gen_args
115		#'
116		#' @export
117		#'
118		lbt06_pre <- function(adam_db, ...) {
119	3x	missing_rule <- rule("<Missing>" = c("", NA, "<Missing>"))
120
121	3x	adam_db$adlb <- adam_db$adlb %>%
122	3x	filter(
123	3x	.data$ONTRTFL == "Y",
124	3x	.data$PARCAT2 == "SI"
125		) %>%
126	3x	mutate(
127	3x	across(all_of(c("ANRIND", "BNRIND")), ~ reformat(.x, .env$missing_rule)),
128	3x	AVISIT = reorder(.data$AVISIT, .data$AVISITN),
129	3x	AVISIT = with_label(.data$AVISIT, "Visit"),
130	3x	ANRIND = with_label(.data$ANRIND, "Abnormality at Visit"),
131	3x	BNRIND = with_label(.data$BNRIND, "Baseline Status")
132		)
133
134	2x	adam_db
135		}
136
137		#' @describeIn lbt06 Postprocessing
138		#'
139		#' @inheritParams gen_args
140		#'
141		#' @export
142		#'
143		lbt06_post <- function(tlg, prune_0 = FALSE, ...) {
144	!	if (prune_0) {
145	!	tlg <- smart_prune(tlg)
146		}
147	!	std_postprocess(tlg)
148		}
149
150		#' `LBT06` Table 1 (Default) Laboratory Abnormalities by Visit and Baseline Status Table 1.
151		#'
152		#' The `LBT06` table produces the standard laboratory abnormalities by visit and
153		#' baseline status summary.
154		#'
155		#' @include chevron_tlg-S4class.R
156		#' @export
157		#'
158		#' @examples
159		#' run(lbt06, syn_data)
160		lbt06 <- chevron_t(
161		main = lbt06_main,
162		preprocess = lbt06_pre,
163		postprocess = lbt06_post
164		)

1		# aet01 ----
2
3		#' @describeIn aet01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param anl_vars Named (`list`) of (`character`) variables the safety variables to be summarized.
7		#' @param anl_lbls (`character`) of analysis labels.
8		#'
9		#' @details
10		#' * Does not remove rows with zero counts by default.
11		#'
12		#' @note
13		#' * `adam_db` object must contain an `adsl` table with the `"DTHFL"` and `"DCSREAS"` columns.
14		#' * `adam_db` object must contain an `adae` table with the columns passed to `anl_vars`.
15		#'
16		#' @export
17		#'
18		aet01_main <- function(adam_db,
19		arm_var = "ACTARM",
20		lbl_overall = NULL,
21		anl_vars = list(
22		safety_var = c(
23		"FATAL", "SER", "SERWD", "SERDSM",
24		"RELSER", "WD", "DSM", "REL", "RELWD", "RELDSM", "SEV"
25		)
26		),
27		anl_lbls = "Total number of {patient_label} with at least one",
28		...) {
29	1x	assert_all_tablenames(adam_db, "adsl", "adae")
30	1x	assert_string(arm_var)
31	1x	assert_string(lbl_overall, null.ok = TRUE)
32	1x	assert_list(anl_vars, types = "character", names = "unique")
33	1x	assert_character(anl_lbls, min.chars = 1L)
34	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
35	1x	assert_valid_variable(adam_db$adsl, c("DTHFL", "DCSREAS"), types = list(c("character", "factor")), min_chars = 0L)
36	1x	assert_valid_variable(adam_db$adae, c(arm_var), types = list(c("character", "factor")))
37	1x	assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
38	1x	assert_valid_variable(adam_db$adae, unlist(anl_vars), types = list("logical"), na_ok = TRUE, empty_ok = TRUE)
39	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
40
41	1x	lbl_overall <- render_safe(lbl_overall)
42	1x	anl_lbls <- render_safe(anl_lbls)
43	1x	if (length(anl_lbls) == 1) {
44	1x	anl_lbls <- rep(anl_lbls, length(anl_vars))
45		}
46	1x	lbl_vars <- lapply(
47	1x	anl_vars,
48	1x	var_labels_for,
49	1x	df = adam_db$adae
50		)
51
52	1x	lyts <- aet01_lyt(
53	1x	arm_var = arm_var,
54	1x	lbl_overall = lbl_overall,
55	1x	anl_vars = anl_vars,
56	1x	anl_lbls = anl_lbls,
57	1x	lbl_vars = lbl_vars
58		)
59
60	1x	rbind(
61	1x	build_table(lyts$ae1, adam_db$adae, alt_counts_df = adam_db$adsl),
62	1x	build_table(lyts$adsl, adam_db$adsl, alt_counts_df = adam_db$adsl),
63	1x	build_table(lyts$ae2, adam_db$adae, alt_counts_df = adam_db$adsl)
64		)
65		}
66
67		#' `aet01` Layout
68		#'
69		#' @inheritParams aet01_main
70		#' @param anl_vars Named (`list`) of analysis variables.
71		#' @param anl_lbls (`character`) of labels.
72		#' @param lbl_vars Named (`list`) of analysis labels.
73		#' @keywords internal
74		#'
75		aet01_lyt <- function(arm_var,
76		lbl_overall,
77		anl_vars,
78		anl_lbls,
79		lbl_vars) {
80	6x	lyt_base <- basic_table(show_colcounts = TRUE) %>%
81	6x	split_cols_by(var = arm_var) %>%
82	6x	ifneeded_add_overall_col(lbl_overall)
83	6x	lyt_ae1 <- lyt_base %>%
84	6x	analyze_num_patients(
85	6x	vars = "USUBJID",
86	6x	.stats = c("unique", "nonunique"),
87	6x	.labels = c(
88	6x	unique = render_safe("Total number of {patient_label} with at least one AE"),
89	6x	nonunique = "Total number of AEs"
90		),
91	6x	.formats = list(unique = format_count_fraction_fixed_dp, nonunique = "xx"),
92	6x	show_labels = "hidden"
93		)
94	6x	lyt_adsl <- lyt_base %>%
95	6x	count_patients_with_event(
96	6x	"USUBJID",
97	6x	filters = c("DTHFL" = "Y"),
98	6x	denom = "N_col",
99	6x	.labels = c(count_fraction = "Total number of deaths"),
100	6x	table_names = "TotDeath"
101		) %>%
102	6x	count_patients_with_event(
103	6x	"USUBJID",
104	6x	filters = c("DCSREAS" = "ADVERSE EVENT"),
105	6x	denom = "N_col",
106	6x	.labels = c(count_fraction = render_safe("Total number of {patient_label} withdrawn from study due to an AE")),
107	6x	table_names = "TotWithdrawal"
108		)
109
110	6x	lyt_ae2 <- lyt_base %>%
111	6x	count_patients_recursive(
112	6x	anl_vars = anl_vars,
113	6x	anl_lbls = anl_lbls,
114	6x	lbl_vars = lbl_vars
115		)
116	6x	return(list(ae1 = lyt_ae1, ae2 = lyt_ae2, adsl = lyt_adsl))
117		}
118
119		#' @describeIn aet01 Preprocessing
120		#'
121		#' @inheritParams aet01_main
122		#'
123		#' @export
124		#'
125		aet01_pre <- function(adam_db, ...) {
126	1x	adam_db$adae <- adam_db$adae %>%
127	1x	filter(.data$ANL01FL == "Y") %>%
128	1x	mutate(
129	1x	FATAL = with_label(.data$AESDTH == "Y", "AE with fatal outcome"),
130	1x	SER = with_label(.data$AESER == "Y", "Serious AE"),
131	1x	SEV = with_label(.data$ASEV == "SEVERE", "Severe AE (at greatest intensity)"),
132	1x	REL = with_label(.data$AREL == "Y", "Related AE"),
133	1x	WD = with_label(.data$AEACN == "DRUG WITHDRAWN", "AE leading to withdrawal from treatment"),
134	1x	DSM = with_label(
135	1x	.data$AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED"),
136	1x	"AE leading to dose modification/interruption"
137		),
138	1x	SERWD = with_label(.data$SER & .data$WD, "Serious AE leading to withdrawal from treatment"),
139	1x	SERDSM = with_label(.data$SER & .data$DSM, "Serious AE leading to dose modification/interruption"),
140	1x	RELSER = with_label(.data$SER & .data$REL, "Related Serious AE"),
141	1x	RELWD = with_label(.data$REL & .data$WD, "Related AE leading to withdrawal from treatment"),
142	1x	RELDSM = with_label(.data$REL & .data$DSM, "Related AE leading to dose modification/interruption"),
143	1x	CTC35 = with_label(.data$ATOXGR %in% c("3", "4", "5"), "Grade 3-5 AE"),
144	1x	CTC45 = with_label(.data$ATOXGR %in% c("4", "5"), "Grade 4/5 AE")
145		)
146
147	1x	adam_db$adsl <- adam_db$adsl %>%
148	1x	mutate(DCSREAS = reformat(.data$DCSREAS, missing_rule))
149
150	1x	adam_db
151		}
152
153		#' @describeIn aet01 Postprocessing
154		#'
155		#' @inheritParams gen_args
156		#'
157		#' @export
158		#'
159		aet01_post <- function(tlg, prune_0 = FALSE, ...) {
160	1x	if (prune_0) {
161	!	tlg <- smart_prune(tlg)
162		}
163	1x	std_postprocess(tlg)
164		}
165
166		#' `AET01` Table 1 (Default) Overview of Deaths and Adverse Events Summary Table 1.
167		#'
168		#' @include chevron_tlg-S4class.R
169		#' @export
170		#'
171		#' @examples
172		#' run(aet01, syn_data, arm_var = "ARM")
173		aet01 <- chevron_t(
174		main = aet01_main,
175		preprocess = aet01_pre,
176		postprocess = aet01_post
177		)

1		# egt05_qtcat ----
2
3		#' @describeIn egt05_qtcat Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in `adeg`
7		#' table of `adam_db` is used as name.
8		#'
9		#' @details
10		#' * The `Value at Visit` column, displays the categories of the specific `"PARAMCD"` value for patients.
11		#' * The `Change from Baseline` column, displays the categories of the specific `"PARAMCD"` value
12		#' change from baseline for patients.
13		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
14		#' * Split columns by arm, typically `"ACTARM"`.
15		#' * Does not include a total column by default.
16		#' * Sorted based on factor level; by chronological time point given by `"AVISIT"`
17		#' or user-defined visit incorporating `"ATPT"`.
18		#' Re-level to customize order.
19		#' * Please note that it is preferable to convert `summaryvars` to factor.
20		#'
21		#' @note
22		#' * `adam_db` object must contain an `adeg` table with column specified in `visitvar`.
23		#' For `summaryvars`, please make sure `AVALCAT1` and `CHGCAT1` columns existed in input data sets.
24		#'
25		#' @export
26		#'
27		egt05_qtcat_main <- function(adam_db,
28		arm_var = "ACTARM",
29		lbl_overall = NULL,
30		summaryvars = c("AVALCAT1", "CHGCAT1"),
31		row_split_var = NULL,
32		visitvar = "AVISIT",
33		page_var = NULL,
34		...) {
35	1x	assert_all_tablenames(adam_db, c("adsl", "adeg"))
36	1x	assert_string(arm_var)
37	1x	assert_string(lbl_overall, null.ok = TRUE)
38	1x	assert_character(summaryvars)
39	1x	assert_character(row_split_var, null.ok = TRUE)
40	1x	assert_string(visitvar)
41	1x	assert_string(page_var, null.ok = TRUE)
42	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)
43	1x	assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
44	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
45	1x	assert_valid_variable(adam_db$adeg, c("PARAM", "PARAMCD"), types = list(c("character", "factor")), na_ok = FALSE)
46	1x	assert_valid_variable(adam_db$adeg, visitvar, types = list("character", "factor"))
47	1x	assert_disjunct(row_split_var, c("PARAMCD", "PARAM", visitvar))
48	1x	assert_valid_variable(adam_db$adeg, summaryvars, types = list(c("factor", "character")), na_ok = TRUE)
49	1x	assert_subset(page_var, c(row_split_var, "PARAMCD"))
50
51	1x	lbl_overall <- render_safe(lbl_overall)
52	1x	lbl_avisit <- var_labels_for(adam_db$adeg, visitvar)
53	1x	lbl_param <- var_labels_for(adam_db$adeg, "PARAM")
54	1x	summaryvars_lbls <- var_labels_for(adam_db$adeg, summaryvars) # Value at visit / change from baseline
55	1x	row_split_lbl <- var_labels_for(adam_db$adeg, row_split_var)
56
57	1x	lyt <- egt05_qtcat_lyt(
58	1x	arm_var = arm_var,
59	1x	lbl_overall = lbl_overall,
60	1x	lbl_avisit = lbl_avisit,
61	1x	lbl_param = lbl_param,
62	1x	lbl_cat = "Category",
63	1x	summaryvars = summaryvars,
64	1x	summaryvars_lbls = summaryvars_lbls,
65	1x	row_split_var = row_split_var,
66	1x	row_split_lbl = row_split_lbl,
67	1x	visitvar = visitvar,
68	1x	page_var = page_var
69		)
70
71	1x	build_table(
72	1x	lyt,
73	1x	df = adam_db$adeg,
74	1x	alt_counts_df = adam_db$adsl
75		)
76		}
77
78		#' `EGT05_QTCAT` Layout
79		#'
80		#' @inheritParams gen_args
81		#'
82		#' @param lbl_avisit (`string`) label of the `visitvar` variable.
83		#' @param lbl_param (`string`) label of the `PARAM` variable.
84		#' @param lbl_cat (`string`) label of the Category of `summaryvars` variable. Default as `Category`.
85		#' @param summaryvars (`character`) the variables to be analyzed. `AVALCAT1` and `CHGCAT1` by default.
86		#' @param summaryvars_lbls (`character`) the label of the variables to be analyzed.
87		#' @param visitvar (`string`) typically `"AVISIT"` or user-defined visit incorporating `"ATPT"`.
88		#'
89		#' @keywords internal
90		#'
91		egt05_qtcat_lyt <- function(arm_var,
92		lbl_overall,
93		lbl_avisit,
94		lbl_param,
95		lbl_cat,
96		summaryvars,
97		summaryvars_lbls,
98		row_split_var,
99		row_split_lbl,
100		visitvar,
101		page_var) {
102	3x	page_by <- get_page_by(page_var, c(row_split_var, "PARAMCD"))
103	3x	label_pos <- ifelse(page_by, "hidden", "topleft")
104	3x	basic_table(show_colcounts = TRUE) %>%
105	3x	split_cols_by(arm_var) %>%
106	3x	ifneeded_add_overall_col(lbl_overall) %>%
107	3x	split_rows_by_recurive(
108	3x	row_split_var,
109	3x	split_label = row_split_lbl,
110	3x	label_pos = head(label_pos, -1L), page_by = head(page_by, -1L)
111		) %>%
112	3x	split_rows_by(
113	3x	var = "PARAMCD",
114	3x	labels_var = "PARAM",
115	3x	split_fun = drop_split_levels,
116	3x	label_pos = tail(label_pos, 1L),
117	3x	split_label = lbl_param,
118	3x	page_by = tail(page_by, 1L)
119		) %>%
120	3x	split_rows_by(
121	3x	visitvar,
122	3x	split_fun = drop_split_levels,
123	3x	split_label = lbl_avisit,
124	3x	label_pos = "topleft"
125		) %>%
126	3x	summarize_vars_allow_na(
127	3x	vars = summaryvars,
128	3x	var_labels = summaryvars_lbls,
129	3x	inclNAs = FALSE
130		) %>%
131	3x	append_topleft(paste0(stringr::str_dup(" ", sum(!page_by) * 2 + 2), lbl_cat))
132		}
133
134		#' @describeIn egt05_qtcat Preprocessing
135		#'
136		#' @inheritParams gen_args
137		#'
138		#' @export
139		#'
140		egt05_qtcat_pre <- function(adam_db, ...) {
141	1x	adam_db$adeg <- adam_db$adeg %>%
142	1x	filter(.data$ANL01FL == "Y") %>%
143	1x	mutate(
144	1x	AVALCAT1 = reformat(.data$AVALCAT1, empty_rule),
145	1x	CHGCAT1 = reformat(.data$CHGCAT1, empty_rule),
146	1x	AVISIT = reorder(.data$AVISIT, .data$AVISITN),
147	1x	AVISIT = with_label(.data$AVISIT, "Analysis Visit")
148		)
149	1x	adam_db
150		}
151
152		#' @describeIn egt05_qtcat Postprocessing
153		#'
154		#' @inheritParams gen_args
155		#'
156		#' @export
157		#'
158		egt05_qtcat_post <- function(tlg, prune_0 = TRUE, ...) {
159	1x	if (prune_0) tlg <- smart_prune(tlg)
160	1x	std_postprocess(tlg)
161		}
162
163		#' `EGT05_QTCAT` ECG Actual Values and Changes from Baseline by Visit Table.
164		#'
165		#' The `EGT05_QTCAT` table summarizes several electrocardiogram parameters and their evolution
166		#' throughout the study.
167		#'
168		#' @include chevron_tlg-S4class.R
169		#' @export
170		#'
171		#' @examples
172		#' run(egt05_qtcat, syn_data)
173		egt05_qtcat <- chevron_t(
174		main = egt05_qtcat_main,
175		preprocess = egt05_qtcat_pre,
176		postprocess = egt05_qtcat_post
177		)

1		# aet05 ----
2
3		#' @describeIn aet05 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param arm_var (`string`) the arm variable used for arm splitting.
7		#' @param ... Further arguments passed to `tern::control_incidence_rate()`.
8		#'
9		#' @details
10		#' * Total patient-years at risk is the sum over all patients of the time intervals (in years).
11		#' * Split columns by arm, typically `ACTARM`.
12		#' * Split rows by parameter code.
13		#' * `AVAL` is patient-years at risk.
14		#' * `n_events` is the number of adverse events observed.
15		#' * The table allows confidence level to be adjusted, default is 95%.
16		#' * Keep zero count rows by default.
17		#'
18		#' @note
19		#' * `adam_db` object must contain an `adaette` table with the columns `"PARAMCD"`, `"PARAM"`, `"AVAL"`, and `"CNSR"`.
20		#'
21		#' @export
22		#'
23		aet05_main <- function(adam_db,
24		arm_var = "ACTARM",
25		lbl_overall = NULL,
26		...) {
27	2x	assert_all_tablenames(adam_db, c("adsl", "adaette"))
28	2x	assert_string(arm_var)
29	2x	assert_string(lbl_overall, null.ok = TRUE)
30	2x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
31	2x	assert_valid_variable(adam_db$adaette, c("USUBJID", arm_var, "PARAMCD", "PARAM"),
32	2x	types = list(c("character", "factor"))
33		)
34	2x	assert_valid_variable(adam_db$adaette, "AVAL", types = list("numeric"), lower = 0, na_ok = TRUE)
35	2x	assert_valid_variable(adam_db$adaette, "n_events", types = list("numeric"), integerish = TRUE, lower = 0L)
36	2x	assert_valid_var_pair(adam_db$adsl, adam_db$adaette, arm_var)
37
38	2x	lbl_overall <- render_safe(lbl_overall)
39	2x	control <- execute_with_args(control_incidence_rate, ...)
40
41	2x	lyt <- aet05_lyt(
42	2x	arm_var = arm_var,
43	2x	lbl_overall = lbl_overall,
44	2x	param_label = "PARAM",
45	2x	vars = "AVAL",
46	2x	n_events = "n_events",
47	2x	control = control
48		)
49
50	2x	tbl <- build_table(lyt, adam_db$adaette, alt_counts_df = adam_db$adsl)
51
52	2x	tbl
53		}
54
55		#' `aet05` Layout
56		#'
57		#' @inheritParams gen_args
58		#' @param param_label (`string`) variable for parameter code.
59		#' @param vars (`string`) variable for the primary analysis variable to be iterated over.
60		#' @param n_events (`string`) variable to count the number of events observed.
61		#' @param control (`list`) parameters for estimation details, specified by using the helper function
62		#' control_incidence_rate().
63		#'
64		#' @keywords internal
65		#'
66		aet05_lyt <- function(arm_var,
67		lbl_overall,
68		param_label,
69		vars,
70		n_events,
71		control) {
72	6x	lyt <- basic_table(show_colcounts = TRUE) %>%
73	6x	split_cols_by(arm_var) %>%
74	6x	ifneeded_add_overall_col(lbl_overall) %>%
75	6x	split_rows_by(param_label, split_fun = drop_split_levels) %>%
76	6x	estimate_incidence_rate(
77	6x	vars = vars,
78	6x	n_events = n_events,
79	6x	control = control
80		)
81		}
82
83		#' @describeIn aet05 Preprocessing
84		#'
85		#' @inheritParams gen_args
86		#'
87		#' @export
88		#'
89		aet05_pre <- function(adam_db, ...) {
90	1x	adam_db$adaette <- adam_db$adaette %>%
91	1x	filter(grepl("AETTE", .data$PARAMCD)) %>%
92	1x	mutate(
93	1x	n_events = as.integer(.data$CNSR == 0)
94		)
95
96	1x	adam_db
97		}
98
99		#' @describeIn aet05 Postprocessing
100		#'
101		#' @inheritParams gen_args
102		#'
103		#' @export
104		#'
105		aet05_post <- function(tlg, prune_0 = FALSE, ...) {
106	2x	if (prune_0) {
107	!	tlg <- smart_prune(tlg)
108		}
109	2x	std_postprocess(tlg)
110		}
111
112		#' `AET05` Table 1 (Default) Adverse Event Rate Adjusted for Patient-Years at Risk - First Occurrence.
113		#'
114		#' The `AET05` table produces the standard adverse event rate adjusted for patient-years at risk summary
115		#' considering first occurrence.
116		#'
117		#' @include chevron_tlg-S4class.R
118		#' @export
119		#'
120		#' @examples
121		#' library(dplyr)
122		#' library(dunlin)
123		#'
124		#' proc_data <- log_filter(syn_data, PARAMCD == "AETTE1", "adaette")
125		#'
126		#' run(aet05, proc_data)
127		#'
128		#' run(aet05, proc_data, conf_level = 0.90, conf_type = "exact")
129		aet05 <- chevron_t(
130		main = aet05_main,
131		preprocess = aet05_pre,
132		postprocess = aet05_post,
133		adam_datasets = c("adsl", "adaette")
134		)

1		# mng01 ----
2
3		#' @describeIn mng01 Main TLG Function
4		#'
5		#' @details
6		#' * No overall value.
7		#' * Preprocessing filters for `ANL01FL` in the selected data set.
8		#'
9		#' @inheritParams gen_args
10		#' @param dataset (`string`) the name of a table in the `adam_db` object.
11		#' @param x_var (`string`) the name of a column in the `dataset` to represent on the x-axis.
12		#' @param y_var (`string`) the name of the variable to be represented on the y-axis.
13		#' @param y_name (`string`) the variable name for `y`. Used for plot's subtitle.
14		#' @param y_unit (`string`) the name of the variable with the units of `y`. Used for plot's subtitle. if `NULL`, only
15		#' `y_name` is displayed as subtitle.
16		#' @param center_fun (`string`) the function to compute the estimate value.
17		#' @param interval_fun (`string`) the function defining the crossbar range.
18		#' @param show_table (`flag`) should the summary statistic table be displayed.
19		#' @param show_n (`flag`) should the number of observation be displayed int the table.
20		#' @param jitter (`numeric`) the width of spread for data points on the x-axis; a number from 0 (no `jitter`) to 1 (high
21		#' `jitter`), with a default of 0.3 (slight `jitter`).
22		#' @param show_h_grid (`flag`) should horizontal grid be displayed.
23		#' @param show_v_grid (`flag`) should vertical grid be displayed.
24		#' @param legend_pos (`string`) the position of the legend.
25		#' @param line_col (`character`) describing the colors to use for the lines or a named `character` associating values of
26		#' `arm_var` with color names.
27		#'
28		#' @note
29		#' * `adam_db` object must contain the table specified by `dataset` with the columns specified by `x_var`, `y_var`,
30		#' `y_name`, `y_unit` and `arm_var`.
31		#'
32		#' @return a list of `ggplot` objects.
33		#'
34		#' @export
35		#'
36		mng01_main <- function(adam_db,
37		dataset = "adlb",
38		x_var = "AVISIT",
39		y_var = "AVAL",
40		y_name = "PARAM",
41		y_unit = NULL,
42		arm_var = "ACTARM",
43		center_fun = "mean",
44		interval_fun = "mean_ci",
45		show_table = TRUE,
46		jitter = 0.3,
47		show_n = TRUE,
48		show_h_grid = TRUE,
49		show_v_grid = FALSE,
50		legend_pos = "top",
51		line_col = nestcolor::color_palette(),
52		...) {
53	3x	assert_all_tablenames(adam_db, c(dataset, "adsl"))
54	3x	assert_character(x_var)
55	3x	assert_string(y_var)
56	3x	assert_string(y_name)
57	3x	assert_string(y_unit, null.ok = TRUE)
58	3x	assert_string(arm_var)
59	3x	assert_string(center_fun)
60	3x	assert_string(interval_fun)
61	3x	assert_names(center_fun, subset.of = c("mean", "median"))
62	3x	assert_choice(interval_fun, c("mean_ci", "mean_sei", "mean_sdi", "median_ci", "quantiles", "range"))
63	3x	assert_flag(show_table)
64	3x	assert_number(jitter, lower = 0, upper = 1)
65	3x	assert_flag(show_n)
66	3x	assert_flag(show_h_grid)
67	3x	assert_flag(show_v_grid)
68	3x	assert_choice(legend_pos, c("top", "bottom", "right", "left"))
69	3x	assert_character(line_col, null.ok = TRUE)
70	3x	assert_valid_variable(adam_db[[dataset]], x_var)
71	3x	assert_valid_variable(adam_db[[dataset]], y_var, types = list(c("numeric")))
72	3x	assert_valid_variable(adam_db[[dataset]], y_unit, types = list(c("character", "factor")))
73	3x	assert_valid_variable(adam_db[[dataset]], arm_var, types = list(c("character", "factor")), na_ok = FALSE)
74	3x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
75	3x	assert_valid_variable(adam_db[[dataset]], "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
76	3x	assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)
77
78	3x	df <- adam_db[[dataset]]
79	3x	line_col <- unlist(line_col)
80
81	3x	data_ls <- split(df, df$PARAM, drop = TRUE)
82	3x	x_var <- paste(x_var, collapse = "_")
83
84	3x	whiskers_fun <- switch(interval_fun,
85	3x	"mean_ci" = c("mean_ci_lwr", "mean_ci_upr"),
86	3x	"mean_sei" = c("mean_sei_lwr", "mean_sei_upr"),
87	3x	"mean_sdi" = c("mean_sdi_lwr", "mean_sdi_upr"),
88	3x	"median_ci" = c("median_ci_lwr", "median_ci_upr"),
89	3x	"quantiles" = c("quantiles_0.25", "quantile_0.75"),
90	3x	"range" = c("min", "max")
91		)
92
93	3x	y_unit <- if (is.null(y_unit)) NA else y_unit
94	3x	variables <- c(
95	3x	x = x_var,
96	3x	y = y_var,
97	3x	strata = arm_var,
98	3x	paramcd = y_name,
99	3x	y_unit = y_unit
100		)
101
102	3x	n_func <- if (show_n) "n" else NULL
103
104	3x	table <- if (show_table) c(n_func, center_fun, interval_fun) else NULL
105
106	3x	ggtheme <- ggplot2::theme_bw() +
107	3x	ggplot2::theme(legend.position = legend_pos) +
108	3x	ggplot2::theme(axis.title.x = ggplot2::element_blank())
109
110	3x	ggtheme <- if (!show_v_grid) {
111	3x	ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank())
112		} else {
113	!	ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_line(linewidth = 1))
114		}
115
116	3x	ggtheme <- if (!show_h_grid) {
117	1x	ggtheme + ggplot2::theme(
118	1x	panel.grid.minor.y = ggplot2::element_blank(),
119	1x	panel.grid.major.y = ggplot2::element_blank()
120		)
121		} else {
122	2x	ggtheme + ggplot2::theme(
123	2x	panel.grid.minor.y = ggplot2::element_line(linewidth = 1),
124	2x	panel.grid.major.y = ggplot2::element_line(linewidth = 1)
125		)
126		}
127
128	3x	if (!is.null(names(line_col))) {
129	2x	color_lvl <- sort(unique(df[[arm_var]]))
130	2x	col <- line_col[as.character(color_lvl)]
131
132	2x	if (anyNA(col)) {
133	1x	missing_col <- setdiff(color_lvl, names(col))
134	1x	stop(paste("Missing color matching for", toString(missing_col)))
135		}
136
137	1x	col <- unname(col)
138		} else {
139	1x	col <- line_col
140		}
141
142	2x	ret <- lapply(
143	2x	data_ls,
144	2x	tern::g_lineplot,
145	2x	alt_count = adam_db[["adsl"]],
146	2x	variables = variables,
147	2x	mid = center_fun,
148	2x	interval = interval_fun,
149	2x	whiskers = whiskers_fun,
150	2x	position = ggplot2::position_dodge(width = jitter),
151	2x	title = NULL,
152	2x	table = table,
153	2x	ggtheme = ggtheme,
154	2x	col = col,
155	2x	subtitle_add_unit = !is.na(y_unit)
156		)
157	2x	do_call(gg_list, ret)
158		}
159
160		#' @describeIn mng01 Preprocessing
161		#'
162		#' @inheritParams mng01_main
163		#'
164		#' @export
165		#'
166		mng01_pre <- function(adam_db, dataset, x_var = "AVISIT", ...) {
167	2x	adam_db[[dataset]] <- adam_db[[dataset]] %>%
168	2x	filter(.data$ANL01FL == "Y") %>%
169	2x	mutate(
170	2x	AVISIT = reorder(.data$AVISIT, .data$AVISITN),
171	2x	AVISIT = with_label(.data$AVISIT, "Visit")
172		)
173
174	2x	dunlin::ls_unite(adam_db, dataset, cols = x_var, sep = "_")
175		}
176
177		# `mng01` Pipeline ----
178
179		#' `MNG01` Mean Plot Graph.
180		#'
181		#' Overview of a summary statistics across time and arm for a selected data set.
182		#'
183		#' @include chevron_tlg-S4class.R
184		#' @export
185		#'
186		#' @examples
187		#' col <- c(
188		#' "A: Drug X" = "black",
189		#' "B: Placebo" = "blue",
190		#' "C: Combination" = "gray"
191		#' )
192		#'
193		#' run(mng01, syn_data, dataset = "adlb", x_var = c("AVISIT", "AVISITN"), line_col = col)
194		mng01 <- chevron_g(
195		main = mng01_main,
196		preproces = mng01_pre
197		)

1		# vst02_1 ----
2
3		#' @describeIn vst02_1 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param exclude_base_abn (`flag`) whether baseline abnormality should be excluded.
7		#'
8		#' @details
9		#' * Only count LOW or HIGH values.
10		#' * Results of "LOW LOW" are treated as the same as "LOW", and "HIGH HIGH" the same as "HIGH".
11		#' * Does not include a total column by default.
12		#' * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.
13		#'
14		#' @note
15		#' * `adam_db` object must contain an `advs` table with the `"PARAM"`, `"ANRIND"` and `"BNRIND"` columns.
16		#'
17		#' @export
18		#'
19		vst02_1_main <- function(adam_db,
20		arm_var = "ACTARM",
21		lbl_overall = NULL,
22		exclude_base_abn = FALSE,
23		...) {
24	2x	assert_all_tablenames(adam_db, "adsl", "advs")
25	2x	assert_string(arm_var)
26	2x	assert_string(lbl_overall, null.ok = TRUE)
27	2x	assert_flag(exclude_base_abn)
28	2x	assert_valid_variable(adam_db$advs, c(arm_var, "PARAM", "ANRIND", "BNRIND"), types = list(c("character", "factor")))
29	2x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
30	2x	assert_valid_variable(adam_db$advs, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
31	2x	assert_valid_var_pair(adam_db$adsl, adam_db$advs, arm_var)
32
33	2x	lbl_overall <- render_safe(lbl_overall)
34	2x	lbl_vs_assessment <- var_labels_for(adam_db$advs, "PARAM")
35	2x	lbl_vs_abnormality <- var_labels_for(adam_db$advs, "ANRIND")
36
37	2x	lyt <- vst02_lyt(
38	2x	arm_var = arm_var,
39	2x	lbl_overall = lbl_overall,
40	2x	exclude_base_abn = exclude_base_abn,
41	2x	lbl_vs_assessment = lbl_vs_assessment,
42	2x	lbl_vs_abnormality = lbl_vs_abnormality
43		)
44
45	2x	tbl <- build_table(lyt, adam_db$advs, alt_counts_df = adam_db$adsl)
46
47	2x	tbl
48		}
49
50		#' `vst02_1` Layout
51		#'
52		#' @inheritParams gen_args
53		#' @param lbl_vs_assessment (`string`) the label of the assessment variable.
54		#' @param lbl_vs_abnormality (`string`) the label of the abnormality variable.
55		#' @param exclude_base_abn (`flag`) whether to exclude subjects with baseline abnormality from numerator and
56		#' denominator.
57		#'
58		#' @keywords internal
59		#'
60		vst02_lyt <- function(arm_var,
61		lbl_overall,
62		exclude_base_abn,
63		lbl_vs_assessment,
64		lbl_vs_abnormality) {
65	4x	basic_table(show_colcounts = TRUE) %>%
66	4x	split_cols_by(var = arm_var) %>%
67	4x	ifneeded_add_overall_col(lbl_overall) %>%
68	4x	split_rows_by("PARAM", split_fun = drop_split_levels, label_pos = "topleft", split_label = lbl_vs_assessment) %>%
69	4x	count_abnormal(
70	4x	"ANRIND",
71	4x	abnormal = list(Low = "LOW", High = "HIGH"),
72	4x	variables = list(id = "USUBJID", baseline = "BNRIND"),
73	4x	exclude_base_abn = exclude_base_abn
74		) %>%
75	4x	append_topleft(paste0(" ", lbl_vs_abnormality))
76		}
77
78		#' @describeIn vst02_1 Preprocessing
79		#'
80		#' @inheritParams gen_args
81		#'
82		#' @export
83		#'
84		vst02_pre <- function(adam_db, ...) {
85	2x	high_low_format <- rule(
86	2x	HIGH = c("HIGH HIGH", "HIGH"),
87	2x	LOW = c("LOW LOW", "LOW")
88		)
89
90	2x	adam_db$advs <- adam_db$advs %>%
91	2x	filter(.data$ONTRTFL == "Y") %>%
92	2x	mutate(
93	2x	PARAM = with_label(.data$PARAM, "Assessment"),
94	2x	ANRIND = with_label(reformat(.data$ANRIND, high_low_format), "Abnormality"),
95	2x	BNRIND = reformat(.data$BNRIND, high_low_format)
96		)
97
98	2x	adam_db
99		}
100
101		#' @describeIn vst02_1 Postprocessing
102		#'
103		#' @inheritParams gen_args
104		#'
105		#' @export
106		#'
107		vst02_post <- function(tlg, prune_0 = FALSE, ...) {
108	2x	if (prune_0) {
109	!	tlg <- smart_prune(tlg)
110		}
111	2x	std_postprocess(tlg)
112		}
113
114		#' `VST02` Vital Sign Abnormalities Table.
115		#'
116		#' Vital Sign Parameters outside Normal Limits Regardless of Abnormality at Baseline.
117		#'
118		#' @include chevron_tlg-S4class.R
119		#' @export
120		#'
121		#' @examples
122		#' run(vst02_1, syn_data)
123		vst02_1 <- chevron_t(
124		main = vst02_1_main,
125		preprocess = vst02_pre,
126		postprocess = vst02_post
127		)
128
129		# vst02_2 ----
130
131		#' @describeIn vst02_2 Main TLG function
132		#'
133		#' @inherit vst02_1_main
134		#'
135		#' @export
136		#'
137		vst02_2_main <- modify_default_args(vst02_1_main, exclude_base_abn = TRUE)
138		#' `VST02` Vital Sign Abnormalities Table.
139		#'
140		#' Vital Sign Parameters outside Normal Limits Among Patients without Abnormality at Baseline.
141		#'
142		#' @include chevron_tlg-S4class.R
143		#' @export
144		#'
145		#' @examples
146		#' run(vst02_2, syn_data)
147		vst02_2 <- chevron_t(
148		main = vst02_2_main,
149		preprocess = vst02_pre,
150		postprocess = vst02_post
151		)

1		# egt03 ----
2		#' @describeIn egt03 Main TLG function
3		#'
4		#' @param arm_var (`character`) the arm variables used for row split, typically `"ACTARMCD"`.
5		#' @param summaryvar (`character`) variables to be analyzed, typically `"BNRIND"`. Labels of the corresponding columns
6		#' are used as subtitles.
7		#' @param splitvar (`character`) variables to be analyzed, typically `"ANRIND"`. Labels of the corresponding columns are
8		#' used as subtitles.
9		#'
10		#' @details
11		#' * `ADEG` data are subsetted to contain only "POST-BASELINE MINIMUM"/"POST-BASELINE MAXIMUM" visit
12		#' according to the preprocessing.
13		#' * Percentages are based on the total number of patients in a treatment group.
14		#' * Split columns by Analysis Reference Range Indicator, typically `ANRIND`.
15		#' * Does not include a total column by default.
16		#' * Sorted based on factor level.
17		#'
18		#' @note
19		#' * `adam_db` object must contain an `adeg` table with a `"ACTARMCD"` column as well as columns specified in
20		#' `summaryvar` and `splitvar`.
21		#'
22		#' @export
23		#'
24		egt03_main <- function(adam_db,
25		arm_var = "ACTARMCD",
26		summaryvar = "BNRIND",
27		splitvar = "ANRIND",
28		visitvar = "AVISIT",
29		page_var = "PARAMCD",
30		...) {
31	1x	assert_all_tablenames(adam_db, c("adsl", "adeg"))
32	1x	assert_string(arm_var)
33	1x	assert_string(summaryvar)
34	1x	assert_string(splitvar)
35	1x	assert_string(visitvar)
36	1x	assert_string(page_var, null.ok = TRUE)
37	1x	assert_subset(page_var, "PARAMCD")
38	1x	assert_valid_variable(adam_db$adeg, summaryvar, types = list("character", "factor"))
39	1x	assert_valid_variable(adam_db$adeg, c("PARAMCD", "PARAM", splitvar), types = list("character", "factor"))
40	1x	assert_single_value(adam_db$adeg[[visitvar]])
41	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)
42	1x	assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
43	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
44	1x	assert_single_value(adam_db$adeg$PARAMCD)
45
46	1x	lbl_armvar <- var_labels_for(adam_db$adeg, arm_var)
47	1x	lbl_summaryvars <- var_labels_for(adam_db$adeg, summaryvar)
48	1x	lbl_splitvar <- var_labels_for(adam_db$adeg, splitvar)
49	1x	lbl_param <- var_labels_for(adam_db$adeg, "PARAM")
50
51	1x	lyt <- egt03_lyt(
52	1x	arm_var = arm_var,
53	1x	splitvar = splitvar,
54	1x	summaryvar = summaryvar,
55	1x	lbl_armvar = lbl_armvar,
56	1x	lbl_summaryvars = lbl_summaryvars,
57	1x	lbl_param = lbl_param,
58	1x	page_var = page_var
59		)
60	1x	adam_db$adeg$SPLIT_LABEL <- factor(rep(lbl_splitvar, nrow(adam_db$adeg)), levels = lbl_splitvar)
61
62	1x	tbl <- build_table(
63	1x	lyt,
64	1x	df = adam_db$adeg
65		)
66
67	1x	tbl
68		}
69
70		#' `egt03` Layout
71		#'
72		#' @inheritParams gen_args
73		#' @inheritParams egt03_main
74		#'
75		#' @param lbl_armvar (`string`) label of the `arm_var` variable.
76		#' @param lbl_summaryvars (`string`) label of the `summaryvar` variable.
77		#'
78		#' @keywords internal
79		#'
80		egt03_lyt <- function(arm_var,
81		splitvar,
82		summaryvar,
83		lbl_armvar,
84		lbl_summaryvars,
85		lbl_param,
86		page_var) {
87	3x	page_by <- !is.null(page_var)
88	3x	indent <- 2L
89	3x	space <- stringr::str_dup(" ", indent * (1L + !page_by))
90	3x	lbl_summaryvars <- paste0(space, lbl_summaryvars)
91
92	3x	basic_table(show_colcounts = FALSE) %>%
93	3x	split_cols_by("SPLIT_LABEL") %>%
94	3x	split_cols_by(splitvar) %>%
95	3x	split_rows_by(
96	3x	"PARAMCD",
97	3x	labels_var = "PARAM",
98	3x	page_by = page_by,
99	3x	split_fun = drop_split_levels,
100	3x	split_label = lbl_param,
101	3x	label_pos = if (page_by) "hidden" else "topleft"
102		) %>%
103	3x	split_rows_by(arm_var,
104	3x	split_fun = drop_split_levels,
105	3x	label_pos = "topleft",
106	3x	split_label = lbl_armvar
107		) %>%
108	3x	add_rowcounts() %>%
109	3x	summarize_vars(summaryvar, denom = "N_row", .stats = "count_fraction") %>%
110	3x	append_topleft(lbl_summaryvars)
111		}
112
113		#' @describeIn egt03 Preprocessing
114		#'
115		#' @inheritParams gen_args
116		#' @inheritParams egt03_main
117		#'
118		#' @export
119		#'
120		egt03_pre <- function(adam_db, ...) {
121	1x	adam_db$adeg <- adam_db$adeg %>%
122	1x	filter(
123	1x	.data$AVISIT == "POST-BASELINE MINIMUM"
124		) %>%
125	1x	mutate(BNRIND = factor(
126	1x	.data$BNRIND,
127	1x	levels = c("LOW", "NORMAL", "HIGH", "Missing"),
128	1x	labels = c("LOW", "NORMAL", "HIGH", "Missing")
129		)) %>%
130	1x	mutate(ANRIND = factor(
131	1x	.data$ANRIND,
132	1x	levels = c("LOW", "NORMAL", "HIGH", "Missing"),
133	1x	labels = c("LOW", "NORMAL", "HIGH", "Missing")
134		)) %>%
135	1x	mutate(
136	1x	BNRIND = with_label(.data$BNRIND, "Baseline Reference Range Indicator"),
137	1x	ANRIND = with_label(.data$ANRIND, "Minimum Post-Baseline Assessment")
138		)
139
140	1x	adam_db
141		}
142
143		#' @describeIn egt03 Postprocessing
144		#'
145		#' @inheritParams gen_args
146		#'
147		#' @export
148		#'
149		egt03_post <- function(tlg, prune_0 = FALSE, ...) {
150	!	if (prune_0) tlg <- smart_prune(tlg)
151
152	1x	std_postprocess(tlg)
153		}
154
155		#' `EGT03` Shift Table of ECG Interval Data - Baseline versus Minimum or Maximum Post-Baseline
156		#'
157		#' The `EGT03` Table entries provide the number of patients by baseline assessment and minimum or maximum post-baseline
158		#' assessment. Percentages are based on the total number of patients in a treatment group. Baseline is the patient's
159		#' last observation prior to initiation of study drug.
160		#'
161		#' @include chevron_tlg-S4class.R
162		#' @export
163		#'
164		#' @examples
165		#' library(dunlin)
166		#'
167		#' proc_data <- log_filter(syn_data, PARAMCD == "HR", "adeg")
168		#' run(egt03, proc_data)
169		egt03 <- chevron_t(
170		main = egt03_main,
171		preprocess = egt03_pre,
172		postprocess = egt03_post
173		)

1		# ael01_nollt ----
2
3		#' @describeIn ael01_nollt Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param dataset (`character`) the name of a table in the `adam_db` object.
7		#' @param default_formatting (`list`) the default format of the listing columns. See [`rlistings::as_listing`].
8		#' @param col_formatting (`list`) the format of specific listing columns. See [`rlistings::as_listing`].
9		#'
10		#' @details
11		#' * Removes duplicate rows.
12		#' * By default, uses dataset `adae`, sorting by key columns `AEBODSYS` and `AEDECOD`.
13		#' * If using with a dataset other than `adae`, be sure to specify the desired labels for variables in
14		#' `key_cols` and `disp_cols`, and pre-process missing data.
15		#'
16		#' @note
17		#' * `adam_db` object must contain the `dataset` table with columns specified by `key_cols` and `disp_cols`.
18		#'
19		#' @export
20		#'
21		ael01_nollt_main <- function(adam_db,
22		dataset = "adae",
23		key_cols = c("AEBODSYS", "AEDECOD"),
24		disp_cols = "AETERM",
25		default_formatting = list(
26		all = formatters::fmt_config(align = "left"),
27		numeric = formatters::fmt_config(align = "center")
28		),
29		col_formatting = NULL,
30		...) {
31	1x	assert_all_tablenames(adam_db, dataset)
32	1x	assert_valid_variable(adam_db[[dataset]], c(key_cols, disp_cols), label = paste0("adam_db$", dataset))
33	1x	assert_list(default_formatting)
34	1x	assert_list(col_formatting, null.ok = TRUE)
35
36	1x	as_listing(
37	1x	adam_db[[dataset]],
38	1x	key_cols = key_cols,
39	1x	disp_cols = disp_cols,
40	1x	default_formatting = default_formatting,
41	1x	col_formatting = col_formatting
42		)
43		}
44
45		#' @describeIn ael01_nollt Preprocessing
46		#'
47		#' @inheritParams ael01_nollt_main
48		#'
49		#' @export
50		#'
51		ael01_nollt_pre <- function(adam_db,
52		dataset = "adae",
53		key_cols = c("AEBODSYS", "AEDECOD"),
54		disp_cols = "AETERM",
55		...) {
56	1x	adam_db[[dataset]] <- adam_db[[dataset]] %>%
57	1x	select(all_of(c(key_cols, disp_cols))) %>%
58	1x	distinct() %>%
59	1x	mutate(
60	1x	across(all_of(c(key_cols, disp_cols)), ~ reformat(.x, nocoding))
61		) %>%
62	1x	arrange(pick(all_of(c(key_cols, disp_cols))))
63
64	1x	adam_db
65		}
66
67		#' @describeIn ael01_nollt Postprocessing
68		#'
69		#' @inheritParams gen_args
70		#'
71		ael01_nollt_post <- function(tlg, ...) {
72	!	if (nrow(tlg) == 0) tlg <- null_report
73
74	1x	tlg
75		}
76
77		#' `AEL01_NOLLT` Listing 1 (Default) Glossary of Preferred Terms and Investigator-Specified Terms.
78		#'
79		#' @include chevron_tlg-S4class.R
80		#' @export
81		#'
82		#' @examples
83		#' run(ael01_nollt, syn_data)
84		ael01_nollt <- chevron_l(
85		main = ael01_nollt_main,
86		preprocess = ael01_nollt_pre,
87		postprocess = ael01_nollt_post
88		)

1		# mht01 ----
2
3		#' @describeIn mht01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#'
7		#' @details
8		#' * Numbers represent absolute numbers of patients and fraction of `N`, or absolute number of event when specified.
9		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
10		#' * Split columns by arm.
11		#' * Does not include a total column by default.
12		#' * Order by body system alphabetically and within body system and medical condition by decreasing total number of
13		#' patients with the specific condition.
14		#'
15		#' @note
16		#' * `adam_db` object must contain an `admh` table with columns `"MHBODSYS"` and `"MHDECOD"`.
17		#'
18		#' @export
19		#'
20		mht01_main <- function(adam_db,
21		arm_var = "ARM",
22		lbl_overall = NULL,
23		...) {
24	1x	assert_all_tablenames(adam_db, c("admh", "adsl"))
25	1x	assert_string(arm_var)
26	1x	assert_string(lbl_overall, null.ok = TRUE)
27	1x	assert_valid_variable(adam_db$admh, c("MHBODSYS", "MHDECOD"), types = list(c("character", "factor")), empty_ok = TRUE)
28	1x	assert_valid_variable(adam_db$admh, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
29	1x	assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))
30	1x	assert_valid_var_pair(adam_db$adsl, adam_db$admh, arm_var)
31
32	1x	lbl_overall <- render_safe(lbl_overall)
33	1x	lbl_mhbodsys <- var_labels_for(adam_db$admh, "MHBODSYS")
34	1x	lbl_mhdecod <- var_labels_for(adam_db$admh, "MHDECOD")
35
36	1x	lyt <- mht01_lyt(
37	1x	arm_var = arm_var,
38	1x	lbl_overall = lbl_overall,
39	1x	lbl_mhbodsys = lbl_mhbodsys,
40	1x	lbl_mhdecod = lbl_mhdecod
41		)
42
43	1x	tbl <- build_table(lyt, adam_db$admh, alt_counts_df = adam_db$adsl)
44
45	1x	tbl
46		}
47
48		#' `mht01` Layout
49		#'
50		#' @inheritParams gen_args
51		#' @inheritParams mht01_main
52		#' @param lbl_mhbodsys (`string`) label associated with `"MHBODSYS"`.
53		#' @param lbl_mhdecod (`string`) label associated with `"MHDECOD"`.
54		#'
55		#' @keywords internal
56		#'
57		mht01_lyt <- function(arm_var,
58		lbl_overall,
59		lbl_mhbodsys,
60		lbl_mhdecod) {
61	4x	basic_table(show_colcounts = TRUE) %>%
62	4x	split_cols_by(var = arm_var) %>%
63	4x	ifneeded_add_overall_col(lbl_overall) %>%
64	4x	summarize_num_patients(
65	4x	var = "USUBJID",
66	4x	.stats = c("unique", "nonunique"),
67	4x	.labels = c(
68	4x	unique = render_safe("Total number of {patient_label} with at least one condition"),
69	4x	nonunique = render_safe("Total number of conditions")
70		)
71		) %>%
72	4x	split_rows_by(
73	4x	"MHBODSYS",
74	4x	child_labels = "visible",
75	4x	labels_var = "MHBODSYS",
76	4x	nested = FALSE,
77	4x	indent_mod = -1L,
78	4x	split_fun = drop_split_levels,
79	4x	label_pos = "topleft",
80	4x	split_label = lbl_mhbodsys
81		) %>%
82	4x	summarize_num_patients(
83	4x	var = "USUBJID",
84	4x	.stats = c("unique", "nonunique"),
85	4x	.labels = c(
86	4x	unique = render_safe("Total number of {patient_label} with at least one condition"),
87	4x	nonunique = "Total number of conditions"
88		)
89		) %>%
90	4x	count_occurrences(
91	4x	vars = "MHDECOD",
92	4x	.indent_mods = -1L
93		) %>%
94	4x	append_topleft(paste0(" ", lbl_mhdecod))
95		}
96
97		#' @describeIn mht01 Preprocessing
98		#'
99		#' @inheritParams gen_args
100		#'
101		#' @export
102		#'
103		mht01_pre <- function(adam_db, ...) {
104	1x	adam_db$admh <- adam_db$admh %>%
105	1x	filter(.data$ANL01FL == "Y")
106
107	1x	adam_db$admh <- adam_db$admh %>%
108	1x	mutate(
109	1x	across(all_of(c("MHBODSYS", "MHDECOD")), ~ reformat(.x, nocoding))
110		) %>%
111	1x	mutate(
112	1x	MHBODSYS = with_label(.data$MHBODSYS, "MedDRA System Organ Class"),
113	1x	MHDECOD = with_label(.data$MHDECOD, "MedDRA Preferred Term")
114		)
115
116	1x	adam_db
117		}
118
119		#' @describeIn mht01 Postprocessing
120		#'
121		#' @inheritParams gen_args
122		#'
123		#' @export
124		#'
125		mht01_post <- function(tlg, prune_0 = TRUE, ...) {
126	1x	if (prune_0) {
127	1x	tlg <- smart_prune(tlg)
128		}
129
130	1x	tbl_sorted <- tlg %>%
131	1x	sort_at_path(
132	1x	path = c("MHBODSYS", "*", "MHDECOD"),
133	1x	scorefun = score_occurrences
134		)
135
136	1x	std_postprocess(tbl_sorted)
137		}
138
139		#' `MHT01` Medical History Table.
140		#'
141		#' The `MHT01` table provides an overview of the subjects medical
142		#' history by SOC and Preferred Term.
143		#'
144		#' @include chevron_tlg-S4class.R
145		#' @export
146		#'
147		#' @examples
148		#' run(mht01, syn_data)
149		mht01 <- chevron_t(
150		main = mht01_main,
151		preprocess = mht01_pre,
152		postprocess = mht01_post
153		)

1		# ext01 ----
2
3		#' @describeIn ext01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in `adex`
7		#' table of `adam_db` is used as label.
8		#' @param map (`data.frame`) of mapping for split rows.
9		#'
10		#' @details
11		#' * Default Exposure table
12		#' * The `n` row provides the number of non-missing values. The percentages for categorical variables is based on `n`.
13		#' The percentages for `Total number of patients with at least one dose modification` are based on the number of
14		#' patients in the corresponding analysis population given by `N`.
15		#' * Split columns by arm, typically `ACTARM`.
16		#' * Does not include a total column by default.
17		#' * Sorted by alphabetic order of the `PARAM` value. Transform to factor and re-level for custom order.
18		#' * `ANL01FL` is not relevant subset.
19		#'
20		#' @note
21		#' * `adam_db` object must contain an `adex` table with columns specified in `summaryvars`.
22		#'
23		#' @export
24		#'
25		ext01_main <- function(adam_db,
26		arm_var = "ACTARM",
27		lbl_overall = NULL,
28		summaryvars = "AVAL",
29		row_split_var = "PARCAT2",
30		page_var = NULL,
31		map = NULL,
32		...) {
33	2x	assert_all_tablenames(adam_db, c("adsl", "adex"))
34	2x	assert_string(arm_var)
35	2x	assert_string(lbl_overall, null.ok = TRUE)
36	2x	assert_character(summaryvars)
37	2x	assert_character(row_split_var, null.ok = TRUE)
38	2x	assert_string(page_var, null.ok = TRUE)
39	2x	assert_data_frame(map, null.ok = TRUE)
40	2x	assert_valid_var_pair(adam_db$adsl, adam_db$adex, arm_var)
41	2x	assert_valid_variable(adam_db$adex, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
42	2x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
43	2x	assert_valid_variable(adam_db$adex, summaryvars, empty_ok = TRUE, na_ok = TRUE)
44	2x	assert_valid_variable(
45	2x	adam_db$adex, c(row_split_var, "PARAMCD", "PARAM"),
46	2x	types = list(c("character", "factor")), empty_ok = TRUE
47		)
48	2x	assert_valid_variable(adam_db$adex, colnames(map), types = list(c("character", "factor")))
49	2x	if (!is.null(map)) {
50	!	map <- infer_mapping(map, adam_db$adex)
51		}
52	2x	assert_subset(page_var, c(row_split_var))
53
54	2x	lbl_overall <- render_safe(lbl_overall)
55	2x	summaryvars_lbls <- var_labels_for(adam_db$adex, summaryvars)
56	2x	row_split_lbl <- var_labels_for(adam_db$adex, row_split_var)
57
58	2x	lyt <- ext01_lyt(
59	2x	arm_var = arm_var,
60	2x	lbl_overall = lbl_overall,
61	2x	summaryvars = summaryvars,
62	2x	summaryvars_lbls = summaryvars_lbls,
63	2x	row_split_var = row_split_var,
64	2x	row_split_lbl = row_split_lbl,
65	2x	page_var = page_var,
66	2x	map = map
67		)
68
69	2x	tbl <- build_table(lyt, adam_db$adex, adam_db$adsl)
70
71	2x	tbl
72		}
73
74		#' `ext01` Layout
75		#'
76		#' @inheritParams gen_args
77		#'
78		#' @param summaryvars (`character`) the name of the variable to be analyzed. By default `"AVAL"`.
79		#' @param summaryvars_lbls (`character`) the label associated with the analyzed variable.
80		#'
81		#' @keywords internal
82		#'
83		ext01_lyt <- function(arm_var,
84		lbl_overall,
85		summaryvars,
86		summaryvars_lbls,
87		row_split_var,
88		row_split_lbl,
89		page_var,
90		map) {
91	9x	page_by <- get_page_by(page_var, c(row_split_var))
92	9x	label_pos <- ifelse(page_by, "hidden", "topleft")
93	9x	basic_table(show_colcounts = TRUE) %>%
94	9x	split_cols_by(var = arm_var) %>%
95	9x	ifneeded_add_overall_col(lbl_overall) %>%
96	9x	split_rows_by_recurive(
97	9x	row_split_var,
98	9x	split_label = row_split_lbl, label_pos = label_pos, page_by = page_by
99		) %>%
100	9x	split_rows_by(
101	9x	"PARAMCD",
102	9x	labels_var = "PARAM",
103	9x	split_fun = split_fun_map(map)
104		) %>%
105	9x	summarize_vars(
106	9x	vars = summaryvars,
107	9x	var_labels = summaryvars_lbls,
108	9x	show_labels = "hidden",
109	9x	.formats = list(count_fraction = format_count_fraction_fixed_dp)
110		)
111		}
112
113		#' @describeIn ext01 Preprocessing
114		#'
115		#' @inheritParams gen_args
116		#'
117		#' @export
118		#'
119		ext01_pre <- function(adam_db,
120		...) {
121	2x	adam_db$adex <- adam_db$adex %>%
122	2x	filter(.data$PARCAT1 == "OVERALL") %>%
123	2x	filter(.data$PARAMCD %in% c("TDURD", "TDOSE"))
124
125	2x	adam_db
126		}
127
128		#' @describeIn ext01 Postprocessing
129		#'
130		#' @inheritParams gen_args
131		#'
132		#' @export
133		#'
134		ext01_post <- function(tlg, prune_0 = TRUE, ...) {
135	2x	if (prune_0) tlg <- smart_prune(tlg)
136	2x	std_postprocess(tlg)
137		}
138
139		#' `EXT01` Exposure Summary Table.
140		#'
141		#' The `EXT01` table provides an overview of the of the exposure of the
142		#' patients in terms of Total dose administered or missed, and treatment duration.
143		#'
144		#' @include chevron_tlg-S4class.R
145		#' @export
146		#'
147		#' @examples
148		#' run(ext01, syn_data)
149		#'
150		#' run(ext01, syn_data, summaryvars = c("AVAL", "AVALCAT1"), prune_0 = FALSE)
151		#'
152		#' levels(syn_data$adex$AVALCAT1) <- c(levels(syn_data$adex$AVALCAT1), "12 months")
153		#' map <- data.frame(
154		#' PARAMCD = "TDURD",
155		#' AVALCAT1 = c("< 1 month", "1 to <3 months", ">=6 months", "3 to <6 months", "12 months")
156		#' )
157		#' run(ext01, syn_data, summaryvars = c("AVAL", "AVALCAT1"), prune_0 = FALSE, map = map)
158		ext01 <- chevron_t(
159		main = ext01_main,
160		preprocess = ext01_pre,
161		postprocess = ext01_post
162		)

1		# pdt02 ----
2
3		#' @describeIn pdt02 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param dvreas_var (`string`) the variable defining the reason for deviation. By default `DVREAS`.
7		#' @param dvterm_var (`string`) the variable defining the protocol deviation term. By default `DVTERM`.
8		#'
9		#' @details
10		#' * Data should be filtered for major protocol deviations related to epidemic/pandemic.
11		#' `(AEPRELFL == "Y" & DVCAT == "MAJOR")`.
12		#' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
13		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
14		#' * Split columns by arm.
15		#' * Does not include a total column by default.
16		#' * Sort by deviation reason alphabetically and within deviation reason by decreasing total number of patients with
17		#' the specific deviation term.
18		#'
19		#' @note
20		#' * `adam_db` object must contain an `addv` table with the columns specified in `dvreas_var` and `dvterm_var`.
21		#'
22		#' @export
23		#'
24		pdt02_main <- function(adam_db,
25		arm_var = "ARM",
26		lbl_overall = NULL,
27		dvreas_var = "DVREAS",
28		dvterm_var = "DVTERM",
29		...) {
30	1x	assert_all_tablenames(adam_db, c("adsl", "addv"))
31	1x	assert_string(arm_var)
32	1x	assert_string(lbl_overall, null.ok = TRUE)
33	1x	assert_string(dvreas_var)
34	1x	assert_string(dvterm_var)
35	1x	assert_valid_variable(adam_db$addv, c(dvreas_var, dvterm_var), types = list(c("character", "factor")))
36	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
37	1x	assert_valid_variable(adam_db$addv, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
38	1x	assert_valid_var_pair(adam_db$adsl, adam_db$addv, arm_var)
39
40	1x	lbl_overall <- render_safe(lbl_overall)
41	1x	lbl_dvreas_var <- var_labels_for(adam_db$addv, dvreas_var)
42	1x	lbl_dvterm_var <- var_labels_for(adam_db$addv, dvterm_var)
43
44	1x	lyt <- pdt02_lyt(
45	1x	arm_var = arm_var,
46	1x	lbl_overall = lbl_overall,
47	1x	lbl_dvreas_var = lbl_dvreas_var,
48	1x	lbl_dvterm_var = lbl_dvterm_var,
49	1x	dvreas_var = dvreas_var,
50	1x	dvterm_var = dvterm_var
51		)
52
53	1x	tbl <- build_table(lyt, adam_db$addv, alt_counts_df = adam_db$adsl)
54
55	1x	tbl
56		}
57
58		#' `pdt02` Layout
59		#'
60		#' @inheritParams gen_args
61		#' @inheritParams pdt02_main
62		#' @param lbl_dvreas_var (`string`) label for the variable defining the reason for deviation.
63		#' @param lbl_dvterm_var (`string`) label for the variable defining the protocol deviation term.
64		#'
65		#' @keywords internal
66		#'
67		pdt02_lyt <- function(arm_var,
68		lbl_overall,
69		lbl_dvreas_var,
70		lbl_dvterm_var,
71		dvreas_var,
72		dvterm_var) {
73	3x	basic_table(show_colcounts = TRUE) %>%
74	3x	split_cols_by(var = arm_var) %>%
75	3x	ifneeded_add_overall_col(lbl_overall) %>%
76	3x	analyze_num_patients(
77	3x	vars = "USUBJID",
78	3x	.stats = c("unique", "nonunique"),
79	3x	.labels = c(
80	3x	unique = render_safe(
81	3x	"Total number of {patient_label} with at least one major protocol deviation related to epidemic/pandemic"
82		),
83	3x	nonunique = "Total number of major protocol deviations related to epidemic/pandemic"
84		)
85		) %>%
86	3x	split_rows_by(
87	3x	dvreas_var,
88	3x	nested = FALSE,
89	3x	split_fun = drop_split_levels,
90	3x	label_pos = "topleft",
91	3x	split_label = lbl_dvreas_var
92		) %>%
93	3x	summarize_num_patients(
94	3x	var = "USUBJID",
95	3x	.stats = "unique",
96	3x	.labels = NULL
97		) %>%
98	3x	count_occurrences(
99	3x	vars = dvterm_var,
100	3x	id = "USUBJID"
101		) %>%
102	3x	append_topleft(paste(" ", lbl_dvterm_var))
103		}
104
105		#' @describeIn pdt02 Preprocessing
106		#'
107		#' @inheritParams pdt02_main
108		#'
109		#' @export
110		#'
111		pdt02_pre <- function(adam_db,
112		...) {
113	1x	adam_db$addv <- adam_db$addv %>%
114	1x	mutate(across(all_of(c("DVCAT", "AEPRELFL")), ~ reformat(.x, missing_rule))) %>%
115	1x	filter(.data$DVCAT == "MAJOR" & .data$AEPRELFL == "Y") %>%
116	1x	mutate(across(all_of(c("DVREAS", "DVTERM")), ~ reformat(.x, nocoding))) %>%
117	1x	mutate(
118	1x	DVREAS = with_label(.data$DVREAS, "Primary Reason"),
119	1x	DVTERM = with_label(.data$DVTERM, "Description")
120		)
121
122	1x	adam_db
123		}
124
125		#' @describeIn pdt02 Postprocessing
126		#'
127		#' @inheritParams pdt02_main
128		#' @inheritParams gen_args
129		#'
130		#' @export
131		#'
132		pdt02_post <- function(tlg, prune_0 = TRUE, dvreas_var = "DVREAS", dvterm_var = "DVTERM", ...) {
133	1x	if (prune_0) {
134	1x	tlg <- smart_prune(tlg)
135		}
136
137	1x	tbl_sorted <- tlg %>%
138	1x	sort_at_path(
139	1x	path = c(dvreas_var, "*", dvterm_var),
140	1x	scorefun = score_occurrences
141		)
142
143	1x	std_postprocess(tbl_sorted)
144		}
145
146		#' `pdt02` Major Protocol Deviations Related to Epidemic/Pandemic Table.
147		#'
148		#' A major protocol deviations
149		#' table with the number of subjects and the total number of Major Protocol Deviations Related
150		#' to Epidemic/Pandemic sorted alphabetically and deviations name sorted by frequencies.
151		#'
152		#' @include chevron_tlg-S4class.R
153		#' @export
154		#'
155		#' @examples
156		#' run(pdt02, syn_data)
157		pdt02 <- chevron_t(
158		main = pdt02_main,
159		preprocess = pdt02_pre,
160		postprocess = pdt02_post
161		)

1		# lbt07 ----
2
3		#' @describeIn lbt07 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param param_var (`string`) the name of the column storing the parameters name.
7		#' @param grad_dir_var (`string`) the name of the column storing the grade direction variable which is required in
8		#' order to obtain the correct denominators when building the layout as it is used to define row splitting.
9		#' @param grad_anl_var (`string`) the name of the column storing toxicity grade variable where all negative values from
10		#' `ATOXGR` are replaced by their absolute values.
11		#'
12		#' @details
13		#' * Split columns by arm, typically `ACTARM`.
14		#'
15		#' @note
16		#' * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"ATOXGR"`,
17		#' `"ONTRTFL"` and column specified by `arm_var`.
18		#'
19		#' @export
20		#'
21		lbt07_main <- function(adam_db,
22		arm_var = "ACTARM",
23		lbl_overall = NULL,
24		param_var = "PARAM",
25		grad_dir_var = "GRADE_DIR",
26		grad_anl_var = "GRADE_ANL",
27		...) {
28	1x	assert_all_tablenames(adam_db, c("adsl", "adlb"))
29	1x	assert_string(arm_var)
30	1x	assert_string(lbl_overall, null.ok = TRUE)
31	1x	assert_string(param_var)
32	1x	assert_string(grad_dir_var)
33	1x	assert_string(grad_anl_var)
34	1x	assert_valid_variable(
35	1x	adam_db$adlb, c("ATOXGR", param_var, grad_dir_var, grad_anl_var),
36	1x	types = list(c("character", "factor"))
37		)
38	1x	assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)
39	1x	assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))
40	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)
41
42	1x	lbl_overall <- render_safe(lbl_overall)
43	1x	lbl_param_var <- var_labels_for(adam_db$adlb, param_var)
44	1x	lbl_grad_dir_var <- var_labels_for(adam_db$adlb, grad_dir_var)
45
46	1x	map <- expand.grid(
47	1x	PARAM = levels(adam_db$adlb[[param_var]]),
48	1x	GRADE_DIR = c("LOW", "HIGH"),
49	1x	GRADE_ANL = as.character(1:4),
50	1x	stringsAsFactors = FALSE
51		) %>%
52	1x	arrange(.data$PARAM, desc(.data$GRADE_DIR), .data$GRADE_ANL)
53
54	1x	names(map) <- c(param_var, grad_dir_var, grad_anl_var)
55
56	1x	lyt <- lbt07_lyt(
57	1x	arm_var = arm_var,
58	1x	lbl_overall = lbl_overall,
59	1x	lbl_param_var = lbl_param_var,
60	1x	lbl_grad_dir_var = lbl_grad_dir_var,
61	1x	param_var = param_var,
62	1x	grad_dir_var = grad_dir_var,
63	1x	grad_anl_var = grad_anl_var,
64	1x	map = map
65		)
66
67	1x	tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)
68
69	1x	tbl
70		}
71
72		#' `lbt07` Layout
73		#'
74		#' @inheritParams gen_args
75		#' @inheritParams lbt07_main
76		#'
77		#' @param lbl_param_var (`string`) label of the `param_var` variable.
78		#' @param lbl_grad_dir_var (`string`) label for the `grad_dir_var` variable.
79		#' @param map (`data.frame`) mapping of `PARAM`s to directions of abnormality.
80		#'
81		#' @keywords internal
82		#'
83		lbt07_lyt <- function(arm_var,
84		lbl_overall,
85		lbl_param_var,
86		lbl_grad_dir_var,
87		param_var,
88		grad_dir_var,
89		grad_anl_var,
90		map) {
91	2x	basic_table(show_colcounts = TRUE) %>%
92	2x	split_cols_by(arm_var) %>%
93	2x	ifneeded_add_overall_col(lbl_overall) %>%
94	2x	split_rows_by(
95	2x	param_var,
96	2x	label_pos = "topleft",
97	2x	split_label = lbl_param_var
98		) %>%
99	2x	summarize_num_patients(
100	2x	var = "USUBJID",
101	2x	required = "ATOXGR",
102	2x	.stats = "unique_count"
103		) %>%
104	2x	split_rows_by(
105	2x	grad_dir_var,
106	2x	label_pos = "topleft",
107	2x	split_label = lbl_grad_dir_var,
108	2x	split_fun = trim_levels_to_map(map)
109		) %>%
110	2x	count_abnormal_by_worst_grade(
111	2x	var = grad_anl_var,
112	2x	variables = list(id = "USUBJID", param = param_var, grade_dir = grad_dir_var),
113	2x	.formats = list(count_fraction = tern::format_count_fraction_fixed_dp),
114	2x	.indent_mods = 4L
115		) %>%
116	2x	append_topleft(" Highest NCI CTCAE Grade")
117		}
118
119		#' @describeIn lbt07 Preprocessing
120		#'
121		#' @inheritParams gen_args
122		#'
123		#' @export
124		#'
125		lbt07_pre <- function(adam_db, ...) {
126	1x	adam_db$adlb <- adam_db$adlb %>%
127	1x	mutate(
128	1x	ATOXGR = reformat(.data$ATOXGR, missing_rule)
129		) %>%
130	1x	filter(
131	1x	.data$ATOXGR != "<Missing>",
132	1x	.data$ONTRTFL == "Y",
133	1x	.data$WGRLOFL == "Y" \| .data$WGRHIFL == "Y"
134		) %>%
135	1x	mutate(
136	1x	GRADE_DIR = factor(
137	1x	case_when(
138	1x	ATOXGR %in% c("-1", "-2", "-3", "-4") & .data$WGRLOFL == "Y" ~ "LOW",
139	1x	ATOXGR == "0" ~ "ZERO",
140	1x	ATOXGR %in% c("1", "2", "3", "4") & .data$WGRHIFL == "Y" ~ "HIGH",
141	1x	TRUE ~ "NONE"
142		),
143	1x	levels = c("LOW", "ZERO", "HIGH", "NONE")
144		),
145	1x	GRADE_ANL = factor(.data$ATOXGR, levels = c(-4:4), labels = abs(c(-4:4))),
146	1x	PARAM = as.factor(trimws(stringr::str_remove_all(.data$PARAM, "\\(.+?\\)")))
147		)
148
149	1x	adam_db$adlb <- adam_db$adlb %>%
150	1x	mutate(
151	1x	PARAM = with_label(.data$PARAM, "Parameter"),
152	1x	GRADE_DIR = with_label(.data$GRADE_DIR, "Direction of Abnormality"),
153	1x	GRADE_ANL = with_label(.data$GRADE_ANL, "Toxicity Grade")
154		)
155
156	1x	adam_db
157		}
158
159		#' @describeIn lbt07 Postprocessing
160		#'
161		#' @inheritParams gen_args
162		#'
163		#' @export
164		#'
165		lbt07_post <- function(tlg, prune_0 = TRUE, ...) {
166	1x	if (prune_0) {
167	1x	tlg <- smart_prune(tlg)
168		}
169	1x	std_postprocess(tlg)
170		}
171
172		#' `LBT07` Table 1 (Default) Laboratory Test Results and Change from Baseline by Visit.
173		#'
174		#' The `LBT07` table provides an
175		#' overview of the analysis values and its change from baseline of each respective arm over the course of the trial.
176		#' @include chevron_tlg-S4class.R
177		#' @export
178		#'
179		#' @examples
180		#' run(lbt07, syn_data)
181		lbt07 <- chevron_t(
182		main = lbt07_main,
183		preprocess = lbt07_pre,
184		postprocess = lbt07_post
185		)

1		# dst01 ----
2
3		#' @describeIn dst01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param arm_var (`string`) variable. Usually one of `ARM`, `ACTARM`, `TRT01A`, or `TRT01A`.
7		#' @param study_status_var (`string`) variable used to define patient status. Default is `EOSSTT`, however can also be a
8		#' variable name with the pattern `EOPxxSTT` where `xx` must be substituted by 2 digits referring to the analysis
9		#' period.
10		#' @param detail_vars Named (`list`) of grouped display of `study_status_var`. The names must be subset of unique levels
11		#' of `study_status_var`.
12		#' @param trt_status_var (`string`) variable of treatment status.
13		#' @details
14		#' * Default patient disposition table summarizing the reasons for patients withdrawal.
15		#' * Numbers represent absolute numbers of patients and fraction of `N`.
16		#' * Remove zero-count rows.
17		#' * Split columns by arm.
18		#' * Include a total column by default.
19		#' * Sort withdrawal reasons by alphabetic order.
20		#'
21		#' @note
22		#' * `adam_db` object must contain an `adsl` table with the columns specified by `status_var` and `disc_reason_var`.
23		#'
24		#' @export
25		#'
26		dst01_main <- function(adam_db,
27		arm_var = "ARM",
28		lbl_overall = "All {Patient_label}",
29		study_status_var = "EOSSTT",
30		detail_vars = list(
31		Discontinued = c("DCSREAS")
32		),
33		trt_status_var = NULL,
34		...) {
35	1x	assert_all_tablenames(adam_db, "adsl")
36	1x	assert_string(arm_var)
37	1x	assert_string(lbl_overall, null.ok = TRUE)
38	1x	assert_string(study_status_var)
39	1x	assert_list(detail_vars, types = "character", names = "unique")
40	1x	assert_string(trt_status_var, null.ok = TRUE)
41	1x	assert_valid_variable(
42	1x	adam_db$adsl,
43	1x	arm_var,
44	1x	types = list(c("character", "factor")), na_ok = TRUE
45		)
46	1x	assert_valid_variable(
47	1x	adam_db$adsl, study_status_var,
48	1x	types = list(c("character", "factor")), na_ok = TRUE,
49	1x	empty_ok = FALSE, min_chars = 1L
50		)
51	1x	status_var_lvls <- lvls(adam_db$adsl[[study_status_var]])
52	1x	assert_subset(names(detail_vars), choices = status_var_lvls)
53	1x	assert_valid_variable(
54	1x	adam_db$adsl,
55	1x	unlist(detail_vars),
56	1x	types = list(c("character", "factor")),
57	1x	na_ok = TRUE,
58	1x	empty_ok = TRUE,
59	1x	min_chars = 0L
60		)
61	1x	assert_valid_variable(
62	1x	adam_db$adsl, trt_status_var,
63	1x	types = list(c("character", "factor")), na_ok = TRUE,
64	1x	empty_ok = TRUE, min_chars = 0L
65		)
66
67	1x	lbl_overall <- render_safe(lbl_overall)
68	1x	detail_vars <- setNames(detail_vars[status_var_lvls], status_var_lvls)
69
70	1x	lyt <- dst01_lyt(
71	1x	arm_var = arm_var,
72	1x	lbl_overall = lbl_overall,
73	1x	study_status_var = study_status_var,
74	1x	detail_vars = detail_vars,
75	1x	trt_status_var = trt_status_var
76		)
77	1x	build_table(lyt, adam_db$adsl)
78		}
79
80		#' `dst01` Layout
81		#'
82		#' @inheritParams dst01_main
83		#' @param study_status_var (`string`) variable used to define patient status. Default is `EOSSTT`, however can also be a
84		#' variable name with the pattern `EOPxxSTT` where `xx` must be substituted by 2 digits referring to the analysis
85		#' period.
86		#' @param detail_vars Named (`list`) of grouped display of `study_status_var`.
87		#'
88		#' @keywords internal
89		#'
90		dst01_lyt <- function(arm_var,
91		lbl_overall,
92		study_status_var,
93		detail_vars,
94		trt_status_var) {
95	9x	lyt <- basic_table(show_colcounts = TRUE) %>%
96	9x	split_cols_by(arm_var) %>%
97	9x	ifneeded_add_overall_col(lbl_overall)
98	9x	for (n in names(detail_vars)) {
99	27x	lyt <- lyt %>%
100	27x	count_or_summarize(study_status_var, n, detail_vars[[n]])
101		}
102	9x	if (!is.null(trt_status_var)) {
103	1x	lyt <- lyt %>%
104	1x	summarize_vars(
105	1x	trt_status_var,
106	1x	.stats = "count_fraction",
107	1x	denom = "N_col",
108	1x	.formats = list(count_fraction = format_count_fraction_fixed_dp),
109	1x	show_labels = "hidden",
110	1x	nested = FALSE
111		)
112		}
113
114	9x	lyt
115		}
116
117		#' @describeIn dst01 Preprocessing
118		#'
119		#' @inheritParams dst01_main
120		#'
121		#' @export
122		#'
123		dst01_pre <- function(adam_db,
124		...) {
125	1x	study_status_format <- rule(
126	1x	"Completed" = "COMPLETED",
127	1x	"Ongoing" = "ONGOING",
128	1x	"Discontinued" = "DISCONTINUED"
129		)
130	1x	trt_status_format <- rule(
131	1x	"Completed Treatment" = "COMPLETED",
132	1x	"Ongoing Treatment" = "ONGOING",
133	1x	"Discontinued Treatment" = "DISCONTINUED"
134		)
135	1x	dcsreas_grp_format <- rule(
136	1x	"Safety" = c("ADVERSE EVENT", "DEATH"),
137	1x	"Non-Safety" = c(
138	1x	"WITHDRAWAL BY SUBJECT", "LACK OF EFFICACY", "PROTOCOL VIOLATION",
139	1x	"WITHDRAWAL BY PARENT/GUARDIAN", "PHYSICIAN DECISION"
140		)
141		)
142	1x	adam_db$adsl <- adam_db$adsl %>%
143	1x	mutate(
144	1x	EOSSTT = reformat(.data$EOSSTT, study_status_format),
145	1x	EOTSTT = reformat(.data$EOTSTT, trt_status_format),
146	1x	DCSREASGP = reformat(.data$DCSREAS, dcsreas_grp_format),
147	1x	DCSREAS = reformat(.data$DCSREAS, empty_rule),
148	1x	STDONS = factor(
149	1x	case_when(
150	1x	EOTSTT == "Ongoing Treatment" & EOSSTT == "Ongoing" ~ "Alive: Ongoing",
151	1x	EOTSTT != "Ongoing Treatment" & EOSSTT == "Ongoing" ~ "Alive: In Follow-up",
152	1x	TRUE ~ NA_character_
153		),
154	1x	levels = c("Alive: Ongoing", "Alive: In Follow-up")
155		)
156		)
157	1x	adam_db
158		}
159
160		#' @describeIn dst01 Postprocessing
161		#'
162		#' @inheritParams gen_args
163		#'
164		#' @export
165		#'
166		dst01_post <- function(tlg, prune_0 = TRUE, ...) {
167	1x	if (prune_0) {
168	1x	tlg <- tlg %>%
169	1x	smart_prune()
170		}
171	1x	std_postprocess(tlg)
172		}
173
174		#' DST01 Table 1 (Default) Patient Disposition Table 1.
175		#'
176		#' The DST01 Disposition Table provides an overview of patients
177		#' study completion. For patients who discontinued the study a reason is provided.
178		#'
179		#' @include chevron_tlg-S4class.R
180		#' @export
181		#'
182		#' @examples
183		#' run(dst01, syn_data, detail_vars = list(Ongoing = "STDONS"))
184		#'
185		#' run(dst01, syn_data, detail_vars = list(Discontinued = "DCSREAS", Ongoing = "STDONS"))
186		#'
187		#' run(
188		#' dst01, syn_data,
189		#' detail_vars = list(
190		#' Discontinued = c("DCSREASGP", "DCSREAS"),
191		#' Ongoing = "STDONS"
192		#' )
193		#' )
194		dst01 <- chevron_t(
195		main = dst01_main,
196		preprocess = dst01_pre,
197		postprocess = dst01_post
198		)

1		# rmpt01 ----
2
3		#' @describeIn rmpt01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param summaryvars (`string`) variables to be analyzed. The label attribute of the corresponding columns in `adex`
7		#' table of `adam_db` is used as label.
8		#' @param show_tot (`flag`) whether to display the cumulative total.
9		#' @param row_split_var (`string`) the name of the column that containing variable to split exposure by.
10		#' @param col_split_var (`string`) additional column splitting variable.
11		#' @param overall_col_lbl (`string`) name of the overall column. If `NULL`, no overall level is added.
12		#'
13		#' @details
14		#' * Person time is the sum of exposure across all patients.
15		#' * Summary statistics are by default based on the number of patients in the corresponding `N` row
16		#' (number of non-missing values).
17		#' * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.
18		#'
19		#' @note
20		#' * `adam_db` object must contain an `adex` table with `"AVAL"` and the columns specified by `summaryvars`.
21		#'
22		#' @export
23		#'
24		rmpt01_main <- function(adam_db,
25		summaryvars = "AVALCAT1",
26		show_tot = TRUE,
27		row_split_var = NULL,
28		col_split_var = NULL,
29		overall_col_lbl = NULL,
30		...) {
31	4x	assert_all_tablenames(adam_db, c("adsl", "adex"))
32	4x	assert_string(summaryvars)
33	4x	assert_flag(show_tot)
34	4x	assert_string(row_split_var, null.ok = TRUE)
35	4x	assert_string(col_split_var, null.ok = TRUE)
36	4x	assert_string(overall_col_lbl, null.ok = TRUE)
37	4x	assert_valid_variable(adam_db$adex, summaryvars, types = list(c("factor", "character")), empty_ok = FALSE)
38	4x	assert_valid_variable(adam_db$adex, "AVAL", types = list("numeric"))
39	4x	assert_valid_variable(adam_db$adex, row_split_var, types = list(c("factor", "numeric")), empty_ok = TRUE)
40	4x	assert_valid_variable(adam_db$adex, col_split_var, types = list(c("factor", "character")))
41	4x	assert_valid_variable(adam_db$adex, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
42	4x	assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))
43
44	4x	lbl_summaryvars <- var_labels_for(adam_db$adex, summaryvars)
45
46	4x	lyt <- rmpt01_lyt(
47	4x	summaryvars = summaryvars,
48	4x	lbl_summaryvars = lbl_summaryvars,
49	4x	show_tot = show_tot,
50	4x	row_split_var = row_split_var,
51	4x	col_split_var = col_split_var,
52	4x	overall_col_lbl = overall_col_lbl
53		)
54
55	4x	build_table(lyt, adam_db$adex, alt_counts_df = adam_db$adsl)
56		}
57
58		#' `rmpt01` Layout
59		#'
60		#' @inheritParams gen_args
61		#' @inheritParams rmpt01_main
62		#' @param lbl_summaryvars (`character`) label associated with the analyzed variables.
63		#'
64		#' @keywords internal
65		#'
66		rmpt01_lyt <- function(summaryvars,
67		lbl_summaryvars,
68		show_tot,
69		row_split_var,
70		col_split_var,
71		overall_col_lbl) {
72	12x	lyt <- basic_table(show_colcounts = TRUE) %>%
73	12x	ifneeded_split_col(
74	12x	col_split_var,
75	12x	split_fun = if (!is.null(overall_col_lbl)) add_overall_level("ALL", overall_col_lbl)
76		) %>%
77	12x	split_cols_by_multivar(
78	12x	vars = c("AVAL", "AVAL"),
79	12x	varlabels = c(n_patients = render_safe("{Patient_label}"), sum_exposure = "Person time"),
80	12x	extra_args = list(.stats = c("n_patients", "sum_exposure"))
81		) %>%
82	12x	analyze_patients_exposure_in_cols(
83	12x	var = summaryvars,
84	12x	col_split = FALSE,
85	12x	add_total_level = show_tot,
86	12x	custom_label = render_safe("Total {patient_label} number/person time")
87		)
88
89	12x	if (!is.null(row_split_var)) {
90	!	lyt %>%
91	!	split_rows_by(row_split_var) %>%
92	!	analyze_patients_exposure_in_cols(
93	!	.indent_mods = -1L,
94	!	var = summaryvars,
95	!	col_split = FALSE,
96	!	add_total_level = show_tot,
97	!	custom_label = render_safe("Total {patient_label} number/person time")
98		) %>%
99	!	append_topleft(c("", lbl_summaryvars))
100		} else {
101	12x	lyt %>%
102	12x	append_topleft(c("", lbl_summaryvars))
103		}
104		}
105
106		#' @describeIn rmpt01 Preprocessing
107		#'
108		#' @inheritParams gen_args
109		#' @inheritParams rmpt01_main
110		#'
111		#' @export
112		#'
113		rmpt01_pre <- function(adam_db,
114		summaryvars = "AVALCAT1",
115		...) {
116	4x	adam_db$adex <- adam_db$adex %>%
117	4x	filter(.data$PARAMCD == "TDURD")
118
119	4x	adam_db$adex$AVALCAT1 <- droplevels(adam_db$adex$AVALCAT1)
120
121	4x	adam_db$adex <- adam_db$adex %>%
122	4x	mutate(
123	4x	AVALCAT1 = with_label(.data$AVALCAT1, "Duration of exposure")
124		)
125
126	4x	adam_db$adex[[summaryvars]] <- reformat(adam_db$adex[[summaryvars]], missing_rule)
127	4x	if (!"<Missing>" %in% adam_db$adex[[summaryvars]] && summaryvars %in% colnames(adam_db$adex)) {
128	4x	adam_db$adex[[summaryvars]] <- forcats::fct_drop(adam_db$adex[[summaryvars]], only = "<Missing>")
129		}
130
131	4x	adam_db
132		}
133
134		#' @describeIn rmpt01 Postprocessing
135		#'
136		#' @inheritParams gen_args
137		#'
138		#' @export
139		#'
140		rmpt01_post <- function(tlg, prune_0 = FALSE, ...) {
141	4x	if (prune_0) {
142	!	tlg <- smart_prune(tlg)
143		}
144	4x	std_postprocess(tlg)
145		}
146
147		#' `RMPT01`Duration of Exposure for Risk Management Plan Table.
148		#'
149		#' The `RMPT01` table provides an overview of duration of exposure.
150		#'
151		#' @include chevron_tlg-S4class.R
152		#' @export
153		#'
154		#' @examples
155		#' run(rmpt01, syn_data, col_split_var = "SEX")
156		rmpt01 <- chevron_t(
157		main = rmpt01_main,
158		preprocess = rmpt01_pre,
159		postprocess = rmpt01_post
160		)

1		# dmt01 ----
2
3		#' @describeIn dmt01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param summaryvars (`character`) variables summarized in demographic table. The label attribute of the corresponding
7		#' column in `adsl` table of `adam_db` is used as label.
8		#'
9		#' @details
10		#' * Information from `ADSUB` are generally included into `ADSL` before analysis.
11		#' * Default demographic and characteristics table
12		#' * If not specified otherwise, numbers represent absolute numbers of patients and fraction of `N`
13		#' * Remove zero-count rows
14		#' * Split columns by arm (planned or actual / code or description)
15		#' * Include a total column by default
16		#'
17		#' @note
18		#' * `adam_db` object must contain an `adsl` table with the columns specified in `summaryvars`.
19		#'
20		#' @export
21		#'
22		dmt01_main <- function(adam_db,
23		arm_var = "ARM",
24		lbl_overall = "All {Patient_label}",
25		summaryvars = c(
26		"AAGE",
27		"AGEGR1",
28		"SEX",
29		"ETHNIC",
30		"RACE"
31		),
32		...) {
33	1x	assert_string(arm_var)
34	1x	assert_string(lbl_overall, null.ok = TRUE)
35	1x	assert_character(summaryvars, null.ok = TRUE)
36	1x	assert_valid_variable(adam_db$adsl, summaryvars, na_ok = TRUE)
37	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
38
39	1x	lbl_overall <- render_safe(lbl_overall)
40	1x	summaryvars_lbls <- var_labels_for(adam_db$adsl, summaryvars)
41
42	1x	lyt <- dmt01_lyt(
43	1x	arm_var = arm_var,
44	1x	lbl_overall = lbl_overall,
45	1x	summaryvars = summaryvars,
46	1x	summaryvars_lbls = summaryvars_lbls
47		)
48
49	1x	tbl <- build_table(lyt, adam_db$adsl)
50
51	1x	tbl
52		}
53
54		#' `dmt01` Layout
55		#' @param summaryvars_lbls (`character`) labels corresponding to the analyzed variables.
56		#'
57		#' @inheritParams gen_args
58		#'
59		#' @keywords internal
60		#'
61		dmt01_lyt <- function(arm_var,
62		lbl_overall,
63		summaryvars,
64		summaryvars_lbls) {
65	4x	basic_table(show_colcounts = TRUE) %>%
66	4x	split_cols_by(var = arm_var) %>%
67	4x	ifneeded_add_overall_col(lbl_overall) %>%
68	4x	summarize_vars(
69	4x	vars = summaryvars,
70	4x	var_labels = summaryvars_lbls,
71	4x	.formats = list(count_fraction = format_count_fraction_fixed_dp)
72		)
73		}
74
75		#' @describeIn dmt01 Preprocessing
76		#'
77		#' @inheritParams gen_args
78		#'
79		#' @export
80		#'
81		dmt01_pre <- function(adam_db, ...) {
82	1x	adam_db$adsl <- adam_db$adsl %>%
83	1x	mutate(SEX = reformat(.data$SEX, rule(Male = "M", Female = "F")))
84	1x	adam_db
85		}
86
87		#' @describeIn dmt01 Postprocessing
88		#'
89		#' @inheritParams gen_args
90		#'
91		#' @export
92		#'
93		dmt01_post <- function(tlg, prune_0 = TRUE, ...) {
94	1x	if (prune_0) {
95	1x	tlg <- smart_prune(tlg)
96		}
97	1x	std_postprocess(tlg)
98		}
99
100		#' `DMT01` Table 1 (Default) Demographics and Baseline Characteristics Table 1.
101		#'
102		#' For each variable, summary statistics are
103		#' by default based on the number of patients in the corresponding `n` row.
104		#'
105		#' @include chevron_tlg-S4class.R
106		#' @export
107		#'
108		#' @examples
109		#' run(dmt01, syn_data)
110		dmt01 <- chevron_t(
111		main = dmt01_main,
112		preprocess = dmt01_pre,
113		postprocess = dmt01_post
114		)

1		# aet10 ----
2
3		#' @describeIn aet10 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#'
7		#' @details
8		#' * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.
9		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
10		#' * Split columns by arm.
11		#' * Does not include a total column by default.
12		#' * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.
13		#' * Missing values in `AEDECOD` are labeled by `No Coding Available`.
14		#'
15		#' @note
16		#' * `adam_db` object must contain an `adae` table with the columns `"AEDECOD"`.
17		#'
18		#' @export
19		#'
20		aet10_main <- function(adam_db,
21		arm_var = "ACTARM",
22		lbl_overall = NULL,
23		...) {
24	1x	assert_all_tablenames(adam_db, "adsl", "adae")
25	1x	assert_string(arm_var)
26	1x	assert_string(lbl_overall, null.ok = TRUE)
27	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
28	1x	assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))
29	1x	assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
30	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
31
32	1x	lbl_overall <- render_safe(lbl_overall)
33	1x	lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")
34
35	1x	lyt <- aet10_lyt(
36	1x	arm_var = arm_var,
37	1x	lbl_overall = lbl_overall,
38	1x	lbl_aedecod = lbl_aedecod
39		)
40
41	1x	tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)
42
43	1x	tbl
44		}
45
46		#' `aet10` Layout
47		#'
48		#' @inheritParams gen_args
49		#' @param lbl_aedecod (`character`) text label for `AEDECOD`.
50		#'
51		#' @keywords internal
52		#'
53		aet10_lyt <- function(arm_var,
54		lbl_overall,
55		lbl_aedecod) {
56	3x	basic_table(show_colcounts = TRUE) %>%
57	3x	split_cols_by(var = arm_var) %>%
58	3x	ifneeded_add_overall_col(lbl_overall) %>%
59	3x	count_occurrences(
60	3x	vars = "AEDECOD",
61	3x	.indent_mods = -1L
62		) %>%
63	3x	append_topleft(paste0("\n", lbl_aedecod))
64		}
65
66		#' @describeIn aet10 Preprocessing
67		#'
68		#' @inheritParams gen_args
69		#'
70		#' @export
71		#'
72		aet10_pre <- function(adam_db, ...) {
73	1x	adam_db$adae <- adam_db$adae %>%
74	1x	filter(.data$ANL01FL == "Y") %>%
75	1x	mutate(AEDECOD = reformat(.data$AEDECOD, nocoding))
76	1x	return(adam_db)
77		}
78
79		#' @describeIn aet10 Postprocessing
80		#'
81		#' @inheritParams gen_args
82		#' @param atleast given cut-off in numeric format, default is `0.05`
83		#'
84		#' @export
85		#'
86		aet10_post <- function(tlg, atleast = 0.05, ...) {
87	1x	assert_number(atleast, lower = 0, upper = 1)
88	1x	tbl_sorted <- tlg %>%
89	1x	sort_at_path(
90	1x	path = c("AEDECOD"),
91	1x	scorefun = score_occurrences
92		)
93
94	1x	tlg_prune <- prune_table(
95	1x	tt = tbl_sorted,
96	1x	prune_func = keep_rows(
97	1x	has_fraction_in_any_col(
98	1x	atleast = atleast
99		)
100		)
101		)
102
103	1x	std_postprocess(tlg_prune)
104		}
105
106		#' `AET10` Table 1 (Default) Most Common (xx%) Adverse Events Preferred Terms Table 1
107		#'
108		#' The `AET10` table Include Adverse Events occurring with user-specified threshold X% in at least
109		#' one of the treatment groups. Standard table summarized by preferred term (PT).
110		#' Order the data by total column frequency from most to least frequently reported PT (regardless of SOC).
111		#'
112		#' @include chevron_tlg-S4class.R
113		#' @export
114		#'
115		#' @examples
116		#' run(aet10, syn_data)
117		aet10 <- chevron_t(
118		main = aet10_main,
119		preprocess = aet10_pre,
120		postprocess = aet10_post
121		)

1		# kmg01 ----
2
3		#' @describeIn kmg01 Main TLG Function
4		#'
5		#' @details
6		#' * No overall value.
7		#'
8		#' @inheritParams gen_args
9		#' @param dataset (`string`) the name of a table in the `adam_db` object.
10		#' @param strat (`character`) the variable name of stratification variables.
11		#' @param ... Further arguments passed to `g_km` and `control_coxph`. For details, see
12		#' the documentation in `tern`.
13		#' Commonly used arguments include `col`, `pval_method`, `ties`, `conf_level`, `conf_type`,
14		#' `annot_coxph`, `annot_stats`, etc.
15		#'
16		#' @note
17		#' * `adam_db` object must contain the table specified by `dataset` with the columns specified by `arm_var`.
18		#'
19		#' @return a `gTree` object.
20		#' @export
21		kmg01_main <- function(adam_db,
22		dataset = "adtte",
23		arm_var = "ARM",
24		strat = NULL,
25		...) {
26	1x	assert_all_tablenames(adam_db, c("adsl", dataset))
27	1x	df_lbl <- paste0("adam_db$", dataset)
28	1x	assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_lbl)
29	1x	assert_valid_variable(adam_db[[dataset]], "IS_EVENT", types = list("logical"), label = df_lbl)
30	1x	assert_valid_variable(adam_db[[dataset]], strat, types = list(c("character", "factor")), label = df_lbl)
31	1x	assert_valid_variable(
32	1x	adam_db[[dataset]],
33	1x	c("PARAMCD", arm_var),
34	1x	types = list(c("character", "factor")),
35	1x	na_ok = FALSE,
36	1x	label = df_lbl
37		)
38	1x	assert_single_value(adam_db[[dataset]]$PARAMCD, label = paste0(df_lbl, "$PARAMCD"))
39	1x	assert_valid_variable(adam_db[[dataset]], "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))
40	1x	variables <- list(tte = "AVAL", is_event = "IS_EVENT", arm = arm_var, strat = strat)
41	1x	control_cox <- execute_with_args(control_coxph, ...)
42	1x	control_surv <- execute_with_args(control_surv_timepoint, ...)
43	1x	execute_with_args(
44	1x	g_km,
45	1x	df = adam_db[[dataset]],
46	1x	variables = variables,
47	1x	control_surv = control_surv,
48	1x	control_coxph_pw = control_cox,
49		...,
50	1x	draw = FALSE
51		)
52		}
53
54		#' @describeIn kmg01 Preprocessing
55		#'
56		#' @inheritParams kmg01_main
57		#'
58		#' @export
59		kmg01_pre <- function(adam_db, dataset = "adtte", ...) {
60	1x	adam_db[[dataset]] <- adam_db[[dataset]] %>%
61	1x	mutate(IS_EVENT = .data$CNSR == 0)
62
63	1x	adam_db
64		}
65
66		# `kmg01` Pipeline ----
67
68		#' `KMG01` Kaplan-Meier Plot 1.
69		#'
70		#' @include chevron_tlg-S4class.R
71		#' @export
72		#'
73		#' @examples
74		#' library(dplyr)
75		#' library(dunlin)
76		#'
77		#' col <- c(
78		#' "A: Drug X" = "black",
79		#' "B: Placebo" = "blue",
80		#' "C: Combination" = "gray"
81		#' )
82		#'
83		#' syn_data2 <- log_filter(syn_data, PARAMCD == "OS", "adtte")
84		#' run(kmg01, syn_data2, dataset = "adtte", line_col = col)
85		#'
86		#' syn_data3 <- log_filter(syn_data, PARAMCD == "AEREPTTE", "adaette")
87		#' run(kmg01, syn_data3, dataset = "adaette")
88		kmg01 <- chevron_g(
89		main = kmg01_main,
90		preproces = kmg01_pre
91		)

1		# aet01_aesi ----
2
3		#' @describeIn aet01_aesi Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param aesi_vars (`character`) the `AESI` variables to be included in the summary. Defaults to `NA`.
7		#' @param grade_groups (`list`) the grade groups to be displayed.
8		#' @details
9		#' * Does not remove rows with zero counts by default.
10		#'
11		#' @note
12		#' * `adam_db` object must contain an `adae` table with columns `"AEOUT"`, `"AEACN"`, `"AECONTRT"`, `"AESER"`,
13		#' `"AREL"`, and the column specified by `arm_var`.
14		#' * `aesi_vars` may contain any/all of the following variables to display: `"ALLRESWD"`, `"ALLRESDSM"`,
15		#' `"ALLRESCONTRT"`, `"NOTRESWD"`, `"NOTRESDSM"`, `"NOTRESCONTRT"`, `"SERWD"`, `"SERDSM"`, `"SERCONTRT"`,
16		#' `"RELWD"`, `"RELDSM"`, `"RELCONTRT"`, `"RELSER"`.
17		#' * `aesi_vars` variable prefixes are defined as follows:
18		#' * `"ALLRES"` = "all non-fatal adverse events resolved"
19		#' * `"NOTRES"` = "at least one unresolved or ongoing non-fatal adverse event"
20		#' * `"SER"` = "serious adverse event"
21		#' * `"REL"` = "related adverse event"
22		#' * `aesi_vars` variable suffixes are defined as follows:
23		#' * `"WD"` = "patients with study drug withdrawn"
24		#' * `"DSM"` = "patients with dose modified/interrupted"
25		#' * `"CONTRT"` = "patients with treatment received"
26		#' * Several `aesi_vars` can be added to the table at once:
27		#' * `aesi_vars = "ALL"` will include all possible `aesi_vars`.
28		#' * Including `"ALL_XXX"` in `aesi_vars` where `XXX` is one of the prefixes listed above will include all
29		#' `aesi_vars` with that prefix.
30		#'
31		#' @export
32		#'
33		aet01_aesi_main <- function(adam_db,
34		arm_var = "ACTARM",
35		lbl_overall = NULL,
36		aesi_vars = NULL,
37		grade_groups = NULL,
38		...) {
39	1x	assert_all_tablenames(adam_db, "adsl", "adae")
40	1x	assert_string(arm_var)
41	1x	assert_string(lbl_overall, null.ok = TRUE)
42	1x	assert_character(aesi_vars, null.ok = TRUE)
43	1x	assert_list(grade_groups, null.ok = TRUE)
44	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var))
45	1x	assert_valid_variable(adam_db$adae, c(arm_var))
46	1x	assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE)
47	1x	assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)
48
49	1x	if (is.null(grade_groups)) {
50	1x	grade_groups <- list(
51	1x	"Grade 1" = "1",
52	1x	"Grade 2" = "2",
53	1x	"Grade 3" = "3",
54	1x	"Grade 4" = "4",
55	1x	"Grade 5 (fatal outcome)" = "5"
56		)
57		}
58	1x	all_aesi_vars <- get_aesi_vars(aesi_vars)
59	1x	assert_valid_variable(adam_db$adae, c(all_aesi_vars), empty_ok = TRUE, na_ok = TRUE, types = list("logical"))
60
61	1x	lbl_overall <- render_safe(lbl_overall)
62	1x	lbl_aesi_vars <- var_labels_for(adam_db$adae, all_aesi_vars)
63
64	1x	lyt <- aet01_aesi_lyt(
65	1x	arm_var = arm_var,
66	1x	aesi_vars = all_aesi_vars,
67	1x	lbl_overall = lbl_overall,
68	1x	lbl_aesi_vars = lbl_aesi_vars,
69	1x	grade_groups = grade_groups
70		)
71
72	1x	tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)
73
74	1x	tbl
75		}
76
77		#' `aet01_aesi` Layout
78		#'
79		#' @inheritParams gen_args
80		#' @param lbl_aesi_vars (`character`) the labels of the `AESI` variables to be summarized.
81		#'
82		#' @keywords internal
83		#'
84		aet01_aesi_lyt <- function(arm_var,
85		aesi_vars,
86		lbl_overall,
87		lbl_aesi_vars,
88		grade_groups) {
89	5x	names(lbl_aesi_vars) <- aesi_vars
90	5x	basic_table(show_colcounts = TRUE) %>%
91	5x	split_cols_by(var = arm_var) %>%
92	5x	ifneeded_add_overall_col(lbl_overall) %>%
93	5x	count_patients_with_event(
94	5x	vars = "USUBJID",
95	5x	filters = c("ANL01FL" = "Y"),
96	5x	denom = "N_col",
97	5x	.labels = c(count_fraction = render_safe("Total number of {patient_label} with at least one AE"))
98		) %>%
99	5x	count_values(
100	5x	"ANL01FL",
101	5x	values = "Y",
102	5x	.stats = "count",
103	5x	.labels = c(count = "Total number of AEs"),
104	5x	table_names = "total_aes"
105		) %>%
106	5x	count_occurrences_by_grade(
107	5x	var = "ATOXGR",
108	5x	var_labels = render_safe("Total number of {patient_label} with at least one AE by worst grade"),
109	5x	show_labels = "visible",
110	5x	grade_groups = grade_groups
111		) %>%
112	5x	count_patients_with_flags(
113	5x	"USUBJID",
114	5x	flag_variables = lbl_aesi_vars,
115	5x	denom = "N_col"
116		)
117		}
118
119		#' @describeIn aet01_aesi Preprocessing
120		#'
121		#' @inheritParams aet01_aesi_main
122		#'
123		#' @export
124		#'
125		aet01_aesi_pre <- function(adam_db,
126		...) {
127	1x	assert_all_tablenames(adam_db, c("adsl", "adae"))
128
129	1x	adam_db$adae <- adam_db$adae %>%
130	1x	filter(.data$ANL01FL == "Y") %>%
131	1x	mutate(
132	1x	NOT_RESOLVED = with_label(
133	1x	.data$AEOUT %in% c("NOT RECOVERED/NOT RESOLVED", "RECOVERING/RESOLVING", "UNKNOWN"),
134	1x	"Total number of {patient_label} with at least one unresolved or ongoing non-fatal AE"
135		),
136	1x	ALL_RESOLVED = with_label(
137	1x	!.data$AEOUT %in% "FATAL" & !.data$NOT_RESOLVED,
138	1x	"Total number of {patient_label} with all non-fatal AEs resolved"
139		),
140	1x	WD = with_label(
141	1x	.data$AEACN %in% "DRUG WITHDRAWN", "Total number of {patient_label} with study drug withdrawn due to AE"
142		),
143	1x	DSM = with_label(
144	1x	.data$AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED"),
145	1x	"Total number of {patient_label} with dose modified/interrupted due to AE"
146		),
147	1x	CONTRT = with_label(
148	1x	.data$AECONTRT %in% "Y", "Total number of {patient_label} with treatment received for AE"
149		),
150	1x	SER = with_label(
151	1x	.data$AESER %in% "Y", "Total number of {patient_label} with at least one serious AE"
152		),
153	1x	REL = with_label(
154	1x	.data$AREL %in% "Y", "Total number of {patient_label} with at least one related AE"
155		),
156	1x	ALLRESWD = with_label(
157	1x	.data$WD & .data$ALL_RESOLVED, " No. of {patient_label} with study drug withdrawn due to resolved AE"
158		),
159	1x	ALLRESDSM = with_label(
160	1x	.data$DSM & .data$ALL_RESOLVED, " No. of {patient_label} with dose modified/interrupted due to resolved AE"
161		),
162	1x	ALLRESCONTRT = with_label(
163	1x	.data$CONTRT & .data$ALL_RESOLVED, " No. of {patient_label} with treatment received for resolved AE"
164		),
165	1x	NOTRESWD = with_label(
166	1x	.data$WD & .data$NOT_RESOLVED,
167	1x	" No. of {patient_label} with study drug withdrawn due to unresolved or ongoing AE"
168		),
169	1x	NOTRESDSM = with_label(
170	1x	.data$DSM & .data$NOT_RESOLVED,
171	1x	" No. of {patient_label} with dose modified/interrupted due to unresolved or ongoing AE"
172		),
173	1x	NOTRESCONTRT = with_label(
174	1x	.data$CONTRT & .data$NOT_RESOLVED,
175	1x	" No. of {patient_label} with treatment received for unresolved/ongoing AE"
176		),
177	1x	SERWD = with_label(
178	1x	.data$SER & .data$WD, " No. of {patient_label} with study drug withdrawn due to serious AE"
179		),
180	1x	SERDSM = with_label(
181	1x	.data$SER & .data$DSM, " No. of {patient_label} with dose modified/interrupted due to serious AE"
182		),
183	1x	SERCONTRT = with_label(
184	1x	.data$SER & .data$CONTRT, " No. of {patient_label} with treatment received for serious AE"
185		),
186	1x	RELWD = with_label(
187	1x	.data$REL & .data$WD, " No. of {patient_label} with study drug withdrawn due to related AE"
188		),
189	1x	RELDSM = with_label(
190	1x	.data$REL & .data$DSM, " No. of {patient_label} with dose modified/interrupted due to related AE"
191		),
192	1x	RELCONTRT = with_label(
193	1x	.data$REL & .data$CONTRT, " No. of {patient_label} with treatment received for related AE"
194		),
195	1x	RELSER = with_label(
196	1x	.data$REL & .data$SER, " No. of {patient_label} with serious, related AE"
197		)
198		) %>%
199	1x	mutate(
200	1x	ATOXGR = factor(.data$ATOXGR, levels = 1:5)
201		)
202
203	1x	adam_db
204		}
205
206		#' @describeIn aet01_aesi Postprocessing
207		#'
208		#' @inheritParams gen_args
209		#'
210		#' @export
211		#'
212		aet01_aesi_post <- function(tlg, prune_0 = FALSE, ...) {
213	1x	if (prune_0) {
214	!	tlg <- smart_prune(tlg)
215		}
216	1x	std_postprocess(tlg)
217		}
218
219		#' `AET01_AESI` Table 1 (Default) Adverse Event of Special Interest Summary Table.
220		#'
221		#' @include chevron_tlg-S4class.R
222		#' @export
223		#'
224		#' @examples
225		#' run(aet01_aesi, syn_data)
226		aet01_aesi <- chevron_t(
227		main = aet01_aesi_main,
228		preprocess = aet01_aesi_pre,
229		postprocess = aet01_aesi_post
230		)
231
232		#' @keywords internal
233		get_aesi_vars <- function(aesi_vars) {
234	1x	if ("ALL" %in% aesi_vars) aesi_vars <- c("ALL_ALLRES", "ALL_NOTRES", "ALL_SER", "ALL_REL")
235	5x	if (any(grepl("^ALL_", aesi_vars))) {
236	1x	aesi <- c(grep("^ALL_", aesi_vars, value = TRUE, invert = TRUE), sapply(
237	1x	c("WD", "DSM", "CONTRT"),
238	1x	function(x) sub("^(ALL_)(.*)", paste0("\\2", x), grep("^ALL_", aesi_vars, value = TRUE))
239		))
240	1x	if ("ALL_REL" %in% aesi_vars) aesi <- c(aesi, "RELSER")
241		} else {
242	4x	aesi <- aesi_vars
243		}
244	5x	all_aesi_vars <- c(
245	5x	"WD", "DSM", "CONTRT", "ALL_RESOLVED", grep("^ALLRES", aesi, value = TRUE),
246	5x	"NOT_RESOLVED", grep("^NOTRES", aesi, value = TRUE), "SER", grep("^SER", aesi, value = TRUE),
247	5x	"REL", grep("^REL", aesi, value = TRUE)
248		)
249	5x	return(all_aesi_vars)
250		}

1		# coxt01 ----
2
3		#' @describeIn coxt01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param arm_var (`string`) the arm variable used for arm splitting.
7		#' @param time_var (`string`) the time variable in a Cox proportional hazards regression model.
8		#' @param event_var (`string`) the event variable in a Cox proportional hazards regression model.
9		#' @param covariates (`character`) will be fitted and the corresponding effect will be estimated.
10		#' @param strata (`character`) will be fitted for the stratified analysis.
11		#' @param lbl_vars (`string`) text label for the a Cox regression model variables.
12		#' @param multivar (`flag`) indicator of whether multivariate cox regression is conducted.
13		#' @param ... Further arguments passed to `tern::control_coxreg()`.
14		#'
15		#' @details
16		#' * The reference arm will always the first level of `arm_var`. Please change the level if you want to
17		#' change the reference arms.
18		#' * The table allows confidence level to be adjusted, default is two-sided 95%.
19		#' * The stratified analysis is with DISCRETE tie handling (equivalent to `tern::control_coxreg(ties = "exact")` in R).
20		#' * Model includes treatment plus specified covariate(s) as factor(s) or numeric(s),
21		#' with `"SEX"`, `"RACE"` and `"AAGE"` as default candidates.
22		#' * The selection of the covariates and whether or not there is a selection process
23		#' (vs. a fixed, pre-specified list) needs to be pre-specified.
24		#' * For pairwise comparisons using the hazard ratio, the value for the control group is the denominator.
25		#' * Keep zero-count rows unless overridden with `prune_0 = TRUE`.
26		#'
27		#' @note
28		#' * `adam_db` object must contain an `adtte` table with `"PARAMCD"`, `"ARM"`,
29		#' `"AVAL"`, `"CNSR`, and the columns specified by `"covariates"` which is denoted as
30		#' `c("SEX", "RACE", "AAGE")` by default.
31		#'
32		#' @export
33		#'
34		coxt01_main <- function(adam_db,
35		arm_var = "ARM",
36		time_var = "AVAL",
37		event_var = "EVENT",
38		covariates = c("SEX", "RACE", "AAGE"),
39		strata = NULL,
40		lbl_vars = "Effect/Covariate Included in the Model",
41		multivar = FALSE,
42		...) {
43	2x	assert_all_tablenames(adam_db, "adtte")
44	2x	assert_string(arm_var)
45	2x	assert_string(time_var)
46	2x	assert_string(event_var)
47	2x	assert_character(covariates, null.ok = TRUE)
48	2x	assert_character(strata, null.ok = TRUE)
49	2x	assert_flag(multivar)
50	2x	assert_valid_variable(adam_db$adtte, arm_var, types = list("factor"), n.levels = if (!multivar) 2L)
51	2x	assert_valid_variable(adam_db$adtte, c("USUBJID", arm_var, "PARAMCD"), types = list(c("character", "factor")))
52	2x	assert_valid_variable(adam_db$adtte, strata, types = list(c("factor", "integer", "character")), na_ok = TRUE)
53	2x	assert_valid_variable(adam_db$adtte, covariates, na_ok = TRUE)
54	2x	assert_valid_variable(adam_db$adtte, event_var, types = list("numeric"), integerish = TRUE, lower = 0L, upper = 1L)
55	2x	assert_valid_variable(adam_db$adtte, time_var, types = list("numeric"), lower = 0)
56	2x	assert_single_value(adam_db$adtte$PARAMCD)
57	2x	control <- execute_with_args(control_coxreg, ...)
58
59	2x	variables <- list(
60	2x	time = time_var,
61	2x	event = event_var,
62	2x	arm = arm_var,
63	2x	covariates = covariates,
64	2x	strata = strata
65		)
66
67	2x	lyt <- coxt01_lyt(
68	2x	variables = variables,
69	2x	col_split = if (!multivar) "COL_LABEL",
70	2x	lbl_vars = lbl_vars,
71	2x	multivar = multivar,
72	2x	control = control,
73		...
74		)
75
76	2x	col_split <- "Treatment Effect Adjusted for Covariate"
77	2x	adam_db$adtte$COL_LABEL <- factor(rep(col_split, nrow(adam_db$adtte)), levels = col_split)
78
79	2x	tbl <- build_table(lyt, adam_db$adtte)
80
81	2x	tbl
82		}
83
84		#' `COXT01` Layout
85		#'
86		#' @inheritParams coxt01_main
87		#' @param variables (`list`) list of variables in a Cox proportional hazards regression model.
88		#'
89		#' @keywords internal
90		#'
91		coxt01_lyt <- function(variables,
92		col_split,
93		lbl_vars,
94		control,
95		multivar,
96		...) {
97	4x	lyt <- basic_table() %>%
98	4x	ifneeded_split_col(col_split)
99	4x	lyt <- execute_with_args(
100	4x	summarize_coxreg,
101	4x	lyt = lyt, variables = variables, control = control, multivar = multivar, ...
102		)
103	4x	lyt %>%
104	4x	append_topleft(lbl_vars)
105		}
106
107		#' @describeIn coxt01 Preprocessing
108		#'
109		#' @inheritParams gen_args
110		#'
111		#' @export
112		#'
113		coxt01_pre <- function(adam_db, ...) {
114	2x	adam_db$adtte <- adam_db$adtte %>%
115	2x	mutate(EVENT = 1 - .data$CNSR)
116
117	2x	adam_db
118		}
119
120		#' @describeIn coxt01 Postprocessing
121		#'
122		#' @inheritParams gen_args
123		#'
124		#' @export
125		#'
126		coxt01_post <- function(tlg, prune_0 = FALSE, ...) {
127	2x	if (prune_0) {
128	!	tlg <- smart_prune(tlg)
129		}
130	2x	std_postprocess(tlg)
131		}
132
133		#' `COXT01` (Default) Cox Regression Model Table.
134		#'
135		#' Cox models are the most commonly used methods to estimate the magnitude of the effect in survival analyses.
136		#' It assumes proportional hazards; that is, it assumes that the ratio of the hazards
137		#' of the two groups (e.g. two arms) is constant over time.
138		#' This ratio is referred to as the "hazard ratio" and is one of the most commonly reported metrics
139		#' to describe the effect size in survival analysis.
140		#'
141		#' @include chevron_tlg-S4class.R
142		#' @export
143		#'
144		#' @examples
145		#' library(dunlin)
146		#'
147		#' proc_data <- log_filter(syn_data, PARAMCD == "CRSD", "adtte")
148		#' proc_data <- log_filter(proc_data, ARMCD != "ARM C", "adsl")
149		#' proc_data$adtte$ARM <- droplevels(proc_data$adtte$ARM)
150		#' run(coxt01, proc_data)
151		#'
152		#' run(coxt01, proc_data, covariates = c("SEX", "AAGE"), strata = c("RACE"), conf_level = 0.90)
153		coxt01 <- chevron_t(
154		main = coxt01_main,
155		preprocess = coxt01_pre,
156		postprocess = coxt01_post
157		)

1		# fstg01 ----
2
3		#' @describeIn fstg01 Main TLG Function
4		#'
5		#' @details
6		#' * No overall value.
7		#' * Keep zero count rows by default.
8		#'
9		#' @inheritParams gen_args
10		#' @param dataset (`string`) the name of a table in the `adam_db` object.
11		#' @param arm_var (`string`) the arm variable name used for group splitting.
12		#' @param rsp_var (`string`) the response variable name to flag whether each subject is a binary response or not.
13		#' @param subgroups (`character`) the subgroups variable name to list baseline risk factors.
14		#' @param strata_var (`character`) required if stratified analysis is performed.
15		#' @param stat_var (`character`) the names of statistics to be reported in `tabulate_rsp_subgroups`.
16		#' @param max_colwidth (`int`) maximum width of columns. Stratification label longer than this will be truncated.
17		#' @param ... Further arguments passed to `g_forest` and `extract_rsp_subgroups` (a wrapper for
18		#' `h_odds_ratio_subgroups_df` and `h_proportion_subgroups_df`). For details, see the documentation in `tern`.
19		#' Commonly used arguments include `col_symbol_size`, `col`, `vline`, `groups_lists`, `conf_level`,
20		#' `method`, `label_all`, etc.
21		#'
22		#' @note
23		#' * `adam_db` object must contain the table specified by `dataset` with `"PARAMCD"`, `"ARM"`,
24		#' `"AVALC"`, and the columns specified by `subgroups` which is denoted as
25		#' `c("SEX", "AGEGR1", "RACE")` by default.
26		#' * If the plot is too large to be rendered in the output, please provide `width_row_names`,
27		#' `width_columns` and `width_forest` manually to make it fit. See `g_forest` for more details.
28		#'
29		#' @return a `gTree` object.
30		#'
31		#' @export
32		#'
33		fstg01_main <- function(adam_db,
34		dataset = "adrs",
35		arm_var = "ARM",
36		rsp_var = "IS_RSP",
37		subgroups = c("SEX", "AGEGR1", "RACE"),
38		strata_var = NULL,
39		stat_var = c("n_tot", "n", "n_rsp", "prop", "or", "ci"),
40		max_colwidth = 12,
41		...) {
42	1x	assert_all_tablenames(adam_db, c("adsl", dataset))
43	1x	df_lbl <- paste0("adam_db$", dataset)
44	1x	assert_string(arm_var)
45	1x	assert_string(rsp_var)
46	1x	assert_int(max_colwidth)
47	1x	assert_character(subgroups, null.ok = TRUE)
48	1x	assert_character(strata_var, null.ok = TRUE)
49	1x	assert_character(stat_var, null.ok = TRUE)
50	1x	assert_valid_variable(adam_db[[dataset]], arm_var, types = list("factor"), n.levels = 2, label = df_lbl)
51	1x	assert_valid_variable(adam_db[[dataset]], c("USUBJID", "PARAMCD"),
52	1x	types = list(c("character", "factor")),
53	1x	label = df_lbl
54		)
55	1x	assert_valid_variable(adam_db[[dataset]], rsp_var, types = list("logical"), label = df_lbl)
56	1x	assert_valid_variable(adam_db[[dataset]], c(subgroups, strata_var),
57	1x	types = list(c("factor")), na_ok = TRUE,
58	1x	label = df_lbl
59		)
60	1x	assert_single_value(adam_db[[dataset]]$PARAMCD, label = df_lbl)
61
62	1x	variables <- list(
63	1x	arm = arm_var,
64	1x	rsp = rsp_var,
65	1x	subgroups = subgroups,
66	1x	strata_var = strata_var
67		)
68
69	1x	df <- execute_with_args(extract_rsp_subgroups,
70	1x	variables = variables,
71	1x	data = adam_db[[dataset]],
72		...
73		)
74	1x	df$prop$subgroup <- stringr::str_trunc(df$prop$subgroup, max_colwidth)
75	1x	df$or$subgroup <- stringr::str_trunc(df$or$subgroup, max_colwidth)
76	1x	result <- basic_table() %>%
77	1x	tabulate_rsp_subgroups(df, vars = stat_var)
78	1x	cw <- pmin(propose_column_widths(result), max_colwidth + 2)
79	1x	final_width <- stringWidth(strrep("x", cw))
80	1x	execute_with_args(
81	1x	g_forest,
82	1x	tbl = result,
83		...,
84	1x	width_row_names = final_width[1],
85	1x	width_columns = final_width[-1],
86	1x	draw = FALSE
87		)
88		}
89
90		#' @describeIn fstg01 Preprocessing
91		#'
92		#' @inheritParams fstg01_main
93		#'
94		#' @export
95		#'
96		fstg01_pre <- function(adam_db, ...) {
97	1x	adam_db$adrs <- adam_db$adrs %>%
98	1x	mutate(
99	1x	ARM = droplevels(.data$ARM),
100	1x	IS_RSP = .data$AVALC %in% c("CR", "PR")
101		)
102
103	1x	adam_db
104		}
105
106		# `fstg01` Pipeline ----
107
108		#' `FSTG01` Subgroup Analysis of Best Overall Response.
109		#'
110		#' The template produces the subgroup analysis of best overall response graphic.
111		#'
112		#' @include chevron_tlg-S4class.R
113		#' @export
114		#'
115		#' @examples
116		#' library(dplyr)
117		#' library(dunlin)
118		#'
119		#' proc_data <- log_filter(
120		#' syn_data,
121		#' PARAMCD == "BESRSPI" & ARM %in% c("A: Drug X", "B: Placebo"), "adrs"
122		#' )
123		#' run(fstg01, proc_data,
124		#' subgroups = c("SEX", "AGEGR1", "RACE"),
125		#' conf_level = 0.90, dataset = "adrs"
126		#' )
127		fstg01 <- chevron_g(
128		main = fstg01_main,
129		preproces = fstg01_pre
130		)

1		# pdt01 ----
2
3		#' @describeIn pdt01 Main TLG function
4		#'
5		#' @inheritParams gen_args
6		#' @param dvcode_var (`string`) the variable defining the protocol deviation coded term. By default `DVDECOD`.
7		#' @param dvterm_var (`string`) the variable defining the protocol deviation term. By default `DVTERM`.
8		#'
9		#' @details
10		#' * Data should be filtered for major protocol deviations. `(DVCAT == "MAJOR")`.
11		#' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.
12		#' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.
13		#' * Split columns by arm.
14		#' * Does not include a total column by default.
15		#' * Sort by medication class alphabetically and within medication class by decreasing total number of patients with
16		#' the specific medication.
17		#'
18		#' @note
19		#' * `adam_db` object must contain an `addv` table with the columns specified in `dvcode_var` and `dvterm_var` as well
20		#' as `"DVSEQ"`.
21		#'
22		#' @export
23		#'
24		pdt01_main <- function(adam_db,
25		arm_var = "ARM",
26		lbl_overall = NULL,
27		dvcode_var = "DVDECOD",
28		dvterm_var = "DVTERM",
29		...) {
30	1x	assert_all_tablenames(adam_db, c("adsl", "addv"))
31	1x	assert_string(arm_var)
32	1x	assert_string(lbl_overall, null.ok = TRUE)
33	1x	assert_string(dvcode_var)
34	1x	assert_string(dvterm_var)
35	1x	assert_valid_variable(adam_db$addv, c(dvcode_var, dvterm_var), types = list(c("character", "factor")))
36	1x	assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))
37	1x	assert_valid_variable(adam_db$addv, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)
38	1x	assert_valid_var_pair(adam_db$adsl, adam_db$addv, arm_var)
39
40	1x	lbl_overall <- render_safe(lbl_overall)
41	1x	lbl_dvcode_var <- var_labels_for(adam_db$addv, dvcode_var)
42	1x	lbl_dvterm_var <- var_labels_for(adam_db$addv, dvterm_var)
43
44	1x	lyt <- pdt01_lyt(
45	1x	arm_var = arm_var,
46	1x	lbl_overall = lbl_overall,
47	1x	dvcode_var = dvcode_var,
48	1x	lbl_dvcode_var = lbl_dvcode_var,
49	1x	dvterm_var = dvterm_var,
50	1x	lbl_dvterm_var = lbl_dvterm_var
51		)
52
53	1x	tbl <- build_table(lyt, adam_db$addv, alt_counts_df = adam_db$adsl)
54
55	1x	tbl
56		}
57
58		#' `pdt01` Layout
59		#'
60		#' @inheritParams gen_args
61		#' @inheritParams pdt01_main
62		#' @param lbl_dvcode_var (`string`) label for the variable defining the protocol deviation coded term.
63		#' @param lbl_dvterm_var (`string`) label for the variable defining the protocol deviation term.
64		#'
65		#' @keywords internal
66		#'
67		pdt01_lyt <- function(arm_var,
68		lbl_overall,
69		dvcode_var,
70		lbl_dvcode_var,
71		dvterm_var,
72		lbl_dvterm_var) {
73	4x	basic_table(show_colcounts = TRUE) %>%
74	4x	split_cols_by(var = arm_var) %>%
75	4x	ifneeded_add_overall_col(lbl_overall) %>%
76	4x	summarize_num_patients(
77	4x	var = "USUBJID",
78	4x	.stats = c("unique", "nonunique"),
79	4x	.labels = c(
80	4x	unique = render_safe("Total number of {patient_label} with at least one major protocol deviation"),
81	4x	nonunique = "Total number of major protocol deviations"
82		),
83	4x	.formats = list(unique = format_count_fraction_fixed_dp)
84		) %>%
85	4x	split_rows_by(
86	4x	dvcode_var,
87	4x	child_labels = "visible",
88	4x	nested = FALSE,
89	4x	indent_mod = -1L,
90	4x	split_fun = drop_split_levels,
91	4x	label_pos = "topleft",
92	4x	split_label = lbl_dvterm_var
93		) %>%
94	4x	count_occurrences(vars = dvterm_var) %>%
95	4x	append_topleft(paste0(" Description"))
96		}
97
98		#' @describeIn pdt01 Preprocessing
99		#'
100		#' @inheritParams pdt01_main
101		#'
102		#' @export
103		#'
104		pdt01_pre <- function(adam_db, ...) {
105	1x	adam_db$addv <- adam_db$addv %>%
106	1x	mutate(across(all_of(c("DVDECOD", "DVTERM")), ~ reformat(.x, nocoding))) %>%
107	1x	mutate(
108	1x	DVDECOD = with_label(.data$DVDECOD, "Protocol Deviation Coded Term"),
109	1x	DVTERM = with_label(.data$DVTERM, "Category")
110		)
111
112	1x	adam_db
113		}
114
115		#' @describeIn pdt01 Postprocessing
116		#'
117		#' @inheritParams pdt01_main
118		#' @inheritParams gen_args
119		#'
120		#' @export
121		#'
122		pdt01_post <- function(tlg, prune_0 = TRUE, dvcode_var = "DVDECOD", dvterm_var = "DVTERM", ...) {
123	1x	if (prune_0) {
124	1x	tlg <- smart_prune(tlg)
125		}
126
127	1x	tbl_sorted <- tlg %>%
128	1x	sort_at_path(
129	1x	path = c(dvcode_var, "*", dvterm_var),
130	1x	scorefun = score_occurrences
131		)
132
133	1x	std_postprocess(tbl_sorted)
134		}
135
136		#' `pdt01` Major Protocol Deviations Table.
137		#'
138		#' A major protocol deviations
139		#' table with the number of subjects and the total number of treatments by medication class sorted alphabetically and
140		#' medication name sorted by frequencies.
141		#'
142		#' @include chevron_tlg-S4class.R
143		#' @export
144		#'
145		#' @examples
146		#' library(dplyr)
147		#'
148		#' proc_data <- syn_data
149		#' proc_data$addv <- proc_data$addv %>%
150		#' filter(DVCAT == "MAJOR")
151		#'
152		#' run(pdt01, proc_data)
153		pdt01 <- chevron_t(
154		main = pdt01_main,
155		preprocess = pdt01_pre,
156		postprocess = pdt01_post
157		)