Skip to content

Commit

Permalink
Introduce decorators for tm_t_coxreg (#1274)
Browse files Browse the repository at this point in the history 
Part of insightsengineering/teal#1371

<details>
<summary>Example with decorator</summary>

```r
load_all("../teal.code")
load_all("../teal.data")
load_all("../teal")
load_all(".")
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")
  )
)

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)))
    )
  )
}

data <- within(teal_data(), {
  ADSL <- tmc_ex_adsl
  ADTTE <- tmc_ex_adtte
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADTTE <- data[["ADTTE"]]

app <- init(
  data = data,
  modules = modules(
    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())
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

## Second example
library(dplyr)

data <- teal_data()
data <- within(data, {
  ADTTE <- data.frame(
    STUDYID = "LUNG",
    AVAL = c(4, 3, 1, 1, 2, 2, 3, 1, 2),
    CNSR = c(1, 1, 1, 0, 1, 1, 0, 0, 0),
    ARMCD = factor(
      c(0, 1, 1, 1, 1, 0, 0, 0, 0),
      labels = c("ARM A", "ARM B")
    ),
    SEX = factor(
      c(0, 0, 0, 0, 1, 1, 1, 1, 1),
      labels = c("F", "M")
    ),
    INST = factor(c("A", "A", "B", "B", "A", "B", "A", "B", "A")),
    stringsAsFactors = FALSE
  )
  ADTTE <- rbind(ADTTE, ADTTE, ADTTE, ADTTE)
  ADTTE <- as_tibble(ADTTE)
  set.seed(1)
  ADTTE$INST <- sample(ADTTE$INST)
  ADTTE$AGE <- sample(seq(5, 75, 5), size = nrow(ADTTE), replace = TRUE)
  ADTTE$USUBJID <- paste("sub", 1:nrow(ADTTE), ADTTE$INST, sep = "-")
  ADTTE$PARAM <- ADTTE$PARAMCD <- "OS"
  ADSL <- subset(
    ADTTE,
    select = c("USUBJID", "STUDYID", "ARMCD", "SEX", "INST", "AGE")
  )
})

join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADTTE <- data[["ADTTE"]]

## `teal` application
## ----------------
## Note that the R code exported by `Show R Code` does not include the data
## pre-processing. You will need to create the dataset as above before
## running the exported R code.

arm_ref_comp <- list(ARMCD = list(ref = "ARM A", comp = c("ARM B")))

app <- init(
  data = data,
  modules = modules(
    tm_t_coxreg(
      label = "Cox Reg.",
      dataname = "ADTTE",
      arm_var = choices_selected(c("ARMCD"), "ARMCD"),
      arm_ref_comp = arm_ref_comp,
      paramcd = choices_selected(
        value_choices(ADTTE, "PARAMCD", "PARAM"), "OS"
      ),
      strata_var = choices_selected(c("INST"), NULL),
      cov_var = choices_selected(c("SEX", "AGE"), "SEX"),
      multivariate = TRUE,
      decorators = list(insert_rrow_decorator())
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```

</details>

---------

Signed-off-by: Lluís Revilla <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>
  • Loading branch information
@llrs-roche @averissimo
llrs-roche and averissimo authored Dec 4, 2024
1 parent 6ddb425 commit 37e42a2
Show file tree
Hide file tree
Showing 2 changed files with 57 additions and 16 deletions.
52 changes: 37 additions & 15 deletions R/tm_t_coxreg.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -337,6 +336,7 @@ template_coxreg_m <- function(dataname,
#' @inheritParams template_coxreg_m
#' @param multivariate (`logical`)\cr if `FALSE`, the univariable approach is used instead of the
#' multi-variable model.
#' @param decorators `r roxygen_decorators_param("tm_t_coxreg")`
#'
#' @details
#' The Cox Proportional Hazards (PH) model is the most commonly used method to
Expand All @@ -361,6 +361,14 @@ template_coxreg_m <- function(dataname,
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_t_coxreg`:
#'
#' 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
Expand Down Expand Up @@ -520,7 +528,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)
Expand All @@ -536,6 +545,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())

Expand All @@ -561,7 +572,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)
Expand Down Expand Up @@ -694,7 +706,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")
Expand All @@ -720,7 +733,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")
Expand Down Expand Up @@ -831,10 +845,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,
Expand Down Expand Up @@ -1080,7 +1091,18 @@ 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"]]})

Check warning on line 1105 in R/tm_t_coxreg.R

View workflow job for this annotation

GitHub Actions / SuperLinter 🦸‍♀️ / Lint R code 🧶 

file=R/tm_t_coxreg.R,line=1105,col=6,[indentation_linter] Hanging indent should be 25 spaces but is 6 spaces.

teal.widgets::table_with_settings_srv(
id = "table",
Expand All @@ -1089,7 +1111,7 @@ srv_t_coxreg <- function(id,

teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(all_q())),
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
title = "R Code for the Current (Multi-Variable) Cox proportional hazard regression model"
)

Expand All @@ -1108,7 +1130,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(teal.code::get_code(req(decorated_table_q())))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
21 changes: 20 additions & 1 deletion man/tm_t_coxreg.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 37e42a2

Please sign in to comment.