Teal module for the heatmap by grade — tm_g_heat

Display the heatmap by grade as a shiny module

Usage

tm_g_heat_bygrade(
  label,
  sl_dataname,
  ex_dataname,
  ae_dataname,
  cm_dataname,
  id_var,
  visit_var,
  ongo_var,
  anno_var,
  heat_var,
  conmed_var = NULL,
  fontsize = c(5, 3, 7),
  plot_height = c(600L, 200L, 2000L),
  plot_width = NULL
)

Arguments

label: (character(1))
menu item label of the module in the teal app.
sl_dataname: (character) subject level dataset name, needs to be available in the list passed to the data argument of init
ex_dataname: (character) exposures dataset name, needs to be available in the list passed to the data argument of init
ae_dataname: (character) adverse events dataset name, needs to be available in the list passed to the data argument of init
cm_dataname: (character) concomitant medications dataset name, needs to be available in the list passed to the data argument of init
specify to NA if no concomitant medications data is available
id_var: (choices_seleced) unique subject ID variable
visit_var: (choices_seleced) analysis visit variable
ongo_var: (choices_seleced) study ongoing status variable, This variable is a derived logical variable. Usually it can be derived from EOSSTT.
anno_var: (choices_seleced) annotation variable
heat_var: (choices_seleced) heatmap variable
conmed_var: (choices_seleced) concomitant medications variable, specify to NA if no concomitant medications data is available
fontsize: (numeric(1) or numeric(3))
Defines initial possible range of font-size. fontsize is set for teal.widgets::optionalSliderInputValMinMax() which controls font-size in the output plot.
plot_height: (numeric(3))
vector to indicate default value, minimum and maximum values.
plot_width: (numeric(3))
vector to indicate default value, minimum and maximum values.

Value

the teal::module() object.

Examples

library(scda)
library(dplyr)
library(nestcolor)
latest_data <- synthetic_cdisc_data("latest")
ADSL <- latest_data$adsl %>% slice(1:30)
ADEX <- latest_data$adex %>% filter(USUBJID %in% ADSL$USUBJID)
ADAE <- latest_data$adae %>% filter(USUBJID %in% ADSL$USUBJID)
ADCM <- latest_data$adcm %>% filter(USUBJID %in% ADSL$USUBJID)

# This preprocess is only to force legacy standard on ADCM
ADCM <- ADCM %>%
  select(-starts_with("ATC")) %>%
  unique()

# function to derive AVISIT from ADEX
add_visit <- function(data_need_visit) {
  visit_dates <- ADEX %>%
    filter(PARAMCD == "DOSE") %>%
    distinct(USUBJID, AVISIT, ASTDTM) %>%
    group_by(USUBJID) %>%
    arrange(ASTDTM) %>%
    mutate(next_vis = lead(ASTDTM), is_last = ifelse(is.na(next_vis), TRUE, FALSE)) %>%
    rename(this_vis = ASTDTM)
  data_visit <- data_need_visit %>%
    select(USUBJID, ASTDTM) %>%
    left_join(visit_dates, by = "USUBJID") %>%
    filter(ASTDTM > this_vis & (ASTDTM < next_vis | is_last == TRUE)) %>%
    left_join(data_need_visit) %>%
    distinct()
  return(data_visit)
}
# derive AVISIT for ADAE and ADCM
ADAE <- add_visit(ADAE)
#> Joining, by = c("USUBJID", "ASTDTM")
ADCM <- add_visit(ADCM)
#> Joining, by = c("USUBJID", "ASTDTM")
# derive ongoing status variable for ADEX
ADEX <- ADEX %>%
  filter(PARCAT1 == "INDIVIDUAL") %>%
  mutate(ongo_status = (EOSSTT == "ONGOING"))

app <- init(
  data = cdisc_data(
    cdisc_dataset("ADSL", ADSL),
    cdisc_dataset("ADEX", ADEX),
    cdisc_dataset("ADAE", ADAE),
    cdisc_dataset("ADCM", ADCM, keys = c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "CMDECOD")),
    code = "
    latest_data <- synthetic_cdisc_data('latest')
    ADSL <- latest_data$adsl %>% slice(1:30)
    ADEX <- latest_data$adex %>% filter(USUBJID %in% ADSL$USUBJID)
    ADAE <- latest_data$adae %>% filter(USUBJID %in% ADSL$USUBJID)
    ADCM <- latest_data$adcm %>% filter(USUBJID %in% ADSL$USUBJID)
    ADCM <- ADCM %>% select(-starts_with(\"ATC\")) %>% unique()
    ADEX  <- ADEX %>%
      filter(PARCAT1 == 'INDIVIDUAL') %>%
      mutate(ongo_status = (EOSSTT == 'ONGOING'))
    add_visit <- function(data_need_visit) {
      visit_dates <- ADEX %>%
        filter(PARAMCD == 'DOSE') %>%
        distinct(USUBJID, AVISIT, ASTDTM) %>%
        group_by(USUBJID) %>%
        arrange(ASTDTM) %>%
        mutate(next_vis = lead(ASTDTM), is_last = ifelse(is.na(next_vis), TRUE, FALSE)) %>%
        rename(this_vis = ASTDTM)
      data_visit <- data_need_visit %>%
        select(USUBJID, ASTDTM) %>%
        left_join(visit_dates, by = 'USUBJID') %>%
        filter(ASTDTM > this_vis & (ASTDTM < next_vis | is_last == TRUE)) %>%
        left_join(data_need_visit) %>% distinct()
      return(data_visit)
    }
    ADAE <- add_visit(ADAE)
    ADCM <- add_visit(ADCM)
    ",
    check = TRUE
  ),
  modules = modules(
    tm_g_heat_bygrade(
      label = "Heatmap by grade",
      sl_dataname = "ADSL",
      ex_dataname = "ADEX",
      ae_dataname = "ADAE",
      cm_dataname = "ADCM",
      id_var = choices_selected(
        selected = "USUBJID",
        choices = c("USUBJID", "SUBJID")
      ),
      visit_var = choices_selected(
        selected = "AVISIT",
        choices = c("AVISIT")
      ),
      ongo_var = choices_selected(
        selected = "ongo_status",
        choices = c("ongo_status")
      ),
      anno_var = choices_selected(
        selected = c("SEX", "COUNTRY"),
        choices = c("SEX", "COUNTRY", "USUBJID")
      ),
      heat_var = choices_selected(
        selected = "AETOXGR",
        choices = c("AETOXGR")
      ),
      conmed_var = choices_selected(
        selected = "CMDECOD",
        choices = c("CMDECOD")
      ),
      plot_height = c(600, 200, 2000)
    )
  )
)
#> Joining, by = c("USUBJID", "ASTDTM")
#> Joining, by = c("USUBJID", "ASTDTM")
#> [INFO] 2022-10-19 12:23:45.8692 pid:1898 token:[] teal.osprey Initializing tm_g_heat_bygrade
if (FALSE) {
shinyApp(app$ui, app$server)
}