Uses same code for source code generation in modules #1301

averissimo · 2024-12-12T14:37:36Z

Example app with all modules / decorators

Example app

# Load packages
pkgload::load_all("../teal.modules.clinical", export_all = FALSE)

# Decorators ------------------------------------------------------------------
insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") {
  teal_transform_module(
    label = "New rtables row",
    ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row))
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}
add_title_decorator <- function(default_check = TRUE, .var_to_replace = "plot") {
  teal_transform_module(
    label = "Title",
    ui = function(id) shiny::checkboxInput(NS(id, "flag"), "Add title?", TRUE),
    server = make_teal_transform_server(
      substitute({
        if (flag) .var_to_replace <-
            .var_to_replace + ggplot2::ggtitle("Title added by decorator")
      },
      env = list(.var_to_replace = as.name(.var_to_replace))
      )
    )
  )
}
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)))
    )
  )
}
change_theme_decorator <- function(default_check = TRUE, .var_to_replace = "plot") {
  teal_transform_module(
    label = "Theme",
    ui = function(id) shiny::checkboxInput(NS(id, "flag"), "Apply dark theme?", TRUE),
    server = make_teal_transform_server(
      substitute({
        if (flag) .var_to_replace <- .var_to_replace + ggplot2::theme_dark()
      },
      env = list(.var_to_replace = as.name(.var_to_replace))
      )
    )
  )
}
add_cowplot_title_decorator <- function(default_check = TRUE, .var_to_replace = "plot") {
  teal_transform_module(
    label = "Cowplot title",
    ui = function(id) shiny::checkboxInput(NS(id, "flag"), "Add title?", TRUE),
    server = make_teal_transform_server(
      substitute({
        if (flag) .var_to_replace <-
            .var_to_replace +
            ggplot2::ggtitle("Title added by decorator") +
            cowplot::theme_cowplot()
      },
      env = list(.var_to_replace = as.name(.var_to_replace))
      )
    )
  )
}
rlisting_footer <- function(default_footer = "I am a good footer", .var_to_replace = "table_listing") {
  teal_transform_module(
    label = "New row",
    ui = function(id) shiny::textInput(shiny::NS(id, "footer"), "footer", value = default_footer),
    server = make_teal_transform_server(
      substitute({
        rlistings::main_footer(.var_to_replace) <- footer
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}

# End of decorators -----------------------------------------------------------

library(dplyr)

# arm_ref_comp <- list(ARMCD = list(ref = "ARM B", comp = c("ARM A", "ARM C")))

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

data <- within(teal_data(), {
  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"))

  ADAE <- tmc_ex_adae |>
    filter(!((AETOXGR == 1) & (AESEV == "MILD") & (ARM == "A: Drug X")))

  ADAE$ASTDY <- structure(
    as.double(ADAE$ASTDY, unit = attr(ADAE$ASTDY, "units", exact = TRUE)),
    label = attr(ADAE$ASTDY, "label", exact = TRUE)
  )

  .lbls_adae <- col_labels(tmc_ex_adae)
  ADAE <- tmc_ex_adae %>%
    mutate_if(is.character, as.factor) #' be certain of having factors
  col_labels(ADAE) <- .lbls_adae

  ADTTE <- tmc_ex_adtte

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

  ADVS <- tmc_ex_advs

  ADRS <- tmc_ex_adrs |>
    mutate(
      AVALC = d_onco_rsp_label(AVALC) |>
        with_label("Character Result/Finding")
    ) |>
    filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP") |>
    filter(PARAMCD %in% c("BESRSPI", "INVET"))

  ADAETTE <- tmc_ex_adaette %>%
    filter(PARAMCD %in% c("AETTE1", "AETTE2", "AETTE3")) %>%
    mutate(is_event = CNSR == 0) %>%
    mutate(n_events = as.integer(is_event))

  .add_event_flags <- function(dat) {
    dat <- dat %>%
      mutate(
        TMPFL_SER = AESER == "Y",
        TMPFL_REL = AEREL == "Y",
        TMPFL_GR5 = AETOXGR == "5",
        TMP_SMQ01 = !is.na(SMQ01NAM),
        TMP_SMQ02 = !is.na(SMQ02NAM),
        TMP_CQ01 = !is.na(CQ01NAM)
      )
    column_labels <- list(
      TMPFL_SER = "Serious AE",
      TMPFL_REL = "Related AE",
      TMPFL_GR5 = "Grade 5 AE",
      TMP_SMQ01 = aesi_label(dat[["SMQ01NAM"]], dat[["SMQ01SC"]]),
      TMP_SMQ02 = aesi_label("Y.9.9.9.9/Z.9.9.9.9 AESI"),
      TMP_CQ01 = aesi_label(dat[["CQ01NAM"]])
    )
    col_labels(dat)[names(column_labels)] <- as.character(column_labels)
    dat
  }

  ADEX <- tmc_ex_adex

  set.seed(1, kind = "Mersenne-Twister")
  .labels <- col_labels(ADEX, fill = FALSE)
  ADEX <- ADEX %>%
    distinct(USUBJID, .keep_all = TRUE) %>%
    mutate(
      PARAMCD = "TDURD",
      PARAM = "Overall duration (days)",
      AVAL = sample(x = seq(1, 200), size = n(), replace = TRUE),
      AVALU = "Days"
    ) %>%
    bind_rows(ADEX)
  col_labels(ADEX) <- .labels

  ADCM <- tmc_ex_adcm

  ADMH <- tmc_ex_admh

  ADCM$CMASTDTM <- ADCM$ASTDTM
  ADCM$CMAENDTM <- ADCM$AENDTM

  ADEG <- tmc_ex_adeg

  # smq
  .names_baskets <- grep("^(SMQ|CQ).*NAM$", names(ADAE), value = TRUE)
  .names_scopes <- grep("^SMQ.*SC$", names(ADAE), value = TRUE)

  .cs_baskets <- choices_selected(
    choices = variable_choices(ADAE, subset = .names_baskets),
    selected = .names_baskets
  )

  .cs_scopes <- choices_selected(
    choices = variable_choices(ADAE, subset = .names_scopes),
    selected = .names_scopes,
    fixed = TRUE
  )

  # summary
  ADSL$EOSDY[1] <- NA_integer_
})
join_keys(data) <- default_cdisc_join_keys[names(data)]
adcm_keys <- c("STUDYID", "USUBJID", "ASTDTM", "CMSEQ", "ATC1", "ATC2", "ATC3", "ATC4")
join_keys(data)["ADCM", "ADCM"] <- adcm_keys

# Use in choices selected -----------------------------------------------------

ADSL <- data[["ADSL"]]
ADQS <- data[["ADQS"]]
ADAE <- data[["ADAE"]]
ADTTE <- data[["ADTTE"]]
ADLB <- data[["ADLB"]]
ADAE <- data[["ADAE"]]
ADVS <- data[["ADVS"]]
ADRS <- data[["ADRS"]]
ADAETTE <- data[["ADAETTE"]]
ADEX <- data[["ADEX"]]
ADCM <- data[["ADCM"]]
ADMH <- data[["ADMH"]]
ADEG <- data[["ADEG"]]

# Init ------------------------------------------------------------------------

init(
  data = data,
  modules = modules(
    # -------------------------------------------------------------------------
    tm_t_summary_by(
      label = "Summary by Row Groups Table",
      dataname = "ADLB",
      arm_var = choices_selected(
        choices = variable_choices(ADSL, c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      add_total = TRUE,
      by_vars = choices_selected(
        choices = variable_choices(ADLB, c("PARAM", "AVISIT")),
        selected = c("AVISIT")
      ),
      summarize_vars = choices_selected(
        choices = variable_choices(ADLB, c("AVAL", "CHG")),
        selected = c("AVAL")
      ),
      useNA = "ifany",
      paramcd = choices_selected(
        choices = value_choices(ADLB, "PARAMCD", "PARAM"),
        selected = "ALT"
      ),
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_smq(
      label = "Adverse Events by SMQ Table",
      dataname = "ADAE",
      arm_var = choices_selected(
        choices = variable_choices(data[["ADSL"]], subset = c("ARM", "SEX")),
        selected = "ARM"
      ),
      add_total = FALSE,
      baskets = data[[".cs_baskets"]],
      scopes = data[[".cs_scopes"]],
      llt = choices_selected(
        choices = variable_choices(data[["ADAE"]], subset = c("AEDECOD")),
        selected = "AEDECOD"
      ),
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_shift_by_grade(
      label = "Grade Laboratory Abnormality Table",
      dataname = "ADLB",
      arm_var = choices_selected(
        choices = variable_choices(ADSL, subset = c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      paramcd = choices_selected(
        choices = value_choices(ADLB, "PARAMCD", "PARAM"),
        selected = "ALT"
      ),
      worst_flag_var = choices_selected(
        choices = variable_choices(ADLB, subset = c("WGRLOVFL", "WGRLOFL", "WGRHIVFL", "WGRHIFL")),
        selected = c("WGRLOVFL")
      ),
      worst_flag_indicator = choices_selected(
        value_choices(ADLB, "WGRLOVFL"),
        selected = "Y", fixed = TRUE
      ),
      anl_toxgrade_var = choices_selected(
        choices = variable_choices(ADLB, subset = c("ATOXGR")),
        selected = c("ATOXGR"),
        fixed = TRUE
      ),
      base_toxgrade_var = choices_selected(
        choices = variable_choices(ADLB, subset = c("BTOXGR")),
        selected = c("BTOXGR"),
        fixed = TRUE
      ),
      add_total = FALSE,
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_shift_by_arm(
      label = "Shift by Arm Table",
      dataname = "ADEG",
      arm_var = choices_selected(
        variable_choices(ADSL, subset = c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      paramcd = choices_selected(
        value_choices(ADEG, "PARAMCD"),
        selected = "HR"
      ),
      visit_var = choices_selected(
        value_choices(ADEG, "AVISIT"),
        selected = "POST-BASELINE MINIMUM"
      ),
      aval_var = choices_selected(
        variable_choices(ADEG, subset = "ANRIND"),
        selected = "ANRIND",
        fixed = TRUE
      ),
      baseline_var = choices_selected(
        variable_choices(ADEG, subset = "BNRIND"),
        selected = "BNRIND",
        fixed = TRUE
      ),
      useNA = "ifany",
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_shift_by_arm_by_worst(
      label = "Shift by Arm Table (by worst)",
      dataname = "ADEG",
      arm_var = choices_selected(
        variable_choices(ADSL, subset = c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      paramcd = choices_selected(
        value_choices(ADEG, "PARAMCD"),
        selected = "ECGINTP"
      ),
      worst_flag_var = choices_selected(
        variable_choices(ADEG, c("WORS02FL", "WORS01FL")),
        selected = "WORS02FL"
      ),
      worst_flag = choices_selected(
        value_choices(ADEG, "WORS02FL"),
        selected = "Y",
        fixed = TRUE
      ),
      aval_var = choices_selected(
        variable_choices(ADEG, c("AVALC", "ANRIND")),
        selected = "AVALC"
      ),
      baseline_var = choices_selected(
        variable_choices(ADEG, c("BASEC", "BNRIND")),
        selected = "BASEC"
      ),
      useNA = "ifany",
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_pp_prior_medication(
      label = "Prior Medication",
      dataname = "ADCM",
      parentname = "ADSL",
      patient_col = "USUBJID",
      atirel = choices_selected(
        choices = variable_choices(ADCM, "ATIREL"),
        selected = "ATIREL"
      ),
      cmdecod = choices_selected(
        choices = variable_choices(ADCM, "CMDECOD"),
        selected = "CMDECOD"
      ),
      cmindc = choices_selected(
        choices = variable_choices(ADCM, "CMINDC"),
        selected = "CMINDC"
      ),
      cmstdy = choices_selected(
        choices = variable_choices(ADCM, "ASTDY"),
        selected = "ASTDY"
      ),
      decorators = list(
        table = rlisting_footer(.var_to_replace = "table")
      )
    ),
    # -------------------------------------------------------------------------
    tm_t_pp_medical_history(
      label = "Medical History",
      dataname = "ADMH",
      parentname = "ADSL",
      patient_col = "USUBJID",
      mhterm = choices_selected(
        choices = variable_choices(ADMH, c("MHTERM")),
        selected = "MHTERM"
      ),
      mhbodsys = choices_selected(
        choices = variable_choices(ADMH, "MHBODSYS"),
        selected = "MHBODSYS"
      ),
      mhdistat = choices_selected(
        choices = variable_choices(ADMH, "MHDISTAT"),
        selected = "MHDISTAT"
      ),
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_pp_laboratory(
      label = "Vitals",
      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 = rlisting_footer(.var_to_replace = "table"))
    ),
    # -------------------------------------------------------------------------
    tm_t_pp_basic_info(
      label = "Basic Info",
      dataname = "ADSL",
      patient_col = "USUBJID",
      vars = choices_selected(choices = variable_choices(ADSL), selected = c("ARM", "AGE", "SEX", "COUNTRY", "RACE", "EOSSTT"))
      , decorators = list(
        table = rlisting_footer(.var_to_replace = "table")
      )
    ),
    # -------------------------------------------------------------------------
    tm_t_mult_events(
      label = "Concomitant Medications by Medication Class and Preferred Name",
      dataname = "ADCM",
      arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
      seq_var = choices_selected("CMSEQ", selected = "CMSEQ", fixed = TRUE),
      hlt = choices_selected(
        choices = variable_choices(ADCM, c("ATC1", "ATC2", "ATC3", "ATC4")),
        selected = c("ATC1", "ATC2", "ATC3", "ATC4")
      ),
      llt = choices_selected(choices = variable_choices(ADCM, c("CMDECOD")), selected = c("CMDECOD")),
      add_total = TRUE,
      event_type = "treatment",
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_logistic(
      label = "Logistic Regression",
      dataname = "ADRS",
      arm_var = choices_selected(
        choices = variable_choices(ADRS, c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      arm_ref_comp = arm_ref_comp,
      paramcd = choices_selected(
        choices = value_choices(ADRS, "PARAMCD", "PARAM"),
        selected = "BESRSPI"
      ),
      cov_var = choices_selected(
        choices = c("SEX", "AGE", "BMRKR1", "BMRKR2"),
        selected = "SEX"
      ),
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_exposure(
      label = "Duration of Exposure Table",
      dataname = "ADEX",
      paramcd = choices_selected(
        choices = value_choices(data[["ADEX"]], "PARAMCD", "PARAM"),
        selected = "TDURD"
      ),
      col_by_var = choices_selected(
        choices = variable_choices(data[["ADEX"]], subset = c("SEX", "ARM")),
        selected = "SEX"
      ),
      row_by_var = choices_selected(
        choices = variable_choices(data[["ADEX"]], subset = c("RACE", "REGION1", "STRATA1", "SEX")),
        selected = "RACE"
      ),
      parcat = choices_selected(
        choices = value_choices(data[["ADEX"]], "PARCAT2"),
        selected = "Drug A"
      ),
      add_total = FALSE,
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_events(
      label = "Adverse Event Table",
      dataname = "ADAE",
      arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
      llt = choices_selected(
        choices = variable_choices(ADAE, c("AETERM", "AEDECOD")),
        selected = c("AEDECOD")
      ),
      hlt = choices_selected(
        choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")),
        selected = "AEBODSYS"
      ),
      add_total = TRUE,
      event_type = "adverse event",
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_events_patyear(
      label = "AE Rate Adjusted for Patient-Years At Risk Table",
      dataname = "ADAETTE",
      arm_var = choices_selected(
        choices = variable_choices(ADSL, c("ARM", "ARMCD")),
        selected = "ARMCD"
      ),
      add_total = TRUE,
      events_var = choices_selected(
        choices = variable_choices(ADAETTE, "n_events"),
        selected = "n_events",
        fixed = TRUE
      ),
      paramcd = choices_selected(
        choices = value_choices(ADAETTE, "PARAMCD", "PARAM"),
        selected = "AETTE1"
      ),
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_events_by_grade(
      label = "Adverse Events by Grade Table",
      dataname = "ADAE",
      arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
      llt = choices_selected(
        choices = variable_choices(ADAE, c("AETERM", "AEDECOD")),
        selected = c("AEDECOD")
      ),
      hlt = choices_selected(
        choices = variable_choices(ADAE, c("AEBODSYS", "AESOC")),
        selected = "AEBODSYS"
      ),
      grade = choices_selected(
        choices = variable_choices(ADAE, c("AETOXGR", "AESEV")),
        selected = "AETOXGR"
      ),
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_coxreg(
      label = "Cox Reg.",
      dataname = "ADTTE",
      arm_var = choices_selected(c("ARM", "ARMCD", "ACTARMCD"), "ARM"),
      arm_ref_comp = arm_ref_comp,
      paramcd = choices_selected(
        value_choices(ADTTE, "PARAMCD", "PARAM"), "OS"
      ),
      strata_var = choices_selected(
        c("COUNTRY", "STRATA1", "STRATA2"), "STRATA1"
      ),
      cov_var = choices_selected(
        c("AGE", "BMRKR1", "BMRKR2", "REGION1"), "AGE"
      ),
      multivariate = TRUE,
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_abnormality(
      label = "Abnormality Table",
      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(insert_rrow_decorator("I am a good new row"))
    ),
    # -------------------------------------------------------------------------
    tm_g_pp_vitals(
      label = "Vitals",
      dataname = "ADVS",
      parentname = "ADSL",
      patient_col = "USUBJID",
      plot_height = c(600L, 200L, 2000L),
      paramcd = choices_selected(
        choices = variable_choices(ADVS, "PARAMCD"),
        selected = "PARAMCD"
      ),
      xaxis = choices_selected(
        choices = variable_choices(ADVS, "ADY"),
        selected = "ADY"
      ),
      aval_var = choices_selected(
        choices = variable_choices(ADVS, "AVAL"),
        selected = "AVAL"
      ),
      decorators = list(plot = add_title_decorator("plot"))
    ),
    # -------------------------------------------------------------------------
    tm_g_pp_adverse_events(
      label = "Adverse Events",
      dataname = "ADAE",
      parentname = "ADSL",
      patient_col = "USUBJID",
      plot_height = c(600L, 200L, 2000L),
      aeterm = choices_selected(
        choices = variable_choices(ADAE, "AETERM"),
        selected = "AETERM"
      ),
      tox_grade = choices_selected(
        choices = variable_choices(ADAE, "AETOXGR"),
        selected = "AETOXGR"
      ),
      causality = choices_selected(
        choices = variable_choices(ADAE, "AEREL"),
        selected = "AEREL"
      ),
      outcome = choices_selected(
        choices = variable_choices(ADAE, "AEOUT"),
        selected = "AEOUT"
      ),
      action = choices_selected(
        choices = variable_choices(ADAE, "AEACN"),
        selected = "AEACN"
      ),
      time = choices_selected(
        choices = variable_choices(ADAE, "ASTDY"),
        selected = "ASTDY"
      ),
      decod = NULL,
      decorators = list(
        plot = caption_decorator('I am a good caption', 'plot'),
        table = rlisting_footer(.var_to_replace = 'table')
      )
    ),
    # -------------------------------------------------------------------------
    tm_g_lineplot(
      label = "Line Plot",
      dataname = "ADLB",
      strata = choices_selected(
        variable_choices(ADSL, c("ARM", "ARMCD", "ACTARMCD")),
        "ARM"
      ),
      y = choices_selected(
        variable_choices(ADLB, c("AVAL", "BASE", "CHG", "PCHG")),
        "AVAL"
      ),
      param = choices_selected(
        value_choices(ADLB, "PARAMCD", "PARAM"),
        "ALT"
      ),
      decorators = list(add_cowplot_title_decorator("plot"))
    ),
    # -------------------------------------------------------------------------
    tm_g_km(
      label = "Kaplan-Meier Plot",
      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 = arm_ref_comp,
      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 = add_cowplot_title_decorator(TRUE, "plot"))
    ),
    # -------------------------------------------------------------------------
    tm_g_barchart_simple(
      label = "ADAE Analysis",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          choices = variable_choices(
            ADSL,
            c(
              "ARM", "ACTARM", "SEX",
              "RACE", "ITTFL", "SAFFL", "STRATA2"
            )
          ),
          selected = "ACTARM",
          multiple = FALSE
        )
      ),
      fill = list(
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(
              ADSL,
              c(
                "ARM", "ACTARM", "SEX",
                "RACE", "ITTFL", "SAFFL", "STRATA2"
              )
            ),
            selected = "SEX",
            multiple = FALSE
          )
        ),
        data_extract_spec(
          dataname = "ADAE",
          select = select_spec(
            choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
            selected = NULL,
            multiple = FALSE
          )
        )
      ),
      x_facet = list(
        data_extract_spec(
          dataname = "ADAE",
          select = select_spec(
            choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
            selected = "AETOXGR",
            multiple = FALSE
          )
        ),
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(
              ADSL,
              c(
                "ARM", "ACTARM", "SEX",
                "RACE", "ITTFL", "SAFFL", "STRATA2"
              )
            ),
            selected = NULL,
            multiple = FALSE
          )
        )
      ),
      y_facet = list(
        data_extract_spec(
          dataname = "ADAE",
          select = select_spec(
            choices = variable_choices(ADAE, c("AETOXGR", "AESEV", "AESER")),
            selected = "AESEV",
            multiple = FALSE
          )
        ),
        data_extract_spec(
          dataname = "ADSL",
          select = select_spec(
            choices = variable_choices(
              ADSL,
              c(
                "ARM", "ACTARM", "SEX",
                "RACE", "ITTFL", "SAFFL", "STRATA2"
              )
            ),
            selected = NULL,
            multiple = FALSE
          )
        )
      ),
      decorators = list(plot = caption_decorator('The best', 'plot'))
    )
  )
) |> shiny::runApp()

Second App

# Load packages
pkgload::load_all("../teal.modules.clinical", export_all = FALSE)
# Example below

insert_rrow_decorator <- function(default_caption = "I am a good new row", .var_to_replace = "table") {
  teal_transform_module(
    label = "New row",
    ui = function(id) shiny::textInput(shiny::NS(id, "new_row"), "New row", value = default_caption),
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- rtables::insert_rrow(.var_to_replace, rtables::rrow(new_row))
      }, env = list(.var_to_replace = as.name(.var_to_replace)))
    )
  )
}

# Preparation of the test case - use `EOSDY` and `DCSREAS` variables to demonstrate missing data.
data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl |>
    mutate(
      DTHFL = case_when(
        !is.na(DTHDT) ~ "Y",
        TRUE ~ ""
      ) %>% with_label("Subject Death Flag")
    )
  ADSL$EOSDY[1] <- NA_integer_

  ADAE <- tmc_ex_adae

  .add_event_flags <- function(dat) {
    dat <- dat %>%
      mutate(
        TMPFL_SER = AESER == "Y",
        TMPFL_REL = AEREL == "Y",
        TMPFL_GR5 = AETOXGR == "5",
        TMP_SMQ01 = !is.na(SMQ01NAM),
        TMP_SMQ02 = !is.na(SMQ02NAM),
        TMP_CQ01 = !is.na(CQ01NAM)
      )
    column_labels <- list(
      TMPFL_SER = "Serious AE",
      TMPFL_REL = "Related AE",
      TMPFL_GR5 = "Grade 5 AE",
      TMP_SMQ01 = aesi_label(dat[["SMQ01NAM"]], dat[["SMQ01SC"]]),
      TMP_SMQ02 = aesi_label("Y.9.9.9.9/Z.9.9.9.9 AESI"),
      TMP_CQ01 = aesi_label(dat[["CQ01NAM"]])
    )
    col_labels(dat)[names(column_labels)] <- as.character(column_labels)
    dat
  }

  #' Generating user-defined event flags.
  ADAE <- ADAE %>% .add_event_flags()

  .ae_anl_vars <- names(ADAE)[startsWith(names(ADAE), "TMPFL_")]
  .aesi_vars <- names(ADAE)[startsWith(names(ADAE), "TMP_")]

  ADTTE <- tmc_ex_adtte

  # responder

  ADRS <- tmc_ex_adrs %>%
    mutate(
      AVALC = d_onco_rsp_label(AVALC) %>%
        with_label("Character Result/Finding")
    ) %>%
    filter(PARAMCD != "OVRINV" | AVISIT == "FOLLOW UP")


  ADQS <- tmc_ex_adqs %>%
    filter(ABLFL != "Y" & ABLFL2 != "Y") %>%
    filter(AVISIT %in% c("WEEK 1 DAY 8", "WEEK 2 DAY 15", "WEEK 3 DAY 22")) %>%
    mutate(
      AVISIT = as.factor(AVISIT),
      AVISITN = rank(AVISITN) %>%
        as.factor() %>%
        as.numeric() %>%
        as.factor() #' making consecutive numeric factor
    )
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADRS <- data[["ADRS"]]

app <- init(
  data = data,
  modules = modules(
    # -------------------------------------------------------------------------
    tm_a_mmrm(
      label = "MMRM",
      dataname = "ADQS",
      aval_var = choices_selected(c("AVAL", "CHG"), "AVAL"),
      id_var = choices_selected(c("USUBJID", "SUBJID"), "USUBJID"),
      arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
      visit_var = choices_selected(c("AVISIT", "AVISITN"), "AVISIT"),
      arm_ref_comp = arm_ref_comp,
      paramcd = choices_selected(
        choices = value_choices(data[["ADQS"]], "PARAMCD", "PARAM"),
        selected = "FKSI-FWB"
      ),
      cov_var = choices_selected(c("BASE", "AGE", "SEX", "BASE:AVISIT"), NULL)
      , decorators = list(
        lsmeans_table = insert_rrow_decorator("A", .var_to_replace = "lsmeans_table")
        , lsmeans_plot = add_title_decorator("B", .var_to_replace = "lsmeans_plot")
        , covariance_table = insert_rrow_decorator("C", .var_to_replace = "covariance_table")
        , fixed_effects_table = insert_rrow_decorator("D", .var_to_replace = "fixed_effects_table")
        , diagnostic_table = insert_rrow_decorator(.var_to_replace = "diagnostic_table")
        , diagnostic_plot = add_title_decorator(.var_to_replace = "diagnostic_plot")
      )
    ),
    # -------------------------------------------------------------------------
    tm_t_binary_outcome(
      label = "Responders",
      dataname = "ADRS",
      paramcd = choices_selected(
        choices = value_choices(ADRS, "PARAMCD", "PARAM"),
        selected = "BESRSPI"
      ),
      arm_var = choices_selected(
        choices = variable_choices(ADRS, c("ARM", "ARMCD", "ACTARMCD")),
        selected = "ARM"
      ),
      arm_ref_comp = arm_ref_comp,
      strata_var = choices_selected(
        choices = variable_choices(ADRS, c("SEX", "BMRKR2", "RACE")),
        selected = "RACE"
      ),
      default_responses = list(
        BESRSPI = list(
          rsp = c("Complete Response (CR)", "Partial Response (PR)"),
          levels = c(
            "Complete Response (CR)", "Partial Response (PR)",
            "Stable Disease (SD)", "Progressive Disease (PD)"
          )
        ),
        INVET = list(
          rsp = c("Stable Disease (SD)", "Not Evaluable (NE)"),
          levels = c(
            "Complete Response (CR)", "Not Evaluable (NE)", "Partial Response (PR)",
            "Progressive Disease (PD)", "Stable Disease (SD)"
          )
        ),
        OVRINV = list(
          rsp = c("Progressive Disease (PD)", "Stable Disease (SD)"),
          levels = c("Progressive Disease (PD)", "Stable Disease (SD)", "Not Evaluable (NE)")
        )
      ),
      decorators = list(insert_rrow_decorator("I am a new row"))
    ),
    # -------------------------------------------------------------------------
    tm_t_events_summary(
      label = "Adverse Events Summary",
      dataname = "ADAE",
      arm_var = choices_selected(
        choices = variable_choices("ADSL", c("ARM", "ARMCD")),
        selected = "ARM"
      ),
      flag_var_anl = choices_selected(
        choices = variable_choices("ADAE", data[[".ae_anl_vars"]]),
        selected = data[[".ae_anl_vars"]][1],
        keep_order = TRUE,
        fixed = FALSE
      ),
      flag_var_aesi = choices_selected(
        choices = variable_choices("ADAE", data[[".aesi_vars"]]),
        selected = data[[".aesi_vars"]][1],
        keep_order = TRUE,
        fixed = FALSE
      ),
      add_total = TRUE,
      decorators = list(insert_rrow_decorator())
    ),
    # -------------------------------------------------------------------------
    tm_t_summary(
      label = "Demographic Table",
      dataname = "ADSL",
      arm_var = choices_selected(c("ARM", "ARMCD"), "ARM"),
      add_total = TRUE,
      summarize_vars = choices_selected(
        c("SEX", "RACE", "BMRKR2", "EOSDY", "DCSREAS", "AGE"),
        c("SEX", "RACE")
      ),
      useNA = "ifany",
      decorators = list(insert_rrow_decorator())
    )
  )
) |> shiny::runApp()

…te_output@main * 1187_decorate_output@main: fix: tm_t_coxreg bug

m7pr · 2024-12-13T13:00:40Z

Hey @averissimo I see this one in the first module

m7pr · 2024-12-13T13:03:37Z

For the prior medication I do not see object to be edited with the footnote

EDIT: Vitals and Basic info tab doesn't have this one as well

m7pr · 2024-12-13T13:13:18Z

Responders have an error

m7pr · 2024-12-13T13:14:27Z

Adverse events has issues

m7pr · 2024-12-13T13:16:37Z

I think MMRM uses wrong data :P

averissimo · 2024-12-13T16:18:12Z

I've updated the apps and corrected one more bug in the feature branch (already merged here)

For the prior medication I do not see object to be edited with the footnote

EDIT: Vitals and Basic info tab doesn't have this one as well

No action: They are only present on the reporter.

Responders have an error

Fixed the app: by moving to second application.

The teal_data modifications after introducing this module had incompatible data :-\

Adverse events has issues

Fixed: Bug in decorators, fixed in feature branch and merged here

I think MMRM uses wrong data :P

No action: Moved to second application

…te_output@main

m7pr · 2024-12-16T08:14:06Z

Thanks @averissimo - will re-review

m7pr · 2024-12-16T08:18:53Z

For the prior medication I can not add a card to the reporter

Error in `[<-`(`*tmp*`, disp, kcol, value = NA_character_) : 
  (subscript) logical subscript too long
Warning in observe() :
  The card could not be added to the report. Have the outputs for the report been created yet? If not please try again when they are ready. Otherwise contact your application developer

m7pr · 2024-12-16T08:22:57Z

Vitals:

Show R Code

Warning: Error in : object 'source_code_r' not found
  1: shiny::runApp

m7pr · 2024-12-16T08:27:15Z

Adverse events

m7pr · 2024-12-16T08:33:56Z

Second app - MMRM

When going between outputs you can see that UI presents an error because data hasn't changed yet. Any way to delay that?

mmrm.mp4

m7pr · 2024-12-16T08:35:20Z

Other than that, everything works like a charm : )! great job!

averissimo · 2024-12-16T13:25:55Z

Thanks @m7pr

Starting with the unfixable: mmrm and Adverse events

mmrm: We need to decouple decorators from transformators or extend it to ignore temporary error states.
- Regardless, this is out of the scope of tmc and is a teal issue
Adverse events: known bug that is the same as mmrm

What was fixed:

prior medication: You discovered a bug with vitals, nice! I've fixed it by showing No data available. when the medication table is empty. I also created this issue on rlistings which hopefully will trickle back to {tmc} if they implement a fix.

Vitals

Sorry about this, it was too many modules, fixed now.

Ready for another round!

m7pr · 2024-12-16T13:32:56Z

Amazing @averissimo - thanks for the work! Do we have a card for handling those two? I would start those, at least just to bring the attention to discuss those

mmrm: We need to decouple decorators from transformators or extend it to ignore temporary error states.
Regardless, this is out of the scope of tmc and is a teal issue

Adverse events: known bug that is the same as mmrm

averissimo · 2024-12-16T13:40:21Z

@m7pr we do: insightsengineering/teal#1421

It's a question but I'll extend with a practical example

feat: standardize source_code

d26f906

averissimo added the core label Dec 12, 2024

averissimo added 2 commits December 12, 2024 14:38

chore: file was not saved to disk with previous commit

f635350

Merge branch '1187_decorate_output@main' into source_code@1187_decora…

3fef680

…te_output@main * 1187_decorate_output@main: fix: tm_t_coxreg bug

m7pr self-assigned this Dec 13, 2024

averissimo marked this pull request as ready for review December 13, 2024 10:56

m7pr closed this Dec 13, 2024

m7pr reopened this Dec 13, 2024

github-actions bot locked and limited conversation to collaborators Dec 13, 2024

insightsengineering unlocked this conversation Dec 13, 2024

Merge branch '1187_decorate_output@main' into source_code@1187_decora…

8b79a0a

…te_output@main

averissimo added 2 commits December 16, 2024 11:25

fix: vitas

fad1a4f

fix: bug when no data is available

6369459

m7pr approved these changes Dec 16, 2024

View reviewed changes

averissimo merged commit 8a9edd2 into 1187_decorate_output@main Dec 16, 2024
1 check passed

averissimo deleted the source_code@1187_decorate_output@main branch December 16, 2024 13:39

github-actions bot locked and limited conversation to collaborators Dec 16, 2024

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uses same code for source code generation in modules #1301

Uses same code for source code generation in modules #1301

averissimo commented Dec 12, 2024 •

edited

Loading

m7pr commented Dec 13, 2024 •

edited

Loading

m7pr commented Dec 13, 2024 •

edited

Loading

m7pr commented Dec 13, 2024

m7pr commented Dec 13, 2024

m7pr commented Dec 13, 2024

averissimo commented Dec 13, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

averissimo commented Dec 16, 2024

m7pr commented Dec 16, 2024

averissimo commented Dec 16, 2024

Uses same code for source code generation in modules #1301

Uses same code for source code generation in modules #1301

Conversation

averissimo commented Dec 12, 2024 • edited Loading

Example app with all modules / decorators

m7pr commented Dec 13, 2024 • edited Loading

m7pr commented Dec 13, 2024 • edited Loading

m7pr commented Dec 13, 2024

m7pr commented Dec 13, 2024

m7pr commented Dec 13, 2024

averissimo commented Dec 13, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

m7pr commented Dec 16, 2024

averissimo commented Dec 16, 2024

m7pr commented Dec 16, 2024

averissimo commented Dec 16, 2024

averissimo commented Dec 12, 2024 •

edited

Loading

m7pr commented Dec 13, 2024 •

edited

Loading

m7pr commented Dec 13, 2024 •

edited

Loading