---
title: "Decorate Module Output"
author: "NEST CoreDev"
output:
  rmarkdown::html_vignette:
    toc: true
vignette: >
  %\VignetteIndexEntry{Decorate Module Output}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
library(teal.modules.clinical)
```


## Introduction

The outputs produced by `teal` modules, like graphs or tables, are created by the module developer and look a certain way.
It is hard to design an output that will satisfy every possible user, so the form of the output should be considered a default value that can be customized.
Here we describe the concept of _decoration_, enabling the app developer to tailor outputs to their specific requirements without rewriting the original module code.

The decoration process is build upon transformation procedures, introduced in `teal`.
While `transformators` are meant to edit module's input, decorators are meant to adjust the module's output.
To distinguish the difference, modules in  `teal.modules.clinical` have 2 separate parameters:
`transformators` and `decorators`. 

To get a complete understanding refer the following vignettes:

- Transforming the input data in
[this vignette](https://insightsengineering.github.io/teal/latest-tag/articles/transform-input-data.html).
- Transforming module output in [this vignette](https://insightsengineering.github.io/teal/latest-tag/articles/transform-module-output.html).

## Outputs that can be decorated

It is important to note which output objects from a given module can be decorated.
The module function documentation's _Decorating Module_ section has this information.

You can also refer the table shown below to know which module outputs can be decorated.

| Module                           | Outputs (Class)                                                                                           |
|----------------------------------|---------------------------------------------------------------------------------------------------------|
| `tm_a_gee`                      | table (ElementaryTable)                                                                                |
| `tm_a_mmrm`                     | lsmeans_table (TableTree), lsmeans_plot (ggplot), covariance_table (ElementaryTable), fixed_effects_table (ElementaryTable), diagnostic_table (ElementaryTable), diagnostic_plot (ggplot) |
| `tm_g_barchart_simple`          | plot (ggplot)                                                                                          |
| `tm_g_ci`                       | plot (ggplot)                                                                                          |
| `tm_g_forest_rsp`               | plot (ggplot)                                                                                          |
| `tm_g_forest_tte`               | plot (ggplot)                                                                                          |
| `tm_g_ipp`                      | plot (ggplot)                                                                                          |
| `tm_g_km`                       | plot (ggplot)                                                                                          |
| `tm_g_lineplot`                 | plot (ggplot)                                                                                          |
| `tm_g_pp_adverse_events`        | table (datatables), plot (ggplot)                                                                      |
| `tm_g_pp_patient_timeline`      | plot (ggplot)                                                                                          |
| `tm_g_pp_therapy`               | plot (ggplot), table (datatables)                                                                                          |
| `tm_g_pp_vitals`                | plot (ggplot)                                                                                          |
| `tm_t_abnormality`              | table (TableTree)                                                                                      |
| `tm_t_abnormality_by_worst_grade` | table (TableTree)                                                                                    |
| `tm_t_ancova`                   | table (TableTree)                                                                                      |
| `tm_t_binary_outcome`           | table (TableTree)                                                                                      |
| `tm_t_coxreg`                   | table (TableTree)                                                                                      |
| `tm_t_events`                   | table (TableTree)                                                                                      |
| `tm_t_events_by_grade`          | table (TableTree)                                                                                      |
| `tm_t_events_patyear`           | table (ElementaryTable)                                                                                |
| `tm_t_events_summary`           | table (TableTree)                                                                                      |
| `tm_t_exposure`                 | table (ElementaryTable)                                                                                |
| `tm_t_logistic`                 | table (TableTree)                                                                                      |
| `tm_t_mult_events`              | table (TableTree)                                                                                      |
| `tm_t_pp_basic_info`            | table (datatables)                                                                                    |
| `tm_t_pp_laboratory`            | table (datatables)                                                                                    |
| `tm_t_pp_medical_history`       | table (TableTree)                                                                                      |
| `tm_t_pp_prior_medication`      | table (datatables)                                                                                    |
| `tm_t_shift_by_arm`             | table (TableTree)                                                                                      |
| `tm_t_shift_by_arm_by_worst`    | table (TableTree)                                                                                      |
| `tm_t_shift_by_grade`           | table (TableTree)                                                                                      |
| `tm_t_smq`                      | table (TableTree)                                                                                      |
| `tm_t_summary`                  | table (TableTree)                                                                                      |
| `tm_t_summary_by`               | table (TableTree)                                                                                      |
| `tm_t_tte`                      | table (TableTree)                                                                                      |


Also, note that there are three different types of objects that can be decorated:

1. `listing_df`, `ElementaryTable`, `TableTree`
2. `ggplot`
3. `datatables`

*Tip:* A general tip before trying to decorate the output from the module is to
copy the reproducible code and running them in a separate R session to
quickly iterate the decoration you want.

## Decorating `listing_df`, `ElementaryTable`, `TableTree`

Here's an example to showcase how you can edit an output of class `listing_df`, `ElementaryTable`, or `TableTree`.
All these classes are extension of objects created using `rtables` and
can be modified with the help of `rtables` modifiers like `rtables::insert_rrow`.

```{r decorate_listing_df, message=FALSE}
library(teal.modules.clinical)

data <- within(teal_data(), {
  library(dplyr)
  ADSL <- tmc_ex_adsl |>
    mutate(
      ITTFL = factor("Y") |> with_label("Intent-To-Treat Population Flag")
    ) |>
    mutate(DTHFL = case_when(!is.na(DTHDT) ~ "Y", TRUE ~ "") |> with_label("Subject Death Flag"))


  ADLB <- tmc_ex_adlb |>
    mutate(AVISIT == forcats::fct_reorder(AVISIT, AVISITN, min)) |>
    mutate(
      ONTRTFL = case_when(
        AVISIT %in% c("SCREENING", "BASELINE") ~ "",
        TRUE ~ "Y"
      ) |> with_label("On Treatment Record Flag")
    )
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

insert_rrow_decorator <- function(default_caption = "I am a good new row") {
  teal_transform_module(
    label = "New row",
    ui = function(id) {
      shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption)
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          data() |>
            within(
              {
                table <- rtables::insert_rrow(table, rtables::rrow(new_row))
              },
              new_row = input$new_row
            )
        })
      })
    }
  )
}

app <- init(
  data = data,
  modules = modules(
    tm_t_abnormality(
      label = "tm_t_abnormality",
      dataname = "ADLB",
      arm_var = choices_selected(
        choices = variable_choices("ADSL", subset = c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      add_total = FALSE,
      by_vars = choices_selected(
        choices = variable_choices("ADLB", subset = c("LBCAT", "PARAM", "AVISIT")),
        selected = c("LBCAT", "PARAM"),
        keep_order = TRUE
      ),
      baseline_var = choices_selected(
        variable_choices("ADLB", subset = "BNRIND"),
        selected = "BNRIND", fixed = TRUE
      ),
      grade = choices_selected(
        choices = variable_choices("ADLB", subset = "ANRIND"),
        selected = "ANRIND",
        fixed = TRUE
      ),
      abnormal = list(low = "LOW", high = "HIGH"),
      exclude_base_abn = FALSE,
      decorators = list(table = insert_rrow_decorator("I am a good new row"))
    )
  )
)

if (interactive()) {
  shinyApp(app$ui, app$server)
}
```

```{r shinylive_iframe_1, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")}
code <- paste0(c(
  "interactive <- function() TRUE",
  knitr::knit_code$get("setup"),
  knitr::knit_code$get("decorate_listing_df")
), collapse = "\n")

url <- roxy.shinylive::create_shinylive_url(code)
knitr::include_url(url, height = "800px")
```

## Decorating `ggplot`

Here's an example to showcase how you can edit an output of class `ggplot`.
You can extend them using `ggplot2` functions.

```{r decorate_ggplot, message=FALSE}
library(teal.modules.clinical)

data <- teal_data(join_keys = default_cdisc_join_keys[c("ADSL", "ADRS")])
data <- within(data, {
  require(nestcolor)
  ADSL <- rADSL
  ADTTE <- tmc_ex_adtte
})
join_keys(data) <- default_cdisc_join_keys[names(data)]


ggplot_caption_decorator <- function(default_caption = "I am a good decorator") {
  teal_transform_module(
    label = "Caption",
    ui = function(id) {
      shiny::textInput(shiny::NS(id, "title"), "Plot Title", value = default_caption)
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          data() |>
            within(
              {
                plot <- plot +
                  ggplot2::ggtitle(title) +
                  cowplot::theme_cowplot()
              },
              title = input$title
            )
        })
      })
    }
  )
}

app <- init(
  data = data,
  modules = modules(
    tm_g_km(
      label = "tm_g_km",
      dataname = "ADTTE",
      arm_var = choices_selected(
        variable_choices("ADSL", c("ARM", "ARMCD", "ACTARMCD")),
        "ARM"
      ),
      paramcd = choices_selected(
        value_choices("ADTTE", "PARAMCD", "PARAM"),
        "OS"
      ),
      arm_ref_comp = list(
        ACTARMCD = list(ref = "ARM B", comp = c("ARM A", "ARM C")),
        ARM = list(ref = "B: Placebo", comp = c("A: Drug X", "C: Combination"))
      ),
      strata_var = choices_selected(
        variable_choices("ADSL", c("SEX", "BMRKR2")),
        "SEX"
      ),
      facet_var = choices_selected(
        variable_choices("ADSL", c("SEX", "BMRKR2")),
        NULL
      ),
      decorators = list(plot = ggplot_caption_decorator())
    )
  )
)

if (interactive()) {
  shinyApp(app$ui, app$server)
}
```

```{r shinylive_iframe_2, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")}
code <- paste0(c(
  "interactive <- function() TRUE",
  knitr::knit_code$get("setup"),
  knitr::knit_code$get("decorate_ggplot")
), collapse = "\n")

url <- roxy.shinylive::create_shinylive_url(code)
knitr::include_url(url, height = "800px")
```

## Decorating `datatables`

Here's an example to showcase how you can edit an output of class `datatables`.
Please refer the [helper functions](https://rstudio.github.io/DT/functions.html) of the `DT` package to learn more about extending the `datatables` objects.
```{r decorate_datatable, message=FALSE}
library(teal.modules.clinical)

data <- teal_data(join_keys = default_cdisc_join_keys[c("ADSL", "ADRS")])
data <- within(data, {
  ADSL <- rADSL
  ADLB <- tmc_ex_adlb |>
    mutate(AVISIT == forcats::fct_reorder(AVISIT, AVISITN, min)) |>
    mutate(
      ONTRTFL = case_when(
        AVISIT %in% c("SCREENING", "BASELINE") ~ "",
        TRUE ~ "Y"
      ) |> with_label("On Treatment Record Flag")
    )
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

dt_table_decorator <- function(color1 = "pink", color2 = "lightblue") {
  teal_transform_module(
    label = "Table color",
    ui = function(id) {
      selectInput(
        NS(id, "color"),
        "Table Color",
        choices = c("white", color1, color2),
        selected = "Default"
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          data() |> within(
            {
              table <- DT::formatStyle(
                table,
                columns = attr(table$x, "colnames")[-1],
                target = "row",
                backgroundColor = color
              )
            },
            color = input$color
          )
        })
      })
    }
  )
}

app <- init(
  data = data,
  modules = modules(
    tm_t_pp_laboratory(
      label = "tm_t_pp_laboratory",
      dataname = "ADLB",
      patient_col = "USUBJID",
      paramcd = choices_selected(
        choices = variable_choices("ADLB", "PARAMCD"),
        selected = "PARAMCD"
      ),
      param = choices_selected(
        choices = variable_choices("ADLB", "PARAM"),
        selected = "PARAM"
      ),
      timepoints = choices_selected(
        choices = variable_choices("ADLB", "ADY"),
        selected = "ADY"
      ),
      anrind = choices_selected(
        choices = variable_choices("ADLB", "ANRIND"),
        selected = "ANRIND"
      ),
      aval_var = choices_selected(
        choices = variable_choices("ADLB", "AVAL"),
        selected = "AVAL"
      ),
      avalu_var = choices_selected(
        choices = variable_choices("ADLB", "AVALU"),
        selected = "AVALU"
      ),
      decorators = list(table = dt_table_decorator())
    )
  )
)

if (interactive()) {
  shinyApp(app$ui, app$server)
}
```

```{r shinylive_iframe_3, echo = FALSE, out.width = '150%', out.extra = 'style = "position: relative; z-index:1"', eval = requireNamespace("roxy.shinylive", quietly = TRUE) && knitr::is_html_output() && identical(Sys.getenv("IN_PKGDOWN"), "true")}
code <- paste0(c(
  "interactive <- function() TRUE",
  knitr::knit_code$get("setup"),
  knitr::knit_code$get("decorate_datatable")
), collapse = "\n")

url <- roxy.shinylive::create_shinylive_url(code)
knitr::include_url(url, height = "800px")
```