Skip to content

Commit

Permalink
Merge branch '1187_decorate_output@main' into tm_t_shift_by_arm@1187_…
Browse files Browse the repository at this point in the history 
…decorate_output@main
  • Loading branch information
@averissimo
averissimo authored Dec 10, 2024
2 parents f1b24ad + 8986e27 commit 1cfec56
Show file tree
Hide file tree
Showing 15 changed files with 437 additions and 94 deletions.
90 changes: 70 additions & 20 deletions R/tm_g_pp_adverse_events.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ template_adverse_events <- function(dataname = "ANL",
list(),
substitute(
expr = {
table <- dataname %>%
table_data <- dataname %>%
dplyr::select(
aeterm, tox_grade, causality, outcome, action, time, decod
) %>%
Expand All @@ -63,9 +63,7 @@ template_adverse_events <- function(dataname = "ANL",
key_cols = NULL,
default_formatting = list(all = fmt_config(align = "left"))
)
main_title(table) <- paste("Patient ID:", patient_id)

table
main_title(table_output) <- paste("Patient ID:", patient_id)
},
env = list(
dataname = as.name(dataname),
Expand Down Expand Up @@ -110,7 +108,7 @@ template_adverse_events <- function(dataname = "ANL",
chart_list <- add_expr(
list(),
substitute(
expr = plot <- dataname %>%
expr = plot_output <- dataname %>%
dplyr::select(aeterm, time, tox_grade, causality) %>%
dplyr::mutate(ATOXGR = as.character(tox_grade)) %>%
dplyr::arrange(dplyr::desc(ATOXGR)) %>%
Expand Down Expand Up @@ -156,11 +154,6 @@ template_adverse_events <- function(dataname = "ANL",
)
)

chart_list <- add_expr(
expr_ls = chart_list,
new_expr = quote(plot)
)

y$table <- bracket_expr(table_list)
y$chart <- bracket_expr(chart_list)

Expand All @@ -187,9 +180,35 @@ template_adverse_events <- function(dataname = "ANL",
#' available choices and preselected option for the `ASTDY` variable from `dataname`.
#' @param decod ([teal.transform::choices_selected()])\cr object with all
#' available choices and preselected option for the `AEDECOD` variable from `dataname`.
#' @param decorators `r roxygen_decorators_param("tm_g_pp_adverse_events")`
#'
#' @inherit module_arguments return
#'
#' @section Decorating `tm_g_pp_adverse_events`:
#'
#' This module generates the following objects, which can be modified in place using decorators::
#' - `plot` (`ggplot2`)
#' - `table` (`listing_df` - output of `rlistings::as_listing`)
#'
#' Decorators can be applied to all outputs or only to specific objects using a
#' named list of `teal_transform_module` objects.
#' The `"default"` name is reserved for decorators that are applied to all outputs.
#' See code snippet below:
#'
#' ```
#' tm_g_pp_adverse_events(
#' ..., # arguments for module
#' decorators = list(
#' default = list(teal_transform_module(...)), # applied to all outputs
#' plot = list(teal_transform_module(...)), # applied only to `plot` output
#' table = list(teal_transform_module(...)) # applied only to `table` output
#' )
#' )
#' ```
#'
#' 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 @@ -268,7 +287,8 @@ tm_g_pp_adverse_events <- function(label,
plot_width = NULL,
pre_output = NULL,
post_output = NULL,
ggplot2_args = teal.widgets::ggplot2_args()) {
ggplot2_args = teal.widgets::ggplot2_args(),
decorators = NULL) {
message("Initializing tm_g_pp_adverse_events")
checkmate::assert_string(label)
checkmate::assert_string(dataname)
Expand All @@ -293,6 +313,8 @@ tm_g_pp_adverse_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(ggplot2_args, "ggplot2_args")
decorators <- normalize_decorators(decorators)
assert_decorators(decorators, names = c("plot", "table"), null.ok = TRUE)

args <- as.list(environment())
data_extract_list <- list(
Expand All @@ -319,7 +341,8 @@ tm_g_pp_adverse_events <- function(label,
patient_col = patient_col,
plot_height = plot_height,
plot_width = plot_width,
ggplot2_args = ggplot2_args
ggplot2_args = ggplot2_args,
decorators = decorators
)
),
datanames = c(dataname, parentname)
Expand Down Expand Up @@ -408,6 +431,8 @@ ui_g_adverse_events <- function(id, ...) {
is_single_dataset = is_single_dataset_value
)
),
ui_decorate_teal_data(ns("d_table"), decorators = select_decorators(ui_args$decorators, "table")),
ui_decorate_teal_data(ns("d_plot"), decorators = select_decorators(ui_args$decorators, "plot")),
teal.widgets::panel_item(
title = "Plot settings",
collapsed = TRUE,
Expand Down Expand Up @@ -445,7 +470,8 @@ srv_g_adverse_events <- function(id,
plot_height,
plot_width,
label,
ggplot2_args) {
ggplot2_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 @@ -564,14 +590,29 @@ srv_g_adverse_events <- function(id,
paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
})

output$table <- DT::renderDataTable(
expr = teal.code::dev_suppress(all_q()[["table"]]),
options = list(pageLength = input$table_rows)
# Allow for the table and plot qenv to be joined
table_q <- reactive(within(all_q(), table <- table_output))
plot_q <- reactive(within(all_q(), plot <- plot_output))

decorated_all_q_table <- srv_decorate_teal_data(
"d_table",
data = table_q,
decorators = select_decorators(decorators, "table"),
expr = table
)

decorated_all_q_plot <- srv_decorate_teal_data(
"d_plot",
data = plot_q,
decorators = select_decorators(decorators, "plot"),
expr = print(plot)
)

table_r <- reactive(teal.code::dev_suppress(decorated_all_q_table()[["table"]]))

plot_r <- reactive({
req(iv_r()$is_valid())
all_q()[["plot"]]
decorated_all_q_plot()[["plot"]]
})

pws <- teal.widgets::plot_with_settings_srv(
Expand All @@ -581,9 +622,18 @@ srv_g_adverse_events <- function(id,
width = plot_width
)

output$table <- DT::renderDataTable(
expr = table_r(),
options = list(pageLength = input$table_rows)
)

decorated_all_q <- reactive(
c(decorated_all_q_table(), decorated_all_q_plot())
)

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_all_q()))),
title = label
)

Expand All @@ -597,14 +647,14 @@ srv_g_adverse_events <- function(id,
filter_panel_api = filter_panel_api
)
card$append_text("Table", "header3")
card$append_table(teal.code::dev_suppress(all_q()[["table"]]))
card$append_table(teal.code::dev_suppress(table_r()))
card$append_text("Plot", "header3")
card$append_plot(plot_r(), dim = pws$dim())
if (!comment == "") {
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_all_q())))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
42 changes: 33 additions & 9 deletions R/tm_t_logistic.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -186,14 +186,13 @@ template_logistic <- function(dataname,

y$table <- substitute(
expr = {
result <- expr_basic_table_args %>%
table <- expr_basic_table_args %>%
summarize_logistic(
conf_level = conf_level,
drop_and_remove_str = "_NA_"
) %>%
rtables::append_topleft(topleft) %>%
rtables::build_table(df = mod)
result
},
env = list(
expr_basic_table_args = parsed_basic_table_args,
Expand Down Expand Up @@ -222,6 +221,14 @@ template_logistic <- 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` (`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.
#'
#' @examplesShinylive
#' library(teal.modules.clinical)
#' interactive <- function() TRUE
Expand Down Expand Up @@ -297,7 +304,8 @@ tm_t_logistic <- 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_logistic")
checkmate::assert_string(label)
checkmate::assert_string(dataname)
Expand All @@ -311,6 +319,8 @@ tm_t_logistic <- 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 @@ -333,7 +343,8 @@ tm_t_logistic <- function(label,
label = label,
dataname = dataname,
parentname = parentname,
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 @@ -424,7 +435,8 @@ ui_t_logistic <- function(id, ...) {
a$conf_level$selected,
multiple = FALSE,
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 @@ -447,7 +459,8 @@ srv_t_logistic <- function(id,
avalc_var,
cov_var,
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 @@ -659,6 +672,7 @@ srv_t_logistic <- function(id,
)
})

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

Expand Down Expand Up @@ -696,16 +710,26 @@ srv_t_logistic <- function(id,
teal.code::eval_code(merged$anl_q(), as.expression(calls))
})

table_r <- reactive(all_q()[["result"]])
# Decoration of table output.
decorated_table_q <- srv_decorate_teal_data(
id = "decorator",
data = all_q,
decorators = select_decorators(decorators, "table"),
expr = table
)

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 @@ -724,7 +748,7 @@ srv_t_logistic <- 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
Loading

0 comments on commit 1cfec56

Please sign in to comment.