introduce decorators for tm_g_pp_therapy

[m7pr]

Part of insightsengineering/teal#1371

Working Example

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

library(nestcolor)
library(dplyr)

data <- teal_data()
data <- within(data, {
  ADCM <- tmc_ex_adcm
  ADSL <- tmc_ex_adsl %>% filter(USUBJID %in% ADCM$USUBJID)
  ADCM$CMASTDTM <- ADCM$ASTDTM
  ADCM$CMAENDTM <- ADCM$AENDTM
})

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

ADSL <- data[["ADSL"]]
ADCM <- data[["ADCM"]]

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_pp_therapy(
      label = "Therapy",
      dataname = "ADCM",
      parentname = "ADSL",
      patient_col = "USUBJID",
      plot_height = c(600L, 200L, 2000L),
      atirel = choices_selected(
        choices = variable_choices(ADCM, "ATIREL"),
        selected = c("ATIREL")
      ),
      cmdecod = choices_selected(
        choices = variable_choices(ADCM, "CMDECOD"),
        selected = "CMDECOD"
      ),
      cmindc = choices_selected(
        choices = variable_choices(ADCM, "CMINDC"),
        selected = "CMINDC"
      ),
      cmdose = choices_selected(
        choices = variable_choices(ADCM, "CMDOSE"),
        selected = "CMDOSE"
      ),
      cmtrt = choices_selected(
        choices = variable_choices(ADCM, "CMTRT"),
        selected = "CMTRT"
      ),
      cmdosu = choices_selected(
        choices = variable_choices(ADCM, "CMDOSU"),
        selected = c("CMDOSU")
      ),
      cmroute = choices_selected(
        choices = variable_choices(ADCM, "CMROUTE"),
        selected = "CMROUTE"
      ),
      cmdosfrq = choices_selected(
        choices = variable_choices(ADCM, "CMDOSFRQ"),
        selected = "CMDOSFRQ"
      ),
      cmstdy = choices_selected(
        choices = variable_choices(ADCM, "ASTDY"),
        selected = "ASTDY"
      ),
      cmendy = choices_selected(
        choices = variable_choices(ADCM, "AENDY"),
        selected = "AENDY"
      ),
      decorators = list(plot = caption_decorator('Marcin', 'plot'), table = head_decorator(2, 'table'))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[llrs-roche]

Code looks fine but the example has an error that prevents the module to display.

Warning: Error in : One or more variables in the dataframe have class 'difftime'. Please convert to factor or character. 
 when evaluating qenv code:
table <- rlistings::as_listing(table, key_cols = NULL, default_formatting = list(all = fmt_config(align = "left")))

This prevents the module to display the plot with the caption:

[m7pr]

@llrs-roche this is what I see

[m7pr]

Can you confirm you

• pulled teal on 1187_decorate_output@main branch, and checked-out to this branch
• pulled teal.reporter on main branch, and checked-out to this branch
• pulled teal.modules.clinical on tm_g_pp_therapy@1187_decorate_output@main, and checked-out to this branch

and then. before running the example did you run

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

[llrs-roche]

I can confirm that I run all the steps above and I still see those warnings/errors.
The issue could be that I'm using rlistings 0.2.9.9010.

[llrs-roche]

Changing to CRAN's version for rlistings worked. I'm not sure if this should be a separate issue, sooner or later teal* packages will be facing this

[vedhav]

Yup it’s the rlistings issue. Have to use character or factor column instead.

[m7pr]

Alrighty, the rlistings thing was fixed in here #1271