Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

introduce decorators for tm_g_pp_therapy #1268

Merged
merged 1 commit into from
Nov 29, 2024
Merged

introduce decorators for tm_g_pp_therapy #1268

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
74 changes: 59 additions & 15 deletions R/tm_g_pp_therapy.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ template_therapy <- function(dataname = "ANL",

dataname[setdiff(cols_to_include, names(dataname))] <- NA

therapy_table <- dataname %>%
table <- dataname %>%
dplyr::filter(atirel %in% c("CONCOMITANT", "PRIOR")) %>% # removed PRIOR_CONCOMITANT
dplyr::select(dplyr::all_of(cols_to_include)) %>%
dplyr::filter(!is.na(cmdecod)) %>%
Expand All @@ -84,14 +84,13 @@ template_therapy <- function(dataname = "ANL",
col_labels(dataname, fill = TRUE)[c(cmstdy_char, cmendy_char)]
))

therapy_table <- rlistings::as_listing(
therapy_table,
table <- rlistings::as_listing(
table,
key_cols = NULL,
default_formatting = list(all = fmt_config(align = "left"))
)
main_title(therapy_table) <- paste("Patient ID:", patient_id)
main_title(table) <- paste("Patient ID:", patient_id)

therapy_table
}, env = list(
dataname = as.name(dataname),
atirel = as.name(atirel),
Expand Down Expand Up @@ -173,7 +172,7 @@ template_therapy <- function(dataname = "ANL",
TRUE ~ as.character(cmdecod)
))

therapy_plot <-
plot <-
ggplot2::ggplot(data = data, ggplot2::aes(fill = cmindc, color = cmindc, y = CMDECOD, x = CMSTDY)) +
ggplot2::geom_segment(ggplot2::aes(xend = CMENDY, yend = CMDECOD), size = 2) +
ggplot2::geom_text(
Expand All @@ -192,7 +191,6 @@ template_therapy <- function(dataname = "ANL",
ggtheme +
theme

therapy_plot
}, env = c(
list(
dataname = as.name(dataname),
Expand Down Expand Up @@ -247,6 +245,31 @@ template_therapy <- function(dataname = "ANL",
#'
#' @inherit module_arguments return
#'
#' @section Decorating `tm_g_pp_therapy`:
#'
#' 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_therapy(
#' ..., # 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 @@ -347,7 +370,8 @@ tm_g_pp_therapy <- 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_therapy")
checkmate::assert_class(atirel, "choices_selected", null.ok = TRUE)
checkmate::assert_class(cmdecod, "choices_selected", null.ok = TRUE)
Expand Down Expand Up @@ -375,6 +399,8 @@ tm_g_pp_therapy <- 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, null.ok = TRUE, names = c('plot', 'table'))

args <- as.list(environment())
data_extract_list <- list(
Expand Down Expand Up @@ -404,7 +430,8 @@ tm_g_pp_therapy <- 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 @@ -510,6 +537,8 @@ ui_g_therapy <- function(id, ...) {
data_extract_spec = ui_args$cmendy,
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 @@ -551,7 +580,8 @@ srv_g_therapy <- 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 @@ -673,16 +703,30 @@ srv_g_therapy <- function(id,
paste("<h5><b>Patient ID:", all_q()[["pt_id"]], "</b></h5>")
})

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

output$therapy_table <- DT::renderDataTable(
expr = {
teal.code::dev_suppress(all_q()[["therapy_table"]])
teal.code::dev_suppress(decorated_all_q_table()[["table"]])
},
options = list(pageLength = input$therapy_table_rows)
)

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

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

pws <- teal.widgets::plot_with_settings_srv(
Expand All @@ -694,7 +738,7 @@ srv_g_therapy <- function(id,

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

Expand All @@ -708,14 +752,14 @@ srv_g_therapy <- function(id,
filter_panel_api = filter_panel_api
)
card$append_text("Table", "header3")
card$append_table(teal.code::dev_suppress(all_q()[["therapy_table"]]))
card$append_table(teal.code::dev_suppress(all_q()[["table"]]))
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_plot())))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down