introduce decorators for tm_g_barchart_simple

[m7pr]

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

Working Example

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

[llrs-roche]

Code works and looks good. It is nice that this module that have multiple decorators was documented showing how to do it and that the example also have both of them.

To see the caption on my machine I have to preview the cards, and I realized the reporter preview doesn't show the table:

This might be out of scope of the PR, but I'm curious if the table should also show on the card. The code reported has a table statement at the end, so I would expect it to show up.

[llrs-roche]

Just two minor comments, I modified the example to be able to run it as is.

If working locally you'll need to pull the code as I messed it with the local branch I had and reverted it back.