From 9ec59e9bcea5ed8e766dddcfdc0dbff22495e689 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 17 Dec 2024 15:22:03 +0000 Subject: [PATCH] =?UTF-8?q?=F0=9F=97=83=EF=B8=8F=20Decorators=20feature=20?= =?UTF-8?q?branch=20(#1252)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Partner to https://github.com/insightsengineering/teal/pull/1357 - Introduces decorators to modules. More about decorators in here https://github.com/insightsengineering/teal/issues/1384 - Part 1 of https://github.com/insightsengineering/teal/issues/1371#issue-2575079391 ### Changes description - Adds internal wrapper around `srv_decorate_data` as utility to append code after decorator _(such as `print(plot)`)_ - Implements decorators in modules #### Checklist for final review: Double check check for every module: - Works with and without decorators - Has param and section in documentation - Code shows in "Show R code" - Reporter shows both the outputs and code #### Todo on feature branch - [x] Link the `teal_transform_module` parameter to an extended explanation as [suggested here](https://github.com/insightsengineering/teal.modules.clinical/pull/1252/files/a78c0baa0996fb30fdff551bccb7bab0ec86caa6#r1870909229) - [x] Meet with SME to validate some changes in template, topics: - modules with listing/dt - Merge all modules - [x] Part 1 of https://github.com/insightsengineering/teal/issues/1371#issue-2575079391 - [x] Part 2 of https://github.com/insightsengineering/teal/issues/1371#issue-2575079391 - [x] Accept changes to snapshots in regression testing https://github.com/insightsengineering/teal.modules.clinical/pull/1304 #### Example apps Not all modules could be used in same App as the examples' data are not 100% compatible. Hence the 2 apps below.
Example app ```r # Load packages pkgload::load_all("../teal.modules.clinical", export_all = FALSE) # Decorators ------------------------------------------------------------------ insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") { teal_transform_module( label = "New rtables row", ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row)) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } add_title_decorator <- function(default_check = TRUE, .var_to_replace = "plot") { teal_transform_module( label = "Title", ui = function(id) shiny::checkboxInput(NS(id, "flag"), "Add title?", TRUE), server = make_teal_transform_server( substitute({ if (flag) .var_to_replace <- .var_to_replace + ggplot2::ggtitle("Title added by decorator") }, env = list(.var_to_replace = as.name(.var_to_replace)) ) ) ) } caption_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") { teal_transform_module( label = "Caption", ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } change_theme_decorator <- function(default_check = TRUE, .var_to_replace = "plot") { teal_transform_module( label = "Theme", ui = function(id) shiny::checkboxInput(NS(id, "flag"), "Apply dark theme?", TRUE), server = make_teal_transform_server( substitute({ if (flag) .var_to_replace <- .var_to_replace + ggplot2::theme_dark() }, env = list(.var_to_replace = as.name(.var_to_replace)) ) ) ) } add_cowplot_title_decorator <- function(default_check = TRUE, .var_to_replace = "plot") { teal_transform_module( label = "Cowplot title", ui = function(id) shiny::checkboxInput(NS(id, "flag"), "Add title?", TRUE), server = make_teal_transform_server( substitute({ if (flag) .var_to_replace <- .var_to_replace + ggplot2::ggtitle("Title added by decorator") + cowplot::theme_cowplot() }, env = list(.var_to_replace = as.name(.var_to_replace)) ) ) ) } rlisting_footer <- function(default_footer = "I am a good footer", .var_to_replace = "table_listing") { teal_transform_module( label = "New row", ui = function(id) shiny::textInput(shiny::NS(id, "footer"), "footer", value = default_footer), server = make_teal_transform_server( substitute({ rlistings::main_footer(.var_to_replace) <- footer }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } # End of decorators ----------------------------------------------------------- library(dplyr) # arm_ref_comp <- list(ARMCD = list(ref = "ARM B", comp = c("ARM A", "ARM C"))) arm_ref_comp <- list( ACTARMCD = list(ref = "ARM B", comp = c("ARM A", "ARM C")), ARM = list(ref = "B: Placebo", comp = c("A: Drug X", "C: Combination")) ) data <- within(teal_data(), { ADSL <- tmc_ex_adsl |> mutate(ITTFL = factor("Y") |> with_label("Intent-To-Treat Population Flag")) |> mutate(DTHFL = case_when(!is.na(DTHDT) ~ "Y", TRUE ~ "") |> with_label("Subject Death Flag")) ADAE <- tmc_ex_adae |> filter(!((AETOXGR == 1) & (AESEV == "MILD") & (ARM == "A: Drug X"))) ADAE$ASTDY <- structure( as.double(ADAE$ASTDY, unit = attr(ADAE$ASTDY, "units", exact = TRUE)), label = attr(ADAE$ASTDY, "label", exact = TRUE) ) .lbls_adae <- col_labels(tmc_ex_adae) ADAE <- tmc_ex_adae %>% mutate_if(is.character, as.factor) #' be certain of having factors col_labels(ADAE) <- .lbls_adae ADTTE <- tmc_ex_adtte ADLB <- tmc_ex_adlb |> mutate(AVISIT == forcats::fct_reorder(AVISIT, AVISITN, min)) |> mutate( ONTRTFL = case_when( AVISIT %in% c("SCREENING", "BASELINE") ~ "", TRUE ~ "Y" ) |> with_label("On Treatment Record Flag") ) ADVS <- tmc_ex_advs ADRS <- tmc_ex_adrs |> mutate( AVALC = d_onco_rsp_label(AVALC) |> with_label("Character Result/Finding") ) |> filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP") |> filter(PARAMCD %in% c("BESRSPI", "INVET")) ADAETTE <- tmc_ex_adaette %>% filter(PARAMCD %in% c("AETTE1", "AETTE2", "AETTE3")) %>% mutate(is_event = CNSR == 0) %>% mutate(n_events = as.integer(is_event)) .add_event_flags <- function(dat) { dat <- dat %>% mutate( TMPFL_SER = AESER == "Y", TMPFL_REL = AEREL == "Y", TMPFL_GR5 = AETOXGR == "5", TMP_SMQ01 = !is.na(SMQ01NAM), TMP_SMQ02 = !is.na(SMQ02NAM), TMP_CQ01 = !is.na(CQ01NAM) ) column_labels <- list( TMPFL_SER = "Serious AE", TMPFL_REL = "Related AE", TMPFL_GR5 = "Grade 5 AE", TMP_SMQ01 = aesi_label(dat[["SMQ01NAM"]], dat[["SMQ01SC"]]), TMP_SMQ02 = aesi_label("Y.9.9.9.9/Z.9.9.9.9 AESI"), TMP_CQ01 = aesi_label(dat[["CQ01NAM"]]) ) col_labels(dat)[names(column_labels)] <- as.character(column_labels) dat } ADEX <- tmc_ex_adex set.seed(1, kind = "Mersenne-Twister") .labels <- col_labels(ADEX, fill = FALSE) ADEX <- ADEX %>% distinct(USUBJID, .keep_all = TRUE) %>% mutate( PARAMCD = "TDURD", PARAM = "Overall duration (days)", AVAL = sample(x = seq(1, 200), size = n(), replace = TRUE), AVALU = "Days" ) %>% bind_rows(ADEX) col_labels(ADEX) <- .labels ADCM <- tmc_ex_adcm ADMH <- tmc_ex_admh ADCM$CMASTDTM <- ADCM$ASTDTM ADCM$CMAENDTM <- ADCM$AENDTM ADEG <- tmc_ex_adeg # smq .names_baskets <- grep("^(SMQ|CQ).*NAM$", names(ADAE), value = TRUE) .names_scopes <- grep("^SMQ.*SC$", names(ADAE), value = TRUE) .cs_baskets <- choices_selected( choices = variable_choices(ADAE, subset = .names_baskets), selected = .names_baskets ) .cs_scopes <- choices_selected( choices = variable_choices(ADAE, subset = .names_scopes), selected = .names_scopes, fixed = TRUE ) # summary ADSL$EOSDY[1] <- NA_integer_ }) join_keys(data) <- default_cdisc_join_keys[names(data)] adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4") join_keys(data)["ADCM", "ADCM"] <- adcm_keys # Use in choices selected ----------------------------------------------------- ADSL <- data[["ADSL"]] ADQS <- data[["ADQS"]] ADAE <- data[["ADAE"]] ADTTE <- data[["ADTTE"]] ADLB <- data[["ADLB"]] ADAE <- data[["ADAE"]] ADVS <- data[["ADVS"]] ADRS <- data[["ADRS"]] ADAETTE <- data[["ADAETTE"]] ADEX <- data[["ADEX"]] ADCM <- data[["ADCM"]] ADMH <- data[["ADMH"]] ADEG <- data[["ADEG"]] # Init ------------------------------------------------------------------------ init( data = data, modules = modules( # ------------------------------------------------------------------------- tm_t_summary_by( label = "Summary by Row Groups Table", dataname = "ADLB", arm_var = choices_selected( choices = variable_choices(ADSL, c("ARM", "ARMCD")), selected = "ARM" ), add_total = TRUE, by_vars = choices_selected( choices = variable_choices(ADLB, c("PARAM", "AVISIT")), selected = c("AVISIT") ), summarize_vars = choices_selected( choices = variable_choices(ADLB, c("AVAL", "CHG")), selected = c("AVAL") ), useNA = "ifany", paramcd = choices_selected( choices = value_choices(ADLB, "PARAMCD", "PARAM"), selected = "ALT" ), decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_smq( label = "Adverse Events by SMQ Table", dataname = "ADAE", arm_var = choices_selected( choices = variable_choices(data[["ADSL"]], subset = c("ARM", "SEX")), selected = "ARM" ), add_total = FALSE, baskets = data[[".cs_baskets"]], scopes = data[[".cs_scopes"]], llt = choices_selected( choices = variable_choices(data[["ADAE"]], subset = c("AEDECOD")), selected = "AEDECOD" ), decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_shift_by_grade( label = "Grade Laboratory Abnormality Table", dataname = "ADLB", arm_var = choices_selected( choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")), selected = "ARM" ), paramcd = choices_selected( choices = value_choices(ADLB, "PARAMCD", "PARAM"), selected = "ALT" ), worst_flag_var = choices_selected( choices = variable_choices(ADLB, subset = c("WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL")), selected = c("WGRLOVFL") ), worst_flag_indicator = choices_selected( value_choices(ADLB, "WGRLOVFL"), selected = "Y", fixed = TRUE ), anl_toxgrade_var = choices_selected( choices = variable_choices(ADLB, subset = c("ATOXGR")), selected = c("ATOXGR"), fixed = TRUE ), base_toxgrade_var = choices_selected( choices = variable_choices(ADLB, subset = c("BTOXGR")), selected = c("BTOXGR"), fixed = TRUE ), add_total = FALSE, decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_shift_by_arm( label = "Shift by Arm Table", dataname = "ADEG", arm_var = choices_selected( variable_choices(ADSL, subset = c("ARM", "ARMCD")), selected = "ARM" ), paramcd = choices_selected( value_choices(ADEG, "PARAMCD"), selected = "HR" ), visit_var = choices_selected( value_choices(ADEG, "AVISIT"), selected = "POST-BASELINE MINIMUM" ), aval_var = choices_selected( variable_choices(ADEG, subset = "ANRIND"), selected = "ANRIND", fixed = TRUE ), baseline_var = choices_selected( variable_choices(ADEG, subset = "BNRIND"), selected = "BNRIND", fixed = TRUE ), useNA = "ifany", decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_shift_by_arm_by_worst( label = "Shift by Arm Table (by worst)", dataname = "ADEG", arm_var = choices_selected( variable_choices(ADSL, subset = c("ARM", "ARMCD")), selected = "ARM" ), paramcd = choices_selected( value_choices(ADEG, "PARAMCD"), selected = "ECGINTP" ), worst_flag_var = choices_selected( variable_choices(ADEG, c("WORS02FL", "WORS01FL")), selected = "WORS02FL" ), worst_flag = choices_selected( value_choices(ADEG, "WORS02FL"), selected = "Y", fixed = TRUE ), aval_var = choices_selected( variable_choices(ADEG, c("AVALC", "ANRIND")), selected = "AVALC" ), baseline_var = choices_selected( variable_choices(ADEG, c("BASEC", "BNRIND")), selected = "BASEC" ), useNA = "ifany", decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_pp_prior_medication( label = "Prior Medication", dataname = "ADCM", parentname = "ADSL", patient_col = "USUBJID", atirel = choices_selected( choices = variable_choices(ADCM, "ATIREL"), selected = "ATIREL" ), cmdecod = choices_selected( choices = variable_choices(ADCM, "CMDECOD"), selected = "CMDECOD" ), cmindc = choices_selected( choices = variable_choices(ADCM, "CMINDC"), selected = "CMINDC" ), cmstdy = choices_selected( choices = variable_choices(ADCM, "ASTDY"), selected = "ASTDY" ), decorators = list( table = rlisting_footer(.var_to_replace = "table") ) ), # ------------------------------------------------------------------------- tm_t_pp_medical_history( label = "Medical History", dataname = "ADMH", parentname = "ADSL", patient_col = "USUBJID", mhterm = choices_selected( choices = variable_choices(ADMH, c("MHTERM")), selected = "MHTERM" ), mhbodsys = choices_selected( choices = variable_choices(ADMH, "MHBODSYS"), selected = "MHBODSYS" ), mhdistat = choices_selected( choices = variable_choices(ADMH, "MHDISTAT"), selected = "MHDISTAT" ), decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_pp_laboratory( label = "Vitals", dataname = "ADLB", patient_col = "USUBJID", paramcd = choices_selected( choices = variable_choices(ADLB, "PARAMCD"), selected = "PARAMCD" ), param = choices_selected( choices = variable_choices(ADLB, "PARAM"), selected = "PARAM" ), timepoints = choices_selected( choices = variable_choices(ADLB, "ADY"), selected = "ADY" ), anrind = choices_selected( choices = variable_choices(ADLB, "ANRIND"), selected = "ANRIND" ), aval_var = choices_selected( choices = variable_choices(ADLB, "AVAL"), selected = "AVAL" ), avalu_var = choices_selected( choices = variable_choices(ADLB, "AVALU"), selected = "AVALU" ), decorators = list(table = rlisting_footer(.var_to_replace = "table")) ), # ------------------------------------------------------------------------- tm_t_pp_basic_info( label = "Basic Info", dataname = "ADSL", patient_col = "USUBJID", vars = choices_selected(choices = variable_choices(ADSL), selected = c("ARM", "AGE", "SEX", "COUNTRY", "RACE", "EOSSTT")) , decorators = list( table = rlisting_footer(.var_to_replace = "table") ) ), # ------------------------------------------------------------------------- tm_t_mult_events( label = "Concomitant Medications by Medication Class and Preferred Name", dataname = "ADCM", arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), seq_var = choices_selected("CMSEQ", selected = "CMSEQ", fixed = TRUE), hlt = choices_selected( choices = variable_choices(ADCM, c("ATC1", "ATC2", "ATC3", "ATC4")), selected = c("ATC1", "ATC2", "ATC3", "ATC4") ), llt = choices_selected(choices = variable_choices(ADCM, c("CMDECOD")), selected = c("CMDECOD")), add_total = TRUE, event_type = "treatment", decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_logistic( label = "Logistic Regression", dataname = "ADRS", arm_var = choices_selected( choices = variable_choices(ADRS, c("ARM", "ARMCD")), selected = "ARM" ), arm_ref_comp = arm_ref_comp, paramcd = choices_selected( choices = value_choices(ADRS, "PARAMCD", "PARAM"), selected = "BESRSPI" ), cov_var = choices_selected( choices = c("SEX", "AGE", "BMRKR1", "BMRKR2"), selected = "SEX" ), decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_exposure( label = "Duration of Exposure Table", dataname = "ADEX", paramcd = choices_selected( choices = value_choices(data[["ADEX"]], "PARAMCD", "PARAM"), selected = "TDURD" ), col_by_var = choices_selected( choices = variable_choices(data[["ADEX"]], subset = c("SEX", "ARM")), selected = "SEX" ), row_by_var = choices_selected( choices = variable_choices(data[["ADEX"]], subset = c("RACE", "REGION1", "STRATA1", "SEX")), selected = "RACE" ), parcat = choices_selected( choices = value_choices(data[["ADEX"]], "PARCAT2"), selected = "Drug A" ), add_total = FALSE, decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_events( label = "Adverse Event Table", dataname = "ADAE", arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), llt = choices_selected( choices = variable_choices(ADAE, c("AETERM", "AEDECOD")), selected = c("AEDECOD") ), hlt = choices_selected( choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")), selected = "AEBODSYS" ), add_total = TRUE, event_type = "adverse event", decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_events_patyear( label = "AE Rate Adjusted for Patient-Years At Risk Table", dataname = "ADAETTE", arm_var = choices_selected( choices = variable_choices(ADSL, c("ARM", "ARMCD")), selected = "ARMCD" ), add_total = TRUE, events_var = choices_selected( choices = variable_choices(ADAETTE, "n_events"), selected = "n_events", fixed = TRUE ), paramcd = choices_selected( choices = value_choices(ADAETTE, "PARAMCD", "PARAM"), selected = "AETTE1" ), decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_events_by_grade( label = "Adverse Events by Grade Table", dataname = "ADAE", arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), llt = choices_selected( choices = variable_choices(ADAE, c("AETERM", "AEDECOD")), selected = c("AEDECOD") ), hlt = choices_selected( choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")), selected = "AEBODSYS" ), grade = choices_selected( choices = variable_choices(ADAE, c("AETOXGR", "AESEV")), selected = "AETOXGR" ), decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_coxreg( label = "Cox Reg.", dataname = "ADTTE", arm_var = choices_selected(c("ARM", "ARMCD", "ACTARMCD"), "ARM"), arm_ref_comp = arm_ref_comp, paramcd = choices_selected( value_choices(ADTTE, "PARAMCD", "PARAM"), "OS" ), strata_var = choices_selected( c("COUNTRY", "STRATA1", "STRATA2"), "STRATA1" ), cov_var = choices_selected( c("AGE", "BMRKR1", "BMRKR2", "REGION1"), "AGE" ), multivariate = TRUE, decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_abnormality( label = "Abnormality Table", dataname = "ADLB", arm_var = choices_selected( choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")), selected = "ARM" ), add_total = FALSE, by_vars = choices_selected( choices = variable_choices(ADLB, subset = c("LBCAT", "PARAM", "AVISIT")), selected = c("LBCAT", "PARAM"), keep_order = TRUE ), baseline_var = choices_selected( variable_choices(ADLB, subset = "BNRIND"), selected = "BNRIND", fixed = TRUE ), grade = choices_selected( choices = variable_choices(ADLB, subset = "ANRIND"), selected = "ANRIND", fixed = TRUE ), abnormal = list(low = "LOW", high = "HIGH"), exclude_base_abn = FALSE, decorators = list(insert_rrow_decorator("I am a good new row")) ), # ------------------------------------------------------------------------- tm_g_pp_vitals( label = "Vitals", dataname = "ADVS", parentname = "ADSL", patient_col = "USUBJID", plot_height = c(600L, 200L, 2000L), paramcd = choices_selected( choices = variable_choices(ADVS, "PARAMCD"), selected = "PARAMCD" ), xaxis = choices_selected( choices = variable_choices(ADVS, "ADY"), selected = "ADY" ), aval_var = choices_selected( choices = variable_choices(ADVS, "AVAL"), selected = "AVAL" ), decorators = list(plot = add_title_decorator("plot")) ), # ------------------------------------------------------------------------- tm_g_pp_adverse_events( label = "Adverse Events", dataname = "ADAE", parentname = "ADSL", patient_col = "USUBJID", plot_height = c(600L, 200L, 2000L), aeterm = choices_selected( choices = variable_choices(ADAE, "AETERM"), selected = "AETERM" ), tox_grade = choices_selected( choices = variable_choices(ADAE, "AETOXGR"), selected = "AETOXGR" ), causality = choices_selected( choices = variable_choices(ADAE, "AEREL"), selected = "AEREL" ), outcome = choices_selected( choices = variable_choices(ADAE, "AEOUT"), selected = "AEOUT" ), action = choices_selected( choices = variable_choices(ADAE, "AEACN"), selected = "AEACN" ), time = choices_selected( choices = variable_choices(ADAE, "ASTDY"), selected = "ASTDY" ), decod = NULL, decorators = list( plot = caption_decorator('I am a good caption', 'plot'), table = rlisting_footer(.var_to_replace = 'table') ) ), # ------------------------------------------------------------------------- tm_g_lineplot( label = "Line Plot", dataname = "ADLB", strata = choices_selected( variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")), "ARM" ), y = choices_selected( variable_choices(ADLB, c("AVAL", "BASE", "CHG", "PCHG")), "AVAL" ), param = choices_selected( value_choices(ADLB, "PARAMCD", "PARAM"), "ALT" ), decorators = list(add_cowplot_title_decorator("plot")) ), # ------------------------------------------------------------------------- tm_g_km( label = "Kaplan-Meier Plot", dataname = "ADTTE", arm_var = choices_selected( variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")), "ARM" ), paramcd = choices_selected( value_choices(ADTTE, "PARAMCD", "PARAM"), "OS" ), arm_ref_comp = arm_ref_comp, strata_var = choices_selected( variable_choices(ADSL, c("SEX", "BMRKR2")), "SEX" ), facet_var = choices_selected( variable_choices(ADSL, c("SEX", "BMRKR2")), NULL ), decorators = list(plot = add_cowplot_title_decorator(TRUE, "plot")) ), # ------------------------------------------------------------------------- tm_g_barchart_simple( label = "ADAE Analysis", x = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( ADSL, c( "ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2" ) ), selected = "ACTARM", multiple = FALSE ) ), fill = list( data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( ADSL, c( "ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2" ) ), selected = "SEX", multiple = FALSE ) ), data_extract_spec( dataname = "ADAE", select = select_spec( choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")), selected = NULL, multiple = FALSE ) ) ), x_facet = list( data_extract_spec( dataname = "ADAE", select = select_spec( choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")), selected = "AETOXGR", multiple = FALSE ) ), data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( ADSL, c( "ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2" ) ), selected = NULL, multiple = FALSE ) ) ), y_facet = list( data_extract_spec( dataname = "ADAE", select = select_spec( choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")), selected = "AESEV", multiple = FALSE ) ), data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( ADSL, c( "ARM", "ACTARM", "SEX", "RACE", "ITTFL", "SAFFL", "STRATA2" ) ), selected = NULL, multiple = FALSE ) ) ), decorators = list(plot = caption_decorator('The best', 'plot')) ) ) ) |> shiny::runApp() ```
Second App ```r # Load packages pkgload::load_all("../teal.modules.clinical", export_all = FALSE) # Example below insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") { teal_transform_module( label = "New row", ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption), server = make_teal_transform_server( substitute({ .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row)) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } # Preparation of the test case - use `EOSDY` and `DCSREAS` variables to demonstrate missing data. data <- teal_data() data <- within(data, { ADSL <- tmc_ex_adsl |> mutate( DTHFL = case_when( !is.na(DTHDT) ~ "Y", TRUE ~ "" ) %>% with_label("Subject Death Flag") ) ADSL$EOSDY[1] <- NA_integer_ ADAE <- tmc_ex_adae .add_event_flags <- function(dat) { dat <- dat %>% mutate( TMPFL_SER = AESER == "Y", TMPFL_REL = AEREL == "Y", TMPFL_GR5 = AETOXGR == "5", TMP_SMQ01 = !is.na(SMQ01NAM), TMP_SMQ02 = !is.na(SMQ02NAM), TMP_CQ01 = !is.na(CQ01NAM) ) column_labels <- list( TMPFL_SER = "Serious AE", TMPFL_REL = "Related AE", TMPFL_GR5 = "Grade 5 AE", TMP_SMQ01 = aesi_label(dat[["SMQ01NAM"]], dat[["SMQ01SC"]]), TMP_SMQ02 = aesi_label("Y.9.9.9.9/Z.9.9.9.9 AESI"), TMP_CQ01 = aesi_label(dat[["CQ01NAM"]]) ) col_labels(dat)[names(column_labels)] <- as.character(column_labels) dat } #' Generating user-defined event flags. ADAE <- ADAE %>% .add_event_flags() .ae_anl_vars <- names(ADAE)[startsWith(names(ADAE), "TMPFL_")] .aesi_vars <- names(ADAE)[startsWith(names(ADAE), "TMP_")] ADTTE <- tmc_ex_adtte # responder ADRS <- tmc_ex_adrs %>% mutate( AVALC = d_onco_rsp_label(AVALC) %>% with_label("Character Result/Finding") ) %>% filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP") ADQS <- tmc_ex_adqs %>% filter(ABLFL != "Y" & ABLFL2 != "Y") %>% filter(AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22")) %>% mutate( AVISIT = as.factor(AVISIT), AVISITN = rank(AVISITN) %>% as.factor() %>% as.numeric() %>% as.factor() #' making consecutive numeric factor ) }) join_keys(data) <- default_cdisc_join_keys[names(data)] ADSL <- data[["ADSL"]] ADRS <- data[["ADRS"]] app <- init( data = data, modules = modules( # ------------------------------------------------------------------------- tm_a_mmrm( label = "MMRM", dataname = "ADQS", aval_var = choices_selected(c("AVAL", "CHG"), "AVAL"), id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"), arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), visit_var = choices_selected(c("AVISIT", "AVISITN"), "AVISIT"), arm_ref_comp = arm_ref_comp, paramcd = choices_selected( choices = value_choices(data[["ADQS"]], "PARAMCD", "PARAM"), selected = "FKSI-FWB" ), cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL) , decorators = list( lsmeans_table = insert_rrow_decorator("A", .var_to_replace = "lsmeans_table") , lsmeans_plot = add_title_decorator("B", .var_to_replace = "lsmeans_plot") , covariance_table = insert_rrow_decorator("C", .var_to_replace = "covariance_table") , fixed_effects_table = insert_rrow_decorator("D", .var_to_replace = "fixed_effects_table") , diagnostic_table = insert_rrow_decorator(.var_to_replace = "diagnostic_table") , diagnostic_plot = add_title_decorator(.var_to_replace = "diagnostic_plot") ) ), # ------------------------------------------------------------------------- tm_t_binary_outcome( label = "Responders", dataname = "ADRS", paramcd = choices_selected( choices = value_choices(ADRS, "PARAMCD", "PARAM"), selected = "BESRSPI" ), arm_var = choices_selected( choices = variable_choices(ADRS, c("ARM", "ARMCD", "ACTARMCD")), selected = "ARM" ), arm_ref_comp = arm_ref_comp, strata_var = choices_selected( choices = variable_choices(ADRS, c("SEX", "BMRKR2", "RACE")), selected = "RACE" ), default_responses = list( BESRSPI = list( rsp = c("Complete Response (CR)", "Partial Response (PR)"), levels = c( "Complete Response (CR)", "Partial Response (PR)", "Stable Disease (SD)", "Progressive Disease (PD)" ) ), INVET = list( rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"), levels = c( "Complete Response (CR)", "Not Evaluable (NE)", "Partial Response (PR)", "Progressive Disease (PD)", "Stable Disease (SD)" ) ), OVRINV = list( rsp = c("Progressive Disease (PD)", "Stable Disease (SD)"), levels = c("Progressive Disease (PD)", "Stable Disease (SD)", "Not Evaluable (NE)") ) ), decorators = list(insert_rrow_decorator("I am a new row")) ), # ------------------------------------------------------------------------- tm_t_events_summary( label = "Adverse Events Summary", dataname = "ADAE", arm_var = choices_selected( choices = variable_choices("ADSL", c("ARM", "ARMCD")), selected = "ARM" ), flag_var_anl = choices_selected( choices = variable_choices("ADAE", data[[".ae_anl_vars"]]), selected = data[[".ae_anl_vars"]][1], keep_order = TRUE, fixed = FALSE ), flag_var_aesi = choices_selected( choices = variable_choices("ADAE", data[[".aesi_vars"]]), selected = data[[".aesi_vars"]][1], keep_order = TRUE, fixed = FALSE ), add_total = TRUE, decorators = list(insert_rrow_decorator()) ), # ------------------------------------------------------------------------- tm_t_summary( label = "Demographic Table", dataname = "ADSL", arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"), add_total = TRUE, summarize_vars = choices_selected( c("SEX", "RACE", "BMRKR2", "EOSDY", "DCSREAS", "AGE"), c("SEX", "RACE") ), useNA = "ifany", decorators = list(insert_rrow_decorator()) ) ) ) |> shiny::runApp() ```
--------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Signed-off-by: Lluís Revilla <185338939+llrs-roche@users.noreply.github.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: m7pr Co-authored-by: Lluís Revilla <185338939+llrs-roche@users.noreply.github.com> Co-authored-by: Lluís Revilla Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> --- .pre-commit-config.yaml | 4 +- R/argument_convention.R | 8 + R/tm_a_gee.R | 58 +++++-- R/tm_a_mmrm.R | 163 ++++++++++++++---- R/tm_g_barchart_simple.R | 39 +++-- R/tm_g_ci.R | 40 ++++- R/tm_g_forest_rsp.R | 36 +++- R/tm_g_forest_tte.R | 36 +++- R/tm_g_ipp.R | 35 +++- R/tm_g_km.R | 36 +++- R/tm_g_lineplot.R | 40 +++-- R/tm_g_pp_adverse_events.R | 95 +++++++--- R/tm_g_pp_patient_timeline.R | 40 ++++- R/tm_g_pp_therapy.R | 78 +++++++-- R/tm_g_pp_vitals.R | 39 ++++- R/tm_t_abnormality.R | 37 +++- R/tm_t_abnormality_by_worst_grade.R | 37 +++- R/tm_t_ancova.R | 39 ++++- R/tm_t_binary_outcome.R | 40 +++-- R/tm_t_coxreg.R | 71 +++++--- R/tm_t_events.R | 46 +++-- R/tm_t_events_by_grade.R | 49 ++++-- R/tm_t_events_patyear.R | 41 +++-- R/tm_t_events_summary.R | 67 ++++--- R/tm_t_exposure.R | 41 +++-- R/tm_t_logistic.R | 42 ++++- R/tm_t_mult_events.R | 37 +++- R/tm_t_pp_basic_info.R | 45 +++-- R/tm_t_pp_laboratory.R | 96 +++++++---- R/tm_t_pp_medical_history.R | 45 +++-- R/tm_t_pp_prior_medication.R | 71 ++++++-- R/tm_t_shift_by_arm.R | 42 +++-- R/tm_t_shift_by_arm_by_worst.R | 42 +++-- R/tm_t_shift_by_grade.R | 39 ++++- R/tm_t_smq.R | 40 ++++- R/tm_t_summary.R | 45 +++-- R/tm_t_summary_by.R | 44 +++-- R/tm_t_tte.R | 38 +++- R/utils.R | 136 +++++++++++++++ inst/WORDLIST | 1 + man/module_arguments.Rd | 9 + man/normalize_decorators.Rd | 18 ++ man/select_decorators.Rd | 22 +++ man/srv_decorate_teal_data.Rd | 35 ++++ man/tm_a_gee.Rd | 24 ++- man/tm_a_mmrm.Rd | 45 ++++- man/tm_g_barchart_simple.Rd | 24 ++- man/tm_g_ci.Rd | 24 ++- man/tm_g_forest_rsp.Rd | 24 ++- man/tm_g_forest_tte.Rd | 24 ++- man/tm_g_ipp.Rd | 24 ++- man/tm_g_km.Rd | 24 ++- man/tm_g_lineplot.Rd | 24 ++- man/tm_g_pp_adverse_events.Rd | 40 ++++- man/tm_g_pp_patient_timeline.Rd | 24 ++- man/tm_g_pp_therapy.Rd | 40 ++++- man/tm_g_pp_vitals.Rd | 24 ++- man/tm_t_abnormality.Rd | 24 ++- man/tm_t_abnormality_by_worst_grade.Rd | 24 ++- man/tm_t_ancova.Rd | 24 ++- man/tm_t_binary_outcome.Rd | 24 ++- man/tm_t_coxreg.Rd | 24 ++- man/tm_t_events.Rd | 24 ++- man/tm_t_events_by_grade.Rd | 24 ++- man/tm_t_events_patyear.Rd | 24 ++- man/tm_t_events_summary.Rd | 24 ++- man/tm_t_exposure.Rd | 24 ++- man/tm_t_logistic.Rd | 24 ++- man/tm_t_mult_events.Rd | 24 ++- man/tm_t_pp_basic_info.Rd | 24 ++- man/tm_t_pp_laboratory.Rd | 24 ++- man/tm_t_pp_medical_history.Rd | 24 ++- man/tm_t_pp_prior_medication.Rd | 24 ++- man/tm_t_shift_by_arm.Rd | 24 ++- man/tm_t_shift_by_arm_by_worst.Rd | 24 ++- man/tm_t_shift_by_grade.Rd | 24 ++- man/tm_t_smq.Rd | 24 ++- man/tm_t_summary.Rd | 24 ++- man/tm_t_summary_by.Rd | 24 ++- man/tm_t_tte.Rd | 24 ++- tests/testthat/_snaps/tm_a_gee.md | 26 ++- tests/testthat/_snaps/tm_a_mmrm.md | 10 +- tests/testthat/_snaps/tm_g_ci.md | 12 +- tests/testthat/_snaps/tm_g_forest_rsp.md | 4 +- tests/testthat/_snaps/tm_g_forest_tte.md | 4 +- tests/testthat/_snaps/tm_g_km.md | 3 - tests/testthat/_snaps/tm_g_lineplot.md | 2 - tests/testthat/_snaps/tm_t_abnormality.md | 9 +- .../_snaps/tm_t_abnormality_by_worst_grade.md | 6 +- tests/testthat/_snaps/tm_t_ancova.md | 21 +-- tests/testthat/_snaps/tm_t_binary_outcome.md | 21 +-- tests/testthat/_snaps/tm_t_coxreg.md | 7 +- tests/testthat/_snaps/tm_t_events.md | 46 ++--- tests/testthat/_snaps/tm_t_events_by_grade.md | 8 - tests/testthat/_snaps/tm_t_events_patyear.md | 9 +- tests/testthat/_snaps/tm_t_events_summary.md | 16 +- tests/testthat/_snaps/tm_t_exposure.md | 12 +- tests/testthat/_snaps/tm_t_logisitic.md | 9 +- tests/testthat/_snaps/tm_t_mult_events.md | 18 +- .../_snaps/tm_t_pp_medical_history.md | 5 +- tests/testthat/_snaps/tm_t_shift_by_arm.md | 9 +- .../_snaps/tm_t_shift_by_arm_by_worst.md | 9 +- tests/testthat/_snaps/tm_t_shift_by_grade.md | 6 +- tests/testthat/_snaps/tm_t_smq.md | 6 +- tests/testthat/_snaps/tm_t_summary.md | 18 +- tests/testthat/_snaps/tm_t_summary_by.md | 15 +- tests/testthat/_snaps/tm_t_tte.md | 4 - 107 files changed, 2612 insertions(+), 682 deletions(-) create mode 100644 man/normalize_decorators.Rd create mode 100644 man/select_decorators.Rd create mode 100644 man/srv_decorate_teal_data.Rd diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 30be9922fb..dc5788b75b 100755 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -33,7 +33,6 @@ repos: - methods - rlistings - rmarkdown - - rtables - scales - shiny - shinyjs @@ -48,6 +47,9 @@ repos: - insightsengineering/teal.widgets - insightsengineering/tern.gee - insightsengineering/tern.mmrm + - insightsengineering/rtables + - insightsengineering/rtables.officer + - insightsengineering/formatters - utils - vistime - id: spell-check diff --git a/R/argument_convention.R b/R/argument_convention.R index f9cbcfb961..6c70ef2608 100644 --- a/R/argument_convention.R +++ b/R/argument_convention.R @@ -203,6 +203,14 @@ NULL #' value indicating worst grade. #' @param worst_flag_var ([teal.transform::choices_selected()])\cr object #' with all available choices and preselected option for variable names that can be used as worst flag variable. +#' @param decorators `r lifecycle::badge("experimental")` +#' " (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or" `NULL`) optional, +#' if not `NULL`, decorator for tables or plots included in the module. +#' When a named list of `teal_transform_module`, the decorators are applied to the respective output objects. +#' +#' Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`. +#' +#' See section "Decorating Module" below for more details. #' #' @return a `teal_module` object. #' diff --git a/R/tm_a_gee.R b/R/tm_a_gee.R index 8426a72662..3a4d354f4a 100644 --- a/R/tm_a_gee.R +++ b/R/tm_a_gee.R @@ -69,9 +69,9 @@ template_a_gee <- function(output_table, if (output_table == "t_gee_cov") { substitute( expr = { - result_table <- tern.gee::as.rtable(model_fit, type = "cov") - subtitles(result_table) <- st - main_footer(result_table) <- mf + table <- tern.gee::as.rtable(model_fit, type = "cov") + subtitles(table) <- st + main_footer(table) <- mf }, env = list( st = basic_table_args$subtitles, @@ -81,9 +81,9 @@ template_a_gee <- function(output_table, } else if (output_table == "t_gee_coef") { substitute( expr = { - result_table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients)) - subtitles(result_table) <- st - main_footer(result_table) <- mf + table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients)) + subtitles(table) <- st + main_footer(table) <- mf }, env = list( conf_level = conf_level, @@ -95,7 +95,7 @@ template_a_gee <- function(output_table, substitute( expr = { lsmeans_fit_model <- tern.gee::lsmeans(model_fit, conf_level) - result_table <- rtables::basic_table(show_colcounts = TRUE) %>% + table <- rtables::basic_table(show_colcounts = TRUE) %>% rtables::split_cols_by(var = input_arm_var, ref_group = model_fit$ref_level) %>% tern.gee::summarize_gee_logistic() %>% rtables::build_table( @@ -103,9 +103,8 @@ template_a_gee <- function(output_table, alt_counts_df = dataname_lsmeans ) - subtitles(result_table) <- st - main_footer(result_table) <- mf - result_table + subtitles(table) <- st + main_footer(table) <- mf }, env = list( dataname_lsmeans = as.name(dataname_lsmeans), @@ -135,6 +134,14 @@ template_a_gee <- function(output_table, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -200,7 +207,8 @@ tm_a_gee <- function(label, conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_a_gee (prototype)") cov_var <- teal.transform::add_no_selected_choices(cov_var, multiple = TRUE) @@ -218,6 +226,8 @@ tm_a_gee <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- as.list(environment()) @@ -243,7 +253,8 @@ tm_a_gee <- function(label, parentname = parentname, arm_ref_comp = arm_ref_comp, label = label, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -358,7 +369,8 @@ ui_gee <- function(id, ...) { "Coefficients" = "t_gee_coef" ), selected = "t_gee_lsmeans" - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -385,7 +397,8 @@ srv_gee <- function(id, label, plot_height, plot_width, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -546,9 +559,15 @@ srv_gee <- function(id, output_title }) - table_r <- reactive({ - table_q()[["result_table"]] - }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + # Outputs to render. + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -556,9 +575,10 @@ srv_gee <- function(id, ) # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = source_code_r, title = label ) @@ -582,7 +602,7 @@ srv_gee <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_a_mmrm.R b/R/tm_a_mmrm.R index 59039b41ce..63455af4fd 100644 --- a/R/tm_a_mmrm.R +++ b/R/tm_a_mmrm.R @@ -273,7 +273,6 @@ template_mmrm_tables <- function(parentname, df = df_explicit_na(broom::tidy(fit_mmrm), na_level = default_na_str()), alt_counts_df = parentname ) - lsmeans_table }, env = list( parentname = as.name(parentname), @@ -284,9 +283,8 @@ template_mmrm_tables <- function(parentname, t_mmrm_cov = { y$cov_matrix <- substitute( expr = { - cov_matrix <- tern.mmrm::as.rtable(fit_mmrm, type = "cov") - subtitles(cov_matrix) <- st - cov_matrix + covariance_table <- tern.mmrm::as.rtable(fit_mmrm, type = "cov") + subtitles(covariance_table) <- st }, env = list( fit_mmrm = as.name(fit_name), @@ -297,9 +295,8 @@ template_mmrm_tables <- function(parentname, t_mmrm_fixed = { y$fixed_effects <- substitute( expr = { - fixed_effects <- tern.mmrm::as.rtable(fit_mmrm, type = "fixed") - subtitles(fixed_effects) <- st - fixed_effects + fixed_effects_table <- tern.mmrm::as.rtable(fit_mmrm, type = "fixed") + subtitles(fixed_effects_table) <- st }, env = list( fit_mmrm = as.name(fit_name), @@ -312,7 +309,6 @@ template_mmrm_tables <- function(parentname, expr = { diagnostic_table <- tern.mmrm::as.rtable(fit_mmrm, type = "diagnostic") subtitles(diagnostic_table) <- st - diagnostic_table }, env = list( fit_mmrm = as.name(fit_name), @@ -462,6 +458,35 @@ template_mmrm_plots <- function(fit_name, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `lsmeans_plot` (`ggplot2`) +#' - `diagnostic_plot` (`TableTree`- output from `rtables::build_table`) +#' - `lsmeans_table` (`TableTree`- output from `rtables::build_table`) +#' - `covariance_table` (`TableTree`- output from `rtables::build_table`) +#' - `fixed_effects_table` (`TableTree`- output from `rtables::build_table`) +#' - `diagnostic_table` (`TableTree`- output from `rtables::build_table`) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_a_mrmm( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' lsmeans_plot = list(teal_transform_module(...)) # applied only to `lsmeans_plot` output +#' diagnostic_plot = list(teal_transform_module(...)) # applied only to `diagnostic_plot` output +#' lsmeans_table = list(teal_transform_module(...)) # applied only to `lsmeans_table` output +#' covariance_table = list(teal_transform_module(...)) # applied only to `covariance_table` output +#' fixed_effects_table = list(teal_transform_module(...)) # applied only to `fixed_effects_table` output +#' diagnostic_table = list(teal_transform_module(...)) # applied only to `diagnostic_table` output +#' ) +#' ) +#' ``` #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -543,7 +568,8 @@ tm_a_mmrm <- function(label, pre_output = NULL, post_output = NULL, basic_table_args = teal.widgets::basic_table_args(), - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_a_mmrm") cov_var <- teal.transform::add_no_selected_choices(cov_var, multiple = TRUE) checkmate::assert_string(label) @@ -572,6 +598,20 @@ tm_a_mmrm <- function(label, checkmate::assert_list(ggplot2_args, types = "ggplot2_args") checkmate::assert_subset(names(ggplot2_args), c("default", plot_choices)) + decorators <- normalize_decorators(decorators) + assert_decorators( + decorators, + c( + "lsmeans_table", + "lsmeans_plot", + "covariance_table", + "fixed_effects_table", + "diagnostic_table", + "diagnostic_plot" + ), + null.ok = TRUE + ) + args <- as.list(environment()) data_extract_list <- list( @@ -600,7 +640,8 @@ tm_a_mmrm <- function(label, plot_height = plot_height, plot_width = plot_width, basic_table_args = basic_table_args, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -754,6 +795,32 @@ ui_mmrm <- function(id, ...) { ), selected = "t_mmrm_lsmeans" ), + # Decorators --- + conditionalPanel( + condition = sprintf("input['%s'] == '%s'", ns("output_function"), "t_mmrm_lsmeans"), + ui_decorate_teal_data(ns("d_lsmeans_table"), select_decorators(a$decorators, "lsmeans_table")) + ), + conditionalPanel( + condition = sprintf("input['%s'] == '%s'", ns("output_function"), "g_mmrm_lsmeans"), + ui_decorate_teal_data(ns("d_lsmeans_plot"), select_decorators(a$decorators, "lsmeans_plot")) + ), + conditionalPanel( + condition = sprintf("input['%s'] == '%s'", ns("output_function"), "t_mmrm_cov"), + ui_decorate_teal_data(ns("d_covariance_table"), select_decorators(a$decorators, "covariance_table")) + ), + conditionalPanel( + condition = sprintf("input['%s'] == '%s'", ns("output_function"), "t_mmrm_fixed"), + ui_decorate_teal_data(ns("d_fixed_effects_table"), select_decorators(a$decorators, "fixed_effects_table")) + ), + conditionalPanel( + condition = sprintf("input['%s'] == '%s'", ns("output_function"), "t_mmrm_diagnostic"), + ui_decorate_teal_data(ns("d_diagnostic_table"), select_decorators(a$decorators, "diagnostic_table")) + ), + conditionalPanel( + condition = sprintf("input['%s'] == '%s'", ns("output_function"), "g_mmrm_diagnostic"), + ui_decorate_teal_data(ns("d_diagnostic_plot"), select_decorators(a$decorators, "diagnostic_plot")) + ), + # End of Decorators --- conditionalPanel( condition = paste0( "input['", ns("output_function"), "'] == 't_mmrm_lsmeans'", " || ", @@ -843,7 +910,8 @@ srv_mmrm <- function(id, plot_height, plot_width, basic_table_args, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -1399,30 +1467,62 @@ srv_mmrm <- function(id, teal.code::eval_code(qenv, as.expression(mmrm_plot_expr)) }) - all_q <- reactive({ - if (!is.null(plot_q()) && !is.null(table_q())) { - c(plot_q(), table_q()) - } else if (!is.null(plot_q())) { - plot_q() - } else { - table_q() + decorated_tables_q <- lapply( + stats::setNames( + nm = c("lsmeans_table", "diagnostic_table", "fixed_effects_table", "covariance_table") + ), + function(output_function) { + srv_decorate_teal_data( + id = sprintf("d_%s", output_function), + data = table_q, + decorators = select_decorators(decorators, output_function), + expr = reactive(bquote(.(as.name(output_function)))), + expr_is_reactive = TRUE + ) } - }) + ) - table_r <- reactive({ + decorated_objs_q <- c( + decorated_tables_q, + lapply( + stats::setNames(nm = c("lsmeans_plot", "diagnostic_plot")), + function(output_function) { + srv_decorate_teal_data( + id = sprintf("d_%s", output_function), + data = plot_q, + decorators = select_decorators(decorators, output_function), + expr = reactive(bquote(.(as.name(output_function)))), + expr_is_reactive = TRUE + ) + } + ) + ) + + obj_ix_r <- reactive({ switch(input$output_function, - t_mmrm_lsmeans = table_q()[["lsmeans_table"]], - t_mmrm_diagnostic = table_q()[["diagnostic_table"]], - t_mmrm_fixed = table_q()[["fixed_effects"]], - t_mmrm_cov = table_q()[["cov_matrix"]] + t_mmrm_lsmeans = "lsmeans_table", + t_mmrm_diagnostic = "diagnostic_table", + t_mmrm_fixed = "fixed_effects_table", + t_mmrm_cov = "covariance_table", + g_mmrm_lsmeans = "lsmeans_plot", + g_mmrm_diagnostic = "diagnostic_plot" ) }) plot_r <- reactive({ - switch(input$output_function, - g_mmrm_lsmeans = plot_q()[["lsmeans_plot"]], - g_mmrm_diagnostic = plot_q()[["diagnostic_plot"]] - ) + if (is.null(plot_q())) { + NULL + } else { + decorated_objs_q[[obj_ix_r()]]()[[obj_ix_r()]] + } + }) + + table_r <- reactive({ + if (is.null(table_q())) { + NULL + } else { + decorated_objs_q[[obj_ix_r()]]()[[obj_ix_r()]] + } }) pws <- teal.widgets::plot_with_settings_srv( @@ -1440,9 +1540,12 @@ srv_mmrm <- function(id, ) # Show R code once button is pressed. + source_code_r <- reactive( + teal.code::get_code(req(decorated_objs_q[[obj_ix_r()]]())) + ) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, disabled = disable_r_code, title = "R Code for the Current MMRM Analysis" ) @@ -1472,7 +1575,7 @@ srv_mmrm <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_barchart_simple.R b/R/tm_g_barchart_simple.R index ecd8d463aa..6650fdfd04 100644 --- a/R/tm_g_barchart_simple.R +++ b/R/tm_g_barchart_simple.R @@ -15,6 +15,14 @@ #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -146,7 +154,8 @@ tm_g_barchart_simple <- function(x = NULL, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_barchart_simple") checkmate::assert_string(label) checkmate::assert_list(plot_options, null.ok = TRUE) @@ -171,6 +180,8 @@ tm_g_barchart_simple <- function(x = NULL, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, names = "plot", null.ok = TRUE) plot_options <- utils::modifyList( list(stacked = FALSE), # default @@ -190,7 +201,8 @@ tm_g_barchart_simple <- function(x = NULL, y_facet = y_facet, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ), datanames = "all" ) @@ -249,6 +261,7 @@ ui_g_barchart_simple <- function(id, ...) { is_single_dataset = is_single_dataset_value ) }, + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional plot settings", @@ -336,7 +349,8 @@ srv_g_barchart_simple <- function(id, y_facet, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -506,13 +520,16 @@ srv_g_barchart_simple <- function(id, ) )) %>% teal.code::eval_code(code = plot_call) - - # explicitly calling print on the plot inside the qenv evaluates - # the ggplot call and therefore catches errors - teal.code::eval_code(all_q, code = quote(print(plot))) }) - plot_r <- reactive(all_q()[["plot"]]) + decorated_all_q_code <- srv_decorate_teal_data( + "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + + plot_r <- reactive(decorated_all_q_code()[["plot"]]) output$table <- renderTable({ req(iv_r()$is_valid()) @@ -548,9 +565,11 @@ srv_g_barchart_simple <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q_code()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = "Bar Chart" ) @@ -569,7 +588,7 @@ srv_g_barchart_simple <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_ci.R b/R/tm_g_ci.R index 46d4ee8652..04a5f123c8 100644 --- a/R/tm_g_ci.R +++ b/R/tm_g_ci.R @@ -171,8 +171,7 @@ template_g_ci <- function(dataname, substitute( expr = { - gg <- graph_expr - print(gg) + plot <- graph_expr }, env = list(graph_expr = pipe_expr(graph_list, pipe_str = "+")) ) @@ -189,6 +188,14 @@ template_g_ci <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -275,7 +282,8 @@ tm_g_ci <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_ci") checkmate::assert_string(label) stat <- match.arg(stat) @@ -293,6 +301,8 @@ tm_g_ci <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) args <- as.list(environment()) @@ -306,7 +316,8 @@ tm_g_ci <- function(label, label = label, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ), ui = ui_g_ci, ui_args = args, @@ -355,7 +366,8 @@ ui_g_ci <- function(id, ...) { label = "Statistic to use", choices = c("mean", "median"), selected = args$stat - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code") @@ -376,7 +388,8 @@ srv_g_ci <- function(id, label, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -466,11 +479,20 @@ srv_g_ci <- function(id, teal.code::eval_code(anl_q(), list_calls) }) - plot_r <- reactive(all_q()[["gg"]]) + decorated_plot_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + # Outputs to render. + plot_r <- reactive(decorated_plot_q()[["plot"]]) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_plot_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -497,7 +519,7 @@ srv_g_ci <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_forest_rsp.R b/R/tm_g_forest_rsp.R index 37c042fa0e..bc9369bc14 100644 --- a/R/tm_g_forest_rsp.R +++ b/R/tm_g_forest_rsp.R @@ -211,7 +211,7 @@ template_forest_rsp <- function(dataname = "ANL", plot_list, substitute( expr = { - p <- cowplot::plot_grid( + plot <- cowplot::plot_grid( f[["table"]] + ggplot2::labs(title = ggplot2_args_title), f[["plot"]] + ggplot2::labs(caption = ggplot2_args_caption), align = "h", @@ -243,6 +243,14 @@ template_forest_rsp <- function(dataname = "ANL", #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -355,7 +363,8 @@ tm_g_forest_rsp <- function(label, font_size = c(15L, 1L, 30L), pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_forest_rsp") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -381,6 +390,8 @@ tm_g_forest_rsp <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) args <- as.list(environment()) @@ -409,7 +420,8 @@ tm_g_forest_rsp <- function(label, default_responses = default_responses, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -475,6 +487,7 @@ ui_g_forest_rsp <- function(id, ...) { data_extract_spec = a$strata_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional plot settings", @@ -529,7 +542,8 @@ srv_g_forest_rsp <- function(id, plot_width, label, default_responses, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -761,7 +775,13 @@ srv_g_forest_rsp <- function(id, teal.code::eval_code(anl_q(), as.expression(unlist(my_calls))) }) - plot_r <- reactive(all_q()[["p"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) pws <- teal.widgets::plot_with_settings_srv( id = "myplot", @@ -770,9 +790,11 @@ srv_g_forest_rsp <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -791,7 +813,7 @@ srv_g_forest_rsp <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_forest_tte.R b/R/tm_g_forest_tte.R index f4c3c86f4a..f70b0cfbc6 100644 --- a/R/tm_g_forest_tte.R +++ b/R/tm_g_forest_tte.R @@ -210,7 +210,7 @@ template_forest_tte <- function(dataname = "ANL", plot_list, substitute( expr = { - p <- cowplot::plot_grid( + plot <- cowplot::plot_grid( f[["table"]] + ggplot2::labs(title = ggplot2_args_title, subtitle = ggplot2_args_subtitle), f[["plot"]] + ggplot2::labs(caption = ggplot2_args_caption), align = "h", @@ -243,6 +243,14 @@ template_forest_tte <- function(dataname = "ANL", #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -339,7 +347,8 @@ tm_g_forest_tte <- function(label, font_size = c(15L, 1L, 30L), pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_forest_tte") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -367,6 +376,8 @@ tm_g_forest_tte <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) args <- as.list(environment()) @@ -395,7 +406,8 @@ tm_g_forest_tte <- function(label, riskdiff = riskdiff, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -468,6 +480,7 @@ ui_g_forest_tte <- function(id, ...) { data_extract_spec = a$strata_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional plot settings", @@ -528,7 +541,8 @@ srv_g_forest_tte <- function(id, riskdiff, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -691,7 +705,13 @@ srv_g_forest_tte <- function(id, }) # Outputs to render. - plot_r <- reactive(all_q()[["p"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) pws <- teal.widgets::plot_with_settings_srv( id = "myplot", @@ -700,9 +720,11 @@ srv_g_forest_tte <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = "R Code for the Current Time-to-Event Forest Plot" ) @@ -721,7 +743,7 @@ srv_g_forest_tte <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_ipp.R b/R/tm_g_ipp.R index 3c6a7be5f6..3cd65e3b81 100644 --- a/R/tm_g_ipp.R +++ b/R/tm_g_ipp.R @@ -179,6 +179,15 @@ template_g_ipp <- function(dataname = "ANL", #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -293,7 +302,8 @@ tm_g_ipp <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { if (lifecycle::is_present(base_var)) { baseline_var <- base_var warning( @@ -329,6 +339,8 @@ tm_g_ipp <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) args <- as.list(environment()) data_extract_list <- list( @@ -354,7 +366,8 @@ tm_g_ipp <- function(label, parentname = parentname, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -428,6 +441,7 @@ ui_g_ipp <- function(id, ...) { data_extract_spec = a$baseline_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional plot settings", @@ -479,7 +493,8 @@ srv_g_ipp <- function(id, plot_height, plot_width, label, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -611,7 +626,13 @@ srv_g_ipp <- function(id, }) # Outputs to render. - plot_r <- reactive(all_q()[["plot"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) # Insert the plot into a plot with settings module from teal.widgets pws <- teal.widgets::plot_with_settings_srv( @@ -621,9 +642,11 @@ srv_g_ipp <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -642,7 +665,7 @@ srv_g_ipp <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_km.R b/R/tm_g_km.R index 861baab819..e96d79aa11 100644 --- a/R/tm_g_km.R +++ b/R/tm_g_km.R @@ -230,7 +230,6 @@ template_g_km <- function(dataname = "ANL", plotlist = plot_list, ncol = 1 ) - plot }, env = list( facet_var = if (length(facet_var) != 0L) as.name(facet_var), @@ -271,6 +270,15 @@ template_g_km <- function(dataname = "ANL", #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -364,7 +372,8 @@ tm_g_km <- function(label, plot_height = c(800L, 400L, 5000L), plot_width = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_g_km") checkmate::assert_string(label) @@ -387,6 +396,8 @@ tm_g_km <- function(label, ) checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) args <- as.list(environment()) data_extract_list <- list( @@ -415,7 +426,8 @@ tm_g_km <- function(label, plot_width = plot_width, control_annot_surv_med = control_annot_surv_med, control_annot_coxph = control_annot_coxph, - legend_pos = legend_pos + legend_pos = legend_pos, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -512,6 +524,7 @@ ui_g_km <- function(id, ...) { ) ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")), conditionalPanel( condition = paste0("input['", ns("compare_arms"), "']"), teal.widgets::panel_group( @@ -635,7 +648,8 @@ srv_g_km <- function(id, plot_width, control_annot_surv_med, control_annot_coxph, - legend_pos) { + legend_pos, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -809,7 +823,13 @@ srv_g_km <- function(id, teal.code::eval_code(anl_q(), as.expression(unlist(my_calls))) }) - plot_r <- reactive(all_q()[["plot"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) # Insert the plot into a plot with settings module from teal.widgets pws <- teal.widgets::plot_with_settings_srv( @@ -819,9 +839,11 @@ srv_g_km <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -841,7 +863,7 @@ srv_g_km <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_lineplot.R b/R/tm_g_lineplot.R index bcaa321eb2..9cead84851 100644 --- a/R/tm_g_lineplot.R +++ b/R/tm_g_lineplot.R @@ -195,10 +195,7 @@ template_g_lineplot <- function(dataname = "ANL", graph_list <- add_expr( graph_list, substitute( - expr = { - plot <- plot_call - plot - }, + expr = plot <- plot_call, env = list(plot_call = plot_call) ) ) @@ -217,6 +214,14 @@ template_g_lineplot <- function(dataname = "ANL", #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -301,7 +306,8 @@ tm_g_lineplot <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { if (lifecycle::is_present(strata)) { warning( "The `strata` argument of `tm_g_lineplot()` is deprecated as of teal.modules.clinical 0.9.1. ", @@ -341,6 +347,9 @@ tm_g_lineplot <- function(label, checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) + args <- as.list(environment()) data_extract_list <- list( group_var = cs_to_des_select(group_var, dataname = parentname), @@ -364,7 +373,8 @@ tm_g_lineplot <- function(label, parentname = parentname, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -446,6 +456,7 @@ ui_g_lineplot <- function(id, ...) { "Include screening visit", value = TRUE ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional plot settings", @@ -543,7 +554,8 @@ srv_g_lineplot <- function(id, label, plot_height, plot_width, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -658,7 +670,13 @@ srv_g_lineplot <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) - plot_r <- reactive(all_q()[["plot"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) # Insert the plot into a plot with settings module from teal.widgets pws <- teal.widgets::plot_with_settings_srv( @@ -668,9 +686,11 @@ srv_g_lineplot <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -689,7 +709,7 @@ srv_g_lineplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_pp_adverse_events.R b/R/tm_g_pp_adverse_events.R index 95f1356daf..674827b119 100644 --- a/R/tm_g_pp_adverse_events.R +++ b/R/tm_g_pp_adverse_events.R @@ -47,7 +47,7 @@ template_adverse_events <- function(dataname = "ANL", list(), substitute( expr = { - table <- dataname %>% + table_data <- dataname %>% dplyr::select( aeterm, tox_grade, causality, outcome, action, time, decod ) %>% @@ -58,14 +58,12 @@ template_adverse_events <- function(dataname = "ANL", dplyr::where(~ inherits(., what = "difftime")), ~ as.double(., units = "auto") ) ) - table <- rlistings::as_listing( - table, + table_output <- rlistings::as_listing( + table_data, key_cols = NULL, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(table) <- paste("Patient ID:", patient_id) - - table + main_title(table_output) <- paste("Patient ID:", patient_id) }, env = list( dataname = as.name(dataname), @@ -110,7 +108,7 @@ template_adverse_events <- function(dataname = "ANL", chart_list <- add_expr( list(), substitute( - expr = plot <- dataname %>% + expr = plot_output <- dataname %>% dplyr::select(aeterm, time, tox_grade, causality) %>% dplyr::mutate(ATOXGR = as.character(tox_grade)) %>% dplyr::arrange(dplyr::desc(ATOXGR)) %>% @@ -156,11 +154,6 @@ template_adverse_events <- function(dataname = "ANL", ) ) - chart_list <- add_expr( - expr_ls = chart_list, - new_expr = quote(plot) - ) - y$table <- bracket_expr(table_list) y$chart <- bracket_expr(chart_list) @@ -190,6 +183,31 @@ template_adverse_events <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Modules: +#' +#' This module generates the following objects, which can be modified in place using decorators:: +#' - `plot` (`ggplot2`) +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_g_pp_adverse_events( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' plot = list(teal_transform_module(...)), # applied only to `plot` output +#' table = list(teal_transform_module(...)) # applied only to `table` output +#' ) +#' ) +#' ``` +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -268,7 +286,8 @@ tm_g_pp_adverse_events <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_pp_adverse_events") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -293,6 +312,8 @@ tm_g_pp_adverse_events <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, names = c("plot", "table"), null.ok = TRUE) args <- as.list(environment()) data_extract_list <- list( @@ -319,7 +340,8 @@ tm_g_pp_adverse_events <- function(label, patient_col = patient_col, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -408,6 +430,8 @@ ui_g_adverse_events <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), + ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(ui_args$decorators, "table")), + ui_decorate_teal_data(ns("d_plot"), decorators = select_decorators(ui_args$decorators, "plot")), teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -445,7 +469,8 @@ srv_g_adverse_events <- function(id, plot_height, plot_width, label, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -564,14 +589,29 @@ srv_g_adverse_events <- function(id, paste("
Patient ID:", all_q()[["pt_id"]], "
") }) - output$table <- DT::renderDataTable( - expr = teal.code::dev_suppress(all_q()[["table"]]), - options = list(pageLength = input$table_rows) + # Allow for the table and plot qenv to be joined + table_q <- reactive(within(all_q(), table <- table_output)) + plot_q <- reactive(within(all_q(), plot <- plot_output)) + + decorated_all_q_table <- srv_decorate_teal_data( + "d_table", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + decorated_all_q_plot <- srv_decorate_teal_data( + "d_plot", + data = plot_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) ) + table_r <- reactive(teal.code::dev_suppress(decorated_all_q_table()[["table"]])) + plot_r <- reactive({ req(iv_r()$is_valid()) - all_q()[["plot"]] + decorated_all_q_plot()[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -581,9 +621,20 @@ srv_g_adverse_events <- function(id, width = plot_width ) + output$table <- DT::renderDataTable( + expr = table_r(), + options = list(pageLength = input$table_rows) + ) + + decorated_all_q <- reactive( + c(decorated_all_q_table(), decorated_all_q_plot()) + ) + + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -597,14 +648,14 @@ srv_g_adverse_events <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(teal.code::dev_suppress(all_q()[["table"]])) + card$append_table(teal.code::dev_suppress(table_r())) card$append_text("Plot", "header3") card$append_plot(plot_r(), dim = pws$dim()) if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_pp_patient_timeline.R b/R/tm_g_pp_patient_timeline.R index 1c7ff8c3b4..a451c3663a 100644 --- a/R/tm_g_pp_patient_timeline.R +++ b/R/tm_g_pp_patient_timeline.R @@ -175,7 +175,7 @@ template_patient_timeline <- function(dataname = "ANL", ) + ggplot2::scale_x_datetime(labels = scales::date_format("%b-%Y")) + labs + themes } - patient_timeline_plot + plot <- patient_timeline_plot }, env = list( font_size_var = font_size, @@ -303,7 +303,7 @@ template_patient_timeline <- function(dataname = "ANL", ggthemes + themes } - patient_timeline_plot + plot <- patient_timeline_plot }, env = list( labs = parsed_ggplot2_args$labs, @@ -347,6 +347,15 @@ template_patient_timeline <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -461,7 +470,8 @@ tm_g_pp_patient_timeline <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_pp_patient_timeline") checkmate::assert_string(label) checkmate::assert_string(dataname_adcm) @@ -487,6 +497,8 @@ tm_g_pp_patient_timeline <- function(label, plot_width[1], lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" ) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "plot", null.ok = TRUE) xor_error_string <- function(x, y) { paste( @@ -543,7 +555,8 @@ tm_g_pp_patient_timeline <- function(label, patient_col = patient_col, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = c(dataname_adcm, dataname_adae, parentname) @@ -670,6 +683,7 @@ ui_g_patient_timeline <- function(id, ...) { is_single_dataset = is_single_dataset_value ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "plot")), teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -712,7 +726,8 @@ srv_g_patient_timeline <- function(id, plot_height, plot_width, label, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -909,7 +924,14 @@ srv_g_patient_timeline <- function(id, teal.code::eval_code(object = qenv, as.expression(patient_timeline_calls)) }) - plot_r <- reactive(all_q()[["patient_timeline_plot"]]) + decorated_all_q <- srv_decorate_teal_data( + "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = plot + ) + + plot_r <- reactive(decorated_all_q()[["plot"]]) pws <- teal.widgets::plot_with_settings_srv( id = "patient_timeline_plot", @@ -918,9 +940,11 @@ srv_g_patient_timeline <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -939,7 +963,7 @@ srv_g_patient_timeline <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_pp_therapy.R b/R/tm_g_pp_therapy.R index ea1822873b..7a40b5088a 100644 --- a/R/tm_g_pp_therapy.R +++ b/R/tm_g_pp_therapy.R @@ -65,7 +65,7 @@ template_therapy <- function(dataname = "ANL", dataname[setdiff(cols_to_include, names(dataname))] <- NA - therapy_table <- dataname %>% + table <- dataname %>% dplyr::filter(atirel %in% c("CONCOMITANT", "PRIOR")) %>% # removed PRIOR_CONCOMITANT dplyr::select(dplyr::all_of(cols_to_include)) %>% dplyr::filter(!is.na(cmdecod)) %>% @@ -85,14 +85,12 @@ template_therapy <- function(dataname = "ANL", col_labels(dataname, fill = TRUE)[c(cmstdy_char, cmendy_char)] )) - therapy_table <- rlistings::as_listing( - therapy_table, + table <- rlistings::as_listing( + table, key_cols = NULL, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(therapy_table) <- paste("Patient ID:", patient_id) - - therapy_table + main_title(table) <- paste("Patient ID:", patient_id) }, env = list( dataname = as.name(dataname), atirel = as.name(atirel), @@ -174,7 +172,7 @@ template_therapy <- function(dataname = "ANL", TRUE ~ as.character(cmdecod) )) - therapy_plot <- + plot <- ggplot2::ggplot(data = data, ggplot2::aes(fill = cmindc, color = cmindc, y = CMDECOD, x = CMSTDY)) + ggplot2::geom_segment(ggplot2::aes(xend = CMENDY, yend = CMDECOD), size = 2) + ggplot2::geom_text( @@ -192,8 +190,6 @@ template_therapy <- function(dataname = "ANL", labs + ggtheme + theme - - therapy_plot }, env = c( list( dataname = as.name(dataname), @@ -248,6 +244,31 @@ template_therapy <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators:: +#' - `plot` (`ggplot2`) +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' Decorators can be applied to all outputs or only to specific objects using a +#' named list of `teal_transform_module` objects. +#' The `"default"` name is reserved for decorators that are applied to all outputs. +#' See code snippet below: +#' +#' ``` +#' tm_g_pp_therapy( +#' ..., # arguments for module +#' decorators = list( +#' default = list(teal_transform_module(...)), # applied to all outputs +#' plot = list(teal_transform_module(...)), # applied only to `plot` output +#' table = list(teal_transform_module(...)) # applied only to `table` output +#' ) +#' ) +#' ``` +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -348,7 +369,8 @@ tm_g_pp_therapy <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { message("Initializing tm_g_pp_therapy") checkmate::assert_class(atirel, "choices_selected", null.ok = TRUE) checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE) @@ -376,6 +398,8 @@ tm_g_pp_therapy <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(ggplot2_args, "ggplot2_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, names = c("plot", "table"), null.ok = TRUE) args <- as.list(environment()) data_extract_list <- list( @@ -405,7 +429,8 @@ tm_g_pp_therapy <- function(label, patient_col = patient_col, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -511,6 +536,8 @@ ui_g_therapy <- function(id, ...) { data_extract_spec = ui_args$cmendy, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(ui_args$decorators, "table")), + ui_decorate_teal_data(ns("d_plot"), decorators = select_decorators(ui_args$decorators, "plot")), teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -552,7 +579,8 @@ srv_g_therapy <- function(id, plot_height, plot_width, label, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -674,16 +702,30 @@ srv_g_therapy <- function(id, paste("
Patient ID:", all_q()[["pt_id"]], "
") }) + decorated_all_q_table <- srv_decorate_teal_data( + "d_table", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + output$therapy_table <- DT::renderDataTable( expr = { - teal.code::dev_suppress(all_q()[["therapy_table"]]) + teal.code::dev_suppress(decorated_all_q_table()[["table"]]) }, options = list(pageLength = input$therapy_table_rows) ) + decorated_all_q_plot <- srv_decorate_teal_data( + "d_plot", + data = decorated_all_q_table, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive({ req(iv_r()$is_valid()) - all_q()[["therapy_plot"]] + decorated_all_q_plot()[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -693,9 +735,11 @@ srv_g_therapy <- function(id, width = plot_width ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q_plot()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -709,14 +753,14 @@ srv_g_therapy <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(teal.code::dev_suppress(all_q()[["therapy_table"]])) + card$append_table(teal.code::dev_suppress(all_q()[["table"]])) card$append_text("Plot", "header3") card$append_plot(plot_r(), dim = pws$dim()) if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_pp_vitals.R b/R/tm_g_pp_vitals.R index 8721b153ab..9598cb6337 100644 --- a/R/tm_g_pp_vitals.R +++ b/R/tm_g_pp_vitals.R @@ -123,7 +123,7 @@ template_vitals <- function(dataname = "ANL", color = paramcd_levels_e ) - result_plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY + plot <- ggplot2::ggplot(data = vitals, mapping = ggplot2::aes(x = xaxis)) + # replaced VSDY ggplot2::geom_line( data = vitals, mapping = ggplot2::aes(y = aval_var, color = paramcd), @@ -172,8 +172,6 @@ template_vitals <- function(dataname = "ANL", labs + ggthemes + themes - - print(result_plot) }, env = list( dataname = as.name(dataname), @@ -211,6 +209,15 @@ template_vitals <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `plot` (`ggplot2`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -271,7 +278,8 @@ tm_g_pp_vitals <- function(label, plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args()) { + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL) { if (lifecycle::is_present(aval)) { aval_var <- aval warning( @@ -306,6 +314,8 @@ tm_g_pp_vitals <- function(label, checkmate::assert_multi_class(paramcd, c("choices_selected", "data_extract_spec"), null.ok = TRUE) checkmate::assert_multi_class(aval_var, c("choices_selected", "data_extract_spec"), null.ok = TRUE) checkmate::assert_multi_class(xaxis, c("choices_selected", "data_extract_spec"), null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "plot") args <- as.list(environment()) data_extract_list <- list( @@ -328,7 +338,8 @@ tm_g_pp_vitals <- function(label, patient_col = patient_col, plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -378,6 +389,7 @@ ui_g_vitals <- function(id, ...) { data_extract_spec = ui_args$aval_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "plot")), teal.widgets::panel_item( title = "Plot settings", collapsed = TRUE, @@ -409,7 +421,8 @@ srv_g_vitals <- function(id, plot_height, plot_width, label, - ggplot2_args) { + ggplot2_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -553,8 +566,16 @@ srv_g_vitals <- function(id, teal.code::eval_code(as.expression(unlist(my_calls))) }) - plot_r <- reactive(all_q()[["result_plot"]]) + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "plot"), + expr = print(plot) + ) + plot_r <- reactive(decorated_all_q()[["plot"]]) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) pws <- teal.widgets::plot_with_settings_srv( id = "vitals_plot", plot_r = plot_r, @@ -564,7 +585,7 @@ srv_g_vitals <- function(id, teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -583,7 +604,7 @@ srv_g_vitals <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_abnormality.R b/R/tm_t_abnormality.R index fa24c97272..7874ca4dff 100644 --- a/R/tm_t_abnormality.R +++ b/R/tm_t_abnormality.R @@ -211,9 +211,8 @@ template_abnormality <- function(parentname, y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) %>% rtables::prune_table() - result }, env = list(parent = as.name(parentname)) ) @@ -237,6 +236,14 @@ template_abnormality <- function(parentname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @note Patients with the same abnormality at baseline as on the treatment visit can be #' excluded in accordance with GDSR specifications by using `exclude_base_abn`. #' @@ -330,7 +337,8 @@ tm_t_abnormality <- function(label, pre_output = NULL, post_output = NULL, na_level = default_na_str(), - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_abnormality") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -351,6 +359,8 @@ tm_t_abnormality <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) data_extract_list <- list( arm_var = cs_to_des_select(arm_var, dataname = parentname), @@ -378,7 +388,8 @@ tm_t_abnormality <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -434,6 +445,7 @@ ui_t_abnormality <- function(id, ...) { "Exclude subjects whose baseline grade is the same as abnormal grade", value = a$exclude_base_abn ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -502,7 +514,8 @@ srv_t_abnormality <- function(id, drop_arm_levels, label, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -644,8 +657,15 @@ srv_t_abnormality <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -653,9 +673,10 @@ srv_t_abnormality <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -674,7 +695,7 @@ srv_t_abnormality <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_abnormality_by_worst_grade.R b/R/tm_t_abnormality_by_worst_grade.R index 979f7ea585..2caca15882 100644 --- a/R/tm_t_abnormality_by_worst_grade.R +++ b/R/tm_t_abnormality_by_worst_grade.R @@ -221,8 +221,7 @@ template_abnormality_by_worst_grade <- function(parentname, # nolint: object_len y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) ) @@ -249,6 +248,14 @@ template_abnormality_by_worst_grade <- function(parentname, # nolint: object_len #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @export #' #' @examplesShinylive @@ -339,7 +346,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_abnormality_by_worst_grade") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -355,6 +363,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") data_extract_list <- list( arm_var = cs_to_des_select(arm_var, dataname = parentname), @@ -380,7 +390,8 @@ tm_t_abnormality_by_worst_grade <- function(label, # nolint: object_length. label = label, worst_flag_indicator = worst_flag_indicator, total_label = total_label, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -452,6 +463,7 @@ ui_t_abnormality_by_worst_grade <- function(id, ...) { # nolint: object_length. data_extract_spec = a$worst_high_flag_var, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -501,7 +513,8 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. total_label, drop_arm_levels, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -664,8 +677,15 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -673,9 +693,10 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -695,7 +716,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length. card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_ancova.R b/R/tm_t_ancova.R index 9a5efebc03..16c4c56a9e 100644 --- a/R/tm_t_ancova.R +++ b/R/tm_t_ancova.R @@ -401,8 +401,7 @@ template_ancova <- function(dataname = "ANL", # Build table. y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list( anl = as.name(dataname), @@ -425,6 +424,14 @@ template_ancova <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @details #' When a single endpoint is selected, both unadjusted and adjusted comparison are provided. This modules #' expects that the analysis data has the following variables: @@ -520,7 +527,8 @@ tm_t_ancova <- function(label, conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_ancova") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -534,6 +542,8 @@ tm_t_ancova <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- c(as.list(environment())) @@ -566,7 +576,8 @@ tm_t_ancova <- function(label, arm_ref_comp = arm_ref_comp, include_interact = include_interact, label = label, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -666,7 +677,8 @@ ui_ancova <- function(id, ...) { fixed = FALSE ) ) - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")) ) ), forms = tagList( @@ -693,7 +705,8 @@ srv_ancova <- function(id, paramcd, avisit, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -940,9 +953,16 @@ srv_ancova <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Output to render. table_r <- reactive({ - table_q()[["result"]] + decorated_table_q()[["table"]] }) teal.widgets::table_with_settings_srv( @@ -951,9 +971,10 @@ srv_ancova <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = source_code_r, title = label ) @@ -973,7 +994,7 @@ srv_ancova <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_binary_outcome.R b/R/tm_t_binary_outcome.R index 43c7b0a0f5..f17f8d0129 100644 --- a/R/tm_t_binary_outcome.R +++ b/R/tm_t_binary_outcome.R @@ -314,8 +314,7 @@ template_binary_outcome <- function(dataname, y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parentname) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parentname) }, env = list(parentname = as.name(parentname)) ) @@ -351,6 +350,14 @@ template_binary_outcome <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -464,7 +471,8 @@ tm_t_binary_outcome <- function(label, na_level = default_na_str(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_binary_outcome") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -504,6 +512,8 @@ tm_t_binary_outcome <- function(label, control$strat$method_ci, c("wald", "waldcc", "cmh", "ha", "strat_newcombe", "strat_newcombecc") ) checkmate::assert_subset(control$strat$method_test, c("cmh")) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- as.list(environment()) @@ -531,7 +541,8 @@ tm_t_binary_outcome <- function(label, control = control, rsp_table = rsp_table, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -678,6 +689,7 @@ ui_t_binary_outcome <- function(id, ...) { condition = paste0("!input['", ns("compare_arms"), "']"), checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_item( "Additional table settings", teal.widgets::optionalSelectInput( @@ -745,7 +757,8 @@ srv_t_binary_outcome <- function(id, default_responses, rsp_table, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -995,8 +1008,16 @@ srv_t_binary_outcome <- function(id, teal.code::eval_code(qenv, as.expression(unlist(my_calls))) }) + + decorated_all_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(table_q()[["result"]]) + table_r <- reactive(decorated_all_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -1004,11 +1025,10 @@ srv_t_binary_outcome <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_all_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive({ - teal.code::get_code(table_q()) - }), + verbatim_content = source_code_r, title = label ) @@ -1027,7 +1047,7 @@ srv_t_binary_outcome <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_coxreg.R b/R/tm_t_coxreg.R index 44af30ae1a..5ad7fd125f 100644 --- a/R/tm_t_coxreg.R +++ b/R/tm_t_coxreg.R @@ -161,9 +161,9 @@ template_coxreg_u <- function(dataname, ) y$table <- if (append) { - quote(result <- c(result, rtables::build_table(lyt = lyt, df = anl))) + quote(table <- c(table, rtables::build_table(lyt = lyt, df = anl))) } else { - quote(result <- rtables::build_table(lyt = lyt, df = anl)) + quote(table <- rtables::build_table(lyt = lyt, df = anl)) } y @@ -318,8 +318,7 @@ template_coxreg_m <- function(dataname, ) y$table <- quote({ - result <- rtables::build_table(lyt = lyt, df = anl) - result + table <- rtables::build_table(lyt = lyt, df = anl) }) y @@ -361,6 +360,14 @@ template_coxreg_m <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -520,7 +527,8 @@ tm_t_coxreg <- function(label, conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_coxreg") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -536,6 +544,8 @@ tm_t_coxreg <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- as.list(environment()) @@ -561,7 +571,8 @@ tm_t_coxreg <- function(label, parentname = parentname, label = label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -694,7 +705,8 @@ ui_t_coxreg <- function(id, ...) { fixed = a$conf_level$fixed ) ) - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -720,7 +732,8 @@ srv_t_coxreg <- function(id, arm_ref_comp, label, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -831,10 +844,7 @@ srv_t_coxreg <- function(id, merge_function = "dplyr::inner_join" ) - anl_q <- reactive({ - data() %>% - teal.code::eval_code(as.expression(anl_inputs()$expr)) - }) + anl_q <- reactive(teal.code::eval_code(data(), as.expression(anl_inputs()$expr))) merged <- list( anl_input_r = anl_inputs, @@ -1044,7 +1054,7 @@ srv_t_coxreg <- function(id, ) merged$anl_q() %>% - teal.code::eval_code(quote(result <- list())) %>% + teal.code::eval_code(quote(table <- list())) %>% teal.code::eval_code( as.expression(unlist(lapply( unlist(input$buckets$Comp), @@ -1056,19 +1066,18 @@ srv_t_coxreg <- function(id, teal.code::eval_code( substitute( expr = { - result <- lapply(result, function(x) { - rtables::col_info(x) <- rtables::col_info(result[[1]]) + table <- lapply(table, function(x) { + rtables::col_info(x) <- rtables::col_info(table[[1]]) x }) - result <- rtables::rbindl_rtables(result, check_headers = TRUE) - rtables::main_title(result) <- title - rtables::main_footer(result) <- c( + table <- rtables::rbindl_rtables(table, check_headers = TRUE) + rtables::main_title(table) <- title + rtables::main_footer(table) <- c( paste("p-value method for Coxph (Hazard Ratio):", control$pval_method), paste("Ties for Coxph (Hazard Ratio):", control$ties) ) - rtables::prov_footer(result) <- p_footer - rtables::subtitles(result) <- subtitle - result + rtables::prov_footer(table) <- p_footer + rtables::subtitles(table) <- subtitle }, env = list( title = all_basic_table_args$title, @@ -1080,16 +1089,30 @@ srv_t_coxreg <- function(id, } }) - table_r <- reactive(all_q()[["result"]]) + + + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + # Outputs to render. + table_r <- reactive({ + decorated_table_q()[["table"]] + }) teal.widgets::table_with_settings_srv( id = "table", table_r = table_r ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = "R Code for the Current (Multi-Variable) Cox proportional hazard regression model" ) @@ -1108,7 +1131,7 @@ srv_t_coxreg <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_events.R b/R/tm_t_events.R index c5b353a80d..496d9b338b 100644 --- a/R/tm_t_events.R +++ b/R/tm_t_events.R @@ -266,7 +266,7 @@ template_events <- function(dataname, # Full table. y$table <- substitute( - expr = result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent), + expr = table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent), env = list(parent = as.name(parentname)) ) @@ -275,7 +275,7 @@ template_events <- function(dataname, prune_list <- add_expr( prune_list, quote( - pruned_result <- result %>% rtables::prune_table() + pruned_result <- rtables::prune_table(table) ) ) @@ -284,7 +284,7 @@ template_events <- function(dataname, prune_list <- add_expr( prune_list, substitute( - expr = col_indices <- 1:(ncol(result) - add_total), + expr = col_indices <- 1:(ncol(table) - add_total), env = list(add_total = add_total) ) ) @@ -366,7 +366,7 @@ template_events <- function(dataname, sort_list <- add_expr( sort_list, substitute( - expr = idx_split_col <- which(sapply(col_paths(result), tail, 1) == sort_freq_col), + expr = idx_split_col <- which(sapply(col_paths(table), tail, 1) == sort_freq_col), env = list(sort_freq_col = sort_freq_col) ) ) @@ -378,7 +378,7 @@ template_events <- function(dataname, quote(cont_n_allcols) } scorefun_llt <- if (add_total) { - quote(score_occurrences_cols(col_indices = seq(1, ncol(result)))) + quote(score_occurrences_cols(col_indices = seq(1, ncol(table)))) } else { quote(score_occurrences) } @@ -461,6 +461,14 @@ template_events <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -524,7 +532,8 @@ tm_t_events <- function(label, incl_overall_sum = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_events") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -545,6 +554,8 @@ tm_t_events <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- as.list(environment()) @@ -570,7 +581,8 @@ tm_t_events <- function(label, na_level = na_level, sort_freq_col = sort_freq_col, incl_overall_sum = incl_overall_sum, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -612,6 +624,7 @@ ui_t_events_byterm <- function(id, ...) { is_single_dataset = is_single_dataset_value ), checkboxInput(ns("add_total"), "Add All Patients columns", value = a$add_total), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_item( "Additional table settings", checkboxInput( @@ -675,7 +688,8 @@ srv_t_events_byterm <- function(id, total_label, na_level, sort_freq_col, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -808,10 +822,15 @@ srv_t_events_byterm <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive({ - table_q()[["pruned_and_sorted_result"]] - }) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -819,9 +838,10 @@ srv_t_events_byterm <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = source_code_r, title = label ) @@ -840,7 +860,7 @@ srv_t_events_byterm <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_events_by_grade.R b/R/tm_t_events_by_grade.R index f0b01a5436..8e99ee1aca 100644 --- a/R/tm_t_events_by_grade.R +++ b/R/tm_t_events_by_grade.R @@ -332,7 +332,6 @@ template_events_by_grade <- function(dataname, expr = { pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = term_var, scorefun = scorefun, decreasing = TRUE) - pruned_and_sorted_result }, env = list( term_var = term_var, @@ -356,11 +355,6 @@ template_events_by_grade <- function(dataname, ) ) ) - - sort_list <- add_expr( - sort_list, - quote(pruned_and_sorted_result) - ) } y$sort <- bracket_expr(sort_list) @@ -769,11 +763,6 @@ template_events_col_by_grade <- function(dataname, prune_list, prune_pipe ) - prune_list <- add_expr( - prune_list, - quote(pruned_and_sorted_result) - ) - y$prune <- bracket_expr(prune_list) y @@ -791,6 +780,14 @@ template_events_col_by_grade <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @export #' #' @examplesShinylive @@ -865,7 +862,8 @@ tm_t_events_by_grade <- function(label, drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_events_by_grade") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -883,6 +881,8 @@ tm_t_events_by_grade <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- as.list(environment()) @@ -907,7 +907,8 @@ tm_t_events_by_grade <- function(label, total_label = total_label, grading_groups = grading_groups, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -962,6 +963,7 @@ ui_t_events_by_grade <- function(id, ...) { "Display grade groupings in nested columns", value = a$col_by_grade ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -1017,7 +1019,8 @@ srv_t_events_by_grade <- function(id, drop_arm_levels, total_label, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -1202,9 +1205,20 @@ srv_t_events_by_grade <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + + table_renamed_q <- reactive({ + within(table_q(), table <- pruned_and_sorted_result) + }) + + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_renamed_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) # Outputs to render. table_r <- reactive({ - table_q()[["pruned_and_sorted_result"]] + decorated_table_q()[["table"]] }) teal.widgets::table_with_settings_srv( @@ -1213,9 +1227,10 @@ srv_t_events_by_grade <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = source_code_r, title = label ) @@ -1234,7 +1249,7 @@ srv_t_events_by_grade <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_events_patyear.R b/R/tm_t_events_patyear.R index 301cae730c..b42e923139 100644 --- a/R/tm_t_events_patyear.R +++ b/R/tm_t_events_patyear.R @@ -168,8 +168,7 @@ template_events_patyear <- function(dataname, # table y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) ) @@ -193,6 +192,15 @@ template_events_patyear <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' +#' #' @examples #' library(dplyr) #' @@ -310,7 +318,8 @@ tm_t_events_patyear <- function(label, drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_events_patyear") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -328,6 +337,8 @@ tm_t_events_patyear <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- c(as.list(environment())) @@ -352,7 +363,8 @@ tm_t_events_patyear <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -422,6 +434,7 @@ ui_events_patyear <- function(id, ...) { multiple = FALSE, fixed = FALSE ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional table settings", @@ -473,7 +486,8 @@ srv_events_patyear <- function(id, na_level, drop_arm_levels, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -627,10 +641,16 @@ srv_events_patyear <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive({ - table_q()[["result"]] - }) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "patyear_table", @@ -638,9 +658,10 @@ srv_events_patyear <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = source_code_r, title = label ) @@ -659,7 +680,7 @@ srv_events_patyear <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_events_summary.R b/R/tm_t_events_summary.R index 49709bbee5..3ffa8b6f06 100644 --- a/R/tm_t_events_summary.R +++ b/R/tm_t_events_summary.R @@ -244,7 +244,7 @@ template_events_summary <- function(anl_name, table_parent_list <- add_expr( table_parent_list, substitute( - expr = result_parent <- rtables::build_table(lyt = lyt_parent, df = df_parent, alt_counts_df = df_parent), + expr = table_parent <- rtables::build_table(lyt = lyt_parent, df = df_parent, alt_counts_df = df_parent), env = list(df_parent = as.name(parentname)) ) ) @@ -310,7 +310,7 @@ template_events_summary <- function(anl_name, table_anl_list <- add_expr( table_anl_list, substitute( - expr = result_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = df_parent), + expr = table_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = df_parent), env = list(df_parent = as.name(parentname)) ) ) @@ -444,7 +444,7 @@ template_events_summary <- function(anl_name, table_list <- add_expr( table_list, quote( - rtables::col_info(result_parent) <- rtables::col_info(result_anl) + rtables::col_info(table_parent) <- rtables::col_info(table_anl) ) ) @@ -461,10 +461,10 @@ template_events_summary <- function(anl_name, table_list <- add_expr( table_list, quote( - expr = result <- rtables::rbind( - result_anl[1:2, ], - result_parent, - result_anl[3:nrow(result_anl), ] + expr = table <- rtables::rbind( + table_anl[1:2, ], + table_parent, + table_anl[3:nrow(table_anl), ] ) ) ) @@ -472,9 +472,9 @@ template_events_summary <- function(anl_name, table_list <- add_expr( table_list, quote( - expr = result <- rtables::rbind( - result_anl[1:2, ], - result_anl[3:nrow(result_anl), ] + expr = table <- rtables::rbind( + table_anl[1:2, ], + table_anl[3:nrow(table_anl), ] ) ) ) @@ -482,7 +482,7 @@ template_events_summary <- function(anl_name, table_list <- add_expr( table_list, quote( - result <- rtables::rbind(result_anl, result_parent) + table <- rtables::rbind(table_anl, table_parent) ) ) } @@ -522,6 +522,14 @@ template_events_summary <- function(anl_name, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -638,7 +646,8 @@ tm_t_events_summary <- function(label, count_events = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_events_summary") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -661,6 +670,8 @@ tm_t_events_summary <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) args <- c(as.list(environment())) @@ -695,7 +706,8 @@ tm_t_events_summary <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -758,6 +770,7 @@ ui_t_events_summary <- function(id, ...) { "Add All Patients column", value = a$add_total ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_item( "Table Settings", checkboxInput( @@ -841,7 +854,8 @@ srv_t_events_summary <- function(id, label, total_label, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -990,11 +1004,10 @@ srv_t_events_summary <- function(id, teal.code::eval_code( substitute( expr = { - rtables::main_title(result) <- title - rtables::main_footer(result) <- footer - rtables::prov_footer(result) <- p_footer - rtables::subtitles(result) <- subtitle - result + rtables::main_title(table) <- title + rtables::main_footer(table) <- footer + rtables::prov_footer(table) <- p_footer + rtables::subtitles(table) <- subtitle }, env = list( title = `if`(is.null(all_basic_table_args$title), label, all_basic_table_args$title), footer = `if`(is.null(all_basic_table_args$main_footer), "", all_basic_table_args$main_footer), @@ -1006,16 +1019,26 @@ srv_t_events_summary <- function(id, }) # Outputs to render. - table_r <- reactive(table_q()[["result"]]) + + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = table_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", table_r = table_r ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(table_q())), + verbatim_content = source_code_r, title = label ) @@ -1034,7 +1057,7 @@ srv_t_events_summary <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(table_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_exposure.R b/R/tm_t_exposure.R index c535217956..0ac3a4d932 100644 --- a/R/tm_t_exposure.R +++ b/R/tm_t_exposure.R @@ -189,8 +189,7 @@ template_exposure <- function(parentname, y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) ) @@ -198,8 +197,8 @@ template_exposure <- function(parentname, if (drop_levels) { y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - rtables::prune_table(result) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) + table <- rtables::prune_table(table) }, env = list(parent = as.name(parentname)) ) @@ -227,6 +226,14 @@ template_exposure <- function(parentname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Modules: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` as created from `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -324,7 +331,8 @@ tm_t_exposure <- function(label, na_level = default_na_str(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_exposure") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -344,6 +352,8 @@ tm_t_exposure <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, "table", null.ok = TRUE) data_extract_list <- list( paramcd = cs_to_des_filter(paramcd, dataname = dataname), @@ -371,7 +381,8 @@ tm_t_exposure <- function(label, total_row_label = total_row_label, na_level = na_level, basic_table_args = basic_table_args, - paramcd_label = paramcd_label + paramcd_label = paramcd_label, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -430,6 +441,7 @@ ui_t_exposure <- function(id, ...) { ), checkboxInput(ns("add_total_row"), "Add Total row", value = a$add_total_row), checkboxInput(ns("add_total"), "Add All Patients column", value = a$add_total), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -481,7 +493,8 @@ srv_t_exposure <- function(id, label, total_label, total_row_label, - basic_table_args = basic_table_args) { + basic_table_args = basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -631,7 +644,14 @@ srv_t_exposure <- function(id, }) # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -639,9 +659,10 @@ srv_t_exposure <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -660,7 +681,7 @@ srv_t_exposure <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_logistic.R b/R/tm_t_logistic.R index b0101dd1bb..40563a0009 100644 --- a/R/tm_t_logistic.R +++ b/R/tm_t_logistic.R @@ -186,14 +186,13 @@ template_logistic <- function(dataname, y$table <- substitute( expr = { - result <- expr_basic_table_args %>% + table <- expr_basic_table_args %>% summarize_logistic( conf_level = conf_level, drop_and_remove_str = "_NA_" ) %>% rtables::append_topleft(topleft) %>% rtables::build_table(df = mod) - result }, env = list( expr_basic_table_args = parsed_basic_table_args, @@ -222,6 +221,14 @@ template_logistic <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`ElementaryTable` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -297,7 +304,8 @@ tm_t_logistic <- function(label, conf_level = teal.transform::choices_selected(c(0.95, 0.9, 0.8), 0.95, keep_order = TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_logistic") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -311,6 +319,8 @@ tm_t_logistic <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) @@ -333,7 +343,8 @@ tm_t_logistic <- function(label, label = label, dataname = dataname, parentname = parentname, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -424,7 +435,8 @@ ui_t_logistic <- function(id, ...) { a$conf_level$selected, multiple = FALSE, fixed = a$conf_level$fixed - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -447,7 +459,8 @@ srv_t_logistic <- function(id, avalc_var, cov_var, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -659,6 +672,7 @@ srv_t_logistic <- function(id, ) }) + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -696,16 +710,26 @@ srv_t_logistic <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(calls)) }) - table_r <- reactive(all_q()[["result"]]) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", table_r = table_r ) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -724,7 +748,7 @@ srv_t_logistic <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_mult_events.R b/R/tm_t_mult_events.R index e73306d62f..4ba2dacb55 100644 --- a/R/tm_t_mult_events.R +++ b/R/tm_t_mult_events.R @@ -263,8 +263,7 @@ template_mult_events <- function(dataname, # Combine tables. y$final_table <- quote( expr = { - result <- sorted_result - result + table <- sorted_result } ) @@ -283,6 +282,14 @@ template_mult_events <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -345,7 +352,8 @@ tm_t_mult_events <- function(label, drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_mult_events") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -362,6 +370,8 @@ tm_t_mult_events <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) @@ -386,7 +396,8 @@ tm_t_mult_events <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -438,6 +449,7 @@ ui_t_mult_events_byterm <- function(id, ...) { ) ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -474,7 +486,8 @@ srv_t_mult_events_byterm <- function(id, label, total_label, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -592,15 +605,23 @@ srv_t_mult_events_byterm <- function(id, teal.code::eval_code(anl_q, as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv(id = "table", table_r = table_r) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -619,7 +640,7 @@ srv_t_mult_events_byterm <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_pp_basic_info.R b/R/tm_t_pp_basic_info.R index 7f61d41487..609caddb13 100644 --- a/R/tm_t_pp_basic_info.R +++ b/R/tm_t_pp_basic_info.R @@ -36,13 +36,11 @@ template_basic_info <- function(dataname = "ANL", dplyr::select(var, key, value) %>% dplyr::rename(` ` = var, ` ` = key, ` ` = value) - result <- rlistings::as_listing( + table <- rlistings::as_listing( result, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(result) <- paste("Patient ID:", patient_id) - - result + main_title(table) <- paste("Patient ID:", patient_id) }, env = list( dataname = as.name(dataname), vars = vars, @@ -66,6 +64,14 @@ template_basic_info <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -104,7 +110,8 @@ tm_t_pp_basic_info <- function(label, patient_col = "USUBJID", vars = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_t_pp_basic_info") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -112,6 +119,8 @@ tm_t_pp_basic_info <- function(label, checkmate::assert_class(vars, "choices_selected", null.ok = TRUE) checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) data_extract_list <- list( @@ -128,7 +137,8 @@ tm_t_pp_basic_info <- function(label, list( dataname = dataname, label = label, - patient_col = patient_col + patient_col = patient_col, + decorators = decorators ) ), datanames = dataname @@ -163,7 +173,8 @@ ui_t_basic_info <- function(id, ...) { label = "Select variable:", data_extract_spec = ui_args$vars, is_single_dataset = is_single_dataset_value - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "table")), ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -181,7 +192,8 @@ srv_t_basic_info <- function(id, dataname, patient_col, vars, - label) { + label, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -265,11 +277,18 @@ srv_t_basic_info <- function(id, teal.code::eval_code(as.expression(unlist(my_calls))) }) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + output$title <- renderText({ paste("
Patient ID:", all_q()[["pt_id"]], "
") }) - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) output$basic_info_table <- DT::renderDataTable( expr = table_r(), @@ -278,9 +297,11 @@ srv_t_basic_info <- function(id, ) ) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -294,12 +315,12 @@ srv_t_basic_info <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(table_r()) + card$append_table(decorated_table_q()[["table"]]) if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_pp_laboratory.R b/R/tm_t_pp_laboratory.R index 153d52a59c..c0a268e8a5 100644 --- a/R/tm_t_pp_laboratory.R +++ b/R/tm_t_pp_laboratory.R @@ -70,7 +70,7 @@ template_laboratory <- function(dataname = "ANL", dplyr::mutate(aval_anrind = paste(aval_var, anrind)) %>% dplyr::select(-c(aval_var, anrind)) - labor_table_raw <- labor_table_base %>% + result <- labor_table_base %>% as.data.frame() %>% stats::reshape( direction = "wide", @@ -78,18 +78,18 @@ template_laboratory <- function(dataname = "ANL", v.names = "aval_anrind", timevar = "INDEX" ) - colnames(labor_table_raw)[-c(1:3)] <- unique(labor_table_base$INDEX) + colnames(result)[-c(1:3)] <- unique(labor_table_base$INDEX) - labor_table_raw[[param_char]] <- clean_description(labor_table_raw[[param_char]]) + result[[param_char]] <- clean_description(result[[param_char]]) - labor_table_raw <- rlistings::as_listing( - labor_table_raw, + table <- rlistings::as_listing( + result, key_cols = NULL, default_formatting = list(all = fmt_config(align = "left")) ) - main_title(labor_table_raw) <- paste("Patient ID:", patient_id) + main_title(table) <- paste("Patient ID:", patient_id) - labor_table_html <- labor_table_base %>% + table_html <- labor_table_base %>% dplyr::mutate(aval_anrind_col = color_lab_values(aval_anrind)) %>% dplyr::select(-aval_anrind) %>% as.data.frame() %>% @@ -99,15 +99,21 @@ template_laboratory <- function(dataname = "ANL", v.names = "aval_anrind_col", timevar = "INDEX" ) - colnames(labor_table_html)[-c(1:3)] <- unique(labor_table_base$INDEX) - labor_table_html[[param_char]] <- clean_description(labor_table_html[[param_char]]) - - labor_table_html_dt <- DT::datatable(labor_table_html, escape = FALSE) - labor_table_html_dt$dependencies <- c( - labor_table_html_dt$dependencies, + colnames(table_html)[-c(1:3)] <- unique(labor_table_base$INDEX) + table_html[[param_char]] <- clean_description(table_html[[param_char]]) + + table_dt <- DT::datatable( + table_html, + escape = FALSE, + options = list( + lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25")), + scrollX = TRUE + ) + ) + table_dt$dependencies <- c( + table_dt$dependencies, list(rmarkdown::html_dependency_bootstrap("default")) ) - labor_table_html_dt }, env = list( dataname = as.name(dataname), @@ -147,6 +153,14 @@ template_laboratory <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -215,7 +229,8 @@ tm_t_pp_laboratory <- function(label, paramcd = NULL, anrind = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { if (lifecycle::is_present(aval)) { aval_var <- aval warning( @@ -251,6 +266,8 @@ tm_t_pp_laboratory <- function(label, checkmate::assert_class(anrind, "choices_selected", null.ok = TRUE) checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) data_extract_list <- list( @@ -273,7 +290,8 @@ tm_t_pp_laboratory <- function(label, dataname = dataname, parentname = parentname, label = label, - patient_col = patient_col + patient_col = patient_col, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -350,7 +368,8 @@ ui_g_laboratory <- function(id, ...) { inputId = ns("round_value"), label = "Select number of decimal places for rounding:", choices = NULL - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "table")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -374,7 +393,8 @@ srv_g_laboratory <- function(id, param, paramcd, anrind, - label) { + label, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -458,6 +478,7 @@ srv_g_laboratory <- function(id, teal.code::eval_code(as.expression(anl_inputs()$expr)) }) + # Generate r code for the analysis. all_q <- reactive({ teal::validate_inputs(iv_r()) @@ -488,30 +509,35 @@ srv_g_laboratory <- function(id, teal.code::eval_code(as.expression(labor_calls)) }) - output$title <- renderText({ - paste("
Patient ID:", all_q()[["pt_id"]], "
") - }) + # Decoration of raw table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. table_r <- reactive({ - q <- all_q() + q <- decorated_table_q() list( - html = q[["labor_table_html"]], - raw = q[["labor_table_raw"]] + html = q[["table_dt"]], + listing = q[["table"]] ) }) - output$lab_values_table <- DT::renderDataTable( - expr = table_r()$html, - escape = FALSE, - options = list( - lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25")), - scrollX = TRUE - ) - ) + output$title <- renderText({ + req(decorated_table_q()) + paste("
Patient ID:", decorated_table_q()[["pt_id"]], "
") + }) + + output$lab_values_table <- DT::renderDataTable(expr = table_r()$html) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -525,12 +551,12 @@ srv_g_laboratory <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(table_r()$raw) + card$append_table(table_r()$listing) if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_pp_medical_history.R b/R/tm_t_pp_medical_history.R index b73235d391..881e77725e 100644 --- a/R/tm_t_pp_medical_history.R +++ b/R/tm_t_pp_medical_history.R @@ -40,7 +40,7 @@ template_medical_history <- function(dataname = "ANL", dplyr::distinct() %>% `colnames<-`(labels) - result <- rtables::basic_table() %>% + table <- rtables::basic_table() %>% rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>% rtables::split_rows_by( colnames(result_raw)[1], @@ -54,9 +54,7 @@ template_medical_history <- function(dataname = "ANL", rtables::analyze_colvars(function(x) x[seq_along(x)]) %>% rtables::build_table(result_raw) - main_title(result) <- paste("Patient ID:", patient_id) - - result + main_title(table) <- paste("Patient ID:", patient_id) }, env = list( dataname = as.name(dataname), mhbodsys = as.name(mhbodsys), @@ -88,6 +86,13 @@ template_medical_history <- function(dataname = "ANL", #' available choices and preselected option for the `MHDISTAT` variable from `dataname`. #' #' @inherit module_arguments return +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. #' #' @examplesShinylive #' library(teal.modules.clinical) @@ -141,7 +146,8 @@ tm_t_pp_medical_history <- function(label, mhbodsys = NULL, mhdistat = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_t_pp_medical_history") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -152,6 +158,8 @@ tm_t_pp_medical_history <- function(label, checkmate::assert_class(mhdistat, "choices_selected", null.ok = TRUE) checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) data_extract_list <- list( @@ -171,7 +179,8 @@ tm_t_pp_medical_history <- function(label, dataname = dataname, parentname = parentname, label = label, - patient_col = patient_col + patient_col = patient_col, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -221,7 +230,8 @@ ui_t_medical_history <- function(id, ...) { label = "Select MHDISTAT variable:", data_extract_spec = ui_args$mhdistat, is_single_dataset = is_single_dataset_value - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "table")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -242,7 +252,8 @@ srv_t_medical_history <- function(id, mhterm, mhbodsys, mhdistat, - label) { + label, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -303,6 +314,7 @@ srv_t_medical_history <- function(id, teal.code::eval_code(as.expression(anl_inputs()$expr)) }) + # Generate r code for the analysis. all_q <- reactive({ teal::validate_inputs(iv_r()) @@ -335,16 +347,27 @@ srv_t_medical_history <- function(id, teal.code::eval_code(as.expression(unlist(my_calls))) }) - table_r <- reactive(all_q()[["result"]]) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + # Outputs to render. + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", table_r = table_r ) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -363,7 +386,7 @@ srv_t_medical_history <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_pp_prior_medication.R b/R/tm_t_pp_prior_medication.R index 605664e188..ee502da99e 100644 --- a/R/tm_t_pp_prior_medication.R +++ b/R/tm_t_pp_prior_medication.R @@ -33,7 +33,14 @@ template_prior_medication <- function(dataname = "ANL", dplyr::filter(!is.na(cmdecod)) %>% dplyr::distinct() %>% `colnames<-`(col_labels(dataname, fill = TRUE)[c(cmindc_char, cmdecod_char, cmstdy_char)]) - result + + table <- result %>% + dplyr::mutate( # Exception for columns of type difftime that is not supported by as_listing + dplyr::across( + dplyr::where(~ inherits(., what = "difftime")), ~ as.double(., units = "auto") + ) + ) %>% + rlistings::as_listing() }, env = list( dataname = as.name(dataname), atirel = as.name(atirel), @@ -61,6 +68,14 @@ template_prior_medication <- function(dataname = "ANL", #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`listing_df` - output of `rlistings::as_listing`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -123,7 +138,8 @@ tm_t_pp_prior_medication <- function(label, cmindc = NULL, cmstdy = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = NULL) { message("Initializing tm_t_pp_prior_medication") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -135,6 +151,8 @@ tm_t_pp_prior_medication <- function(label, checkmate::assert_class(cmstdy, "choices_selected", null.ok = TRUE) checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) data_extract_list <- list( @@ -155,7 +173,8 @@ tm_t_pp_prior_medication <- function(label, dataname = dataname, parentname = parentname, label = label, - patient_col = patient_col + patient_col = patient_col, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -212,7 +231,8 @@ ui_t_prior_medication <- function(id, ...) { label = "Select CMSTDY variable:", data_extract_spec = ui_args$cmstdy, is_single_dataset = is_single_dataset_value - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "table")), ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -234,7 +254,8 @@ srv_t_prior_medication <- function(id, cmdecod, cmindc, cmstdy, - label) { + label, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -303,6 +324,7 @@ srv_t_prior_medication <- function(id, teal.code::eval_code(as.expression(anl_inputs()$expr)) }) + # Generate r code for the analysis. all_q <- reactive({ teal::validate_inputs(iv_r()) @@ -328,18 +350,35 @@ srv_t_prior_medication <- function(id, teal.code::eval_code(as.expression(unlist(my_calls))) }) - table_r <- reactive(all_q()[["result"]]) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) - output$prior_medication_table <- DT::renderDataTable( - expr = table_r(), - options = list( - lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25")) + # Outputs to render. + table_r <- reactive({ + q <- decorated_table_q() + list( + html = DT::datatable( + q[["result"]], + options = list( + lengthMenu = list(list(-1, 5, 10, 25), list("All", "5", "10", "25")) + ) + ), + listing = q[["table"]] ) - ) + }) + + output$prior_medication_table <- DT::renderDataTable(expr = table_r()$html) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -352,12 +391,16 @@ srv_t_prior_medication <- function(id, filter_panel_api = filter_panel_api ) card$append_text("Table", "header3") - card$append_table(table_r()) + if (nrow(table_r()$listing) == 0L) { + card$append_text("No data available for table.") + } else { + card$append_table(table_r()$listing) + } if (!comment == "") { card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_shift_by_arm.R b/R/tm_t_shift_by_arm.R index f3a2a03fbf..678bb81d00 100644 --- a/R/tm_t_shift_by_arm.R +++ b/R/tm_t_shift_by_arm.R @@ -173,8 +173,7 @@ template_shift_by_arm <- function(dataname, # Full table. y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = dataname) - result + table <- rtables::build_table(lyt = lyt, df = dataname) }, env = list(dataname = as.name(dataname)) ) @@ -191,6 +190,14 @@ template_shift_by_arm <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -268,7 +275,8 @@ tm_t_shift_by_arm <- function(label, total_label = default_total_label(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { if (lifecycle::is_present(base_var)) { baseline_var <- base_var warning( @@ -297,6 +305,8 @@ tm_t_shift_by_arm <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) @@ -323,7 +333,8 @@ tm_t_shift_by_arm <- function(label, total_label = total_label, na_level = na_level, treatment_flag = treatment_flag, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -393,6 +404,7 @@ ui_shift_by_arm <- function(id, ...) { choices = c("ifany", "no"), selected = a$useNA ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -437,7 +449,8 @@ srv_shift_by_arm <- function(id, na_level, add_total, total_label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -509,7 +522,7 @@ srv_shift_by_arm <- function(id, anl_q = anl_q ) - # validate inputs + # Validate inputs. validate_checks <- reactive({ teal::validate_inputs(iv_r()) @@ -540,7 +553,7 @@ srv_shift_by_arm <- function(id, ) }) - # generate r code for the analysis + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -563,8 +576,16 @@ srv_shift_by_arm <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -572,9 +593,10 @@ srv_shift_by_arm <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -593,7 +615,7 @@ srv_shift_by_arm <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_shift_by_arm_by_worst.R b/R/tm_t_shift_by_arm_by_worst.R index a1a813d291..005d86bd0d 100644 --- a/R/tm_t_shift_by_arm_by_worst.R +++ b/R/tm_t_shift_by_arm_by_worst.R @@ -179,8 +179,7 @@ template_shift_by_arm_by_worst <- function(dataname, # Full table. y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = dataname) - result + table <- rtables::build_table(lyt = lyt, df = dataname) }, env = list(dataname = as.name(dataname)) ) @@ -197,6 +196,14 @@ template_shift_by_arm_by_worst <- function(dataname, #' #' @inherit module_arguments return #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -278,7 +285,8 @@ tm_t_shift_by_arm_by_worst <- function(label, total_label = default_total_label(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { if (lifecycle::is_present(base_var)) { baseline_var <- base_var warning( @@ -307,8 +315,10 @@ tm_t_shift_by_arm_by_worst <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") - args <- as.list(environment()) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") + args <- as.list(environment()) data_extract_list <- list( arm_var = cs_to_des_select(arm_var, dataname = parentname), @@ -334,7 +344,8 @@ tm_t_shift_by_arm_by_worst <- function(label, treatment_flag = treatment_flag, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -412,6 +423,7 @@ ui_shift_by_arm_by_worst <- function(id, ...) { choices = c("ifany", "no"), selected = a$useNA ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -456,7 +468,8 @@ srv_shift_by_arm_by_worst <- function(id, na_level, add_total, total_label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -572,7 +585,7 @@ srv_shift_by_arm_by_worst <- function(id, ) }) - # generate r code for the analysis + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -597,8 +610,16 @@ srv_shift_by_arm_by_worst <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -606,9 +627,10 @@ srv_shift_by_arm_by_worst <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -627,7 +649,7 @@ srv_shift_by_arm_by_worst <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_shift_by_grade.R b/R/tm_t_shift_by_grade.R index f45ec53727..97256f3f60 100644 --- a/R/tm_t_shift_by_grade.R +++ b/R/tm_t_shift_by_grade.R @@ -449,9 +449,8 @@ template_shift_by_grade <- function(parentname, y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) %>% rtables::prune_table() - result }, env = list(parent = as.name(parentname)) ) @@ -472,6 +471,14 @@ template_shift_by_grade <- function(parentname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -572,7 +579,8 @@ tm_t_shift_by_grade <- function(label, post_output = NULL, na_level = default_na_str(), code_missing_baseline = FALSE, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_shift_by_grade") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -593,6 +601,8 @@ tm_t_shift_by_grade <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) @@ -619,7 +629,8 @@ tm_t_shift_by_grade <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -704,6 +715,7 @@ ui_t_shift_by_grade <- function(id, ...) { ) ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -751,7 +763,8 @@ srv_t_shift_by_grade <- function(id, drop_arm_levels, na_level, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -840,6 +853,7 @@ srv_t_shift_by_grade <- function(id, ) }) + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -865,8 +879,16 @@ srv_t_shift_by_grade <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -874,9 +896,10 @@ srv_t_shift_by_grade <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -895,7 +918,7 @@ srv_t_shift_by_grade <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_smq.R b/R/tm_t_smq.R index e1081cdec2..b79251aca2 100644 --- a/R/tm_t_smq.R +++ b/R/tm_t_smq.R @@ -290,8 +290,7 @@ template_smq <- function(dataname, all_zero <- function(tr) { !inherits(tr, "ContentRow") && rtables::all_zero_or_na(tr) } - pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = all_zero) - pruned_and_sorted_result + table <- sorted_result %>% rtables::trim_rows(criteria = all_zero) } ) @@ -316,6 +315,14 @@ template_smq <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -391,7 +398,8 @@ tm_t_smq <- function(label, scopes, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_smq") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -408,6 +416,8 @@ tm_t_smq <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) @@ -432,7 +442,8 @@ tm_t_smq <- function(label, na_level = na_level, label = label, total_label = total_label, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -444,7 +455,6 @@ ui_t_smq <- function(id, ...) { ns <- NS(id) a <- list(...) # module args - is_single_dataset_value <- teal.transform::is_single_dataset( a$arm_var, a$id_var, @@ -482,6 +492,7 @@ ui_t_smq <- function(id, ...) { data_extract_spec = a$baskets, is_single_dataset = is_single_dataset_value ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -540,7 +551,8 @@ srv_t_smq <- function(id, na_level, label, total_label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -621,6 +633,7 @@ srv_t_smq <- function(id, ) }) + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -642,8 +655,16 @@ srv_t_smq <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["pruned_and_sorted_result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -651,9 +672,10 @@ srv_t_smq <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -672,7 +694,7 @@ srv_t_smq <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_summary.R b/R/tm_t_summary.R index 239558ada9..c1f7b9f7de 100644 --- a/R/tm_t_summary.R +++ b/R/tm_t_summary.R @@ -199,8 +199,7 @@ template_summary <- function(dataname, y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) ) @@ -223,6 +222,14 @@ template_summary <- function(dataname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -281,7 +288,8 @@ tm_t_summary <- function(label, drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_summary") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -297,6 +305,8 @@ tm_t_summary <- function(label, checkmate::assert_flag(add_total) checkmate::assert_flag(show_arm_var_labels) checkmate::assert_string(total_label) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") useNA <- match.arg(useNA) # nolint: object_name. denominator <- match.arg(denominator) @@ -323,7 +333,8 @@ tm_t_summary <- function(label, show_arm_var_labels = show_arm_var_labels, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = c(dataname, parentname) @@ -404,7 +415,8 @@ ui_summary <- function(id, ...) { ) } ) - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")) ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -429,7 +441,8 @@ srv_summary <- function(id, na_level, drop_arm_levels, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -496,7 +509,7 @@ srv_summary <- function(id, } }) - # validate inputs + # Validate inputs. validate_checks <- reactive({ teal::validate_inputs(iv_r()) adsl_filtered <- merged$anl_q()[[parentname]] @@ -539,7 +552,7 @@ srv_summary <- function(id, ) }) - # generate r code for the analysis + # Generate r code for the analysis. all_q <- reactive({ validate_checks() @@ -572,14 +585,24 @@ srv_summary <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) + teal.widgets::table_with_settings_srv(id = "table", table_r = table_r) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -598,7 +621,7 @@ srv_summary <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_summary_by.R b/R/tm_t_summary_by.R index e9163901bb..49d1df798e 100644 --- a/R/tm_t_summary_by.R +++ b/R/tm_t_summary_by.R @@ -285,20 +285,18 @@ template_summary_by <- function(parentname, rvs <- unlist(unname(row_values(tr))) isTRUE(all(rvs == 0)) } - result <- rtables::build_table( + table <- rtables::build_table( lyt = lyt, df = anl, alt_counts_df = parent ) %>% rtables::trim_rows(criteria = all_zero) - result }, env = list(parent = as.name(parentname)) ) } else { y$table <- substitute( expr = { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parent) }, env = list(parent = as.name(parentname)) ) @@ -321,6 +319,14 @@ template_summary_by <- function(parentname, #' #' @inherit module_arguments return seealso #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @examplesShinylive #' library(teal.modules.clinical) #' interactive <- function() TRUE @@ -396,7 +402,8 @@ tm_t_summary_by <- function(label, drop_zero_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_summary_by") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -424,6 +431,9 @@ tm_t_summary_by <- function(label, numeric_stats_choices <- c("n", "mean_sd", "mean_ci", "geom_mean", "median", "median_ci", "quantiles", "range") numeric_stats <- match.arg(numeric_stats, numeric_stats_choices, several.ok = TRUE) + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") + args <- c(as.list(environment())) data_extract_list <- list( @@ -451,7 +461,8 @@ tm_t_summary_by <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -558,6 +569,7 @@ ui_summary_by <- function(id, ...) { } ) ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), teal.widgets::panel_group( teal.widgets::panel_item( "Additional Variables Info", @@ -596,7 +608,8 @@ srv_summary_by <- function(id, drop_arm_levels, drop_zero_levels, label, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -685,7 +698,7 @@ srv_summary_by <- function(id, } }) - # The R-code corresponding to the analysis. + # Generate r code for the analysis. all_q <- reactive({ validate_checks() summarize_vars <- as.vector(merged$anl_input_r()$columns_source$summarize_vars) @@ -715,8 +728,16 @@ srv_summary_by <- function(id, teal.code::eval_code(merged$anl_q(), as.expression(unlist(my_calls))) }) + # Decoration of table output. + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + # Outputs to render. - table_r <- reactive(all_q()[["result"]]) + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv( id = "table", @@ -724,9 +745,10 @@ srv_summary_by <- function(id, ) # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -745,7 +767,7 @@ srv_summary_by <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_tte.R b/R/tm_t_tte.R index 8043aad6ae..dd63cde12f 100644 --- a/R/tm_t_tte.R +++ b/R/tm_t_tte.R @@ -365,7 +365,6 @@ template_tte <- function(dataname = "ANL", y$table <- substitute( expr = { table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = parentname) - table }, env = list(parentname = as.name(parentname)) ) @@ -388,6 +387,14 @@ template_tte <- function(dataname = "ANL", #' @param event_desc_var (`character` or [teal.transform::data_extract_spec()])\cr variable name with the #' event description information, optional. #' +#' @section Decorating Module: +#' +#' This module generates the following objects, which can be modified in place using decorators: +#' - `table` (`TableTree` - output of `rtables::build_table`) +#' +#' For additional details and examples of decorators, refer to the vignette +#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation. +#' #' @details #' * The core functionality of this module is based on [tern::coxph_pairwise()], [tern::surv_timepoint()], #' and [tern::surv_time()] from the `tern` package. @@ -493,7 +500,8 @@ tm_t_tte <- function(label, na_level = default_na_str(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args()) { + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL) { message("Initializing tm_t_tte") checkmate::assert_string(label) checkmate::assert_string(dataname) @@ -513,6 +521,8 @@ tm_t_tte <- function(label, checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE) checkmate::assert_class(basic_table_args, "basic_table_args") + decorators <- normalize_decorators(decorators) + assert_decorators(decorators, null.ok = TRUE, "table") args <- as.list(environment()) @@ -540,7 +550,8 @@ tm_t_tte <- function(label, label = label, total_label = total_label, na_level = na_level, - basic_table_args = basic_table_args + basic_table_args = basic_table_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -724,7 +735,8 @@ ui_t_tte <- function(id, ...) { data_extract_spec = a$time_unit_var, is_single_dataset = is_single_dataset_value ) - ) + ), + ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "table")), ), forms = tagList( teal.widgets::verbatim_popup_ui(ns("rcode"), button_label = "Show R code") @@ -753,7 +765,8 @@ srv_t_tte <- function(id, total_label, label, na_level, - basic_table_args) { + basic_table_args, + decorators) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -947,13 +960,22 @@ srv_t_tte <- function(id, anl_q() %>% teal.code::eval_code(as.expression(unlist(my_calls))) }) - table_r <- reactive(all_q()[["table"]]) + decorated_table_q <- srv_decorate_teal_data( + id = "decorator", + data = all_q, + decorators = select_decorators(decorators, "table"), + expr = table + ) + + table_r <- reactive(decorated_table_q()[["table"]]) teal.widgets::table_with_settings_srv(id = "table", table_r = table_r) + # Render R code + source_code_r <- reactive(teal.code::get_code(req(decorated_table_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(all_q())), + verbatim_content = source_code_r, title = label ) @@ -972,7 +994,7 @@ srv_t_tte <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(all_q())) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/utils.R b/R/utils.R index 3e0c1b9b8f..f3a4e916f5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -946,3 +946,139 @@ set_default_total_label <- function(total_label) { # for mocking in tests interactive <- NULL + +#' Wrappers around `srv_transform_teal_data` that allows to decorate the data +#' @inheritParams teal::srv_transform_teal_data +#' @param expr (`expression` or `reactive`) to evaluate on the output of the decoration. +#' When an expression it must be inline code. See [within()] +#' Default is `NULL` which won't evaluate any appending code. +#' @param expr_is_reactive (`logical(1)`) whether `expr` is a reactive expression +#' that skips defusing the argument. +#' @details +#' `srv_decorate_teal_data` is a wrapper around `srv_transform_teal_data` that +#' allows to decorate the data with additional expressions. +#' When original `teal_data` object is in error state, it will show that error +#' first. +#' +#' @keywords internal +srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive = FALSE) { + checkmate::assert_class(data, classes = "reactive") + checkmate::assert_list(decorators, "teal_transform_module") + checkmate::assert_flag(expr_is_reactive) + + missing_expr <- missing(expr) + if (!missing_expr && !expr_is_reactive) { + expr <- dplyr::enexpr(expr) # Using dplyr re-export to avoid adding rlang to Imports + } + + moduleServer(id, function(input, output, session) { + decorated_output <- srv_transform_teal_data("inner", data = data, transformators = decorators) + + reactive({ + data_out <- try(data(), silent = TRUE) + if (inherits(data_out, "qenv.error")) { + data() + } else { + # ensure original errors are displayed and `eval_code` is never executed with NULL + req(data(), decorated_output()) + if (missing_expr) { + decorated_output() + } else if (expr_is_reactive) { + teal.code::eval_code(decorated_output(), expr()) + } else { + teal.code::eval_code(decorated_output(), expr) + } + } + }) + }) +} + +#' @rdname srv_decorate_teal_data +#' @details +#' `ui_decorate_teal_data` is a wrapper around `ui_transform_teal_data`. +#' @keywords internal +ui_decorate_teal_data <- function(id, decorators, ...) { + teal::ui_transform_teal_data(NS(id, "inner"), transformators = decorators, ...) +} + +#' Internal function to check if decorators is a valid object +#' @noRd +check_decorators <- function(x, names = NULL, null.ok = FALSE) { # nolint: object_name. + checkmate::qassert(null.ok, "B1") + + check_message <- checkmate::check_list( + x, + null.ok = null.ok, + names = "named" + ) + + if (!is.null(names)) { + check_message <- if (isTRUE(check_message)) { + out_message <- checkmate::check_names(names(x), subset.of = c("default", names)) + # see https://github.com/insightsengineering/teal.logger/issues/101 + if (isTRUE(out_message)) { + out_message + } else { + gsub("\\{", "(", gsub("\\}", ")", out_message)) + } + } else { + check_message + } + } + + if (!isTRUE(check_message)) { + return(check_message) + } + + valid_elements <- vapply( + x, + checkmate::test_list, + types = "teal_transform_module", + null.ok = TRUE, + FUN.VALUE = logical(1L) + ) + + if (all(valid_elements)) { + return(TRUE) + } + + "May only contain the type 'teal_transform_module' or a named list of 'teal_transform_module'." +} + +#' Internal assertion on decorators +#' @noRd +assert_decorators <- checkmate::makeAssertionFunction(check_decorators) + +#' Subset decorators based on the scope +#' +#' `default` is a protected decorator name that is always included in the output, +#' if it exists +#' +#' @param scope (`character`) a character vector of decorator names to include. +#' @param decorators (named `list`) of list decorators to subset. +#' +#' @return A flat list with all decorators to include. +#' It can be an empty list if none of the scope exists in `decorators` argument. +#' @keywords internal +select_decorators <- function(decorators, scope) { + checkmate::assert_character(scope, null.ok = TRUE) + scope <- intersect(union("default", scope), names(decorators)) + c(list(), unlist(decorators[scope], recursive = FALSE)) +} + +#' Convert flat list of `teal_transform_module` to named lists +#' +#' @param decorators (list of `teal_transformodules`) to normalize. +#' @return A named list of lists with `teal_transform_module` objects. +#' @keywords internal +normalize_decorators <- function(decorators) { + if (checkmate::test_list(decorators, "teal_transform_module", null.ok = TRUE)) { + if (checkmate::test_names(names(decorators))) { + lapply(decorators, list) + } else { + list(default = decorators) + } + } else { + decorators + } +} diff --git a/inst/WORDLIST b/inst/WORDLIST index 8dd5973dd2..b73251e664 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -25,6 +25,7 @@ programmatically repo responder responders +transformator unadjusted univariable unstratified diff --git a/man/module_arguments.Rd b/man/module_arguments.Rd index 397fb160f2..d21b1100b7 100644 --- a/man/module_arguments.Rd +++ b/man/module_arguments.Rd @@ -133,6 +133,15 @@ value indicating worst grade.} \item{worst_flag_var}{(\code{\link[teal.transform:choices_selected]{teal.transform::choices_selected()}})\cr object with all available choices and preselected option for variable names that can be used as worst flag variable.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. diff --git a/man/normalize_decorators.Rd b/man/normalize_decorators.Rd new file mode 100644 index 0000000000..a58207f162 --- /dev/null +++ b/man/normalize_decorators.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{normalize_decorators} +\alias{normalize_decorators} +\title{Convert flat list of \code{teal_transform_module} to named lists} +\usage{ +normalize_decorators(decorators) +} +\arguments{ +\item{decorators}{(list of \code{teal_transformodules}) to normalize.} +} +\value{ +A named list of lists with \code{teal_transform_module} objects. +} +\description{ +Convert flat list of \code{teal_transform_module} to named lists +} +\keyword{internal} diff --git a/man/select_decorators.Rd b/man/select_decorators.Rd new file mode 100644 index 0000000000..2c7403dcad --- /dev/null +++ b/man/select_decorators.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{select_decorators} +\alias{select_decorators} +\title{Subset decorators based on the scope} +\usage{ +select_decorators(decorators, scope) +} +\arguments{ +\item{decorators}{(named \code{list}) of list decorators to subset.} + +\item{scope}{(\code{character}) a character vector of decorator names to include.} +} +\value{ +A flat list with all decorators to include. +It can be an empty list if none of the scope exists in \code{decorators} argument. +} +\description{ +\code{default} is a protected decorator name that is always included in the output, +if it exists +} +\keyword{internal} diff --git a/man/srv_decorate_teal_data.Rd b/man/srv_decorate_teal_data.Rd new file mode 100644 index 0000000000..18201124e0 --- /dev/null +++ b/man/srv_decorate_teal_data.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{srv_decorate_teal_data} +\alias{srv_decorate_teal_data} +\alias{ui_decorate_teal_data} +\title{Wrappers around \code{srv_transform_teal_data} that allows to decorate the data} +\usage{ +srv_decorate_teal_data(id, data, decorators, expr, expr_is_reactive = FALSE) + +ui_decorate_teal_data(id, decorators, ...) +} +\arguments{ +\item{id}{(\code{character(1)}) Module id} + +\item{data}{(\verb{reactive teal_data})} + +\item{expr}{(\code{expression} or \code{reactive}) to evaluate on the output of the decoration. +When an expression it must be inline code. See \code{\link[=within]{within()}} +Default is \code{NULL} which won't evaluate any appending code.} + +\item{expr_is_reactive}{(\code{logical(1)}) whether \code{expr} is a reactive expression +that skips defusing the argument.} +} +\description{ +Wrappers around \code{srv_transform_teal_data} that allows to decorate the data +} +\details{ +\code{srv_decorate_teal_data} is a wrapper around \code{srv_transform_teal_data} that +allows to decorate the data with additional expressions. +When original \code{teal_data} object is in error state, it will show that error +first. + +\code{ui_decorate_teal_data} is a wrapper around \code{ui_transform_teal_data}. +} +\keyword{internal} diff --git a/man/tm_a_gee.Rd b/man/tm_a_gee.Rd index 35dd29535f..1ddd4d6b85 100644 --- a/man/tm_a_gee.Rd +++ b/man/tm_a_gee.Rd @@ -20,7 +20,8 @@ tm_a_gee( TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -69,6 +70,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -76,6 +86,18 @@ a \code{teal_module} object. \description{ This module produces an analysis table using Generalized Estimating Equations (GEE). } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_a_mmrm.Rd b/man/tm_a_mmrm.Rd index 58225572c2..24a9ba9600 100644 --- a/man/tm_a_mmrm.Rd +++ b/man/tm_a_mmrm.Rd @@ -26,7 +26,8 @@ tm_a_mmrm( pre_output = NULL, post_output = NULL, basic_table_args = teal.widgets::basic_table_args(), - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -94,6 +95,15 @@ with settings for all the plots or named list of \code{ggplot2_args} objects for List names should match the following: \code{c("default", "lsmeans", "diagnostic")}. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the help vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -107,6 +117,39 @@ different convergence behavior. This is a known observation with the used packag \code{lme4}. However, once convergence is achieved, the results are reliable up to numerical precision. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{lsmeans_plot} (\code{ggplot2}) +\item \code{diagnostic_plot} (\code{TableTree}- output from \code{rtables::build_table}) +\item \code{lsmeans_table} (\code{TableTree}- output from \code{rtables::build_table}) +\item \code{covariance_table} (\code{TableTree}- output from \code{rtables::build_table}) +\item \code{fixed_effects_table} (\code{TableTree}- output from \code{rtables::build_table}) +\item \code{diagnostic_table} (\code{TableTree}- output from \code{rtables::build_table}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_a_mrmm( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + lsmeans_plot = list(teal_transform_module(...)) # applied only to `lsmeans_plot` output + diagnostic_plot = list(teal_transform_module(...)) # applied only to `diagnostic_plot` output + lsmeans_table = list(teal_transform_module(...)) # applied only to `lsmeans_table` output + covariance_table = list(teal_transform_module(...)) # applied only to `covariance_table` output + fixed_effects_table = list(teal_transform_module(...)) # applied only to `fixed_effects_table` output + diagnostic_table = list(teal_transform_module(...)) # applied only to `diagnostic_table` output + ) +) +}\if{html}{\out{
}} +} + \examples{ library(dplyr) diff --git a/man/tm_g_barchart_simple.Rd b/man/tm_g_barchart_simple.Rd index f1e92bc46e..3cf410fcff 100644 --- a/man/tm_g_barchart_simple.Rd +++ b/man/tm_g_barchart_simple.Rd @@ -15,7 +15,8 @@ tm_g_barchart_simple( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -47,6 +48,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -58,6 +68,18 @@ This module produces a \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type bar Categories can be defined up to four levels deep and are defined through the \code{x}, \code{fill}, \code{x_facet}, and \code{y_facet} parameters. Any parameters set to \code{NULL} (default) are ignored. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_ci.Rd b/man/tm_g_ci.Rd index 7f3fc462f7..6d9f6ef3b3 100644 --- a/man/tm_g_ci.Rd +++ b/man/tm_g_ci.Rd @@ -16,7 +16,8 @@ tm_g_ci( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -49,6 +50,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -57,6 +67,18 @@ a \code{teal_module} object. This module produces a \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type confidence interval plot consistent with the TLG Catalog template \code{CIG01} available \href{https://insightsengineering.github.io/tlg-catalog/stable/graphs/other/cig01.html}{here}. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) diff --git a/man/tm_g_forest_rsp.Rd b/man/tm_g_forest_rsp.Rd index f20db1db1d..3812c351a4 100644 --- a/man/tm_g_forest_rsp.Rd +++ b/man/tm_g_forest_rsp.Rd @@ -29,7 +29,8 @@ tm_g_forest_rsp( font_size = c(15L, 1L, 30L), pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -113,6 +114,15 @@ elements: \code{title}, \code{caption}. No other elements would be taken into ac merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -120,6 +130,18 @@ a \code{teal_module} object. \description{ This module produces a grid-style forest plot for response data with ADaM structure. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_forest_tte.Rd b/man/tm_g_forest_tte.Rd index a8ddd026f4..6a63e6fd9e 100644 --- a/man/tm_g_forest_tte.Rd +++ b/man/tm_g_forest_tte.Rd @@ -32,7 +32,8 @@ tm_g_forest_tte( font_size = c(15L, 1L, 30L), pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -114,6 +115,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -121,6 +131,18 @@ a \code{teal_module} object. \description{ This module produces a grid-style forest plot for time-to-event data with ADaM structure. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_ipp.Rd b/man/tm_g_ipp.Rd index 907e24fc61..e0bdd6f36b 100644 --- a/man/tm_g_ipp.Rd +++ b/man/tm_g_ipp.Rd @@ -31,7 +31,8 @@ tm_g_ipp( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -92,6 +93,15 @@ argument is merged with option \code{teal.ggplot2_args} and with default module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -100,6 +110,18 @@ a \code{teal_module} object. This module produces \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type individual patient plots that display trends in parameter values over time for each patient, using data with ADaM structure. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_km.Rd b/man/tm_g_km.Rd index 02308139e0..3ba6fe9c3d 100644 --- a/man/tm_g_km.Rd +++ b/man/tm_g_km.Rd @@ -31,7 +31,8 @@ tm_g_km( plot_height = c(800L, 400L, 5000L), plot_width = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -101,6 +102,15 @@ For example a title.} \item{post_output}{(\code{shiny.tag}) optional,\cr with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -108,6 +118,18 @@ a \code{teal_module} object. \description{ This module produces a \code{ggplot}-style Kaplan-Meier plot for data with ADaM structure. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) diff --git a/man/tm_g_lineplot.Rd b/man/tm_g_lineplot.Rd index 84504eb8d5..653edf00e0 100644 --- a/man/tm_g_lineplot.Rd +++ b/man/tm_g_lineplot.Rd @@ -35,7 +35,8 @@ tm_g_lineplot( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -106,6 +107,15 @@ account. The argument is merged with option \code{teal.ggplot2_args} and with de the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -113,6 +123,18 @@ a \code{teal_module} object. \description{ This module produces a \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type line plot, with optional summary table, for standard ADaM data. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_pp_adverse_events.Rd b/man/tm_g_pp_adverse_events.Rd index a5e56dd54b..3c5f45e4b0 100644 --- a/man/tm_g_pp_adverse_events.Rd +++ b/man/tm_g_pp_adverse_events.Rd @@ -21,7 +21,8 @@ tm_g_pp_adverse_events( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -72,6 +73,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -79,6 +89,34 @@ a \code{teal_module} object. \description{ This module produces an adverse events table and \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type plot using ADaM datasets. } +\section{Decorating Modules}{ + + +This module generates the following objects, which can be modified in place using decorators:: +\itemize{ +\item \code{plot} (\code{ggplot2}) +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_g_pp_adverse_events( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + plot = list(teal_transform_module(...)), # applied only to `plot` output + table = list(teal_transform_module(...)) # applied only to `table` output + ) +) +}\if{html}{\out{
}} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_pp_patient_timeline.Rd b/man/tm_g_pp_patient_timeline.Rd index 5f34a838c4..45175ce256 100644 --- a/man/tm_g_pp_patient_timeline.Rd +++ b/man/tm_g_pp_patient_timeline.Rd @@ -25,7 +25,8 @@ tm_g_pp_patient_timeline( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -87,6 +88,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -94,6 +104,18 @@ a \code{teal_module} object. \description{ This module produces a patient profile timeline \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type plot using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_pp_therapy.Rd b/man/tm_g_pp_therapy.Rd index f91584fa7b..f309465208 100644 --- a/man/tm_g_pp_therapy.Rd +++ b/man/tm_g_pp_therapy.Rd @@ -24,7 +24,8 @@ tm_g_pp_therapy( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -84,6 +85,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -91,6 +101,34 @@ a \code{teal_module} object. \description{ This module produces a patient profile therapy table and \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}} type plot using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators:: +\itemize{ +\item \code{plot} (\code{ggplot2}) +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +Decorators can be applied to all outputs or only to specific objects using a +named list of \code{teal_transform_module} objects. +The \code{"default"} name is reserved for decorators that are applied to all outputs. +See code snippet below: + +\if{html}{\out{
}}\preformatted{tm_g_pp_therapy( + ..., # arguments for module + decorators = list( + default = list(teal_transform_module(...)), # applied to all outputs + plot = list(teal_transform_module(...)), # applied only to `plot` output + table = list(teal_transform_module(...)) # applied only to `table` output + ) +) +}\if{html}{\out{
}} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) library(dplyr) diff --git a/man/tm_g_pp_vitals.Rd b/man/tm_g_pp_vitals.Rd index e4562143c7..1989d7327e 100644 --- a/man/tm_g_pp_vitals.Rd +++ b/man/tm_g_pp_vitals.Rd @@ -18,7 +18,8 @@ tm_g_pp_vitals( plot_width = NULL, pre_output = NULL, post_output = NULL, - ggplot2_args = teal.widgets::ggplot2_args() + ggplot2_args = teal.widgets::ggplot2_args(), + decorators = NULL ) } \arguments{ @@ -59,6 +60,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use for the module plot. The argument is merged with option \code{teal.ggplot2_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -70,6 +80,18 @@ This module produces a patient profile vitals \code{\link[ggplot2:ggplot]{ggplot This plot supports horizontal lines for the following 6 \code{PARAMCD} levels when they are present in \code{dataname}: \code{"SYSBP"}, \code{"DIABP"}, \code{"TEMP"}, \code{"RESP"}, \code{"OXYSAT"}. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{plot} (\code{ggplot2}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(nestcolor) diff --git a/man/tm_t_abnormality.Rd b/man/tm_t_abnormality.Rd index a1d061747b..b6f09ce0e9 100644 --- a/man/tm_t_abnormality.Rd +++ b/man/tm_t_abnormality.Rd @@ -29,7 +29,8 @@ tm_t_abnormality( pre_output = NULL, post_output = NULL, na_level = default_na_str(), - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -89,6 +90,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -100,6 +110,18 @@ This module produces a table to summarize abnormality. Patients with the same abnormality at baseline as on the treatment visit can be excluded in accordance with GDSR specifications by using \code{exclude_base_abn}. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_abnormality_by_worst_grade.Rd b/man/tm_t_abnormality_by_worst_grade.Rd index 555ecc0f8e..f0349e6113 100644 --- a/man/tm_t_abnormality_by_worst_grade.Rd +++ b/man/tm_t_abnormality_by_worst_grade.Rd @@ -28,7 +28,8 @@ tm_t_abnormality_by_worst_grade( drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -83,6 +84,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -90,6 +100,18 @@ a \code{teal_module} object. \description{ This module produces a table to summarize laboratory test results with highest grade post-baseline } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_ancova.Rd b/man/tm_t_ancova.Rd index 82c76ee1c2..b2826c42ef 100644 --- a/man/tm_t_ancova.Rd +++ b/man/tm_t_ancova.Rd @@ -22,7 +22,8 @@ tm_t_ancova( TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -76,6 +77,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -94,6 +104,18 @@ expects that the analysis data has the following variables: observation per patient is expected for the analysis to be meaningful. } } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_binary_outcome.Rd b/man/tm_t_binary_outcome.Rd index 63d00a3332..b942d9d98f 100644 --- a/man/tm_t_binary_outcome.Rd +++ b/man/tm_t_binary_outcome.Rd @@ -30,7 +30,8 @@ tm_t_binary_outcome( na_level = default_na_str(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -103,6 +104,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -120,6 +130,18 @@ or re-categorize response categories and arrange the display order. If response \item Reference arms are automatically combined if multiple arms selected as reference group. } } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_coxreg.Rd b/man/tm_t_coxreg.Rd index ab7fac86e9..623cbcd200 100644 --- a/man/tm_t_coxreg.Rd +++ b/man/tm_t_coxreg.Rd @@ -24,7 +24,8 @@ tm_t_coxreg( TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -79,6 +80,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -113,6 +123,18 @@ test will be substituted in these cases. \item Multi-variable is the default choice for backward compatibility. } } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ ## First example ## ============= diff --git a/man/tm_t_events.Rd b/man/tm_t_events.Rd index 88c500d099..271a58efda 100644 --- a/man/tm_t_events.Rd +++ b/man/tm_t_events.Rd @@ -24,7 +24,8 @@ tm_t_events( incl_overall_sum = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -88,6 +89,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -95,6 +105,18 @@ a \code{teal_module} object. \description{ This module produces a table of events by term. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_events_by_grade.Rd b/man/tm_t_events_by_grade.Rd index 158dcdceda..ab31a139b4 100644 --- a/man/tm_t_events_by_grade.Rd +++ b/man/tm_t_events_by_grade.Rd @@ -24,7 +24,8 @@ tm_t_events_by_grade( drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -80,6 +81,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -87,6 +97,18 @@ a \code{teal_module} object. \description{ This module produces a table to summarize events by grade. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) data <- teal_data() diff --git a/man/tm_t_events_patyear.Rd b/man/tm_t_events_patyear.Rd index d5a2b87029..354a2b091c 100644 --- a/man/tm_t_events_patyear.Rd +++ b/man/tm_t_events_patyear.Rd @@ -24,7 +24,8 @@ tm_t_events_patyear( drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -80,6 +81,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -87,6 +97,18 @@ a \code{teal_module} object. \description{ This module produces a table of event rates adjusted for patient-years. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_events_summary.Rd b/man/tm_t_events_summary.Rd index 8aeca58dcb..47fc8eb878 100644 --- a/man/tm_t_events_summary.Rd +++ b/man/tm_t_events_summary.Rd @@ -32,7 +32,8 @@ tm_t_events_summary( count_events = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -105,6 +106,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -112,6 +122,18 @@ a \code{teal_module} object. \description{ This module produces an adverse events summary table. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_exposure.Rd b/man/tm_t_exposure.Rd index 7aec2d4a88..1899db3c03 100644 --- a/man/tm_t_exposure.Rd +++ b/man/tm_t_exposure.Rd @@ -28,7 +28,8 @@ tm_t_exposure( na_level = default_na_str(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -91,6 +92,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -98,6 +108,18 @@ a \code{teal_module} object. \description{ The module produces an exposure table for risk management plan. } +\section{Decorating Modules}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} as created from \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_logistic.Rd b/man/tm_t_logistic.Rd index 41a8e2bad7..a40e45660d 100644 --- a/man/tm_t_logistic.Rd +++ b/man/tm_t_logistic.Rd @@ -19,7 +19,8 @@ tm_t_logistic( TRUE), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -63,6 +64,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -71,6 +81,18 @@ a \code{teal_module} object. This module produces a multi-variable logistic regression table consistent with the TLG Catalog template \code{LGRT02} available \href{https://insightsengineering.github.io/tlg-catalog/stable/tables/efficacy/lgrt02.html}{here}. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{ElementaryTable} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) diff --git a/man/tm_t_mult_events.Rd b/man/tm_t_mult_events.Rd index 7eb44136ff..029f8663ac 100644 --- a/man/tm_t_mult_events.Rd +++ b/man/tm_t_mult_events.Rd @@ -20,7 +20,8 @@ tm_t_mult_events( drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -72,6 +73,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -79,6 +89,18 @@ a \code{teal_module} object. \description{ This module produces a table of multiple events by term. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_pp_basic_info.Rd b/man/tm_t_pp_basic_info.Rd index 9138d5e517..817a27fdd7 100644 --- a/man/tm_t_pp_basic_info.Rd +++ b/man/tm_t_pp_basic_info.Rd @@ -10,7 +10,8 @@ tm_t_pp_basic_info( patient_col = "USUBJID", vars = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -28,6 +29,15 @@ For example a title.} \item{post_output}{(\code{shiny.tag}) optional,\cr with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -35,6 +45,18 @@ a \code{teal_module} object. \description{ This module produces a patient profile basic info report using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_pp_laboratory.Rd b/man/tm_t_pp_laboratory.Rd index f4d00026c8..c2d32a50f8 100644 --- a/man/tm_t_pp_laboratory.Rd +++ b/man/tm_t_pp_laboratory.Rd @@ -18,7 +18,8 @@ tm_t_pp_laboratory( paramcd = NULL, anrind = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -58,6 +59,15 @@ For example a title.} \item{post_output}{(\code{shiny.tag}) optional,\cr with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -65,6 +75,18 @@ a \code{teal_module} object. \description{ This module produces a patient profile laboratory table using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_pp_medical_history.Rd b/man/tm_t_pp_medical_history.Rd index 0de76f252b..6e6dc2ce90 100644 --- a/man/tm_t_pp_medical_history.Rd +++ b/man/tm_t_pp_medical_history.Rd @@ -13,7 +13,8 @@ tm_t_pp_medical_history( mhbodsys = NULL, mhdistat = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -39,6 +40,15 @@ For example a title.} \item{post_output}{(\code{shiny.tag}) optional,\cr with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -46,6 +56,18 @@ a \code{teal_module} object. \description{ This module produces a patient profile medical history report using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_pp_prior_medication.Rd b/man/tm_t_pp_prior_medication.Rd index 2992351ab9..0dff808985 100644 --- a/man/tm_t_pp_prior_medication.Rd +++ b/man/tm_t_pp_prior_medication.Rd @@ -14,7 +14,8 @@ tm_t_pp_prior_medication( cmindc = NULL, cmstdy = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + decorators = NULL ) } \arguments{ @@ -43,6 +44,15 @@ For example a title.} \item{post_output}{(\code{shiny.tag}) optional,\cr with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -50,6 +60,18 @@ a \code{teal_module} object. \description{ This module produces a patient profile prior medication report using ADaM datasets. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{listing_df} - output of \code{rlistings::as_listing}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ library(dplyr) data <- teal_data() diff --git a/man/tm_t_shift_by_arm.Rd b/man/tm_t_shift_by_arm.Rd index 93d7ea80cb..d3123be141 100644 --- a/man/tm_t_shift_by_arm.Rd +++ b/man/tm_t_shift_by_arm.Rd @@ -25,7 +25,8 @@ tm_t_shift_by_arm( total_label = default_total_label(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -82,6 +83,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -89,6 +99,18 @@ a \code{teal_module} object. \description{ This module produces a summary table of analysis indicator levels by arm. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_shift_by_arm_by_worst.Rd b/man/tm_t_shift_by_arm_by_worst.Rd index 4672fa1283..6d7823f395 100644 --- a/man/tm_t_shift_by_arm_by_worst.Rd +++ b/man/tm_t_shift_by_arm_by_worst.Rd @@ -25,7 +25,8 @@ tm_t_shift_by_arm_by_worst( total_label = default_total_label(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -83,6 +84,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -90,6 +100,18 @@ a \code{teal_module} object. \description{ This module produces a summary table of worst analysis indicator variable level per subject by arm. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_shift_by_grade.Rd b/man/tm_t_shift_by_grade.Rd index 0af0b42f44..059adb022f 100644 --- a/man/tm_t_shift_by_grade.Rd +++ b/man/tm_t_shift_by_grade.Rd @@ -34,7 +34,8 @@ tm_t_shift_by_grade( post_output = NULL, na_level = default_na_str(), code_missing_baseline = FALSE, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -97,6 +98,15 @@ default \code{na_level} to apply in all modules, run \code{set_default_na_str("n with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -104,6 +114,18 @@ a \code{teal_module} object. \description{ This module produces a summary table of worst grades per subject by visit and parameter. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_smq.Rd b/man/tm_t_smq.Rd index cd211d8edd..5169323c17 100644 --- a/man/tm_t_smq.Rd +++ b/man/tm_t_smq.Rd @@ -23,7 +23,8 @@ tm_t_smq( scopes, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -82,6 +83,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -89,6 +99,18 @@ a \code{teal_module} object. \description{ This module produces an adverse events table by Standardized MedDRA Query. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_summary.Rd b/man/tm_t_summary.Rd index e0a427b8c7..912584a416 100644 --- a/man/tm_t_summary.Rd +++ b/man/tm_t_summary.Rd @@ -22,7 +22,8 @@ tm_t_summary( drop_arm_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -78,6 +79,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -85,6 +95,18 @@ a \code{teal_module} object. \description{ This module produces a table to summarize variables. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ # Preparation of the test case - use `EOSDY` and `DCSREAS` variables to demonstrate missing data. data <- teal_data() diff --git a/man/tm_t_summary_by.Rd b/man/tm_t_summary_by.Rd index 91173fea1c..44bf42cebd 100644 --- a/man/tm_t_summary_by.Rd +++ b/man/tm_t_summary_by.Rd @@ -28,7 +28,8 @@ tm_t_summary_by( drop_zero_levels = TRUE, pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -98,6 +99,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -105,6 +115,18 @@ a \code{teal_module} object. \description{ This module produces a table to summarize variables by row groups. } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/man/tm_t_tte.Rd b/man/tm_t_tte.Rd index 17ada77bc3..3fb8d1828b 100644 --- a/man/tm_t_tte.Rd +++ b/man/tm_t_tte.Rd @@ -31,7 +31,8 @@ tm_t_tte( na_level = default_na_str(), pre_output = NULL, post_output = NULL, - basic_table_args = teal.widgets::basic_table_args() + basic_table_args = teal.widgets::basic_table_args(), + decorators = NULL ) } \arguments{ @@ -98,6 +99,15 @@ For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are use with settings for the module table. The argument is merged with option \code{teal.basic_table_args} and with default module arguments (hard coded in the module body). For more details, see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}.} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +" (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or" \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ a \code{teal_module} object. @@ -120,6 +130,18 @@ filtering for \code{PARAMCD} one observation per patient is expected } } } +\section{Decorating Module}{ + + +This module generates the following objects, which can be modified in place using decorators: +\itemize{ +\item \code{table} (\code{TableTree} - output of \code{rtables::build_table}) +} + +For additional details and examples of decorators, refer to the vignette +\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[=teal_transform_module]{teal_transform_module()}} documentation. +} + \examples{ data <- teal_data() data <- within(data, { diff --git a/tests/testthat/_snaps/tm_a_gee.md b/tests/testthat/_snaps/tm_a_gee.md index 54b672ec84..d081d2600a 100644 --- a/tests/testthat/_snaps/tm_a_gee.md +++ b/tests/testthat/_snaps/tm_a_gee.md @@ -13,9 +13,9 @@ $table { - result_table <- tern.gee::as.rtable(model_fit, type = "cov") - subtitles(result_table) <- NULL - main_footer(result_table) <- NULL + table <- tern.gee::as.rtable(model_fit, type = "cov") + subtitles(table) <- NULL + main_footer(table) <- NULL } @@ -34,9 +34,9 @@ $table { - result_table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients)) - subtitles(result_table) <- NULL - main_footer(result_table) <- NULL + table <- tern.gee::as.rtable(data.frame(Coefficient = model_fit$coefficients)) + subtitles(table) <- NULL + main_footer(table) <- NULL } @@ -56,13 +56,12 @@ $table { lsmeans_fit_model <- tern.gee::lsmeans(model_fit, 0.95) - result_table <- rtables::basic_table(show_colcounts = TRUE) %>% + table <- rtables::basic_table(show_colcounts = TRUE) %>% rtables::split_cols_by(var = "ARM", ref_group = model_fit$ref_level) %>% tern.gee::summarize_gee_logistic() %>% rtables::build_table(df = lsmeans_fit_model, alt_counts_df = ANL_ADSL) - subtitles(result_table) <- NULL - main_footer(result_table) <- NULL - result_table + subtitles(table) <- NULL + main_footer(table) <- NULL } @@ -82,13 +81,12 @@ $table { lsmeans_fit_model <- tern.gee::lsmeans(model_fit, 0.95) - result_table <- rtables::basic_table(show_colcounts = TRUE) %>% + table <- rtables::basic_table(show_colcounts = TRUE) %>% rtables::split_cols_by(var = "ARM", ref_group = model_fit$ref_level) %>% tern.gee::summarize_gee_logistic() %>% rtables::build_table(df = lsmeans_fit_model, alt_counts_df = ANL_ADSL) - subtitles(result_table) <- NULL - main_footer(result_table) <- NULL - result_table + subtitles(table) <- NULL + main_footer(table) <- NULL } diff --git a/tests/testthat/_snaps/tm_a_mmrm.md b/tests/testthat/_snaps/tm_a_mmrm.md index f03e7915f4..f480620078 100644 --- a/tests/testthat/_snaps/tm_a_mmrm.md +++ b/tests/testthat/_snaps/tm_a_mmrm.md @@ -62,9 +62,8 @@ $cov_matrix { - cov_matrix <- tern.mmrm::as.rtable(fit_mmrm, type = "cov") - subtitles(cov_matrix) <- NULL - cov_matrix + covariance_table <- tern.mmrm::as.rtable(fit_mmrm, type = "cov") + subtitles(covariance_table) <- NULL } @@ -80,9 +79,8 @@ $cov_matrix { - cov_matrix <- tern.mmrm::as.rtable(fit_mmrm, type = "cov") - subtitles(cov_matrix) <- NULL - cov_matrix + covariance_table <- tern.mmrm::as.rtable(fit_mmrm, type = "cov") + subtitles(covariance_table) <- NULL } diff --git a/tests/testthat/_snaps/tm_g_ci.md b/tests/testthat/_snaps/tm_g_ci.md index 87b69c4257..6c394bdc13 100644 --- a/tests/testthat/_snaps/tm_g_ci.md +++ b/tests/testthat/_snaps/tm_g_ci.md @@ -4,7 +4,7 @@ res Output { - gg <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, + plot <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, y = AVAL, color = SEX, lty = SEX, shape = SEX)) + ggplot2::stat_summary(fun.data = stat_mean_ci, geom = "errorbar", width = 0.1, position = ggplot2::position_dodge(width = 0.5)) + ggplot2::stat_summary(fun = mean, geom = "point", position = ggplot2::position_dodge(width = 0.5)) + @@ -12,7 +12,6 @@ caption = "Mean and 95% CIs for mean are displayed.", x = "Treatment Group", y = "Value", color = "", lty = "", shape = "") - print(gg) } # 3. Confidence Interval Plot (using different stratification variable) @@ -21,7 +20,7 @@ res Output { - gg <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, + plot <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, y = AVAL, color = STRATA2, lty = STRATA2, shape = STRATA2)) + ggplot2::stat_summary(fun.data = stat_mean_ci, geom = "errorbar", width = 0.1, position = ggplot2::position_dodge(width = 0.5)) + @@ -30,7 +29,6 @@ caption = "Mean and 95% CIs for mean are displayed.", x = "Treatment Group", y = "Value", color = "", lty = "", shape = "") - print(gg) } # 4. Median and 95% CIs for median @@ -39,7 +37,7 @@ res Output { - gg <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, + plot <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, y = AVAL, color = STRATA1, lty = STRATA1, shape = STRATA1)) + ggplot2::stat_summary(fun.data = stat_median_ci, geom = "errorbar", width = 0.1, position = ggplot2::position_dodge(width = 0.5)) + @@ -48,7 +46,6 @@ caption = "Median and 95% CIs for median are displayed.", x = "Treatment Group", y = "Value", color = "", lty = "", shape = "") - print(gg) } # 5. Using different alpha level @@ -57,7 +54,7 @@ res Output { - gg <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, + plot <- ggplot2::ggplot(data = ANL, mapping = ggplot2::aes(x = ARMCD, y = AVAL, color = SEX, lty = SEX, shape = SEX)) + ggplot2::stat_summary(fun.data = function(x) stat_mean_ci(x, conf_level = 0.9), geom = "errorbar", width = 0.1, position = ggplot2::position_dodge(width = 0.5)) + ggplot2::stat_summary(fun = mean, geom = "point", position = ggplot2::position_dodge(width = 0.5)) + @@ -65,6 +62,5 @@ caption = "Mean and 90% CIs for mean are displayed.", x = "Treatment Group", y = "Value", color = "", lty = "", shape = "") - print(gg) } diff --git a/tests/testthat/_snaps/tm_g_forest_rsp.md b/tests/testthat/_snaps/tm_g_forest_rsp.md index 5a9daf5d7d..8a238a1902 100644 --- a/tests/testthat/_snaps/tm_g_forest_rsp.md +++ b/tests/testthat/_snaps/tm_g_forest_rsp.md @@ -35,7 +35,7 @@ as_list = TRUE) $plot[[2]] - p <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Best Overall Response for "), + plot <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Best Overall Response for "), f[["plot"]] + ggplot2::labs(caption = ""), align = "h", axis = "tblr", rel_widths = c(1 - 0.25, 0.25)) @@ -80,7 +80,7 @@ as_list = TRUE) $plot[[2]] - p <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Best Overall Response for "), + plot <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Best Overall Response for "), f[["plot"]] + ggplot2::labs(caption = ""), align = "h", axis = "tblr", rel_widths = c(1 - 0.25, 0.25)) diff --git a/tests/testthat/_snaps/tm_g_forest_tte.md b/tests/testthat/_snaps/tm_g_forest_tte.md index f7bcf257a5..2f1c7e5b7b 100644 --- a/tests/testthat/_snaps/tm_g_forest_tte.md +++ b/tests/testthat/_snaps/tm_g_forest_tte.md @@ -38,7 +38,7 @@ as_list = TRUE) $plot[[2]] - p <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Survival Duration for \nStratified by STRATA2", + plot <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Survival Duration for \nStratified by STRATA2", subtitle = NULL), f[["plot"]] + ggplot2::labs(caption = ""), align = "h", axis = "tblr", rel_widths = c(1 - 0.25, 0.25)) @@ -85,7 +85,7 @@ as_list = TRUE) $plot[[2]] - p <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Survival Duration for \nStratified by STRATA2", + plot <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Survival Duration for \nStratified by STRATA2", subtitle = NULL), f[["plot"]] + ggplot2::labs(caption = ""), align = "h", axis = "tblr", rel_widths = c(1 - 0.25, 0.25)) diff --git a/tests/testthat/_snaps/tm_g_km.md b/tests/testthat/_snaps/tm_g_km.md index 06fbb48cf9..8011eba338 100644 --- a/tests/testthat/_snaps/tm_g_km.md +++ b/tests/testthat/_snaps/tm_g_km.md @@ -52,7 +52,6 @@ g_km_counter <- g_km_counter_generator() plot_list <- lapply(anl, g_km_counter) plot <- cowplot::plot_grid(plotlist = plot_list, ncol = 1) - plot } @@ -114,7 +113,6 @@ g_km_counter <- g_km_counter_generator() plot_list <- lapply(anl, g_km_counter) plot <- cowplot::plot_grid(plotlist = plot_list, ncol = 1) - plot } @@ -177,7 +175,6 @@ g_km_counter <- g_km_counter_generator() plot_list <- lapply(anl, g_km_counter) plot <- cowplot::plot_grid(plotlist = plot_list, ncol = 1) - plot } diff --git a/tests/testthat/_snaps/tm_g_lineplot.md b/tests/testthat/_snaps/tm_g_lineplot.md index 82e7977b32..ac91769eba 100644 --- a/tests/testthat/_snaps/tm_g_lineplot.md +++ b/tests/testthat/_snaps/tm_g_lineplot.md @@ -24,7 +24,6 @@ legend_title = NULL, ggtheme = ggplot2::theme_minimal(), control = control_analyze_vars(conf_level = 0.95), subtitle_add_paramcd = FALSE, subtitle_add_unit = FALSE) - plot } @@ -54,7 +53,6 @@ legend_title = NULL, ggtheme = ggplot2::theme_minimal(), control = control_analyze_vars(conf_level = 0.9), subtitle_add_paramcd = FALSE, subtitle_add_unit = FALSE) - plot } diff --git a/tests/testthat/_snaps/tm_t_abnormality.md b/tests/testthat/_snaps/tm_t_abnormality.md index 7218f4dab3..711f3d7e20 100644 --- a/tests/testthat/_snaps/tm_t_abnormality.md +++ b/tests/testthat/_snaps/tm_t_abnormality.md @@ -38,9 +38,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% rtables::prune_table() - result } @@ -83,9 +82,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% rtables::prune_table() - result } @@ -129,9 +127,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% rtables::prune_table() - result } diff --git a/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md b/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md index eb4b9b8f38..206160d2e6 100644 --- a/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md +++ b/tests/testthat/_snaps/tm_t_abnormality_by_worst_grade.md @@ -40,8 +40,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -87,8 +86,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = myadsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = myadsl) } diff --git a/tests/testthat/_snaps/tm_t_ancova.md b/tests/testthat/_snaps/tm_t_ancova.md index c465073a71..15ff963686 100644 --- a/tests/testthat/_snaps/tm_t_ancova.md +++ b/tests/testthat/_snaps/tm_t_ancova.md @@ -30,8 +30,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } @@ -68,8 +67,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } @@ -107,8 +105,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } @@ -148,8 +145,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } @@ -187,8 +183,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } @@ -225,8 +220,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } @@ -263,8 +257,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = adqs, alt_counts_df = adsl) } diff --git a/tests/testthat/_snaps/tm_t_binary_outcome.md b/tests/testthat/_snaps/tm_t_binary_outcome.md index 4e425de8dd..100f127cf1 100644 --- a/tests/testthat/_snaps/tm_t_binary_outcome.md +++ b/tests/testthat/_snaps/tm_t_binary_outcome.md @@ -31,8 +31,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -68,8 +67,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) } @@ -96,8 +94,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) } @@ -141,8 +138,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) } @@ -182,8 +178,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) } @@ -211,8 +206,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ADSL) } @@ -270,8 +264,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } diff --git a/tests/testthat/_snaps/tm_t_coxreg.md b/tests/testthat/_snaps/tm_t_coxreg.md index aacb9470fc..35b47c9a5b 100644 --- a/tests/testthat/_snaps/tm_t_coxreg.md +++ b/tests/testthat/_snaps/tm_t_coxreg.md @@ -25,7 +25,7 @@ "hr", "ci", "pval"), na_str = "") $table - result <- rtables::build_table(lyt = lyt, df = anl) + table <- rtables::build_table(lyt = lyt, df = anl) # template_coxreg generates correct univariate cox regression expressions with interactions @@ -55,7 +55,7 @@ "hr", "ci", "pval", "pval_inter"), na_str = "") $table - result <- rtables::build_table(lyt = lyt, df = anl) + table <- rtables::build_table(lyt = lyt, df = anl) # template_coxreg generates correct multivariate cox regression expressions @@ -85,8 +85,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl) - result + table <- rtables::build_table(lyt = lyt, df = anl) } diff --git a/tests/testthat/_snaps/tm_t_events.md b/tests/testthat/_snaps/tm_t_events.md index 7e9f4302ae..a99064ad79 100644 --- a/tests/testthat/_snaps/tm_t_events.md +++ b/tests/testthat/_snaps/tm_t_events.md @@ -34,21 +34,21 @@ append_varlabels(adae, "AEDECOD", indent = 1L) $table - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) $prune { - pruned_result <- result %>% rtables::prune_table() + pruned_result <- rtables::prune_table(table) } $sort { - idx_split_col <- which(sapply(col_paths(result), tail, 1) == + idx_split_col <- which(sapply(col_paths(table), tail, 1) == "All Patients") pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, - ncol(result)))) + ncol(table)))) pruned_and_sorted_result } @@ -94,21 +94,21 @@ append_varlabels(adae, "AEDECOD", indent = 1L) $table - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) $prune { - pruned_result <- result %>% rtables::prune_table() + pruned_result <- rtables::prune_table(table) } $sort { - idx_split_col <- which(sapply(col_paths(result), tail, 1) == + idx_split_col <- which(sapply(col_paths(table), tail, 1) == "All Patients") pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, - ncol(result)))) + ncol(table)))) pruned_and_sorted_result } @@ -138,16 +138,16 @@ append_varlabels(adcm, "CMDECOD") $table - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) $prune { - pruned_result <- result %>% rtables::prune_table() + pruned_result <- rtables::prune_table(table) } $sort { - idx_split_col <- which(sapply(col_paths(result), tail, 1) == + idx_split_col <- which(sapply(col_paths(table), tail, 1) == "All Patients") pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("CMDECOD"), scorefun = score_occurrences) @@ -193,11 +193,11 @@ append_varlabels(adae, "AEDECOD", indent = 1L) $table - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) $prune { - pruned_result <- result %>% rtables::prune_table() + pruned_result <- rtables::prune_table(table) } $sort @@ -243,12 +243,12 @@ append_varlabels(adae, "AEDECOD", indent = 1L) $table - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) $prune { - pruned_result <- result %>% rtables::prune_table() - col_indices <- 1:(ncol(result) - TRUE) + pruned_result <- rtables::prune_table(table) + col_indices <- 1:(ncol(table) - TRUE) row_condition <- has_fraction_in_any_col(atleast = 0.4, col_indices = col_indices) & has_fractions_difference(atleast = 0.1, col_indices = col_indices) pruned_result <- pruned_result %>% rtables::prune_table(keep_rows(row_condition)) @@ -256,12 +256,12 @@ $sort { - idx_split_col <- which(sapply(col_paths(result), tail, 1) == + idx_split_col <- which(sapply(col_paths(table), tail, 1) == "All Patients") pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, - ncol(result)))) + ncol(table)))) criteria_fun <- function(tr) { inherits(tr, "ContentRow") } @@ -312,12 +312,12 @@ append_varlabels(adae, "AEDECOD", indent = 1L) $table - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) $prune { - pruned_result <- result %>% rtables::prune_table() - col_indices <- 1:(ncol(result) - TRUE) + pruned_result <- rtables::prune_table(table) + col_indices <- 1:(ncol(table) - TRUE) row_condition <- has_fraction_in_any_col(atleast = 0.4, col_indices = col_indices) & has_fractions_difference(atleast = 0.1, col_indices = col_indices) pruned_result <- pruned_result %>% rtables::prune_table(keep_rows(row_condition)) @@ -325,12 +325,12 @@ $sort { - idx_split_col <- which(sapply(col_paths(result), tail, 1) == + idx_split_col <- which(sapply(col_paths(table), tail, 1) == "All Patients") pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = c("AEBODSYS"), scorefun = cont_n_onecol(idx_split_col)) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = score_occurrences_cols(col_indices = seq(1, - ncol(result)))) + ncol(table)))) criteria_fun <- function(tr) { inherits(tr, "ContentRow") } diff --git a/tests/testthat/_snaps/tm_t_events_by_grade.md b/tests/testthat/_snaps/tm_t_events_by_grade.md index c162695772..030113353c 100644 --- a/tests/testthat/_snaps/tm_t_events_by_grade.md +++ b/tests/testthat/_snaps/tm_t_events_by_grade.md @@ -50,7 +50,6 @@ 1), decreasing = TRUE) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = cont_n_onecol(length(levels(adsl$ACTARM)) + 1), decreasing = TRUE) - pruned_and_sorted_result } @@ -110,7 +109,6 @@ 1), decreasing = TRUE) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = cont_n_onecol(length(levels(adsl$ACTARM)) + 1), decreasing = TRUE) - pruned_and_sorted_result } @@ -162,7 +160,6 @@ pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = "AEBODSYS", scorefun = cont_n_allcols, decreasing = TRUE) %>% sort_at_path(path = c("AEBODSYS", "*", "AEDECOD"), scorefun = cont_n_allcols, decreasing = TRUE) - pruned_and_sorted_result } @@ -212,7 +209,6 @@ pruned_and_sorted_result <- pruned_result %>% sort_at_path(path = "AEBODSYS", scorefun = cont_n_onecol(length(levels(adsl$ACTARM)) + 1), decreasing = TRUE) - pruned_and_sorted_result } @@ -279,7 +275,6 @@ col_indices = col_indices) pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = criteria_fun) %>% rtables::prune_table(keep_rows(at_least_percent_any)) - pruned_and_sorted_result } @@ -341,7 +336,6 @@ col_indices = col_indices) pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = criteria_fun) %>% rtables::prune_table(keep_rows(at_least_percent_any)) - pruned_and_sorted_result } @@ -401,7 +395,6 @@ col_indices = col_indices) pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = criteria_fun) %>% rtables::prune_table(keep_rows(at_least_percent_any)) - pruned_and_sorted_result } @@ -460,7 +453,6 @@ col_indices = col_indices) pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = criteria_fun) %>% rtables::prune_table(keep_rows(at_least_percent_any)) - pruned_and_sorted_result } diff --git a/tests/testthat/_snaps/tm_t_events_patyear.md b/tests/testthat/_snaps/tm_t_events_patyear.md index b6ef72e888..fbaa31bcf2 100644 --- a/tests/testthat/_snaps/tm_t_events_patyear.md +++ b/tests/testthat/_snaps/tm_t_events_patyear.md @@ -23,8 +23,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -52,8 +51,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -87,8 +85,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } diff --git a/tests/testthat/_snaps/tm_t_events_summary.md b/tests/testthat/_snaps/tm_t_events_summary.md index 6a7334d7bc..4e13d750b6 100644 --- a/tests/testthat/_snaps/tm_t_events_summary.md +++ b/tests/testthat/_snaps/tm_t_events_summary.md @@ -28,7 +28,7 @@ .formats = c(count_fraction = format_count_fraction), denom = "N_col") $table_parent - result_parent <- rtables::build_table(lyt = lyt_parent, df = adsl, + table_parent <- rtables::build_table(lyt = lyt_parent, df = adsl, alt_counts_df = adsl) $layout_anl @@ -41,12 +41,12 @@ .labels = c(count = "Total AEs"), table_names = "total_aes") $table_anl - result_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = adsl) + table_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = adsl) $table { - rtables::col_info(result_parent) <- rtables::col_info(result_anl) - result <- rtables::rbind(result_anl, result_parent) + rtables::col_info(table_parent) <- rtables::col_info(table_anl) + table <- rtables::rbind(table_anl, table_parent) } @@ -79,7 +79,7 @@ rtables::split_cols_by(var = "ARM") %>% rtables::add_overall_col(label = "All Patients") $table_parent - result_parent <- rtables::build_table(lyt = lyt_parent, df = adsl, + table_parent <- rtables::build_table(lyt = lyt_parent, df = adsl, alt_counts_df = adsl) $layout_anl @@ -114,12 +114,12 @@ show_labels = "visible") $table_anl - result_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = adsl) + table_anl <- rtables::build_table(lyt = lyt_anl, df = anl, alt_counts_df = adsl) $table { - rtables::col_info(result_parent) <- rtables::col_info(result_anl) - result <- rtables::rbind(result_anl[1:2, ], result_anl[3:nrow(result_anl), + rtables::col_info(table_parent) <- rtables::col_info(table_anl) + table <- rtables::rbind(table_anl[1:2, ], table_anl[3:nrow(table_anl), ]) } diff --git a/tests/testthat/_snaps/tm_t_exposure.md b/tests/testthat/_snaps/tm_t_exposure.md index f436b5704a..02f54739b5 100644 --- a/tests/testthat/_snaps/tm_t_exposure.md +++ b/tests/testthat/_snaps/tm_t_exposure.md @@ -26,8 +26,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - rtables::prune_table(result) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::prune_table(table) } @@ -59,8 +59,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = myadsl) - rtables::prune_table(result) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = myadsl) + table <- rtables::prune_table(table) } @@ -92,8 +92,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - rtables::prune_table(result) + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) + table <- rtables::prune_table(table) } diff --git a/tests/testthat/_snaps/tm_t_logisitic.md b/tests/testthat/_snaps/tm_t_logisitic.md index 9a1a99a81f..e4e7ecae2f 100644 --- a/tests/testthat/_snaps/tm_t_logisitic.md +++ b/tests/testthat/_snaps/tm_t_logisitic.md @@ -27,10 +27,9 @@ $table { - result <- rtables::basic_table(title = "Summary of Logistic Regression Analysis for Best Confirmed Overall Response by Investigator for CR Responders") %>% + table <- rtables::basic_table(title = "Summary of Logistic Regression Analysis for Best Confirmed Overall Response by Investigator for CR Responders") %>% summarize_logistic(conf_level = 0.95, drop_and_remove_str = "_NA_") %>% rtables::append_topleft("BESRSPI") %>% rtables::build_table(df = mod) - result } @@ -63,10 +62,9 @@ $table { - result <- rtables::basic_table(title = "Summary of Logistic Regression Analysis for Best Confirmed Overall Response by Investigator for CR Responders") %>% + table <- rtables::basic_table(title = "Summary of Logistic Regression Analysis for Best Confirmed Overall Response by Investigator for CR Responders") %>% summarize_logistic(conf_level = 0.95, drop_and_remove_str = "_NA_") %>% rtables::append_topleft("BESRSPI") %>% rtables::build_table(df = mod) - result } @@ -88,10 +86,9 @@ $table { - result <- rtables::basic_table(title = "Summary of Logistic Regression Analysis for Best Confirmed Overall Response by Investigator for CR Responders") %>% + table <- rtables::basic_table(title = "Summary of Logistic Regression Analysis for Best Confirmed Overall Response by Investigator for CR Responders") %>% summarize_logistic(conf_level = 0.95, drop_and_remove_str = "_NA_") %>% rtables::append_topleft("BESRSPI") %>% rtables::build_table(df = mod) - result } diff --git a/tests/testthat/_snaps/tm_t_mult_events.md b/tests/testthat/_snaps/tm_t_mult_events.md index fbf4492a74..0a825e6cb0 100644 --- a/tests/testthat/_snaps/tm_t_mult_events.md +++ b/tests/testthat/_snaps/tm_t_mult_events.md @@ -43,8 +43,7 @@ $final_table { - result <- sorted_result - result + table <- sorted_result } @@ -95,8 +94,7 @@ $final_table { - result <- sorted_result - result + table <- sorted_result } @@ -151,8 +149,7 @@ $final_table { - result <- sorted_result - result + table <- sorted_result } @@ -211,8 +208,7 @@ $final_table { - result <- sorted_result - result + table <- sorted_result } @@ -256,8 +252,7 @@ $final_table { - result <- sorted_result - result + table <- sorted_result } @@ -306,8 +301,7 @@ $final_table { - result <- sorted_result - result + table <- sorted_result } diff --git a/tests/testthat/_snaps/tm_t_pp_medical_history.md b/tests/testthat/_snaps/tm_t_pp_medical_history.md index 50a9a80d21..997603bcc5 100644 --- a/tests/testthat/_snaps/tm_t_pp_medical_history.md +++ b/tests/testthat/_snaps/tm_t_pp_medical_history.md @@ -11,12 +11,11 @@ dplyr::arrange(mhbodsys) %>% dplyr::mutate_if(is.character, as.factor) %>% dplyr::mutate_if(is.factor, function(x) explicit_na(x, "UNKNOWN")) %>% dplyr::distinct() %>% `colnames<-`(labels) - result <- rtables::basic_table() %>% rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>% + table <- rtables::basic_table() %>% rtables::split_cols_by_multivar(colnames(result_raw)[2:3]) %>% rtables::split_rows_by(colnames(result_raw)[1], split_fun = rtables::drop_split_levels) %>% rtables::split_rows_by(colnames(result_raw)[2], split_fun = rtables::drop_split_levels, child_labels = "hidden") %>% rtables::analyze_colvars(function(x) x[seq_along(x)]) %>% rtables::build_table(result_raw) - main_title(result) <- paste("Patient ID:", NULL) - result + main_title(table) <- paste("Patient ID:", NULL) } diff --git a/tests/testthat/_snaps/tm_t_shift_by_arm.md b/tests/testthat/_snaps/tm_t_shift_by_arm.md index 31e8c262de..b376510198 100644 --- a/tests/testthat/_snaps/tm_t_shift_by_arm.md +++ b/tests/testthat/_snaps/tm_t_shift_by_arm.md @@ -22,8 +22,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adeg) - result + table <- rtables::build_table(lyt = lyt, df = adeg) } @@ -51,8 +50,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adeg) - result + table <- rtables::build_table(lyt = lyt, df = adeg) } @@ -80,8 +78,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adeg) - result + table <- rtables::build_table(lyt = lyt, df = adeg) } diff --git a/tests/testthat/_snaps/tm_t_shift_by_arm_by_worst.md b/tests/testthat/_snaps/tm_t_shift_by_arm_by_worst.md index 137032875c..c219c22457 100644 --- a/tests/testthat/_snaps/tm_t_shift_by_arm_by_worst.md +++ b/tests/testthat/_snaps/tm_t_shift_by_arm_by_worst.md @@ -22,8 +22,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adeg) - result + table <- rtables::build_table(lyt = lyt, df = adeg) } @@ -52,8 +51,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adeg) - result + table <- rtables::build_table(lyt = lyt, df = adeg) } @@ -81,8 +79,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = adeg) - result + table <- rtables::build_table(lyt = lyt, df = adeg) } diff --git a/tests/testthat/_snaps/tm_t_shift_by_grade.md b/tests/testthat/_snaps/tm_t_shift_by_grade.md index 5227edd6c7..89a3f8c8ca 100644 --- a/tests/testthat/_snaps/tm_t_shift_by_grade.md +++ b/tests/testthat/_snaps/tm_t_shift_by_grade.md @@ -53,9 +53,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% rtables::prune_table() - result } @@ -114,9 +113,8 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% rtables::prune_table() - result } diff --git a/tests/testthat/_snaps/tm_t_smq.md b/tests/testthat/_snaps/tm_t_smq.md index 33b82a9b22..83014b17f3 100644 --- a/tests/testthat/_snaps/tm_t_smq.md +++ b/tests/testthat/_snaps/tm_t_smq.md @@ -52,8 +52,7 @@ all_zero <- function(tr) { !inherits(tr, "ContentRow") && rtables::all_zero_or_na(tr) } - pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = all_zero) - pruned_and_sorted_result + table <- sorted_result %>% rtables::trim_rows(criteria = all_zero) } @@ -107,8 +106,7 @@ all_zero <- function(tr) { !inherits(tr, "ContentRow") && rtables::all_zero_or_na(tr) } - pruned_and_sorted_result <- sorted_result %>% rtables::trim_rows(criteria = all_zero) - pruned_and_sorted_result + table <- sorted_result %>% rtables::trim_rows(criteria = all_zero) } diff --git a/tests/testthat/_snaps/tm_t_summary.md b/tests/testthat/_snaps/tm_t_summary.md index b62aabeca5..6d406c0463 100644 --- a/tests/testthat/_snaps/tm_t_summary.md +++ b/tests/testthat/_snaps/tm_t_summary.md @@ -24,8 +24,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -55,8 +54,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -91,8 +89,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -128,8 +125,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -163,8 +159,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -201,8 +196,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } diff --git a/tests/testthat/_snaps/tm_t_summary_by.md b/tests/testthat/_snaps/tm_t_summary_by.md index 41e7a9d906..e150e211d6 100644 --- a/tests/testthat/_snaps/tm_t_summary_by.md +++ b/tests/testthat/_snaps/tm_t_summary_by.md @@ -29,8 +29,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -64,8 +63,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -107,8 +105,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -142,8 +139,7 @@ $table { - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) - result + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) } @@ -185,9 +181,8 @@ rvs <- unlist(unname(row_values(tr))) isTRUE(all(rvs == 0)) } - result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% + table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl) %>% rtables::trim_rows(criteria = all_zero) - result } diff --git a/tests/testthat/_snaps/tm_t_tte.md b/tests/testthat/_snaps/tm_t_tte.md index b3621e75cd..e51da0c8d9 100644 --- a/tests/testthat/_snaps/tm_t_tte.md +++ b/tests/testthat/_snaps/tm_t_tte.md @@ -39,7 +39,6 @@ $table { table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ANL_ADSL) - table } @@ -84,7 +83,6 @@ $table { table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ANL_ADSL) - table } @@ -143,7 +141,6 @@ $table { table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ANL_ADSL) - table } @@ -199,7 +196,6 @@ $table { table <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = ANL_ADSL) - table }