Add `transformators` and `decorators` to modules by m7pr · Pull Request #338 · insightsengineering/teal.osprey

m7pr · 2026-05-26T20:54:16Z

Closes #333

library(teal)
library(teal.data)
library(teal.transform)
library(teal.osprey)
library(dplyr)
library(ggplot2)

# ---- shared transformator / decorator factories --------------------------------

#' Limit rows in one dataset (input transformator; sidebar "Transform Data").
make_row_limit_transformator <- function(dataname, label = NULL, default_n = 150L) {
  checkmate::assert_string(dataname)
  if (is.null(label)) {
    label <- sprintf("Limit rows: %s", dataname)
  }

  dn <- as.name(dataname)
  transform_expr <- bquote(
    within(
      data(),
      .(dn) <- utils::head(.(dn), n),
      n = as.integer(input$n)
    )
  )

  teal::teal_transform_module(
    label = label,
    datanames = dataname,
    ui = function(id) {
      ns <- NS(id)
      numericInput(
        inputId = ns("n"),
        label = sprintf("Max rows in %s", dataname),
        value = default_n,
        min = 20L,
        max = 1000L,
        step = 10L
      )
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          req(data())
          eval(transform_expr)
        })
      })
    }
  )
}

#' Add a ggplot title (output decorator; module encoding panel).
make_ggplot_title_decorator <- function(default_title = "Decorator title") {
  teal::teal_transform_module(
    label = "Plot title (decorator)",
    ui = function(id) {
      ns <- NS(id)
      textInput(ns("title"), "Title", value = default_title)
    },
    server = teal::make_teal_transform_server(
      expression(plot <- plot + ggplot2::labs(title = title))
    )
  )
}

#' Add title/footnote to grid grob plots (grob osprey modules).
make_grob_title_decorator <- function(default_title = "[Decorator]") {
  teal::teal_transform_module(
    label = "Grob title (decorator)",
    ui = function(id) {
      ns <- NS(id)
      textInput(ns("title"), "Decorator title", value = default_title)
    },
    server = function(id, data) {
      moduleServer(id, function(input, output, session) {
        reactive({
          req(data())
          within(
            data(),
            plot <- tern::decorate_grob(
              plot,
              titles = title,
              footnotes = "Added by teal_transform_module decorator"
            ),
            title = input$title
          )
        })
      })
    }
  )
}

# ---- ADaM data ------------------------------------------------------------------

prepare_osprey_demo_data <- function() {
  data <- teal_data() %>%
    within({
      library(nestcolor)

      ADSL <- rADSL %>%
        dplyr::mutate(TRTDURD = as.integer(TRTEDTM - TRTSDTM) + 1L)
      ADSL$SEX <- factor(ADSL$SEX, levels = unique(ADSL$SEX))

      ADAE <- rADAE %>%
        dplyr::mutate(
          ASTDT = as.Date(ASTDTM),
          AENDT = as.Date(AENDTM),
          flag1 = ifelse(AETOXGR == 1L, 1L, 0L),
          flag2 = ifelse(AETOXGR == 2L, 1L, 0L),
          flag3 = ifelse(AETOXGR == 3L, 1L, 0L),
          flag1_filt = "Y",
          TMPFL_SER = AESER == "Y",
          TMPFL_REL = AEREL == "Y",
          TMPFL_GR5 = AETOXGR == "5",
          AEREL1 = AEREL == "Y" & ACTARM == "A: Drug X",
          AEREL2 = AEREL == "Y" & ACTARM == "B: Placebo"
        )
      flag_labels <- c(
        "Serious AE", "Related AE", "Grade 5 AE",
        "AE related to A: Drug X", "AE related to B: Placebo"
      )
      flag_cols <- c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2")
      for (i in seq_along(flag_labels)) {
        attr(ADAE[[flag_cols[i]]], "label") <- flag_labels[i]
      }

      ADTR <- rADTR
      ADRS <- rADRS

      ADEX <- rADEX %>%
        dplyr::filter(PARCAT1 == "INDIVIDUAL") %>%
        dplyr::mutate(ongo_status = EOSSTT == "ONGOING")

      ADCM <- rADCM %>%
        dplyr::select(-dplyr::starts_with("ATC")) %>%
        dplyr::distinct() %>%
        dplyr::mutate(ASTDT = as.Date(ASTDTM), AENDT = as.Date(AENDTM))

      ADLB <- rADLB %>%
        dplyr::mutate(ADT = as.Date(ADTM), LBSTRESN = as.numeric(LBSTRESC))

      # Visit assignment for heatmap (and compatible with other modules)
      visit_dates <- ADEX %>%
        dplyr::filter(PARAMCD == "DOSE") %>%
        dplyr::distinct(USUBJID, AVISIT, ASTDTM) %>%
        dplyr::group_by(USUBJID) %>%
        dplyr::arrange(ASTDTM) %>%
        dplyr::mutate(
          next_vis = dplyr::lead(ASTDTM),
          is_last = is.na(next_vis)
        ) %>%
        dplyr::rename(this_vis = ASTDTM)

      add_visit <- function(dat) {
        dat %>%
          dplyr::select(USUBJID, ASTDTM) %>%
          dplyr::left_join(visit_dates, by = "USUBJID") %>%
          dplyr::filter(ASTDTM > this_vis & (ASTDTM < next_vis | is_last)) %>%
          dplyr::left_join(dat, by = c("USUBJID", "ASTDTM")) %>%
          dplyr::distinct()
      }

      ADAE <- add_visit(ADAE)
      ADCM <- add_visit(ADCM)

      # Smaller subject pool for faster heatmap iteration
      heat_ids <- ADSL$USUBJID[seq_len(min(30L, nrow(ADSL)))]
      ADSL <- ADSL %>% dplyr::filter(USUBJID %in% heat_ids)
      ADEX <- ADEX %>% dplyr::filter(USUBJID %in% heat_ids)
      ADAE <- ADAE %>% dplyr::filter(USUBJID %in% heat_ids)
      ADCM <- ADCM %>% dplyr::filter(USUBJID %in% heat_ids)
    })

  join_keys(data) <- default_cdisc_join_keys[names(data)]
  data
}

# ---- modules --------------------------------------------------------------------

build_osprey_demo_modules <- function(data) {
  ADAE <- data[["ADAE"]]
  ADSL <- data[["ADSL"]]
  # teal.transform::choices_selected(choices, selected) — app uses (selected, choices) order
  cs <- function(selected, choices) {
    choices_selected(choices = choices, selected = selected)
  }

  modules(
    tm_g_ae_oview(
      label = "AE Overview",
      dataname = "ADAE",
      arm_var = cs("ACTARM", c("ACTARM", "ACTARMCD")),
      flag_var_anl = cs(
        "AEREL1",
        variable_choices(ADAE, c("TMPFL_SER", "TMPFL_REL", "TMPFL_GR5", "AEREL1", "AEREL2"))
      ),
      plot_height = c(600L, 200L, 2000L),
      transformators = list(
        make_row_limit_transformator("ADAE", "AE Overview: limit ADAE rows", default_n = 200L)
      ),
      decorators = list(
        plot = make_grob_title_decorator("AE Overview (decorator)")
      )
    ),
    tm_g_ae_sub(
      label = "AE by Subgroup",
      dataname = "ADAE",
      arm_var = cs("ACTARMCD", c("ACTARM", "ACTARMCD")),
      group_var = cs(
        c("SEX", "REGION1"),
        c("SEX", "REGION1", "RACE")
      ),
      plot_height = c(600L, 200L, 2000L),
      transformators = list(
        make_row_limit_transformator("ADAE", "AE Subgroups: limit ADAE rows", default_n = 200L)
      ),
      decorators = list(
        plot = make_grob_title_decorator("AE Subgroups (decorator)")
      )
    ),
    tm_g_events_term_id(
      label = "Common AE",
      dataname = "ADAE",
      term_var = cs("AEDECOD", c("AEDECOD", "AEBODSYS", "AEHLT")),
      arm_var = cs("ACTARMCD", c("ACTARM", "ACTARMCD")),
      plot_height = c(600L, 200L, 2000L),
      transformators = list(
        make_row_limit_transformator("ADAE", "Common AE: limit ADAE rows", default_n = 200L)
      ),
      decorators = list(
        plot = make_grob_title_decorator("Common AE (decorator)")
      )
    ),
    tm_g_butterfly(
      label = "Butterfly Plot",
      dataname = "ADAE",
      right_var = cs("SEX", c("SEX", "ARM", "RACE")),
      left_var = cs("RACE", c("SEX", "ARM", "RACE")),
      category_var = cs("AEBODSYS", c("AEDECOD", "AEBODSYS")),
      color_by_var = cs("AETOXGR", c("AETOXGR", "None")),
      count_by_var = cs("# of patients", c("# of patients", "# of AEs")),
      facet_var = cs(NULL, c("RACE", "SEX", "ARM")),
      sort_by_var = cs("count", c("count", "alphabetical")),
      legend_on = TRUE,
      plot_height = c(600L, 200L, 2000L),
      transformators = list(
        make_row_limit_transformator("ADAE", "Butterfly: limit ADAE rows", default_n = 300L)
      ),
      decorators = list(
        plot = make_ggplot_title_decorator("Butterfly (decorator)")
      )
    ),
    tm_g_waterfall(
      label = "Waterfall",
      dataname_tr = "ADTR",
      dataname_rs = "ADRS",
      bar_paramcd = cs("SLDINV", "SLDINV"),
      bar_var = cs("PCHG", c("PCHG", "AVAL")),
      bar_color_var = cs("ARMCD", c("ARMCD", "SEX")),
      bar_color_opt = NULL,
      sort_var = cs(NULL, c("ARMCD", "SEX")),
      add_label_var_sl = cs(NULL, c("SEX", "EOSDY")),
      add_label_paramcd_rs = cs(NULL, c("BESRSPI", "OBJRSPI")),
      anno_txt_var_sl = cs(c("SEX", "ARMCD"), c("SEX", "ARMCD", "BMK1")),
      anno_txt_paramcd_rs = cs(NULL, c("BESRSPI", "OBJRSPI")),
      facet_var = cs(NULL, c("SEX", "ARMCD", "STRATA1")),
      href_line = "-30, 20",
      transformators = list(
        make_row_limit_transformator("ADTR", "Waterfall: limit ADTR rows", default_n = 200L),
        make_row_limit_transformator("ADRS", "Waterfall: limit ADRS rows", default_n = 500L)
      ),
      decorators = list(
        plot = make_ggplot_title_decorator("Waterfall (decorator)")
      )
    ),
    tm_g_spiderplot(
      label = "Spider plot",
      dataname = "ADTR",
      paramcd = cs("SLDINV", "SLDINV"),
      x_var = cs("ADY", "ADY"),
      y_var = cs("PCHG", c("PCHG", "CHG", "AVAL")),
      marker_var = cs("SEX", c("SEX", "RACE", "USUBJID")),
      line_colorby_var = cs("SEX", c("SEX", "USUBJID", "RACE")),
      xfacet_var = cs("SEX", c("SEX", "ARM")),
      yfacet_var = cs("ARM", c("SEX", "ARM")),
      vref_line = "10, 37",
      href_line = "-20, 0",
      transformators = list(
        make_row_limit_transformator("ADTR", "Spider: limit ADTR rows", default_n = 300L)
      ),
      decorators = list(
        plot = make_ggplot_title_decorator("Spider (decorator)")
      )
    ),
    tm_g_swimlane(
      label = "Swimlane Plot",
      dataname = "ADRS",
      bar_var = cs("TRTDURD", c("TRTDURD", "EOSDY")),
      bar_color_var = cs("EOSSTT", c("EOSSTT", "ARM", "ARMCD", "SEX")),
      sort_var = cs("ACTARMCD", c("USUBJID", "SITEID", "ACTARMCD")),
      marker_pos_var = cs("ADY", "ADY"),
      marker_shape_var = cs("AVALC", c("AVALC", "AVISIT")),
      marker_shape_opt = c("CR" = 16, "PR" = 17, "SD" = 18, "PD" = 15),
      marker_color_var = cs("AVALC", c("AVALC", "AVISIT")),
      marker_color_opt = c(
        "CR" = "green", "PR" = "blue", "SD" = "goldenrod", "PD" = "red"
      ),
      vref_line = c(30, 60),
      anno_txt_var = cs(c("ACTARM", "SEX"), c("ACTARM", "SEX", "RACE")),
      transformators = list(
        make_row_limit_transformator("ADRS", "Swimlane: limit ADRS rows", default_n = 400L),
        make_row_limit_transformator("ADSL", "Swimlane: limit ADSL rows", default_n = 100L)
      ),
      decorators = list(
        plot = make_ggplot_title_decorator("Swimlane (decorator)")
      )
    ),
    tm_g_heat_bygrade(
      label = "Heatmap by grade",
      sl_dataname = "ADSL",
      ex_dataname = "ADEX",
      ae_dataname = "ADAE",
      cm_dataname = "ADCM",
      id_var = cs("USUBJID", c("USUBJID", "SUBJID")),
      visit_var = cs("AVISIT", "AVISIT"),
      ongo_var = cs("ongo_status", "ongo_status"),
      anno_var = cs(c("SEX", "COUNTRY"), c("SEX", "COUNTRY", "USUBJID")),
      heat_var = cs("AETOXGR", "AETOXGR"),
      conmed_var = cs("CMDECOD", "CMDECOD"),
      plot_height = c(600L, 200L, 2000L),
      transformators = list(
        make_row_limit_transformator("ADSL", "Heatmap: limit ADSL rows", default_n = 30L),
        make_row_limit_transformator("ADAE", "Heatmap: limit ADAE rows", default_n = 150L)
      ),
      decorators = list(
        plot = make_grob_title_decorator("Heatmap (decorator)")
      )
    ),
    tm_g_patient_profile(
      label = "Patient Profile",
      patient_id = cs(
        unique(ADSL$USUBJID)[1],
        unique(ADSL$USUBJID)
      ),
      sl_dataname = "ADSL",
      ex_dataname = "ADEX",
      ae_dataname = "ADAE",
      rs_dataname = "ADRS",
      cm_dataname = "ADCM",
      lb_dataname = "ADLB",
      sl_start_date = cs("TRTSDTM", c("TRTSDTM", "RANDDT")),
      ex_var = cs("PARCAT2", "PARCAT2"),
      ae_var = cs("AEDECOD", c("AEDECOD", "AESOC")),
      ae_line_col_var = cs("AESER", c("AESER", "AEREL")),
      ae_line_col_opt = c("Y" = "red", "N" = "blue"),
      rs_var = cs("PARAMCD", "PARAMCD"),
      cm_var = cs("CMDECOD", c("CMDECOD", "CMCAT")),
      lb_var = cs("LBTESTCD", c("LBTESTCD", "LBCAT")),
      x_limit = "-28, 750",
      plot_height = c(1200L, 400L, 5000L),
      transformators = list(
        make_row_limit_transformator("ADAE", "Patient profile: limit ADAE rows", default_n = 100L),
        make_row_limit_transformator("ADEX", "Patient profile: limit ADEX rows", default_n = 100L)
      ),
      decorators = list(
        plot = make_ggplot_title_decorator("Patient profile (decorator)")
      )
    )
  )
}

# ---- launch ---------------------------------------------------------------------

demo_data <- prepare_osprey_demo_data()

app <- init(
  data = demo_data,
  modules = build_osprey_demo_modules(demo_data)
)

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

…nsightsengineering/teal.osprey into decorators_transformators@main

osenan

Hi, great that you achieved decorators and transformators in a single PR.
Minor comments:

We need to run devtools::document() so we update documentation. Let's try to fix failing checks as well.
We need to add check for the transformator as well.

I think it is ambitious and time saving to create all decorators and transformators on a single PR. However, if there is a lot of back and forth trying to fix here and there it might be better to create specific PR for more challenging modules. For the moment:

In the example app, If I change the transformators row number limit, it does not show more the plot. It happens in all modules

Can you check if the problem is in the example or in the transformator implementation?

In addition, in the example app there are modules that fail:

Patient Profile (error)
Swimlane Plot: I cannot see the plot, it seems an issue with the decorator?
Spider Plot: I cannot see the plot, it seems an issue with the decorator?
Waterfall Plot: I cannot see the plot, it seems an issue with the decorator?
Butterfly Plot: I cannot see the plot, it seems an issue with the decorator?

In the other modules the decorators seem to work.

Please check if the big issues mentioned are problems only in the example app or in the implementation

osenan · 2026-05-28T05:33:43Z

+#' decorators for the module `plot` output. See [decorate_module_section] for which
+#' object types are supported per module.
+#'
 #' @return the [teal::module()] object.


I think we need to add an entry for "#' @Transformators" here as well

osenan · 2026-05-28T05:39:59Z

    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
+  teal::assert_decorators(decorators, "plot")


I think we should also assess the class of the transformator object here:

Suggested change

teal::assert_decorators(decorators, "plot")

checkmate::assert_class(transformators, "teal_transform_module")

teal::assert_decorators(decorators, "plot")

We should apply it to all modules

transformators and decorators

5b4172f

m7pr added the core label May 26, 2026

github-actions Bot and others added 3 commits May 26, 2026 20:56

[skip style] [skip vbump] Restyle files

7e4a07c

update documentation

1021ec0

Merge branch 'decorators_transformators@main' of https://github.com/i…

95b27c3

…nsightsengineering/teal.osprey into decorators_transformators@main

m7pr mentioned this pull request May 27, 2026

[Feature Request]: Allow using decorators #333

Open

3 tasks

osenan self-assigned this May 28, 2026

osenan requested changes May 28, 2026

View reviewed changes

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

Add `transformators` and `decorators` to modules#338

Add `transformators` and `decorators` to modules#338
m7pr wants to merge 4 commits into
mainfrom
decorators_transformators@main

m7pr commented May 26, 2026 •

edited

Loading

Uh oh!

osenan left a comment

Uh oh!

osenan May 28, 2026

Uh oh!

osenan May 28, 2026

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

2 participants

	teal::assert_decorators(decorators, "plot")
	checkmate::assert_class(transformators, "teal_transform_module")
	teal::assert_decorators(decorators, "plot")

Uh oh!

Conversation

m7pr commented May 26, 2026 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

osenan left a comment

Choose a reason for hiding this comment

Uh oh!

osenan May 28, 2026

Choose a reason for hiding this comment

Uh oh!

osenan May 28, 2026

Choose a reason for hiding this comment

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

2 participants

m7pr commented May 26, 2026 •

edited

Loading