update

.gitignore

@@ -2,3 +2,5 @@
 .Rhistory
 .RData
 .Ruserdata
+tests/testthat/Rplots.pdf
+tests/testthat/t_dm_output.rds

DESCRIPTION

@@ -24,20 +24,17 @@ Description: Slides automation with R.
 License: file LICENSE
 URL: https://github.com/insightsengineering/autoslider.core
 Depends:
-    flextable (>= 0.9.4),
-    formatters (>= 0.5.9),
-    officer (>= 0.3.18),
     R (>= 2.10),
-    rlistings (>= 0.2.9),
-    rtables (>= 0.6.10),
-    tern (>= 0.9.6)
+    flextable (>= 0.9.4),
+    officer (>= 0.3.18)
 Imports:
     assertthat,
     checkmate,
     cli,
     dplyr,
     filters (>= 0.3.1),
     forcats,
+    formatters (>= 0.5.9),
     ggplot2,
     ggpubr,
     glue,
@@ -50,10 +47,13 @@ Imports:
     purrr,
     readxl,
     rlang,
+    rlistings (>= 0.2.9),
+    rtables (>= 0.6.10),
     rvg (>= 0.2.5),
     stringr,
     survival,
     tidyr,
+    tern (>= 0.9.6),
     yaml
 Suggests:
     devtools,

NAMESPACE

@@ -12,6 +12,7 @@ export(autoslider_error)
 export(autoslider_format)
 export(black_format)
 export(blue_format)
+export(build_table_header)
 export(check_and_set_cutoff)
 export(dec_paste)
 export(decorate)
@@ -32,6 +33,7 @@ export(lyt_to_side_by_side)
 export(lyt_to_side_by_side_two_data)
 export(mutate_actarm)
 export(na_replace)
+export(new_round)
 export(null_report)
 export(orange_format)
 export(perc_perc)
@@ -96,6 +98,7 @@ importFrom(formatters,paginate_indices)
 importFrom(formatters,propose_column_widths)
 importFrom(formatters,var_labels)
 importFrom(formatters,var_relabel)
+importFrom(formatters,with_label)
 importFrom(ggpubr,as_ggplot)
 importFrom(glue,glue)
 importFrom(googlesheets4,read_sheet)

R/generate_output_chg_name.R → R/generate_output.R

@@ -16,6 +16,7 @@
 #' @export
 #'
 #' @examples
+#' library(dplyr)
 #' filters::load_filters(
 #'   yaml_file = system.file("filters.yml", package = "autoslider.core"),
 #'   overwrite = TRUE

R/null_report.R

@@ -1,7 +1,6 @@
 #' Null report
 #'
 #' @author Thomas Neitmann (`neitmant`)
-#' @export
 #'
 #' @details
 #' This will create a null report similar as STREAM does. You can use
@@ -33,6 +32,8 @@
 #'   apply_filter("SER_SE") %>%
 #'   t_ae()
 #'
+#' @export
+#'
 null_report <- function() {
   rtable(
     header = " ",

R/package.R

@@ -10,9 +10,10 @@
 #' @importFrom assertthat assert_that noNA are_equal has_name is.string
 #' @importFrom checkmate assert_class assert_numeric assert_flag assert_count assert_number
 #' @importFrom cli cat_bullet
-#' @importFrom dplyr mutate_at mutate rename filter select semi_join case_when all_of arrange left_join distinct inner_join
+#' @importFrom dplyr mutate_at mutate rename filter select semi_join case_when all_of arrange
+#' @importFrom dplyr left_join distinct inner_join
 #' @importFrom filters apply_filter
-#' @importFrom formatters var_relabel propose_column_widths var_labels obj_label matrix_form
+#' @importFrom formatters var_relabel propose_column_widths var_labels obj_label matrix_form with_label
 #' @importFrom formatters var_labels<- paginate_indices
 #' @importFrom ggpubr as_ggplot
 #' @importFrom glue glue

R/spec.R

@@ -71,6 +71,7 @@ validate_spec <- function(spec) {
 #' @export
 #'
 #' @examples
+#' library(dplyr)
 #' spec_file <- system.file("spec.yml", package = "autoslider.core")
 #' spec <- spec_file %>% read_spec()
 #' ## Keep only outputs belonging to batch 2

R/t_ae_slide.R

@@ -9,6 +9,7 @@
 #' @inherit gen_notes note
 #' @export
 #' @examples
+#' library(dplyr)
 #' adsl <- eg_adsl %>%
 #'   dplyr::mutate(TRT01A = factor(TRT01A, levels = c("A: Drug X", "B: Placebo")))
 #' adae <- eg_adae %>%

R/t_ae_summary_slide.R

@@ -20,6 +20,7 @@
 #' @export
 #'
 #' @examples
+#' library(dplyr)
 #' ADSL <- eg_adsl
 #' ADAE <- eg_adae
 #'

R/t_aesi_slide.R

@@ -12,6 +12,7 @@
 #' @author Kai Xiang Lim (`limk43`)
 #'
 #' @examples
+#' library(dplyr)
 #' adsl <- eg_adsl
 #' adae <- eg_adae
 #' adae_atoxgr <- adae %>% dplyr::mutate(ATOXGR = AETOXGR)

R/t_dd_slide.R

@@ -9,7 +9,7 @@
 #' @inherit gen_notes note
 #' @export
 #' @examples
-#'
+#' library(dplyr)
 #' adsl <- eg_adsl %>% preprocess_t_dd()
 #' out1 <- t_dd_slide(adsl, "TRT01A")
 #' print(out1)

R/t_dor_slide.R

@@ -7,6 +7,7 @@
 #'
 #' @export
 #' @examples
+#' library(dplyr)
 #' adsl <- eg_adsl %>%
 #'   dplyr::mutate(TRT01P = factor(TRT01P, levels = c("A: Drug X", "B: Placebo", "C: Combination")))
 #' adtte <- eg_adtte %>%

R/to_slides.R

@@ -1,4 +1,4 @@
-#' generate slides based on output from enableRF
+#' generate slides based on output
 #'
 #' @param outputs List of output
 #' @param template Template file path
@@ -18,6 +18,7 @@
 #' @examples
 #'
 #' # Example 1. When applying to the whole pipeline
+#' library(dplyr)
 #' data <- list(
 #'   adsl = eg_adsl %>% dplyr::mutate(FASFL = SAFFL),
 #'   adae = eg_adae

R/util.R

@@ -72,6 +72,10 @@ to_vector <- function(num_list) {
   })
 }
 
+#' Founding method
+#' @param x number need to be rounded
+#' @param digits number of digits
+#' @export
 new_round <- function(x, digits = 1) {
   posneg <- sign(x)
   z <- abs(x) * 10^digits
@@ -271,110 +275,6 @@ s_coxph_pairwise_1 <- function(df, .ref_group, .in_ref_col, .var, is_event, stra
   )
 }
 
-s_coxph_pairwise_2 <- function(df, .ref_group, .in_ref_col, .var, is_event, strat = NULL) {
-  # assert_that(is_df_with_variables(df, list(tte = .var, is_event = is_event)),
-  #             is.string(.var), is_numeric_vector(df[[.var]]), is_logical_vector(df[[is_event]]))
-  # pval_method <- control$pval_method
-  # ties <- control$ties
-  # conf_level <- control$conf_level
-  pval_method <- "log-rank"
-  ties <- "efron"
-  conf_level <- 0.95
-
-  strat_type <- ifelse(is.null(strat), "Unstratified", "Stratified")
-  if (.in_ref_col) {
-    return(
-      in_rows(
-        rcell(""),
-        rcell(""),
-        .labels = c(paste0(strat_type, " HR (", conf_level * 100, "% CI)"), paste0("p-value (", pval_method, ")"))
-      )
-      # list(hr_ci = with_label("", paste0("Stratified HR (", conf_level*100, "% CI)")),
-      #      pvalue = with_label("", paste0("p-value (", pval_method, ")"))
-      #      )
-    )
-  }
-  data <- rbind(.ref_group, df)
-  group <- factor(rep(c("ref", "x"), c(nrow(.ref_group), nrow(df))),
-    levels = c("ref", "x")
-  )
-  df_cox <- data.frame(
-    tte = data[[.var]], is_event = data[[is_event]],
-    arm = group
-  )
-  if (is.null(strat)) {
-    formula_cox <- Surv(tte, is_event) ~ arm
-  } else {
-    formula_cox <- as.formula(paste0(
-      "Surv(tte, is_event) ~ arm + strata(",
-      paste(strat, collapse = ","), ")"
-    ))
-    df_cox <- cbind(df_cox, data[strat])
-  }
-  cox_fit <- coxph(formula = formula_cox, data = df_cox, ties = ties)
-  sum_cox <- summary(cox_fit, conf.int = conf_level, extend = TRUE)
-  # old_pval <- switch(pval_method, wald = sum_cox$waldtest["pvalue"],
-  #                `log-rank` = sum_cox$sctest["pvalue"], likelihood = sum_cox$logtest["pvalue"])
-  # print(old_pval)
-  a <- survdiff(formula_cox, df_cox)
-  pval <- 1 - pchisq(a$chisq, length(a$n) - 1)
-  # print(pval)
-
-  list(
-    # hr = with_label(sum_cox$conf.int[1, 1], "Hazard Ratio"),
-    # hr_ci = with_label(unname(sum_cox$conf.int[1, 3:4]), f_conf_level(conf_level)),
-    hr_ci = with_label(
-      c(sum_cox$conf.int[1, 1], unname(sum_cox$conf.int[1, 3:4])),
-      paste0("Stratified HR (", conf_level * 100, "% CI)")
-    ),
-    pvalue = with_label(unname(pval), paste0("p-value (", pval_method, ")"))
-  )
-
-  in_rows(
-    rcell(c(sum_cox$conf.int[1, 1], unname(sum_cox$conf.int[1, 3:4])), format = format_3d),
-    rcell(unname(pval), format = "x.xxxx | (<0.0001)"),
-    .labels = c(paste0("Stratified HR (", conf_level * 100, "% CI)"), paste0("p-value (", pval_method, ")"))
-  )
-}
-
-get_trt_dispositin_data <- function(adsl, actarm, armname, armsdtm, armdtrfl, armdsst, armdcrs) {
-  assert_that(is.character(actarm))
-  assert_that(is.character(armname))
-  assert_that(lubridate::is.Date(adsl[[armsdtm]]))
-
-  unique_fl <- unique(adsl[[armdtrfl]])
-  level_len <- length(unique_fl)
-  assert_that(level_len <= 2, msg = "Must be a flag variable with only Y/N")
-
-  adsl_trt <- adsl %>%
-    filter(TRT01A == actarm) %>%
-    mutate(
-      act_trt = armname,
-      rec_trt = ifelse(is.na(!!sym(armsdtm)), "N", "Y"),
-      DTRTxxFL = explicit_na(sas_na(!!sym(armdtrfl))),
-      # drtfl = ifelse(DTRTxxFL == "<Missing>", "N", "Y"),
-      trt_stat = factor(ifelse(is.na(DTRTxxFL), "<Missing>", explicit_na(sas_na(!!sym(armdsst))))),
-      dc_rsn = factor(ifelse(rec_trt == "N", "<Missing>", explicit_na(sas_na(!!sym(armdcrs)))))
-    )
-}
-
-a_count_occur_1 <- function(x, .N_col, .df_row, vars = c("USUBJID")) {
-  count1 <- length(unique(x))
-
-  df_g34 <- .df_row %>%
-    filter(ATOXGR %in% c(3, 4) & # AOCCSPFL == "Y" &
-      USUBJID %in% x)
-  # print(head(df_g34[c("USUBJID", "TRT01A", "AEBODSYS2")]))
-  count2 <- length(unique(df_g34$USUBJID))
-
-  out <- c(
-    counts = ifelse(count1 == 0 && .N_col == 0, 0, count1 / .N_col),
-    grd34 = ifelse(count2 == 0 && .N_col == 0, 0, count2 / .N_col)
-  )
-
-  setNames(with_label(out, as.character(.df_row[["AEBODSYS2"]][1])), as.character(.df_row[["AEBODSYS2"]][1]))
-}
-
 is_in_repository <- function() {
   system("git status", ignore.stdout = TRUE, ignore.stderr = TRUE) == 0
 }
@@ -676,6 +576,12 @@ do_call <- function(fun, ...) {
 }
 
 
+#' Build table header, a utility function to help with construct structured header for table layout
+#' @param anl analysis data object
+#' @param arm Arm variable for column split
+#' @param split_by_study, if true, construct structured header with the study ID
+#' @param side_by_side A logical value indicating whether to display the data side by side.
+#' @export
 build_table_header <- function(anl,
                                arm,
                                split_by_study,
@@ -689,7 +595,7 @@ build_table_header <- function(anl,
         split_cols_by(var = arm)
     } else {
       lyt <- lyt %>%
-        split_cols_by(var = arm, split_fun = add_overall_level("All Patients", first = FALSE)) %>%
+        split_cols_by(var = arm) %>%
         add_overall_col("All Patients")
     }
   } else {