Skip to content

Commit

Permalink
Adds decorators to tm_t_smq (#1292)
Browse files Browse the repository at this point in the history
Part of insightsengineering/teal#1371

<details>
<summary>Working example</summary>

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

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADAE <- tmc_ex_adae

  .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
  )
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

app <- init(
  data = data,
  modules = modules(
    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())
    )
  )
) |> shiny::runApp()
```

</details>

---------

Co-authored-by: Marcin <[email protected]>
  • Loading branch information
averissimo and m7pr authored Dec 10, 2024
1 parent 3e98e81 commit 015a964
Show file tree
Hide file tree
Showing 2 changed files with 54 additions and 10 deletions.
40 changes: 31 additions & 9 deletions R/tm_t_smq.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
)

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

Expand All @@ -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)
Expand All @@ -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,
Expand Down Expand Up @@ -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",
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -621,6 +633,7 @@ srv_t_smq <- function(id,
)
})

# Generate r code for the analysis.
all_q <- reactive({
validate_checks()

Expand All @@ -642,18 +655,27 @@ 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",
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
)

Expand All @@ -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)
Expand Down
24 changes: 23 additions & 1 deletion man/tm_t_smq.Rd

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

0 comments on commit 015a964

Please sign in to comment.