Skip to content

Commit

Permalink
Introduce decorator for tm_t_events (#1275)
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")
load_all(".")
data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADAE <- tmc_ex_adae
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADAE <- data[["ADAE"]]


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


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

```

</details>

---------

Co-authored-by: André Veríssimo <[email protected]>
  • Loading branch information
@llrs-roche @averissimo
llrs-roche and averissimo authored Dec 4, 2024
1 parent 28ba4c4 commit 5b87fdc
Show file tree
Hide file tree
Showing 2 changed files with 53 additions and 14 deletions.
46 changes: 33 additions & 13 deletions R/tm_t_events.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))
)

Expand All @@ -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)
)
)

Expand All @@ -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)
)
)
Expand Down Expand Up @@ -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)
)
)
Expand All @@ -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)
}
Expand Down Expand Up @@ -458,9 +458,18 @@ template_events <- function(dataname,
#' It defines the grouping variable(s) in the results table.
#' If there are two elements selected for `arm_var`,
#' second variable will be nested under the first variable.
#' @param decorators `r roxygen_decorators_param("tm_t_events")`
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_t_events`:
#'
#' 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 @@ -524,7 +533,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)
Expand All @@ -545,6 +555,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())

Expand All @@ -570,7 +582,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)
Expand Down Expand Up @@ -612,6 +625,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(
Expand Down Expand Up @@ -675,7 +689,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")
Expand Down Expand Up @@ -808,10 +823,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",
Expand All @@ -821,7 +841,7 @@ srv_t_events_byterm <- function(id,
# Render R code.
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(table_q())),
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
title = label
)

Expand All @@ -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(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_events.Rd
View file

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

0 comments on commit 5b87fdc

Please sign in to comment.