Skip to content

Commit

Permalink
introduce decorators to tm_g_pp_patient_timeline (#1270)
Browse files Browse the repository at this point in the history 
Part of insightsengineering/teal#1371

<details>
<summary>Example using cowplot::add_sub with ggplot2</summary>

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

data <- teal_data()
data <- within(data, {
  ADAE <- tmc_ex_adae
  ADSL <- tmc_ex_adsl %>%
    filter(USUBJID %in% ADAE$USUBJID)
  ADCM <- tmc_ex_adcm %>%
    mutate(
      CMSTDY = case_when(
        CMCAT == "medcl B" ~ 20,
        CMCAT == "medcl C" ~ 150,
        TRUE ~ 1
      ) %>% with_label("Study Day of Start of Medication"),
      CMENDY = case_when(
        CMCAT == "medcl B" ~ 700,
        CMCAT == "medcl C" ~ 1000,
        TRUE ~ 500
      ) %>% with_label("Study Day of End of Medication"),
      CMASTDTM = ASTDTM,
      CMAENDTM = AENDTM
    )
})

join_keys(data) <- default_cdisc_join_keys[c("ADSL", "ADAE", "ADCM")]
adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
join_keys(data)["ADCM", "ADCM"] <- adcm_keys
join_keys(data)["ADAE", "ADCM"] <- c("STUDYID", "USUBJID")


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)))
    )
  )
}


app <- init(
  data = data,
  modules = modules(
    tm_g_pp_patient_timeline(
      label = "Patient Timeline",
      dataname_adae = "ADAE",
      dataname_adcm = "ADCM",
      parentname = "ADSL",
      patient_col = "USUBJID",
      plot_height = c(600L, 200L, 2000L),
      cmdecod = choices_selected(
        choices = variable_choices(data[["ADCM"]], "CMDECOD"),
        selected = "CMDECOD",
      ),
      aeterm = choices_selected(
        choices = variable_choices(data[["ADAE"]], "AETERM"),
        selected = c("AETERM")
      ),
      aetime_start = choices_selected(
        choices = variable_choices(data[["ADAE"]], "ASTDTM"),
        selected = c("ASTDTM")
      ),
      aetime_end = choices_selected(
        choices = variable_choices(data[["ADAE"]], "AENDTM"),
        selected = c("AENDTM")
      ),
      dstime_start = choices_selected(
        choices = variable_choices(data[["ADCM"]], "CMASTDTM"),
        selected = c("CMASTDTM")
      ),
      dstime_end = choices_selected(
        choices = variable_choices(data[["ADCM"]], "CMAENDTM"),
        selected = c("CMAENDTM")
      ),
      aerelday_start = choices_selected(
        choices = variable_choices(data[["ADAE"]], "ASTDY"),
        selected = c("ASTDY")
      ),
      aerelday_end = choices_selected(
        choices = variable_choices(data[["ADAE"]], "AENDY"),
        selected = c("AENDY")
      ),
      dsrelday_start = choices_selected(
        choices = variable_choices(data[["ADCM"]], "ASTDY"),
        selected = c("ASTDY")
      ),
      dsrelday_end = choices_selected(
        choices = variable_choices(data[["ADCM"]], "AENDY"),
        selected = c("AENDY")
      ),
      decorators = list(caption_decorator())
    )
  )
)
shinyApp(app$ui, app$server)
```

</details>

---------

Co-authored-by: m7pr <[email protected]>
  • Loading branch information
@llrs-roche @m7pr
llrs-roche and m7pr authored Nov 29, 2024
1 parent 31fdab6 commit 98520eb
Showing 1 changed file with 29 additions and 8 deletions.
37 changes: 29 additions & 8 deletions R/tm_g_pp_patient_timeline.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,14 @@
#'
#' @inherit template_arguments return
#'
#' @section Decorating `tm_g_pp_patient_timeline`:
#'
#' 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.
#'
#' @seealso [tm_g_pp_patient_timeline()]
#'
#' @keywords internal
Expand Down Expand Up @@ -175,7 +183,7 @@ template_patient_timeline <- function(dataname = "ANL",
) +
ggplot2::scale_x_datetime(labels = scales::date_format("%b-%Y")) + labs + themes
}
patient_timeline_plot
plot <- patient_timeline_plot
},
env = list(
font_size_var = font_size,
Expand Down Expand Up @@ -303,7 +311,7 @@ template_patient_timeline <- function(dataname = "ANL",
ggthemes +
themes
}
patient_timeline_plot
plot <- patient_timeline_plot
},
env = list(
labs = parsed_ggplot2_args$labs,
Expand Down Expand Up @@ -461,7 +469,8 @@ tm_g_pp_patient_timeline <- 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_patient_timeline")
checkmate::assert_string(label)
checkmate::assert_string(dataname_adcm)
Expand All @@ -487,6 +496,8 @@ tm_g_pp_patient_timeline <- function(label,
plot_width[1],
lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
)
decorators <- normalize_decorators(decorators)
assert_decorators(decorators, null.ok = TRUE, "plot")

xor_error_string <- function(x, y) {
paste(
Expand Down Expand Up @@ -543,7 +554,8 @@ tm_g_pp_patient_timeline <- 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_adcm, dataname_adae, parentname)
Expand Down Expand Up @@ -670,6 +682,7 @@ ui_g_patient_timeline <- function(id, ...) {
is_single_dataset = is_single_dataset_value
)
),
ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(ui_args$decorators, "plot")),
teal.widgets::panel_item(
title = "Plot settings",
collapsed = TRUE,
Expand Down Expand Up @@ -712,7 +725,8 @@ srv_g_patient_timeline <- 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 @@ -909,7 +923,14 @@ srv_g_patient_timeline <- function(id,
teal.code::eval_code(object = qenv, as.expression(patient_timeline_calls))
})

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

plot_r <- reactive(decorated_all_q()[["plot"]])

pws <- teal.widgets::plot_with_settings_srv(
id = "patient_timeline_plot",
Expand All @@ -920,7 +941,7 @@ srv_g_patient_timeline <- 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 @@ -939,7 +960,7 @@ srv_g_patient_timeline <- 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 98520eb

Please sign in to comment.