Skip to content

Commit

Permalink
Uses same code for source code generation in modules (#1301)
Browse files Browse the repository at this point in the history 
Part of insightsengineering/teal#1371

### Example app with all modules / decorators

<details>
<summary>Example app</summary>

```r
# 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()

```

</details>    

<details>
<summary>Second App</summary>

```r
# 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()
```

</details>
  • Loading branch information
@averissimo
averissimo authored Dec 16, 2024
1 parent 6d4ce5b commit 8a9edd2
Show file tree
Hide file tree
Showing 25 changed files with 89 additions and 49 deletions.
5 changes: 3 additions & 2 deletions R/tm_a_gee.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -575,9 +575,10 @@ srv_gee <- function(id,
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -601,7 +602,7 @@ srv_gee <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_table_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_barchart_simple.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -565,9 +565,11 @@ srv_g_barchart_simple <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q_code())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q_code()))),
verbatim_content = source_code_r,
title = "Bar Chart"
)

Expand All @@ -586,7 +588,7 @@ srv_g_barchart_simple <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q_code())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_ci.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -488,9 +488,11 @@ srv_g_ci <- function(id,
# Outputs to render.
plot_r <- reactive(decorated_plot_q()[["plot"]])

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_plot_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_plot_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -517,7 +519,7 @@ srv_g_ci <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_plot_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_forest_rsp.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -790,9 +790,11 @@ srv_g_forest_rsp <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -811,7 +813,7 @@ srv_g_forest_rsp <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_forest_tte.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -720,9 +720,11 @@ srv_g_forest_tte <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = "R Code for the Current Time-to-Event Forest Plot"
)

Expand All @@ -741,7 +743,7 @@ srv_g_forest_tte <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_ipp.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -642,9 +642,11 @@ srv_g_ipp <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -663,7 +665,7 @@ srv_g_ipp <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_km.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -839,9 +839,11 @@ srv_g_km <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -861,7 +863,7 @@ srv_g_km <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_lineplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -686,9 +686,11 @@ srv_g_lineplot <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -707,7 +709,7 @@ srv_g_lineplot <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_pp_adverse_events.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -630,9 +630,11 @@ srv_g_adverse_events <- function(id,
c(decorated_all_q_table(), decorated_all_q_plot())
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -653,7 +655,7 @@ srv_g_adverse_events <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_pp_patient_timeline.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -940,9 +940,11 @@ srv_g_patient_timeline <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -961,7 +963,7 @@ srv_g_patient_timeline <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_pp_therapy.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -735,9 +735,11 @@ srv_g_therapy <- function(id,
width = plot_width
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q_plot())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q_plot()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -758,7 +760,7 @@ srv_g_therapy <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q_plot())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_g_pp_vitals.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -574,6 +574,8 @@ srv_g_vitals <- function(id,
)
plot_r <- reactive(decorated_all_q()[["plot"]])

# Render R code.
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
pws <- teal.widgets::plot_with_settings_srv(
id = "vitals_plot",
plot_r = plot_r,
Expand All @@ -583,7 +585,7 @@ srv_g_vitals <- function(id,

teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_all_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -602,7 +604,7 @@ srv_g_vitals <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
5 changes: 3 additions & 2 deletions R/tm_t_abnormality.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -673,9 +673,10 @@ srv_t_abnormality <- function(id,
)

# Render R code.
source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -694,7 +695,7 @@ srv_t_abnormality <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_table_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
5 changes: 3 additions & 2 deletions R/tm_t_abnormality_by_worst_grade.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -693,9 +693,10 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
)

# Render R code.
source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -715,7 +716,7 @@ srv_t_abnormality_by_worst_grade <- function(id, # nolint: object_length.
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_table_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
5 changes: 3 additions & 2 deletions R/tm_t_ancova.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -971,9 +971,10 @@ srv_ancova <- function(id,
)

# Render R code.
source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -993,7 +994,7 @@ srv_ancova <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_table_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
7 changes: 3 additions & 4 deletions R/tm_t_binary_outcome.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1025,11 +1025,10 @@ srv_t_binary_outcome <- function(id,
)

# Render R code.
source_code_r <- reactive(teal.code::get_code(req(decorated_all_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive({
teal.code::get_code(req(decorated_all_q()))
}),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -1048,7 +1047,7 @@ srv_t_binary_outcome <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_all_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
6 changes: 4 additions & 2 deletions R/tm_t_coxreg.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1108,9 +1108,11 @@ srv_t_coxreg <- function(id,
table_r = table_r
)

# Render R code
source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
verbatim_content = source_code_r,
title = "R Code for the Current (Multi-Variable) Cox proportional hazard regression model"
)

Expand All @@ -1129,7 +1131,7 @@ srv_t_coxreg <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_table_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
5 changes: 3 additions & 2 deletions R/tm_t_events.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -838,9 +838,10 @@ srv_t_events_byterm <- function(id,
)

# Render R code.
source_code_r <- reactive(teal.code::get_code(req(decorated_table_q())))
teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(req(decorated_table_q()))),
verbatim_content = source_code_r,
title = label
)

Expand All @@ -859,7 +860,7 @@ srv_t_events_byterm <- function(id,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(req(decorated_table_q())))
card$append_src(source_code_r())
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
Loading

0 comments on commit 8a9edd2

Please sign in to comment.