Skip to content

Commit 21226d4

Browse files
averissimogithub-actions[bot]llrs-roche
authored
Improvement on decorators (#822)
# Pull Request Fixes insightsengineering/coredev-tasks#605 #### Changes description - [x] Use updated `utils.R` functions - [x] Source code standardization (avoids repeated complex call to reactive) - [x] Update documentation - [ ] ~Revert ggplot2_args to roxygen2 `@template`~ - I think we should keep this as is, it is the recommended way by `roxygen2` documentation. - [x] Revisit `{lifecycle}` dependency - [x] Remove decorators that are not present in report #### Modules that need recheck (for reviewer): - `tm_data_table`: decorators removed - `tm_missing_data`: Decorators using rlisting instead of DataTable - `tm_distribution`: Was decorating data.frames in report, moved to rlisting - `tm_outliers`: Code improvement <details> <summary>Big example app</summary> ```r pkgload::load_all(".") # ###################################################### # # _____ _ # | __ \ | | # | | | | ___ ___ ___ _ __ __ _| |_ ___ _ __ ___ # | | | |/ _ \/ __/ _ \| '__/ _` | __/ _ \| '__/ __| # | |__| | __/ (_| (_) | | | (_| | || (_) | | \__ \ # |_____/ \___|\___\___/|_| \__,_|\__\___/|_| |___/ # # # # Decorators # ##################################################### plot_grob_decorator <- function(default_footnote = "I am a good decorator", .var_to_replace = "plot") { teal_transform_module( label = "Caption (grob)", ui = function(id) shiny::textInput(shiny::NS(id, "footnote"), "Footnote", value = default_footnote), server = function(id, data) { moduleServer(id, function(input, output, session) { logger::log_info("🟠 plot_grob with default: {default_footnote}!", namespace = "teal.modules.general") reactive({ req(data(), input$footnote) logger::log_info("changing the footnote {default_footnote}", namespace = "teal.modules.general") teal.code::eval_code(data(), substitute( { footnote_grob <- grid::textGrob(footnote, x = 0, hjust = 0, gp = grid::gpar(fontsize = 10, fontface = "italic", col = "gray50")) # Arrange the plot and footnote .var_to_replace <- gridExtra::arrangeGrob( .var_to_replace, footnote_grob, ncol = 1, heights = grid::unit.c(grid::unit(1, "npc") - grid::unit(1, "lines"), grid::unit(1, "lines")) ) }, env = list( footnote = input$footnote, .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({ my_name <- .var_name .var_to_replace <- .var_to_replace + ggplot2::labs(caption = footnote) }, env = list(.var_to_replace = as.name(.var_to_replace), .var_name = .var_to_replace)) ) ) } treelis_subtitle_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 <- update(.var_to_replace, sub = footnote) }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } 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))) ) ) } rlisting_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({ rlistings::main_title(.var_to_replace) <- new_row }, env = list(.var_to_replace = as.name(.var_to_replace))) ) ) } do_nothing_decorator <- teal_transform_module(server = function(id, data) moduleServer(id, function(input, output, session) data)) # ########################################## # # _ _ _ _ # | | | | | | | | # | |_ ___ __ _| | __| | __ _| |_ __ _ # | __/ _ \/ _` | | / _` |/ _` | __/ _` | # | || __/ (_| | || (_| | (_| | || (_| | # \__\___|\__,_|_| \__,_|\__,_|\__\__,_| # ______ # |______| # # teal_data # ######################################### data <- teal_data(join_keys = default_cdisc_join_keys[c("ADSL", "ADRS")]) data <- within(data, { require(nestcolor) ADSL <- rADSL ADRS <- rADRS }) # For tm_outliers fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor))) vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl)) # For tm_g_distribution vars1 <- choices_selected( variable_choices(data[["ADSL"]], c("ARM", "COUNTRY", "SEX")), selected = NULL ) init( data = data, modules = modules( # ################################################### # # _ # (_) # _ __ ___ __ _ _ __ ___ ___ ___ _ ___ _ __ # | '__/ _ \/ _` | '__/ _ \/ __/ __| |/ _ \| '_ \ # | | | __/ (_| | | | __/\__ \__ \ | (_) | | | | # |_| \___|\__, |_| \___||___/___/_|\___/|_| |_| # __/ | # |___/ # # regression # ################################################## tm_a_regression( label = "Regression", response = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variable:", choices = "BMRKR1", selected = "BMRKR1", multiple = FALSE, fixed = TRUE ) ), regressor = data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variables:", choices = variable_choices(data[["ADSL"]], c("AGE", "SEX", "RACE")), selected = "AGE", multiple = TRUE, fixed = FALSE ) ), decorators = list(caption_decorator("I am Regression", "plot")) ), # ######################################################### # # _ _ _ _ _ _ _ # | (_) | | (_) | | | (_) # __| |_ ___| |_ _ __ _| |__ _ _| |_ _ ___ _ __ # / _` | / __| __| '__| | '_ \| | | | __| |/ _ \| '_ \ # | (_| | \__ \ |_| | | | |_) | |_| | |_| | (_) | | | | # \__,_|_|___/\__|_| |_|_.__/ \__,_|\__|_|\___/|_| |_| # # # # distribution # ######################################################## tm_g_distribution( dist_var = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), selected = "BMRKR1", multiple = FALSE, fixed = FALSE ) ), strata_var = data_extract_spec( dataname = "ADSL", filter = filter_spec( vars = vars1, multiple = TRUE ) ), group_var = data_extract_spec( dataname = "ADSL", filter = filter_spec( vars = vars1, multiple = TRUE ) ), decorators = list( histogram_plot = caption_decorator("I am density!", "histogram_plot"), qq_plot = caption_decorator("I am QQ!", "qq_plot"), summary_table = rlisting_decorator("summary row", "summary_table"), test_table = rlisting_decorator("test row", "test_table") ) ), # #################### # # # # _ __ ___ __ _ # | '_ \ / __/ _` | # | |_) | (_| (_| | # | .__/ \___\__,_| # | | # |_| # # pca # ################### tm_a_pca( "PCA", dat = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data = data[["ADSL"]], c("BMRKR1", "AGE", "EOSDY")), selected = c("BMRKR1", "AGE") ) ), decorators = list( elbow_plot = caption_decorator("I am PCA / elbow", "elbow_plot"), circle_plot = caption_decorator("I am a PCA / circle", "circle_plot"), biplot = caption_decorator("I am a PCA / bipot", "biplot"), eigenvector_plot = caption_decorator("I am a PCA / eigenvector", "eigenvector_plot") ) ), ###################################### # # _ _ _ # | | | (_) # ___ _ _| |_| |_ ___ _ __ ___ # / _ \| | | | __| | |/ _ \ '__/ __| # | (_) | |_| | |_| | | __/ | \__ \ # \___/ \__,_|\__|_|_|\___|_| |___/ # # # # outliers # ##################################### tm_outliers( outlier_var = list( data_extract_spec( dataname = "ADSL", select = select_spec( label = "Select variable:", choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1")), selected = "AGE", multiple = FALSE, fixed = FALSE ) ) ), categorical_var = list( data_extract_spec( dataname = "ADSL", filter = filter_spec( vars = vars, choices = value_choices(data[["ADSL"]], vars$selected), selected = value_choices(data[["ADSL"]], vars$selected), multiple = TRUE ) ) ), decorators = list( box_plot = caption_decorator("I am a good decorator", "box_plot"), density_plot = caption_decorator("I am a good decorator", "density_plot"), cumulative_plot = caption_decorator("I am a good decorator", "cumulative_plot"), table = rlisting_decorator("table row", "table") ) ), # ####################################################### # # _ _ _ # (_) | | (_) # __ _ ___ ___ ___ ___ _ __ _| |_ _ ___ _ __ # / _` / __/ __|/ _ \ / __| |/ _` | __| |/ _ \| '_ \ # | (_| \__ \__ \ (_) | (__| | (_| | |_| | (_) | | | | # \__,_|___/___/\___/ \___|_|\__,_|\__|_|\___/|_| |_| # # # # association # ###################################################### tm_g_association( ref = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( data[["ADSL"]], c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") ), selected = "RACE" ) ), vars = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices( data[["ADSL"]], c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") ), selected = "BMRKR2", multiple = TRUE ) ), decorators = list(plot_grob_decorator("I am a good grob (association)")) ), # ######################################################## # # _ _ _ # | | | | | | # ___ _ __ ___ ___ ___ ______| |_ __ _| |__ | | ___ # / __| '__/ _ \/ __/ __|______| __/ _` | '_ \| |/ _ \ # | (__| | | (_) \__ \__ \ | || (_| | |_) | | __/ # \___|_| \___/|___/___/ \__\__,_|_.__/|_|\___| # # # # cross-table # ####################################################### tm_t_crosstable( label = "Cross Table", x = data_extract_spec( dataname = "ADSL", select = select_spec( 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 ) ), y = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], subset = function(data) { idx <- vapply(data, is.factor, logical(1)) return(names(data)[idx]) }), selected = "SEX" ) ), decorators = list(insert_rrow_decorator("I am a good new row")) ), # ####################################################################################### # # _ _ _ _ _ _ # | | | | | | | | | | (_) # ___ ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_ _ __ ___ __ _| |_ _ __ ___ __ # / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __| | '_ ` _ \ / _` | __| '__| \ \/ / # \__ \ (_| (_| | |_| || __/ | | |_) | | (_) | |_ | | | | | | (_| | |_| | | |> < # |___/\___\__,_|\__|\__\___|_| | .__/|_|\___/ \__| |_| |_| |_|\__,_|\__|_| |_/_/\_\ # | | # |_| # # scatterplot matrix # ###################################################################################### tm_g_scatterplotmatrix( label = "Scatterplot matrix", variables = list( data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]]), selected = c("AGE", "RACE", "SEX"), multiple = TRUE, ordered = TRUE ) ), data_extract_spec( dataname = "ADRS", filter = filter_spec( label = "Select endpoints:", vars = c("PARAMCD", "AVISIT"), choices = value_choices(data[["ADRS"]], c("PARAMCD", "AVISIT"), c("PARAM", "AVISIT")), selected = "INVET - END OF INDUCTION", multiple = TRUE ), select = select_spec( choices = variable_choices(data[["ADRS"]]), selected = c("AGE", "AVAL", "ADY"), multiple = TRUE, ordered = TRUE ) ) ), decorators = list(treelis_subtitle_decorator("I am a Scatterplot matrix", "plot")) ), # ############################################# # # # # _ __ ___ ___ _ __ ___ _ __ ___ ___ # | '__/ _ \/ __| '_ \ / _ \| '_ \/ __|/ _ \ # | | | __/\__ \ |_) | (_) | | | \__ \ __/ # |_| \___||___/ .__/ \___/|_| |_|___/\___| # | | # |_| # # response # ############################################ tm_g_response( label = "Response", response = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("BMRKR2", "COUNTRY"))) ), x = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("SEX", "RACE")), selected = "RACE") ), decorators = list(caption_decorator("I am a Response", "plot")) ), # ############################################ # # _ _ _ _ # | | (_) (_) | | # | |__ ___ ____ _ _ __ _ __ _| |_ ___ # | '_ \| \ \ / / _` | '__| |/ _` | __/ _ \ # | |_) | |\ V / (_| | | | | (_| | || __/ # |_.__/|_| \_/ \__,_|_| |_|\__,_|\__\___| # # # # bivariate # ########################################### tm_g_bivariate( x = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "AGE") ), y = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "SEX") ), row_facet = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "ARM") ), col_facet = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]]), selected = "COUNTRY") ), decorators = list(caption_decorator("I am a Bivariate", "plot")) ), ##################################################### # # _ _ _ _ # | | | | | | | | # ___ ___ __ _| |_| |_ ___ _ __ _ __ | | ___ | |_ # / __|/ __/ _` | __| __/ _ \ '__| '_ \| |/ _ \| __| # \__ \ (_| (_| | |_| || __/ | | |_) | | (_) | |_ # |___/\___\__,_|\__|\__\___|_| | .__/|_|\___/ \__| # | | # |_| # # scatterplot # #################################################### tm_g_scatterplot( label = "Scatterplot", x = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2"))) ), y = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2")), selected = "BMRKR1" ) ), color_by = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1", "BMRKR2", "RACE", "REGION1")), selected = NULL ) ), size_by = data_extract_spec( dataname = "ADSL", select = select_spec(choices = variable_choices(data[["ADSL"]], c("AGE", "BMRKR1"))) ), row_facet = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")), selected = NULL ) ), col_facet = data_extract_spec( dataname = "ADSL", select = select_spec( choices = variable_choices(data[["ADSL"]], c("BMRKR2", "RACE", "REGION1")), selected = NULL ) ), decorators = list(caption_decorator("I am a scatterplot", "plot")) ), # ############################################################## # # _ _ _ _ # (_) (_) | | | | # _ __ ___ _ ___ ___ _ _ __ __ _ __| | __ _| |_ __ _ # | '_ ` _ \| / __/ __| | '_ \ / _` | / _` |/ _` | __/ _` | # | | | | | | \__ \__ \ | | | | (_| | | (_| | (_| | || (_| | # |_| |_| |_|_|___/___/_|_| |_|\__, | \__,_|\__,_|\__\__,_| # __/ |_____ # |___/______| # # missing_data # ############################################################# tm_missing_data( label = "Missing data", decorators = list( summary_plot = plot_grob_decorator("A", "summary_plot"), combination_plot = plot_grob_decorator("B", "combination_plot"), summary_table = rlisting_decorator("table row", "table"), by_subject_plot = caption_decorator("by_subject_plot") ) ) ) ) |> shiny::runApp() ``` </details> --------- Signed-off-by: André Veríssimo <[email protected]> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: Lluís Revilla <[email protected]>
1 parent 9d193d3 commit 21226d4

33 files changed

+335
-218
lines changed

DESCRIPTION

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ Imports:
3535
DT (>= 0.13),
3636
forcats (>= 1.0.0),
3737
grid,
38-
lifecycle (>= 0.2.0),
38+
rlistings (>= 0.2.8),
3939
scales,
4040
shinyjs,
4141
shinyTree (>= 0.2.8),
@@ -66,6 +66,7 @@ Suggests:
6666
jsonlite,
6767
knitr (>= 1.42),
6868
lattice (>= 0.18-4),
69+
lifecycle (>= 0.2.0),
6970
logger (>= 0.2.0),
7071
MASS,
7172
nestcolor (>= 0.1.0),

R/roxygen2_templates.R

Lines changed: 1 addition & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,4 @@
11
# nocov start
2-
roxygen_decorators_param <- function(module_name) {
3-
paste(
4-
sep = " ",
5-
lifecycle::badge("experimental"),
6-
" (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or",
7-
"`NULL`) optional, if not `NULL`, decorator for tables or plots included in the module.",
8-
"When a named list of `teal_transform_module`, the decorators are applied to the",
9-
"respective output objects.\n\n",
10-
"Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`.\n\n",
11-
sprintf("See section \"Decorating `%s`\"", module_name),
12-
"below for more details."
13-
)
14-
}
15-
162
roxygen_ggplot2_args_param <- function(...) {
173
paste(
184
sep = " ",
@@ -21,7 +7,7 @@ roxygen_ggplot2_args_param <- function(...) {
217
"The argument is merged with options variable `teal.ggplot2_args` and default module setup.\n\n",
228
sprintf(
239
"List names should match the following: `c(\"default\", %s)`.\n\n",
24-
paste("\"", unlist(rlang::list2(...)), "\"", collapse = ", ", sep = "")
10+
paste("\"", unlist(list(...)), "\"", collapse = ", ", sep = "")
2511
),
2612
"For more details see the vignette: `vignette(\"custom-ggplot2-arguments\", package = \"teal.widgets\")`."
2713
)

R/tm_a_pca.R

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -14,11 +14,10 @@
1414
#' - If vector of `length == 1` then the font sizes will have a fixed size.
1515
#' - while vector of `value`, `min`, and `max` allows dynamic adjustment.
1616
#' @param ggplot2_args `r roxygen_ggplot2_args_param("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")`
17-
#' @param decorators `r roxygen_decorators_param("tm_a_pca")`
1817
#'
1918
#' @inherit shared_params return
2019
#'
21-
#' @section Decorating `tm_a_pca`:
20+
#' @section Decorating Module:
2221
#'
2322
#' This module generates the following objects, which can be modified in place using decorators:
2423
#' - `elbow_plot` (`ggplot2`)
@@ -1121,9 +1120,12 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
11211120
)
11221121
})
11231122

1123+
# Render R code.
1124+
source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
1125+
11241126
teal.widgets::verbatim_popup_srv(
11251127
id = "rcode",
1126-
verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
1128+
verbatim_content = source_code_r,
11271129
title = "R Code for PCA"
11281130
)
11291131

@@ -1146,7 +1148,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
11461148
card$append_text("Comment", "header3")
11471149
card$append_text(comment)
11481150
}
1149-
card$append_src(teal.code::get_code(req(decorated_output_q())))
1151+
card$append_src(source_code_r())
11501152
card
11511153
}
11521154
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_a_regression.R

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -40,11 +40,10 @@
4040
# nolint start: line_length.
4141
#' @param ggplot2_args `r roxygen_ggplot2_args_param("Response vs Regressor", "Residuals vs Fitted", "Scale-Location", "Cook's distance", "Residuals vs Leverage", "Cook's dist vs Leverage")`
4242
# nolint end: line_length.
43-
#' @param decorators `r roxygen_decorators_param("tm_a_regression")`
4443
#'
4544
#' @inherit shared_params return
4645
#'
47-
#' @section Decorating `tm_a_regression`:
46+
#' @section Decorating Module:
4847
#'
4948
#' This module generates the following objects, which can be modified in place using decorators:
5049
#' - `plot` (`ggplot2`)
@@ -1006,9 +1005,12 @@ srv_a_regression <- function(id,
10061005
)
10071006
})
10081007

1008+
# Render R code.
1009+
source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
1010+
10091011
teal.widgets::verbatim_popup_srv(
10101012
id = "rcode",
1011-
verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
1013+
verbatim_content = source_code_r,
10121014
title = "R code for the regression plot",
10131015
)
10141016

@@ -1027,7 +1029,7 @@ srv_a_regression <- function(id,
10271029
card$append_text("Comment", "header3")
10281030
card$append_text(comment)
10291031
}
1030-
card$append_src(teal.code::get_code(req(decorated_output_q())))
1032+
card$append_src(source_code_r())
10311033
card
10321034
}
10331035
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_data_table.R

Lines changed: 8 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -26,18 +26,9 @@
2626
#' `list(searching = FALSE, pageLength = 30, lengthMenu = c(5, 15, 30, 100), scrollX = TRUE)`
2727
#' @param server_rendering (`logical`) should the data table be rendered server side
2828
#' (see `server` argument of [DT::renderDataTable()])
29-
#' @param decorators `r roxygen_decorators_param("tm_data_table")`
3029
#'
3130
#' @inherit shared_params return
3231
#'
33-
#' @section Decorating `tm_data_table`:
34-
#'
35-
#' This module generates the following objects, which can be modified in place using decorators:
36-
#' - `table` ([DT::datatable()])
37-
#'
38-
#' For additional details and examples of decorators, refer to the vignette
39-
#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation.
40-
#'
4132
#' @examplesShinylive
4233
#' library(teal.modules.general)
4334
#' interactive <- function() TRUE
@@ -105,8 +96,7 @@ tm_data_table <- function(label = "Data Table",
10596
),
10697
server_rendering = FALSE,
10798
pre_output = NULL,
108-
post_output = NULL,
109-
decorators = NULL) {
99+
post_output = NULL) {
110100
message("Initializing tm_data_table")
111101

112102
# Start of assertions
@@ -132,8 +122,6 @@ tm_data_table <- function(label = "Data Table",
132122
checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
133123
checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
134124

135-
decorators <- normalize_decorators(decorators)
136-
assert_decorators(decorators, null.ok = TRUE, "table")
137125
# End of assertions
138126

139127
ans <- module(
@@ -146,8 +134,7 @@ tm_data_table <- function(label = "Data Table",
146134
datasets_selected = datasets_selected,
147135
dt_args = dt_args,
148136
dt_options = dt_options,
149-
server_rendering = server_rendering,
150-
decorators = decorators
137+
server_rendering = server_rendering
151138
),
152139
ui_args = list(
153140
pre_output = pre_output,
@@ -197,8 +184,7 @@ srv_page_data_table <- function(id,
197184
variables_selected,
198185
dt_args,
199186
dt_options,
200-
server_rendering,
201-
decorators) {
187+
server_rendering) {
202188
checkmate::assert_class(data, "reactive")
203189
checkmate::assert_class(isolate(data()), "teal_data")
204190
moduleServer(id, function(input, output, session) {
@@ -251,8 +237,7 @@ srv_page_data_table <- function(id,
251237
ui_data_table(
252238
id = session$ns(x),
253239
choices = choices,
254-
selected = variables_selected,
255-
decorators = decorators
240+
selected = variables_selected
256241
)
257242
)
258243
)
@@ -274,19 +259,15 @@ srv_page_data_table <- function(id,
274259
if_distinct = if_distinct,
275260
dt_args = dt_args,
276261
dt_options = dt_options,
277-
server_rendering = server_rendering,
278-
decorators = decorators
262+
server_rendering = server_rendering
279263
)
280264
}
281265
)
282266
})
283267
}
284268

285269
# UI function for the data_table module
286-
ui_data_table <- function(id,
287-
choices,
288-
selected,
289-
decorators) {
270+
ui_data_table <- function(id, choices, selected) {
290271
ns <- NS(id)
291272

292273
if (!is.null(selected)) {
@@ -298,7 +279,6 @@ ui_data_table <- function(id,
298279
tagList(
299280
teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")),
300281
fluidRow(
301-
ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(decorators, "table")),
302282
teal.widgets::optionalSelectInput(
303283
ns("variables"),
304284
"Select variables:",
@@ -322,8 +302,7 @@ srv_data_table <- function(id,
322302
if_distinct,
323303
dt_args,
324304
dt_options,
325-
server_rendering,
326-
decorators) {
305+
server_rendering) {
327306
moduleServer(id, function(input, output, session) {
328307
iv <- shinyvalidate::InputValidator$new()
329308
iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names"))
@@ -367,15 +346,9 @@ srv_data_table <- function(id,
367346
)
368347
})
369348

370-
decorated_data_table_data <- srv_decorate_teal_data(
371-
id = "decorator",
372-
data = data_table_data,
373-
decorators = select_decorators(decorators, "table")
374-
)
375-
376349
output$data_table <- DT::renderDataTable(server = server_rendering, {
377350
teal::validate_inputs(iv)
378-
req(decorated_data_table_data())[["table"]]
351+
req(data_table_data())[["table"]]
379352
})
380353
})
381354
}

R/tm_g_association.R

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,10 @@
2121
#' Default to `"gray"`.
2222
#'
2323
#' @param ggplot2_args `r roxygen_ggplot2_args_param("Bivariate1", "Bivariate2")`
24-
#' @param decorators `r roxygen_decorators_param("tm_g_association")`
2524
#'
2625
#' @inherit shared_params return
2726
#'
28-
#' @section Decorating `tm_g_association`:
27+
#' @section Decorating Module:
2928
#'
3029
#' This module generates the following objects, which can be modified in place using decorators:
3130
#' - `plot` (`grob` created with [ggplot2::ggplotGrob()])
@@ -526,9 +525,12 @@ srv_tm_g_association <- function(id,
526525
teal.code::dev_suppress(output_q()[["title"]])
527526
})
528527

528+
# Render R code.
529+
source_code_r <- reactive(teal.code::get_code(req(decorated_output_grob_q())))
530+
529531
teal.widgets::verbatim_popup_srv(
530532
id = "rcode",
531-
verbatim_content = reactive(teal.code::get_code(req(decorated_output_grob_q()))),
533+
verbatim_content = source_code_r,
532534
title = "Association Plot"
533535
)
534536

@@ -547,7 +549,7 @@ srv_tm_g_association <- function(id,
547549
card$append_text("Comment", "header3")
548550
card$append_text(comment)
549551
}
550-
card$append_src(teal.code::get_code(req(decorated_output_grob_q())))
552+
card$append_src(source_code_r())
551553
card
552554
}
553555
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

R/tm_g_bivariate.R

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -43,11 +43,10 @@
4343
#' @param free_y_scales (`logical`) optional, whether Y scaling shall be changeable.
4444
#' Does not allow scaling to be changed by default (`FALSE`).
4545
#' @param swap_axes (`logical`) optional, whether to swap X and Y axes. Defaults to `FALSE`.
46-
#' @param decorators `r roxygen_decorators_param("tm_g_bivariate")`
4746
#'
4847
#' @inherit shared_params return
4948
#'
50-
#' @section Decorating `tm_g_bivariate`:
49+
#' @section Decorating Module:
5150
#'
5251
#' This module generates the following objects, which can be modified in place using decorators:
5352
#' - `plot` (`ggplot2`)
@@ -715,9 +714,12 @@ srv_g_bivariate <- function(id,
715714
width = plot_width
716715
)
717716

717+
# Render R code.
718+
source_code_r <- reactive(teal.code::get_code(req(decorated_output_q_facets())))
719+
718720
teal.widgets::verbatim_popup_srv(
719721
id = "rcode",
720-
verbatim_content = reactive(teal.code::get_code(req(decorated_output_q_facets()))),
722+
verbatim_content = source_code_r,
721723
title = "Bivariate Plot"
722724
)
723725

@@ -736,7 +738,7 @@ srv_g_bivariate <- function(id,
736738
card$append_text("Comment", "header3")
737739
card$append_text(comment)
738740
}
739-
card$append_src(teal.code::get_code(req(decorated_output_q_facets)))
741+
card$append_src(source_code_r())
740742
card
741743
}
742744
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

0 commit comments

Comments
 (0)