Skip to content

Commit

Permalink
introduce decorators for tm_t_abnormality (#1257)
Browse files Browse the repository at this point in the history
Part of insightsengineering/teal#1371

<details><summary> Working Example </summary>

```r
devtools::load_all("../teal")
devtools::load_all(".")

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

library(dplyr)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADLB <- tmc_ex_adlb %>%
    mutate(
      ONTRTFL = case_when(
        AVISIT %in% c("SCREENING", "BASELINE") ~ "",
        TRUE ~ "Y"
      ) %>% with_label("On Treatment Record Flag")
    )
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADLB <- data[["ADLB"]]

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

```

</details>

---------

Co-authored-by: Lluís Revilla <185338939+llrs-roche@users.noreply.github.com>
Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com>
  • Loading branch information
3 people authored Nov 29, 2024
1 parent 3ae43d2 commit d7b036e
Show file tree
Hide file tree
Showing 2 changed files with 51 additions and 11 deletions.
37 changes: 29 additions & 8 deletions R/tm_t_abnormality.R
Original file line number Diff line number Diff line change
Expand Up @@ -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))
)
Expand All @@ -234,9 +233,18 @@ template_abnormality <- function(parentname,
#' @param baseline_var ([teal.transform::choices_selected()])\cr
#' variable for baseline abnormality grade.
#' @param na_level (`character`)\cr the NA level in the input dataset, default to `"<Missing>"`.
#' @param decorators `r roxygen_decorators_param("tm_t_abnormality")`
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_t_abnormality`:
#'
#' 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`.
#'
Expand Down Expand Up @@ -330,7 +338,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)
Expand All @@ -351,6 +360,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),
Expand Down Expand Up @@ -378,7 +389,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)
Expand Down Expand Up @@ -434,6 +446,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",
Expand Down Expand Up @@ -502,7 +515,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")
Expand Down Expand Up @@ -644,8 +658,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",
Expand All @@ -655,7 +676,7 @@ srv_t_abnormality <- function(id,
# Render R code.
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 = label
)

Expand All @@ -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(teal.code::get_code(req(decorated_table_q())))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
25 changes: 22 additions & 3 deletions man/tm_t_abnormality.Rd

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

0 comments on commit d7b036e

Please sign in to comment.