Introduce decorators for tm_g_km

[m7pr]

Part of insightsengineering/teal#1371

Working Example

devtools::load_all("../teal")
devtools::load_all(".")

library(nestcolor)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADTTE <- tmc_ex_adtte
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADTTE <- data[["ADTTE"]]

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

change_theme_decorator <- function(default_check = TRUE, .var_to_replace = "plot") {
  teal_transform_module(
    label = "Theme",
    server = make_teal_transform_server(
      substitute({
        .var_to_replace <- .var_to_replace + ggplot2::theme_void()
      }, 
      env = list(.var_to_replace = as.name(.var_to_replace))
      )
    )
  )
}

app <- init(
  data = data,
  modules = modules(
    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 = change_theme_decorator(TRUE, "plot"))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[averissimo]

Example does nothing, used one below:

# tm_g_lineplot
pkgload::load_all("../teal.modules.clinical")

library(nestcolor)

data <- teal_data()
data <- within(data, {
  ADSL <- tmc_ex_adsl
  ADTTE <- tmc_ex_adtte
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

ADSL <- data[["ADSL"]]
ADTTE <- data[["ADTTE"]]

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

add_title_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::ggtitle("Title added by decorator") +
              cowplot::theme_cowplot()
      },
      env = list(.var_to_replace = as.name(.var_to_replace))
      )
    )
  )
}

app <- init(
  data = data,
  modules = modules(
    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 = change_theme_decorator(TRUE, "plot"))
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}

[m7pr]

Thanks, theme_void rescaled the plot so it's margin where at the edge of the plot, but I guess it's better to add title or caption : P