Skip to content

Commit

Permalink
Introduce decorators to tm_g_forest_rsp (#1266)
Browse files Browse the repository at this point in the history 
Part of insightsengineering/teal#1371

This module also returns a plot from `cowplot`, and I am not sure if the
example I got works well (I am not that familiar with it).

<details>
<summary>Draft of an example</summary>

````r
devtools::load_all("../teal.reporter")
devtools::load_all("../teal")
devtools::load_all(".")
library(nestcolor)
library(dplyr)

caption_decorator <- function(annotation = "I am a good decorator", var_to_decorate = "plot") {
  teal_transform_module(
    label = "Annotation",
    ui = function(id) shiny::textInput(shiny::NS(id, "annotation"), "Annotation", value = annotation),
    server = make_teal_transform_server(
      substitute({
        var_to_decorate <- cowplot::add_sub(var_to_decorate, annotation)
      }, env = list(var_to_decorate = as.name(var_to_decorate)))
    )
  )
}

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADRS <- tmc_ex_adrs %>%
    mutate(AVALC = d_onco_rsp_label(AVALC) %>%
             with_label("Character Result/Finding")) %>%
    filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP")
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADRS <- data[["ADRS"]]

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

app <- init(
  data = data,
  modules = modules(
    tm_g_forest_rsp(
      label = "Forest Response",
      dataname = "ADRS",
      arm_var = choices_selected(
        variable_choices(ADSL, c("ARM", "ARMCD")),
        "ARMCD"
      ),
      arm_ref_comp = arm_ref_comp,
      paramcd = choices_selected(
        value_choices(ADRS, "PARAMCD", "PARAM"),
        "INVET"
      ),
      subgroup_var = choices_selected(
        variable_choices(ADSL, names(ADSL)),
        c("BMRKR2", "SEX")
      ),
      strata_var = choices_selected(
        variable_choices(ADSL, c("STRATA1", "STRATA2")),
        "STRATA2"
      ),
      plot_height = c(600L, 200L, 2000L),
      default_responses = list(
        BESRSPI = list(
          rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"),
          levels = c(
            "Complete Response (CR)", "Partial Response (PR)", "Stable Disease (SD)",
            "Progressive Disease (PD)", "Not Evaluable (NE)"
          )
        ),
        INVET = list(
          rsp = c("Complete Response (CR)", "Partial Response (PR)"),
          levels = c(
            "Complete Response (CR)", "Not Evaluable (NE)", "Partial Response (PR)",
            "Progressive Disease (PD)", "Stable Disease (SD)"
          )
        ),
        OVRINV = list(
          rsp = c("Progressive Disease (PD)", "Stable Disease (SD)"),
          levels = c("Progressive Disease (PD)", "Stable Disease (SD)", "Not Evaluable (NE)")
        )
      ),
      decorators = list(caption_decorator())
    )
  )
)
shinyApp(app$ui, app$server)


```

</details>

---------

Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com>
Co-authored-by: m7pr <marcin.kosinski.mk1@roche.com>
  • Loading branch information
@llrs-roche @m7pr
3 people authored Nov 28, 2024
1 parent b565310 commit 2276fca
Showing 1 changed file with 27 additions and 7 deletions.
34 changes: 27 additions & 7 deletions R/tm_g_forest_rsp.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -211,7 +211,7 @@ template_forest_rsp <- function(dataname = "ANL",
plot_list,
substitute(
expr = {
p <- cowplot::plot_grid(
plot <- cowplot::plot_grid(
f[["table"]] + ggplot2::labs(title = ggplot2_args_title),
f[["plot"]] + ggplot2::labs(caption = ggplot2_args_caption),
align = "h",
Expand Down Expand Up @@ -243,6 +243,14 @@ template_forest_rsp <- function(dataname = "ANL",
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_g_forest_tte`:
#'
#' This module generates the following objects, which can be modified in place using decorators:
#' - `plot` (`gg`)
#'
#' 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 @@ -355,7 +363,8 @@ tm_g_forest_rsp <- function(label,
font_size = c(15L, 1L, 30L),
pre_output = NULL,
post_output = NULL,
ggplot2_args = teal.widgets::ggplot2_args()) {
ggplot2_args = teal.widgets::ggplot2_args(),
decorators = NULL) {
message("Initializing tm_g_forest_rsp")
checkmate::assert_string(label)
checkmate::assert_string(dataname)
Expand All @@ -381,6 +390,8 @@ tm_g_forest_rsp <- 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())

Expand Down Expand Up @@ -409,7 +420,8 @@ tm_g_forest_rsp <- function(label,
default_responses = default_responses,
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 @@ -475,6 +487,7 @@ ui_g_forest_rsp <- function(id, ...) {
data_extract_spec = a$strata_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 @@ -529,7 +542,8 @@ srv_g_forest_rsp <- function(id,
plot_width,
label,
default_responses,
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 @@ -761,7 +775,13 @@ srv_g_forest_rsp <- function(id,
teal.code::eval_code(anl_q(), as.expression(unlist(my_calls)))
})

plot_r <- reactive(all_q()[["p"]])
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"]])

pws <- teal.widgets::plot_with_settings_srv(
id = "myplot",
Expand All @@ -772,7 +792,7 @@ srv_g_forest_rsp <- 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 @@ -791,7 +811,7 @@ srv_g_forest_rsp <- 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 2276fca

Please sign in to comment.