Skip to content

Commit

Permalink
introduce decorators for tm_g_barchart_simple (#1267)
Browse files Browse the repository at this point in the history 
Part of insightsengineering/teal#1371

#### Checklist for final review:

- Has documentation:
- [ ] `` #' @param decorators `r roxygen_decorators_param("tm_X_XXX")`
``
    - [ ] Section for decorators
- [ ] In case of multiple decorators, section has pseudo code explaining
how to limit calls
- [ ] Code shows in "Show R code"
- [ ] Reporter shows both the outputs and code
- [ ] Fix order of `assert_decorators` function (`null.ok = TRUE` is
sometimes second argument and looks better at 3^rd)

#### Example

<details><summary> Working Example </summary>

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

library(nestcolor)
library(dplyr)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl %>%
    mutate(ITTFL = factor("Y") %>%
             with_label("Intent-To-Treat Population Flag"))
  ADAE <- tmc_ex_adae %>%
    filter(!((AETOXGR == 1) & (AESEV == "MILD") & (ARM == "A: Drug X")))
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADAE <- data[["ADAE"]]

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

head_decorator <- function(default_value = 6, .var_to_replace = "object") {
  teal_transform_module(
    label = "Head",
    ui = function(id) shiny::numericInput(shiny::NS(id, "n"), "N rows", value = default_value),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- utils::head(.var_to_replace, n = n)
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}

app <- init(
  data = data,
  modules = modules(
    tm_g_barchart_simple(
      label = "ADAE Analysis",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(
            ADSL,
            c(
              "ARM", "ACTARM", "SEX",
              "RACE", "ITTFL", "SAFFL", "STRATA2"
            )
          ),
          selected = "ACTARM",
          multiple = FALSE
        )
      ),
      fill = list(
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(
              ADSL,
              c(
                "ARM", "ACTARM", "SEX",
                "RACE", "ITTFL", "SAFFL", "STRATA2"
              )
            ),
            selected = "SEX",
            multiple = FALSE
          )
        ),
        data_extract_spec(
          dataname = "ADAE",
          select = select_spec(
            choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
            selected = NULL,
            multiple = FALSE
          )
        )
      ),
      x_facet = list(
        data_extract_spec(
          dataname = "ADAE",
          select = select_spec(
            choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
            selected = "AETOXGR",
            multiple = FALSE
          )
        ),
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(
              ADSL,
              c(
                "ARM", "ACTARM", "SEX",
                "RACE", "ITTFL", "SAFFL", "STRATA2"
              )
            ),
            selected = NULL,
            multiple = FALSE
          )
        )
      ),
      y_facet = list(
        data_extract_spec(
          dataname = "ADAE",
          select = select_spec(
            choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
            selected = "AESEV",
            multiple = FALSE
          )
        ),
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(
              ADSL,
              c(
                "ARM", "ACTARM", "SEX",
                "RACE", "ITTFL", "SAFFL", "STRATA2"
              )
            ),
            selected = NULL,
            multiple = FALSE
          )
        )
      ),
      decorators = list(plot = caption_decorator('Marcin', 'plot'))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}


```

</details>

---------

Signed-off-by: André Veríssimo <[email protected]>
Co-authored-by: Lluís Revilla <[email protected]>
Co-authored-by: André Veríssimo <[email protected]>
Co-authored-by: Lluís Revilla <[email protected]>
  • Loading branch information
@m7pr @llrs-roche @averissimo
4 people authored Dec 4, 2024
1 parent 5fdc43e commit 1ac634c
Show file tree
Hide file tree
Showing 2 changed files with 48 additions and 11 deletions.
38 changes: 28 additions & 10 deletions R/tm_g_barchart_simple.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,9 +12,18 @@
#' @param x_facet (`data_extract_spec`)\cr row-wise faceting groups.
#' @param y_facet (`data_extract_spec`)\cr column-wise faceting groups.
#' @param plot_options (`list`)\cr list of plot options.
#' @param decorators `r roxygen_decorators_param("tm_g_barchart_simple")`
#'
#' @inherit module_arguments return seealso
#'
#' @section Decorating `tm_g_barchart_simple`:
#'
#' 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 @@ -146,7 +155,8 @@ tm_g_barchart_simple <- function(x = NULL,
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_barchart_simple")
checkmate::assert_string(label)
checkmate::assert_list(plot_options, null.ok = TRUE)
Expand All @@ -171,6 +181,8 @@ tm_g_barchart_simple <- function(x = NULL,
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, names = "plot", null.ok = TRUE)

plot_options <- utils::modifyList(
list(stacked = FALSE), # default
Expand All @@ -190,7 +202,8 @@ tm_g_barchart_simple <- function(x = NULL,
y_facet = y_facet,
plot_height = plot_height,
plot_width = plot_width,
ggplot2_args = ggplot2_args
ggplot2_args = ggplot2_args,
decorators = decorators
),
datanames = "all"
)
Expand Down Expand Up @@ -249,6 +262,7 @@ ui_g_barchart_simple <- function(id, ...) {
is_single_dataset = is_single_dataset_value
)
},
ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(args$decorators, "plot")),
teal.widgets::panel_group(
teal.widgets::panel_item(
"Additional plot settings",
Expand Down Expand Up @@ -336,7 +350,8 @@ srv_g_barchart_simple <- function(id,
y_facet,
plot_height,
plot_width,
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 @@ -506,13 +521,16 @@ srv_g_barchart_simple <- function(id,
)
)) %>%
teal.code::eval_code(code = plot_call)

# explicitly calling print on the plot inside the qenv evaluates
# the ggplot call and therefore catches errors
teal.code::eval_code(all_q, code = quote(print(plot)))
})

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

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

output$table <- renderTable({
req(iv_r()$is_valid())
Expand Down Expand Up @@ -550,7 +568,7 @@ srv_g_barchart_simple <- 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_code()))),
title = "Bar Chart"
)

Expand All @@ -569,7 +587,7 @@ srv_g_barchart_simple <- 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_code())))
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_barchart_simple.Rd
View file

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

0 comments on commit 1ac634c

Please sign in to comment.