Skip to content

Commit

Permalink
introduce decorators for tm_g_ipp (#1263)
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)
library(dplyr)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl %>%
    slice(1:20) %>%
    df_explicit_na()
  ADLB <- tmc_ex_adlb %>%
    filter(USUBJID %in% ADSL$USUBJID) %>%
    df_explicit_na() %>%
    filter(AVISIT != "SCREENING")
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADLB <- data[["ADLB"]]

caption_decorator <- function(default_caption = "I am a good decorator", .var_to_replace = "plot") {
  teal_transform_module(
    label = "Caption",
    ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_caption),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote)
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}

app <- init(
  data = data,
  modules = modules(
    tm_g_ipp(
      label = "Individual Patient Plot",
      dataname = "ADLB",
      arm_var = choices_selected(
        value_choices(ADLB, "ARMCD"),
        "ARM A"
      ),
      paramcd = choices_selected(
        value_choices(ADLB, "PARAMCD"),
        "ALT"
      ),
      aval_var = choices_selected(
        variable_choices(ADLB, c("AVAL", "CHG")),
        "AVAL"
      ),
      avalu_var = choices_selected(
        variable_choices(ADLB, c("AVALU")),
        "AVALU",
        fixed = TRUE
      ),
      id_var = choices_selected(
        variable_choices(ADLB, c("USUBJID")),
        "USUBJID",
        fixed = TRUE
      ),
      visit_var = choices_selected(
        variable_choices(ADLB, c("AVISIT")),
        "AVISIT"
      ),
      baseline_var = choices_selected(
        variable_choices(ADLB, c("BASE")),
        "BASE",
        fixed = TRUE
      ),
      add_baseline_hline = FALSE,
      separate_by_obs = FALSE,
      decorators = list(caption_decorator(.var_to_replace = "plot"))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

```

</details>
  • Loading branch information
m7pr authored Nov 28, 2024
1 parent 4e747f9 commit fcc3682
Showing 1 changed file with 27 additions and 6 deletions.
33 changes: 27 additions & 6 deletions R/tm_g_ipp.R
Original file line number Diff line number Diff line change
Expand Up @@ -179,6 +179,15 @@ template_g_ipp <- function(dataname = "ANL",
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_g_ipp`:
#'
#' 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 @@ -293,7 +302,8 @@ tm_g_ipp <- 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) {
if (lifecycle::is_present(base_var)) {
baseline_var <- base_var
warning(
Expand Down Expand Up @@ -329,6 +339,8 @@ tm_g_ipp <- 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, "plot")

args <- as.list(environment())
data_extract_list <- list(
Expand All @@ -354,7 +366,8 @@ tm_g_ipp <- function(label,
parentname = parentname,
plot_height = plot_height,
plot_width = plot_width,
ggplot2_args = ggplot2_args
ggplot2_args = ggplot2_args,
decorators = decorators
)
),
datanames = teal.transform::get_extract_datanames(data_extract_list)
Expand Down Expand Up @@ -428,6 +441,7 @@ ui_g_ipp <- function(id, ...) {
data_extract_spec = a$baseline_var,
is_single_dataset = is_single_dataset_value
),
ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(a$decorators, "plot")),
teal.widgets::panel_group(
teal.widgets::panel_item(
"Additional plot settings",
Expand Down Expand Up @@ -479,7 +493,8 @@ srv_g_ipp <- 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 @@ -611,7 +626,13 @@ srv_g_ipp <- function(id,
})

# Outputs to render.
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 @@ -623,7 +644,7 @@ srv_g_ipp <- 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 @@ -642,7 +663,7 @@ srv_g_ipp <- 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

0 comments on commit fcc3682

Please sign in to comment.