Skip to content

Commit

Permalink
Introduce decorators for tm_g_km (#1254)
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(".")

library(nestcolor)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADTTE <- tmc_ex_adtte
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADTTE <- data[["ADTTE"]]

arm_ref_comp <- list(
  ACTARMCD = list(
    ref = "ARM B",
    comp = c("ARM A", "ARM C")
  ),
  ARM = list(
    ref = "B: Placebo",
    comp = c("A: Drug X", "C: Combination")
  )
)

change_theme_decorator <- function(default_check = TRUE, .var_to_replace = "plot") {
  teal_transform_module(
    label = "Theme",
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- .var_to_replace + ggplot2::theme_void()
      }, 
      env = list(.var_to_replace = as.name(.var_to_replace))
      )
    )
  )
}

app <- init(
  data = data,
  modules = modules(
    tm_g_km(
      label = "Kaplan-Meier Plot",
      dataname = "ADTTE",
      arm_var = choices_selected(
        variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")),
        "ARM"
      ),
      paramcd = choices_selected(
        value_choices(ADTTE, "PARAMCD", "PARAM"),
        "OS"
      ),
      arm_ref_comp = arm_ref_comp,
      strata_var = choices_selected(
        variable_choices(ADSL, c("SEX", "BMRKR2")),
        "SEX"
      ),
      facet_var = choices_selected(
        variable_choices(ADSL, c("SEX", "BMRKR2")),
        NULL
      ),
      decorators = list(plot = change_theme_decorator(TRUE, "plot"))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}


```

</details>

---------

Co-authored-by: André Veríssimo <[email protected]>
  • Loading branch information
m7pr and averissimo authored Nov 29, 2024
1 parent d7b036e commit af7ecff
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 8 deletions.
35 changes: 28 additions & 7 deletions R/tm_g_km.R
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,6 @@ template_g_km <- function(dataname = "ANL",
plotlist = plot_list,
ncol = 1
)
plot
},
env = list(
facet_var = if (length(facet_var) != 0L) as.name(facet_var),
Expand Down Expand Up @@ -268,9 +267,19 @@ template_g_km <- function(dataname = "ANL",
#' @inheritParams template_g_km
#' @param facet_var ([teal.transform::choices_selected()])\cr object with
#' all available choices and preselected option for names of variable that can be used for plot faceting.
#' @param decorators `r roxygen_decorators_param("tm_g_km")`
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_g_km`:
#'
#' This module generates the following objects, which can be modified in place using decorators:
#' - `plot` (`ggplot2`)
#'
#' 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 @@ -364,7 +373,8 @@ tm_g_km <- function(label,
plot_height = c(800L, 400L, 5000L),
plot_width = NULL,
pre_output = NULL,
post_output = NULL) {
post_output = NULL,
decorators = NULL) {
message("Initializing tm_g_km")

checkmate::assert_string(label)
Expand All @@ -387,6 +397,8 @@ tm_g_km <- function(label,
)
checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
decorators <- normalize_decorators(decorators)
assert_decorators(decorators, "plot", null.ok = TRUE)

args <- as.list(environment())
data_extract_list <- list(
Expand Down Expand Up @@ -415,7 +427,8 @@ tm_g_km <- function(label,
plot_width = plot_width,
control_annot_surv_med = control_annot_surv_med,
control_annot_coxph = control_annot_coxph,
legend_pos = legend_pos
legend_pos = legend_pos,
decorators = decorators
)
),
datanames = teal.transform::get_extract_datanames(data_extract_list)
Expand Down Expand Up @@ -512,6 +525,7 @@ ui_g_km <- function(id, ...) {
)
)
),
ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")),
conditionalPanel(
condition = paste0("input['", ns("compare_arms"), "']"),
teal.widgets::panel_group(
Expand Down Expand Up @@ -635,7 +649,8 @@ srv_g_km <- function(id,
plot_width,
control_annot_surv_med,
control_annot_coxph,
legend_pos) {
legend_pos,
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 @@ -809,7 +824,13 @@ srv_g_km <- function(id,
teal.code::eval_code(anl_q(), as.expression(unlist(my_calls)))
})

plot_r <- reactive(all_q()[["plot"]])
decorated_all_q <- srv_decorate_teal_data(
id = "decorator",
data = all_q,
decorators = select_decorators(decorators, "plot"),
expr = print(plot)
)
plot_r <- reactive(decorated_all_q()[["plot"]])

# Insert the plot into a plot with settings module from teal.widgets
pws <- teal.widgets::plot_with_settings_srv(
Expand All @@ -821,7 +842,7 @@ srv_g_km <- 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()))),
title = label
)

Expand All @@ -841,7 +862,7 @@ srv_g_km <- 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_all_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_g_km.Rd

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

0 comments on commit af7ecff

Please sign in to comment.