Skip to content

Commit

Permalink
introduce decorators for tm_t_crosstable (#806)
Browse files Browse the repository at this point in the history
Part of insightsengineering/teal#1370

<details><summary> Working Example </summary>

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


split_by_decorator <- teal_transform_module(
  label = "Footnote",
  ui = function(id) shiny::textInput(
    shiny::NS(id, "text"), "Insert row", "Hello World!" 
  ),
  server = function(id, data) {
    moduleServer(id, function(input, output, session) {
      logger::log_info("🟢 Text called to action!", namespace = "teal.modules.general")
      reactive(
        within(
          data(),
          {
              table <- table %>% insert_rrow(rrow(text))
          },
          text = input$text
        )
      )
    })
  }
)

# CDISC data example
data <- teal_data()
data <- within(data, {
  ADSL <- rADSL
})
join_keys(data) <- default_cdisc_join_keys[names(data)]

app <- init(
  data = data,
  modules = modules(
    tm_t_crosstable(
      label = "Cross Table",
      x = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["ADSL"]], subset = function(data) {
            idx <- !vapply(data, inherits, logical(1), c("Date", "POSIXct", "POSIXlt"))
            return(names(data)[idx])
          }),
          selected = "COUNTRY",
          multiple = TRUE,
          ordered = TRUE,
          fixed = FALSE
        )
      ),
      y = data_extract_spec(
        dataname = "ADSL",
        select = select_spec(
          label = "Select variable:",
          choices = variable_choices(data[["ADSL"]], subset = function(data) {
            idx <- vapply(data, is.factor, logical(1))
            return(names(data)[idx])
          }),
          selected = "SEX",
          multiple = FALSE,
          fixed = FALSE
        )
      ),
      decorators = list(split_by_decorator)
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}


````

</details>

---------

Signed-off-by: Marcin <[email protected]>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
Co-authored-by: André Veríssimo <[email protected]>
  • Loading branch information
3 people authored Nov 22, 2024
1 parent 7deda6d commit 824efcf
Show file tree
Hide file tree
Showing 2 changed files with 43 additions and 11 deletions.
36 changes: 26 additions & 10 deletions R/tm_t_crosstable.R
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,14 @@
#'
#' @inherit shared_params return
#'
#' @section Decorating `tm_t_crosstable`:
#'
#' This module generates the following objects, which can be modified in place using decorators:
#' - `table` (`ElementaryTable` - output of `rtables::build_table`)
#'
#' For additional details and examples of decorators, refer to the vignette
#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
#'
#' @examplesShinylive
#' library(teal.modules.general)
#' interactive <- function() TRUE
Expand Down Expand Up @@ -134,7 +142,8 @@ tm_t_crosstable <- function(label = "Cross Table",
show_total = TRUE,
pre_output = NULL,
post_output = NULL,
basic_table_args = teal.widgets::basic_table_args()) {
basic_table_args = teal.widgets::basic_table_args(),
decorators = NULL) {
message("Initializing tm_t_crosstable")

# Requires Suggested packages
Expand All @@ -158,6 +167,7 @@ tm_t_crosstable <- function(label = "Cross Table",
checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
checkmate::assert_class(basic_table_args, classes = "basic_table_args")
checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
# End of assertions

# Make UI args
Expand All @@ -167,7 +177,8 @@ tm_t_crosstable <- function(label = "Cross Table",
label = label,
x = x,
y = y,
basic_table_args = basic_table_args
basic_table_args = basic_table_args,
decorators = decorators
)

ans <- module(
Expand All @@ -184,6 +195,7 @@ tm_t_crosstable <- function(label = "Cross Table",

# UI function for the cross-table module
ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, post_output, ...) {
args <- list(...)
ns <- NS(id)
is_single_dataset <- teal.transform::is_single_dataset(x, y)

Expand Down Expand Up @@ -221,7 +233,8 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p
checkboxInput(ns("show_percentage"), "Show column percentage", value = show_percentage),
checkboxInput(ns("show_total"), "Show total column", value = show_total)
)
)
),
ui_teal_transform_data(ns("decorate"), transformators = args$decorators)
),
forms = tagList(
teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
Expand All @@ -232,7 +245,7 @@ ui_t_crosstable <- function(id, x, y, show_percentage, show_total, pre_output, p
}

# Server function for the cross-table module
srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args) {
srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, basic_table_args, decorators) {
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
checkmate::assert_class(data, "reactive")
Expand Down Expand Up @@ -351,7 +364,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
teal.code::eval_code(
substitute(
expr = {
lyt <- basic_tables %>%
table <- basic_tables %>%
split_call %>% # styler: off
rtables::add_colcounts() %>%
tern::analyze_vars(
Expand Down Expand Up @@ -387,19 +400,22 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
substitute(
expr = {
ANL <- tern::df_explicit_na(ANL)
tbl <- rtables::build_table(lyt = lyt, df = ANL[order(ANL[[y_name]]), ])
tbl
table <- rtables::build_table(lyt = table, df = ANL[order(ANL[[y_name]]), ])
},
env = list(y_name = y_name)
)
)
})

decorated_output_q_no_print <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators)
decorated_output_q <- reactive(within(decorated_output_q_no_print(), expr = table))

output$title <- renderText(output_q()[["title"]])

table_r <- reactive({
req(iv_r()$is_valid())
output_q()[["tbl"]]
req(output_q())
decorated_output_q()[["table"]]
})

teal.widgets::table_with_settings_srv(
Expand All @@ -409,7 +425,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,

teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(output_q())),
verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
title = "Show R Code for Cross-Table"
)

Expand All @@ -428,7 +444,7 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(output_q()))
card$append_src(teal.code::get_code(req(decorated_output_q())))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
18 changes: 17 additions & 1 deletion man/tm_t_crosstable.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 824efcf

Please sign in to comment.