Skip to content

Commit

Permalink
Introduce decorators for tm_t events by grade (#1276)
Browse files Browse the repository at this point in the history
Part of insightsengineering/teal#1371

<details>
<summary>Example with decorators</summary>

```r
load_all("../teal")
load_all(".")
library(dplyr)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  .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
})
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_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())
    )
  )
)
shinyApp(app$ui, app$server)

```

</details>

---------

Signed-off-by: Lluís Revilla <185338939+llrs-roche@users.noreply.github.com>
Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com>
Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com>
  • Loading branch information
3 people authored Dec 11, 2024
1 parent b85523c commit eb42bae
Show file tree
Hide file tree
Showing 2 changed files with 51 additions and 18 deletions.
48 changes: 31 additions & 17 deletions R/tm_t_events_by_grade.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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)

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

Expand All @@ -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)
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -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})

Check warning on line 1210 in R/tm_t_events_by_grade.R

View workflow job for this annotation

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

file=R/tm_t_events_by_grade.R,line=1210,col=25,[brace_linter] Opening curly braces should never go on their own line and should always be followed by a new line.
})

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(
Expand All @@ -1215,7 +1229,7 @@ srv_t_events_by_grade <- 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 @@ -1234,7 +1248,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(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_by_grade.Rd

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

0 comments on commit eb42bae

Please sign in to comment.