Initial kmg01_1

DESCRIPTION

@@ -83,6 +83,7 @@ Collate:
     'egt05_qtcat.R'
     'ext01.R'
     'gen_args.R'
+    'kmg01.R'
     'lbt01.R'
     'lbt04.R'
     'lbt05.R'

NAMESPACE

@@ -148,6 +148,9 @@ export(get_preprocess)
 export(gg_list)
 export(grob_list)
 export(h_format_dec)
+export(kmg01_1)
+export(kmg01_1_main)
+export(kmg01_1_pre)
 export(lbt01_1)
 export(lbt01_1_lyt)
 export(lbt01_1_main)

R/kmg01.R

@@ -0,0 +1,151 @@
+# kmg01_1 ----
+
+#' @describeIn kmg01_1 Main TLG Function
+#'
+#' @details
+#'  * No overall value.
+#'
+#' @inheritParams gen_args
+#' @param dataset (`string`) the name of a table in the `adam_db` object.
+#' @param x_name (`string`) the name of the x-axis.
+#' @param y_name (`string`) the name of the x-axis.
+#' @param show_statis (`flag`) should the summary statistic table be displayed.
+#' @param show_censor (`flag`) should the censor flag be displayed.
+#' @param pval_method (`string`) should the censor flag be displayed.
+#' @param ties (`string`) should the censor flag be displayed.
+#' @param conf_level (`numeric`) should the censor flag be displayed.
+#' @param legend_pos (`string`) the position of the legend.
+#' @param position_coxph (`numeric`) x and y positions for plotting survival::coxph() model.
+#' @param position_surv_med (`numeric`) x and y positions for plotting annotation table estimating
+#'   median survival time per group.
+#' @param line_col (`list`) describing the colors to use for the lines or a named `list` associating values of `arm_var`
+#'   with color names.
+#'
+#' @note
+#'  * `adam_db` object must contain the table specified by `dataset` with the columns specified by  `arm_var`.
+#'
+#' @return a list of `ggplot` objects.
+#' @export
+kmg01_1_main <- function(adam_db,
+                         dataset = "adtte",
+                         arm_var = "ARM",
+                         x_name = "Time (Days)",
+                         y_name = "Survival Probability",
+                         show_statis = TRUE,
+                         show_censor = TRUE,
+                         pval_method = "wald",
+                         ties = "exact",
+                         conf_level = 0.95,
+                         legend_pos = "bottom",
+                         position_coxph = c(0, 0.05),
+                         position_surv_med = c(0.9, 0.9),
+                         line_col = as.list(nestcolor::color_palette()),
+                         ...) {
+  anl <- adam_db[[dataset]]
+  checkmate::assert_true(length(unique(anl$PARAMCD)) == 1)
+  checkmate::assert_character(x_name)
+  checkmate::assert_character(y_name)
+  checkmate::assert_flag(show_statis)
+  checkmate::assert_flag(show_censor)
+
+  line_col <- unlist(line_col)
+  checkmate::assert_character(line_col, null.ok = TRUE)
+
+  variables <- list(tte = "AVAL", is_event = "is_event", arm = arm_var)
+
+  ggtheme <- ggplot2::theme_bw() +
+    ggplot2::theme(legend.position = legend_pos)
+
+  if (!is.null(names(line_col))) {
+    color_lvl <- sort(unique(anl[[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
+  }
+
+  gkm_plot <- if (!show_statis) {
+    g_km(
+      df = anl,
+      variables = variables,
+      censor_show = show_censor,
+      xlab = x_name,
+      ylab = y_name,
+      annot_surv_med = TRUE,
+      control_coxph = control_coxph(pval_method = pval_method, ties = ties, conf_level = conf_level),
+      ggtheme = ggtheme,
+      position_coxph = position_coxph,
+      position_surv_med = position_surv_med
+    )
+  } else {
+    g_km(
+      df = anl,
+      variables = variables,
+      censor_show = show_censor,
+      xlab = x_name,
+      ylab = y_name,
+      annot_coxph = TRUE,
+      control_coxph = control_coxph(pval_method = pval_method, ties = ties, conf_level = conf_level),
+      ggtheme = ggtheme,
+      position_coxph = position_coxph,
+      position_surv_med = position_surv_med
+    )
+  }
+}
+
+#' @describeIn kmg01_1 Preprocessing
+#'
+#' @inheritParams kmg01_1_main
+#' @param paramcd (`string`) PARAMCD of the endpoint need to be analysis
+#'
+#' @export
+kmg01_1_pre <- function(adam_db, dataset, paramcd = "OS", ...) {
+  checkmate::assert_class(adam_db, "dm")
+  assert_colnames(adam_db[[dataset]], c("PARAMCD", "CNSR"))
+
+  adam_db <- adam_db %>%
+    dm_zoom_to(!!dataset) %>%
+    filter(.data$PARAMCD == paramcd) %>%
+    mutate(is_event = CNSR == 0) %>%
+    dm_update_zoomed()
+}
+
+#' @describeIn kmg01_1 Postprocessing
+#'
+#' @inheritParams gen_args
+#'
+kmg01_1_post <- function(tlg, ...) {
+  tlg
+}
+
+# `kmg01_1` Pipeline ----
+
+#' `KMG01` Kaplan-Meier Plot 1.
+#'
+#'
+#' @include chevron_tlg-S4class.R
+#' @export
+#'
+#' @examples
+#' library(dm)
+#' library(dplyr)
+#'
+#' col <- c(
+#'   "A: Drug X" = "black",
+#'   "B: Placebo" = "blue",
+#'   "C: Combination" = "gray"
+#' )
+#'
+#' run(kmg01_1, syn_data, dataset = "adtte", line_col = col)
+kmg01_1 <- chevron_g(
+  main = kmg01_1_main,
+  preproces = kmg01_1_pre,
+  postprocess = kmg01_1_post,
+  adam_datasets = c("adsl", "adtte")
+)

_pkgdown.yaml

@@ -70,6 +70,7 @@ reference:
       - egt05_qtcat_1
       - ext01_1
       - ext01_2
+      - kmg01_1
       - lbt01_1
       - lbt04_1
       - lbt05_1

inst/WORDLIST

@@ -2,22 +2,21 @@ ADEG
 ADaM
 AESI
 CTCAE
-gg
-gg_list
 Hoffmann
+Kaplan
 NCI
 PARAMCD
 Postprocessing
-postprocessing
-preprocess
 Pre
 Repo
-SSO
+Rua
 TLG
 TLGs
+coxph
+de
 funder
+postprocessing
 pre
+preprocess
 repo
 reproducibility
-de
-Rua

tests/testthat/_snaps/default_tlg.md

@@ -371,6 +371,25 @@
                                     Grade 3-4       43 (32.1%)    46 (34.3%)      43 (32.6%)  
                                     4               43 (32.1%)    46 (34.3%)      43 (32.6%)  
 
+# aet10_1 functions with default argument value return expected result with test data
+
+    Code
+      res
+    Output
+                                A: Drug X    B: Placebo   C: Combination
+        MedDRA Preferred Term    (N=134)      (N=134)        (N=132)    
+        ————————————————————————————————————————————————————————————————
+        dcd D.2.1.5.3           47 (35.1%)   58 (43.3%)     57 (43.2%)  
+        dcd A.1.1.1.1           50 (37.3%)   45 (33.6%)     63 (47.7%)  
+        dcd B.2.2.3.1           48 (35.8%)   54 (40.3%)     51 (38.6%)  
+        dcd A.1.1.1.2           48 (35.8%)   48 (35.8%)     50 (37.9%)  
+        dcd B.2.1.2.1           49 (36.6%)   44 (32.8%)     52 (39.4%)  
+        dcd D.1.1.1.1           50 (37.3%)   42 (31.3%)     51 (38.6%)  
+        dcd D.1.1.4.2           48 (35.8%)   42 (31.3%)     50 (37.9%)  
+        dcd B.1.1.1.1           47 (35.1%)   49 (36.6%)     43 (32.6%)  
+        dcd C.2.1.2.1           35 (26.1%)   48 (35.8%)     55 (41.7%)  
+        dcd C.1.1.1.3           43 (32.1%)   46 (34.3%)     43 (32.6%)  
+
 # cmt01a_1 functions with default argument value return expected result with test data
 
     Code

tests/testthat/test-kmg01.R

@@ -0,0 +1,25 @@
+test_that("kmg01_1 works as expected", {
+  pre_data <- expect_silent(kmg01_1_pre(syn_data, dataset = "adtte"))
+  raw_res <- expect_silent(kmg01_1_main(pre_data, dataset = "adtte"))
+  checkmate::assert_true(grid::is.grob(raw_res))
+})
+
+
+
+test_that("kmg01_1 works as expected with custom color set", {
+  col <- list(
+    "A: Drug X" = "black",
+    "B: Placebo" = "blue",
+    "C: Combination" = "gray"
+  )
+
+  res <- expect_silent(run(kmg01_1, syn_data, dataset = "adtte", line_col = col))
+  checkmate::assert_true(grid::is.grob(res))
+  res <- expect_silent(run(kmg01_1, syn_data, dataset = "adtte", line_col = unname(col)))
+  checkmate::assert_true(grid::is.grob(res))
+})
+
+test_that("kmg01_1 works if show_statis/show_censor is FALSE", {
+  res <- expect_silent(run(kmg01_1, syn_data, dataset = "adtte", show_statis = FALSE, show_censor = FALSE))
+  checkmate::assert_true(grid::is.grob(res))
+})