Add transformators and decorators to modules

[m7pr]

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

[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

[m7pr]

I just run devtools::document() and added assertion for transformators. I also extended documentation to mention transformators parameter. I will no run R CMD CHECK locally and will investigate the app once again.

[osenan]

Hi, thanks for the code changes. I think there are no more comments related to the documentation. I still have questions about the functionality:

Modules that fail:

• Patient Profile (error)
  Modules that do not show the plot:
• Butterfly
• Swimlane
• Waterfall

Decorators

Those work:

• Plot Title
• Footnote

Those do not work in all modules:

• Decorator title
  If we change it the plot does not show anymore

Transformators

They do not work in any module. If we change it the plot is not shown.

Things to fix (sorted by priority)

1. Error in patient profile module
2. Plots not showing in the modules butterfly, swimlane and weterfall
3. Transformators not working in any module or in the example
4. Decorator name not working in any module

Thanks!

[osenan]

Suggested change

	transformators
	transformators

[osenan]

Hi, all comments mentioned here:

Modules that fail:

• Patient Profile (error)
  Modules that do not show the plot:
• Butterfly
• Swimlane
• Waterfall

Those do not work in all modules:

• Decorator title
  If we change it the plot does not show anymore

Transformators

They do not work in any module. If we change it the plot is not shown.

Things to fix (sorted by priority)

1. Error in patient profile module
2. Plots not showing in the modules butterfly, swimlane and weterfall
3. Transformators not working in any module or in the example
4. Decorator name not working in any module

In my previous comment are not fixed. I tried pulling your last commit and running again all problematic issues. Are you able to visualize plots in the modules I highlighted they have problems? Are you able to change number of rows in the plot using the transformator? Or to change the decorator name?

If not, we need to fix it.