diff --git a/DESCRIPTION b/DESCRIPTION index f5a569933..8e0393ffd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,7 +35,7 @@ Imports: DT (>= 0.13), forcats (>= 1.0.0), grid, - lifecycle (>= 0.2.0), + rlistings (>= 0.2.8), scales, shinyjs, shinyTree (>= 0.2.8), @@ -66,6 +66,7 @@ Suggests: jsonlite, knitr (>= 1.42), lattice (>= 0.18-4), + lifecycle (>= 0.2.0), logger (>= 0.2.0), MASS, nestcolor (>= 0.1.0), diff --git a/R/roxygen2_templates.R b/R/roxygen2_templates.R index d55c2aef4..8ff396409 100644 --- a/R/roxygen2_templates.R +++ b/R/roxygen2_templates.R @@ -1,18 +1,4 @@ # nocov start -roxygen_decorators_param <- function(module_name) { - paste( - sep = " ", - lifecycle::badge("experimental"), - " (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or", - "`NULL`) optional, if not `NULL`, decorator for tables or plots included in the module.", - "When a named list of `teal_transform_module`, the decorators are applied to the", - "respective output objects.\n\n", - "Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`.\n\n", - sprintf("See section \"Decorating `%s`\"", module_name), - "below for more details." - ) -} - roxygen_ggplot2_args_param <- function(...) { paste( sep = " ", @@ -21,7 +7,7 @@ roxygen_ggplot2_args_param <- function(...) { "The argument is merged with options variable `teal.ggplot2_args` and default module setup.\n\n", sprintf( "List names should match the following: `c(\"default\", %s)`.\n\n", - paste("\"", unlist(rlang::list2(...)), "\"", collapse = ", ", sep = "") + paste("\"", unlist(list(...)), "\"", collapse = ", ", sep = "") ), "For more details see the vignette: `vignette(\"custom-ggplot2-arguments\", package = \"teal.widgets\")`." ) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 0398ac555..cc8b4df1b 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -14,11 +14,10 @@ #' - If vector of `length == 1` then the font sizes will have a fixed size. #' - while vector of `value`, `min`, and `max` allows dynamic adjustment. #' @param ggplot2_args `r roxygen_ggplot2_args_param("Elbow plot", "Circle plot", "Biplot", "Eigenvector plot")` -#' @param decorators `r roxygen_decorators_param("tm_a_pca")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_a_pca`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `elbow_plot` (`ggplot2`) @@ -1121,9 +1120,12 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), + verbatim_content = source_code_r, title = "R Code for PCA" ) @@ -1146,7 +1148,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index e5d76d95c..622d89fb9 100644 --- a/R/tm_a_regression.R +++ b/R/tm_a_regression.R @@ -40,11 +40,10 @@ # nolint start: line_length. #' @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")` # nolint end: line_length. -#' @param decorators `r roxygen_decorators_param("tm_a_regression")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_a_regression`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`ggplot2`) @@ -1006,9 +1005,12 @@ srv_a_regression <- function(id, ) }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), + verbatim_content = source_code_r, title = "R code for the regression plot", ) @@ -1027,7 +1029,7 @@ srv_a_regression <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_data_table.R b/R/tm_data_table.R index 0f1e6a9a8..ca259cf66 100644 --- a/R/tm_data_table.R +++ b/R/tm_data_table.R @@ -26,18 +26,9 @@ #' `list(searching = FALSE, pageLength = 30, lengthMenu = c(5, 15, 30, 100), scrollX = TRUE)` #' @param server_rendering (`logical`) should the data table be rendered server side #' (see `server` argument of [DT::renderDataTable()]) -#' @param decorators `r roxygen_decorators_param("tm_data_table")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_data_table`: -#' -#' This module generates the following objects, which can be modified in place using decorators: -#' - `table` ([DT::datatable()]) -#' -#' For additional details and examples of decorators, refer to the vignette -#' `vignette("decorate-modules-output", package = "teal")` or the [`teal::teal_transform_module()`] documentation. -#' #' @examplesShinylive #' library(teal.modules.general) #' interactive <- function() TRUE @@ -105,8 +96,7 @@ tm_data_table <- function(label = "Data Table", ), server_rendering = FALSE, pre_output = NULL, - post_output = NULL, - decorators = NULL) { + post_output = NULL) { message("Initializing tm_data_table") # Start of assertions @@ -132,8 +122,6 @@ tm_data_table <- function(label = "Data 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) - decorators <- normalize_decorators(decorators) - assert_decorators(decorators, null.ok = TRUE, "table") # End of assertions ans <- module( @@ -146,8 +134,7 @@ tm_data_table <- function(label = "Data Table", datasets_selected = datasets_selected, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering, - decorators = decorators + server_rendering = server_rendering ), ui_args = list( pre_output = pre_output, @@ -197,8 +184,7 @@ srv_page_data_table <- function(id, variables_selected, dt_args, dt_options, - server_rendering, - decorators) { + server_rendering) { checkmate::assert_class(data, "reactive") checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { @@ -251,8 +237,7 @@ srv_page_data_table <- function(id, ui_data_table( id = session$ns(x), choices = choices, - selected = variables_selected, - decorators = decorators + selected = variables_selected ) ) ) @@ -274,8 +259,7 @@ srv_page_data_table <- function(id, if_distinct = if_distinct, dt_args = dt_args, dt_options = dt_options, - server_rendering = server_rendering, - decorators = decorators + server_rendering = server_rendering ) } ) @@ -283,10 +267,7 @@ srv_page_data_table <- function(id, } # UI function for the data_table module -ui_data_table <- function(id, - choices, - selected, - decorators) { +ui_data_table <- function(id, choices, selected) { ns <- NS(id) if (!is.null(selected)) { @@ -298,7 +279,6 @@ ui_data_table <- function(id, tagList( teal.widgets::get_dt_rows(ns("data_table"), ns("dt_rows")), fluidRow( - ui_decorate_teal_data(ns("decorator"), decorators = select_decorators(decorators, "table")), teal.widgets::optionalSelectInput( ns("variables"), "Select variables:", @@ -322,8 +302,7 @@ srv_data_table <- function(id, if_distinct, dt_args, dt_options, - server_rendering, - decorators) { + server_rendering) { moduleServer(id, function(input, output, session) { iv <- shinyvalidate::InputValidator$new() iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names")) @@ -367,15 +346,9 @@ srv_data_table <- function(id, ) }) - decorated_data_table_data <- srv_decorate_teal_data( - id = "decorator", - data = data_table_data, - decorators = select_decorators(decorators, "table") - ) - output$data_table <- DT::renderDataTable(server = server_rendering, { teal::validate_inputs(iv) - req(decorated_data_table_data())[["table"]] + req(data_table_data())[["table"]] }) }) } diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 941448f67..00230b867 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -21,11 +21,10 @@ #' Default to `"gray"`. #' #' @param ggplot2_args `r roxygen_ggplot2_args_param("Bivariate1", "Bivariate2")` -#' @param decorators `r roxygen_decorators_param("tm_g_association")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_g_association`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`grob` created with [ggplot2::ggplotGrob()]) @@ -526,9 +525,12 @@ srv_tm_g_association <- function(id, teal.code::dev_suppress(output_q()[["title"]]) }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_grob_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_grob_q()))), + verbatim_content = source_code_r, title = "Association Plot" ) @@ -547,7 +549,7 @@ srv_tm_g_association <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_grob_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 26c7b5c86..c4c2691d3 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -43,11 +43,10 @@ #' @param free_y_scales (`logical`) optional, whether Y scaling shall be changeable. #' Does not allow scaling to be changed by default (`FALSE`). #' @param swap_axes (`logical`) optional, whether to swap X and Y axes. Defaults to `FALSE`. -#' @param decorators `r roxygen_decorators_param("tm_g_bivariate")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_g_bivariate`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`ggplot2`) @@ -715,9 +714,12 @@ srv_g_bivariate <- function(id, width = plot_width ) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q_facets()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_q_facets()))), + verbatim_content = source_code_r, title = "Bivariate Plot" ) @@ -736,7 +738,7 @@ srv_g_bivariate <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_q_facets))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_distribution.R b/R/tm_g_distribution.R index 445ce5791..d8ce69231 100644 --- a/R/tm_g_distribution.R +++ b/R/tm_g_distribution.R @@ -23,17 +23,16 @@ #' Defaults to `c(30L, 1L, 100L)`. #' #' @param ggplot2_args `r roxygen_ggplot2_args_param("Histogram", "QQplot")` -#' @param decorators `r roxygen_decorators_param("tm_g_distribution")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_g_distribution`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators:: #' - `histogram_plot` (`ggplot2`) -#' - `qq_plot` (`data.frame`) -#' - `summary_table` (`data.frame`) -#' - `test_table` (`data.frame`) +#' - `qq_plot` (`ggplot2`) +#' - `summary_table` (`listing_df` created with [rlistings::as_listing()]) +#' - `test_table` (`listing_df` created with [rlistings::as_listing()]) #' #' Decorators can be applied to all outputs or only to specific objects using a #' named list of `teal_transform_module` objects. @@ -713,7 +712,7 @@ srv_distribution <- function(id, ) } - qenv <- if (length(s_var) == 0 && length(g_var) == 0) { + if (length(s_var) == 0 && length(g_var) == 0) { teal.code::eval_code( qenv, substitute( @@ -759,20 +758,6 @@ srv_distribution <- function(id, ) ) } - if (iv_r()$is_valid()) { - within(qenv, { - summary_table <- DT::datatable( - summary_table_data, - options = list( - autoWidth = TRUE, - columnDefs = list(list(width = "200px", targets = "_all")) - ), - rownames = FALSE - ) - }) - } else { - within(qenv, summary_table <- NULL) - } }) # distplot qenv ---- @@ -1268,29 +1253,33 @@ srv_distribution <- function(id, ) # outputs ---- - ## building main qenv - output_common_q <- reactive({ + output_dist_q <- reactive(c(common_q(), req(dist_q()))) + output_qq_q <- reactive(c(common_q(), req(qq_q()))) + + # Summary table listing has to be created separately to allow for qenv join + output_summary_q <- reactive({ + if (iv_r()$is_valid()) { + within(common_q(), summary_table <- rlistings::as_listing(summary_table_data)) + } else { + within(common_q(), summary_table <- rlistings::as_listing(summary_table_data[0L, ])) + } + }) + + output_test_q <- reactive({ # wrapped in if since could lead into validate error - we do want to continue test_q_out <- try(test_q(), silent = TRUE) if (!inherits(test_q_out, c("try-error", "error"))) { c( common_q(), within(test_q_out, { - test_table <- DT::datatable( - test_table_data, - options = list(scrollX = TRUE), - rownames = FALSE - ) + test_table <- rlistings::as_listing(test_table_data) }) ) } else { - within(common_q(), test_table <- NULL) + within(common_q(), test_table <- rlistings::as_listing(data.frame(missing = character(0L)))) } }) - output_dist_q <- reactive(c(output_common_q(), req(dist_q()))) - output_qq_q <- reactive(c(output_common_q(), req(qq_q()))) - decorated_output_dist_q <- srv_decorate_teal_data( "d_density", data = output_dist_q, @@ -1307,14 +1296,14 @@ srv_distribution <- function(id, decorated_output_summary_q <- srv_decorate_teal_data( "d_summary", - data = output_common_q, + data = output_summary_q, decorators = select_decorators(decorators, "summary_table"), expr = summary_table ) decorated_output_test_q <- srv_decorate_teal_data( "d_test", - data = output_common_q, + data = output_test_q, decorators = select_decorators(decorators, "test_table"), expr = test_table ) @@ -1339,13 +1328,24 @@ srv_distribution <- function(id, qq_r <- reactive(req(decorated_output_qq_q())[["qq_plot"]]) - output$summary_table <- DT::renderDataTable(expr = decorated_output_summary_q()[["summary_table"]]) + output$summary_table <- DT::renderDataTable( + expr = decorated_output_summary_q()[["summary_table_data"]], + options = list( + autoWidth = TRUE, + columnDefs = list(list(width = "200px", targets = "_all")) + ), + rownames = FALSE + ) tests_r <- reactive({ req(iv_r()$is_valid()) teal::validate_inputs(iv_r_dist()) req(test_q()) # Ensure original errors are displayed - decorated_output_test_q()[["test_table"]] + DT::datatable( + data = decorated_output_test_q()[["test_table_data"]], + options = list(scrollX = TRUE), + rownames = FALSE + ) }) pws1 <- teal.widgets::plot_with_settings_srv( @@ -1364,13 +1364,14 @@ srv_distribution <- function(id, brushing = FALSE ) - output$t_stats <- DT::renderDataTable( - expr = tests_r() - ) + output$t_stats <- DT::renderDataTable(expr = tests_r()) + + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), + verbatim_content = source_code_r, title = "R Code for distribution" ) @@ -1390,8 +1391,7 @@ srv_distribution <- function(id, card$append_plot(qq_r(), dim = pws2$dim()) } card$append_text("Statistics table", "header3") - - card$append_table(common_q()[["summary_table"]]) + card$append_table(decorated_output_summary_q()[["summary_table"]]) tests_error <- tryCatch(expr = tests_r(), error = function(e) "error") if (inherits(tests_error, "data.frame")) { card$append_text("Tests table", "header3") @@ -1402,7 +1402,7 @@ srv_distribution <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_response.R b/R/tm_g_response.R index 98d7647e1..94f8ee329 100644 --- a/R/tm_g_response.R +++ b/R/tm_g_response.R @@ -33,14 +33,13 @@ #' @param freq (`logical(1)`) #' Indicates whether to display frequency (`TRUE`) or density (`FALSE`). #' Defaults to density (`FALSE`). -#' @param decorators `r roxygen_decorators_param("tm_g_response")` #' #' @inherit shared_params return #' #' @note For more examples, please see the vignette "Using response plot" via #' `vignette("using-response-plot", package = "teal.modules.general")`. #' -#' @section Decorating `tm_g_response`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`ggplot2`) @@ -571,9 +570,12 @@ srv_g_response <- function(id, width = plot_width ) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_plot_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_plot_q()))), + verbatim_content = source_code_r, title = "Show R Code for Response" ) @@ -592,7 +594,7 @@ srv_g_response <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_plot_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_scatterplot.R b/R/tm_g_scatterplot.R index 96d8d2b73..3cecd5b77 100644 --- a/R/tm_g_scatterplot.R +++ b/R/tm_g_scatterplot.R @@ -27,11 +27,10 @@ #' `vignette("ggplot2-specs", package="ggplot2")`. #' @param max_deg (`integer`) optional, maximum degree for the polynomial trend line. Must not be less than 1. #' @param table_dec (`integer`) optional, number of decimal places used to round numeric values in the table. -#' @param decorators `r roxygen_decorators_param("tm_g_scatterplot")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_g_scatterplot`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`ggplot2`) @@ -1055,9 +1054,12 @@ srv_g_scatterplot <- function(id, } }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_plot_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_plot_q()))), + verbatim_content = source_code_r, title = "R Code for scatterplot" ) @@ -1076,7 +1078,7 @@ srv_g_scatterplot <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_plot_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_g_scatterplotmatrix.R b/R/tm_g_scatterplotmatrix.R index ec7d4c2b2..fd8ada3cd 100644 --- a/R/tm_g_scatterplotmatrix.R +++ b/R/tm_g_scatterplotmatrix.R @@ -15,11 +15,10 @@ #' Specifies plotting variables from an incoming dataset with filtering and selecting. In case of #' `data_extract_spec` use `select_spec(..., ordered = TRUE)` if plot elements should be #' rendered according to selection order. -#' @param decorators `r roxygen_decorators_param("tm_g_scatterplotmatrix")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_g_scatterplotmatrix`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`trellis` - output of `lattice::splom`) @@ -486,9 +485,12 @@ srv_g_scatterplotmatrix <- function(id, } }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), + verbatim_content = source_code_r, title = "Show R Code for Scatterplotmatrix" ) @@ -507,7 +509,7 @@ srv_g_scatterplotmatrix <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_output_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_missing_data.R b/R/tm_missing_data.R index 97469e39e..db3c5f7a4 100644 --- a/R/tm_missing_data.R +++ b/R/tm_missing_data.R @@ -14,17 +14,16 @@ #' @param ggtheme (`character`) optional, specifies the default `ggplot2` theme for plots. Defaults to `classic`. #' @param ggplot2_args `r roxygen_ggplot2_args_param("Summary Obs", "Summary Patients", "Combinations Main", "Combinations Hist", "By Subject")` # nolint end: line_length. -#' @param decorators `r roxygen_decorators_param("tm_missing_data")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_missing_data`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `summary_plot` (`grob` created with [ggplot2::ggplotGrob()]) #' - `combination_plot` (`grob` created with [ggplot2::ggplotGrob()]) #' - `by_subject_plot` (`ggplot2`) -#' - `table` ([DT::datatable()]) +#' - `table` (`listing_df` created with [rlistings::as_listing()]) #' #' Decorators can be applied to all outputs or only to specific objects using a #' named list of `teal_transform_module` objects. @@ -1149,7 +1148,7 @@ srv_missing_data <- function(id, ) } - within(qenv, table <- DT::datatable(summary_data)) + within(qenv, table <- rlistings::as_listing(summary_data)) }) by_subject_plot_q <- reactive({ @@ -1316,7 +1315,7 @@ srv_missing_data <- function(id, options = list(language = list(zeroRecords = "No variable selected."), pageLength = input$levels_table_rows) ) } else { - decorated_summary_table_q()[["table"]] + DT::datatable(decorated_summary_table_q()[["summary_data"]]) } }) @@ -1361,9 +1360,12 @@ srv_missing_data <- function(id, } }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_final_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_final_q()))), + verbatim_content = source_code_r, title = "Show R Code for Missing Data" ) @@ -1390,7 +1392,12 @@ srv_missing_data <- function(id, card$append_plot(combination_plot_r(), dim = pws2$dim()) } else if (sum_type == "By Variable Levels") { card$append_text("Table", "header3") - card$append_table(summary_table_r[["summary_data"]]) + table <- decorated_summary_table_q()[["table"]] + if (nrow(table) == 0L) { + card$append_text("No data available for table.") + } else { + card$append_table(table) + } } else if (sum_type == "Grouped by Subject") { card$append_text("Plot", "header3") card$append_plot(by_subject_plot_r(), dim = pws3$dim()) @@ -1399,7 +1406,7 @@ srv_missing_data <- function(id, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_final_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_outliers.R b/R/tm_outliers.R index b9fdd90e6..7bb720c13 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -12,17 +12,16 @@ #' @param categorical_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional, #' specifies the categorical variable(s) to split the selected outlier variables on. #' @param ggplot2_args `r roxygen_ggplot2_args_param("Boxplot", "Density Plot", "Cumulative Distribution Plot")` -#' @param decorators `r roxygen_decorators_param("tm_outliers")` #' #' @inherit shared_params return #' -#' @section Decorating `tm_outliers`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `box_plot` (`ggplot2`) #' - `density_plot` (`ggplot2`) #' - `cumulative_plot` (`ggplot2`) -#' - `table` ([DT::datatable()]) +#' - `table` (`listing_df` created with [rlistings::as_listing()]) #' #' Decorators can be applied to all outputs or only to specific objects using a #' named list of `teal_transform_module` objects. @@ -720,15 +719,11 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, within(qenv, summary_table <- data.frame()) } - # Datatable is generated in qenv to allow for output decoration + # Generate decoratable object from data qenv <- within(qenv, { - table <- DT::datatable( - summary_table, - options = list( - dom = "t", - autoWidth = TRUE, - columnDefs = list(list(width = "200px", targets = "_all")) - ) + table <- rlistings::as_listing( + tibble::rownames_to_column(summary_table, var = " "), + key_cols = character(0L) ) }) @@ -894,11 +889,11 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, # Cumulative distribution plot cumulative_plot_q <- reactive({ - ANL <- common_code_q()[["ANL"]] - ANL_OUTLIER <- common_code_q()[["ANL_OUTLIER"]] - qenv <- common_code_q() + ANL <- qenv[["ANL"]] + ANL_OUTLIER <- qenv[["ANL_OUTLIER"]] + outlier_var <- as.vector(merged$anl_input_r()$columns_source$outlier_var) categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) @@ -1027,7 +1022,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, expr_is_reactive = TRUE ) }, - rlang::set_names(c("box_plot", "density_plot", "cumulative_plot")), + stats::setNames(nm = c("box_plot", "density_plot", "cumulative_plot")), c(box_plot_q, density_plot_q, cumulative_plot_q) ) @@ -1045,7 +1040,14 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, if (iv_r()$is_valid()) { categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) if (!is.null(categorical_var)) { - decorated_final_q()[["table"]] + DT::datatable( + decorated_final_q()[["summary_table"]], + options = list( + dom = "t", + autoWidth = TRUE, + columnDefs = list(list(width = "200px", targets = "_all")) + ) + ) } } } @@ -1299,9 +1301,12 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ) }) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_final_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_final_q()))), + verbatim_content = source_code_r, title = "Show R Code for Outlier" ) @@ -1317,7 +1322,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, ) categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) if (length(categorical_var) > 0) { - summary_table <- common_code_q()[["summary_table"]] + summary_table <- decorated_final_q()[["table"]] card$append_text("Summary Table", "header3") card$append_table(summary_table) } @@ -1333,7 +1338,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(req(decorated_final_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/tm_t_crosstable.R b/R/tm_t_crosstable.R index de65386f2..303df7931 100644 --- a/R/tm_t_crosstable.R +++ b/R/tm_t_crosstable.R @@ -19,14 +19,13 @@ #' @param show_total (`logical(1)`) #' Indicates whether to show total column. #' Defaults to `TRUE`. -#' @param decorators `r roxygen_decorators_param("tm_t_crosstable")` #' #' @note For more examples, please see the vignette "Using cross table" via #' `vignette("using-cross-table", package = "teal.modules.general")`. #' #' @inherit shared_params return #' -#' @section Decorating `tm_t_crosstable`: +#' @section Decorating Module: #' #' This module generates the following objects, which can be modified in place using decorators: #' - `table` (`ElementaryTable` - output of `rtables::build_table`) @@ -429,9 +428,12 @@ srv_t_crosstable <- function(id, data, reporter, filter_panel_api, label, x, y, table_r = table_r ) + # Render R code. + source_code_r <- reactive(teal.code::get_code(req(decorated_output_q()))) + teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), + verbatim_content = source_code_r, title = "Show R Code for Cross-Table" ) @@ -450,7 +452,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(req(decorated_output_q()))) + card$append_src(source_code_r()) card } teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun) diff --git a/R/utils.R b/R/utils.R index dcb0ebd17..c1a8262eb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -33,6 +33,14 @@ #' - When the length of `size` is one: the plot point sizes will have a fixed size. #' - When the length of `size` is three: the plot points size are dynamically adjusted based on #' vector of `value`, `min`, and `max`. +#' @param decorators `r lifecycle::badge("experimental")` +#' (`list` of `teal_transform_module`, named `list` of `teal_transform_module` or `NULL`) optional, +#' if not `NULL`, decorator for tables or plots included in the module. +#' When a named list of `teal_transform_module`, the decorators are applied to the respective output objects. +#' +#' Otherwise, the decorators are applied to all objects, which is equivalent as using the name `default`. +#' +#' See section "Decorating Module" below for more details. #' #' @return Object of class `teal_module` to be used in `teal` applications. #' @@ -299,21 +307,26 @@ srv_decorate_teal_data <- function(id, data, decorators, expr, expr_is_reactive missing_expr <- missing(expr) if (!missing_expr && !expr_is_reactive) { - expr <- rlang::enexpr(expr) + expr <- dplyr::enexpr(expr) # Using dplyr re-export to avoid adding rlang to Imports } moduleServer(id, function(input, output, session) { decorated_output <- srv_transform_teal_data("inner", data = data, transformators = decorators) reactive({ - # ensure original errors are displayed and `eval_code` is never executed with NULL - req(data(), decorated_output()) - if (missing_expr) { - decorated_output() - } else if (expr_is_reactive) { - teal.code::eval_code(decorated_output(), expr()) + data_out <- try(data(), silent = TRUE) + if (inherits(data_out, "qenv.error")) { + data() } else { - teal.code::eval_code(decorated_output(), expr) + # ensure original errors are displayed and `eval_code` is never executed with NULL + req(data(), decorated_output()) + if (missing_expr) { + decorated_output() + } else if (expr_is_reactive) { + teal.code::eval_code(decorated_output(), expr()) + } else { + teal.code::eval_code(decorated_output(), expr) + } } }) }) diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100755 index 000000000..b61c57c3f --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100755 index 000000000..5d88fc2c6 --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100755 index 000000000..9bf21e76b --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100755 index 000000000..db8d757f7 --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/shared_params.Rd b/man/shared_params.Rd index 1ea6b7094..92b563c64 100644 --- a/man/shared_params.Rd +++ b/man/shared_params.Rd @@ -47,6 +47,15 @@ vector of \code{value}, \code{min}, and \code{max}. \item When the length of \code{size} is three: the plot points size are dynamically adjusted based on vector of \code{value}, \code{min}, and \code{max}. }} + +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. + +Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. + +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. diff --git a/man/tm_a_pca.Rd b/man/tm_a_pca.Rd index 8dada5c8c..5d013a830 100644 --- a/man/tm_a_pca.Rd +++ b/man/tm_a_pca.Rd @@ -72,11 +72,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_a_pca}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -87,7 +90,7 @@ ways of visualizing the outcomes, including elbow plot, circle plot, biplot, and Additionally, it enables dynamic customization of plot aesthetics, such as opacity, size, and font size, through UI inputs. } -\section{Decorating \code{tm_a_pca}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index 20897f8af..69e455b23 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -96,11 +96,14 @@ It takes the form of \code{c(value, min, max)} and it is passed to the \code{val argument in \code{teal.widgets::optionalSliderInputValMinMax}. }} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_a_regression}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -115,7 +118,7 @@ visualize residuals, and identify outliers. For more examples, please see the vignette "Using regression plots" via \code{vignette("using-regression-plots", package = "teal.modules.general")}. } -\section{Decorating \code{tm_a_regression}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_data_table.Rd b/man/tm_data_table.Rd index 78864c9c4..9fda79408 100644 --- a/man/tm_data_table.Rd +++ b/man/tm_data_table.Rd @@ -13,8 +13,7 @@ tm_data_table( scrollX = TRUE), server_rendering = FALSE, pre_output = NULL, - post_output = NULL, - decorators = NULL + post_output = NULL ) } \arguments{ @@ -47,12 +46,6 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} - -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. - -Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. - -See section "Decorating \code{tm_data_table}" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -68,18 +61,6 @@ Configure the \code{DT.TOJSON_ARGS} option via \code{options(DT.TOJSON_ARGS = list(na = "string"))} before running the module. Note though that sorting of numeric columns with \code{NA}/\code{Inf} will be lexicographic not numerical. } -\section{Decorating \code{tm_data_table}}{ - - -This module generates the following objects, which can be modified in place using decorators: -\itemize{ -\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) -} - -For additional details and examples of decorators, refer to the vignette -\code{vignette("decorate-modules-output", package = "teal")} or the \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} documentation. -} - \examples{ # general data example data <- teal_data() diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index be072e66e..f037b9e52 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -57,11 +57,14 @@ List names should match the following: \code{c("default", "Bivariate1", "Bivaria For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_g_association}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -75,7 +78,7 @@ It supports configuring the appearance of the plots, including themes and whethe For more examples, please see the vignette "Using association plot" via \code{vignette("using-association-plot", package = "teal.modules.general")}. } -\section{Decorating \code{tm_g_association}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_g_bivariate.Rd b/man/tm_g_bivariate.Rd index 80adf050e..55c913bd0 100644 --- a/man/tm_g_bivariate.Rd +++ b/man/tm_g_bivariate.Rd @@ -102,11 +102,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_g_bivariate}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -122,7 +125,7 @@ This is a general module to visualize 1 & 2 dimensional data. For more examples, please see the vignette "Using bivariate plot" via \code{vignette("using-bivariate-plot", package = "teal.modules.general")}. } -\section{Decorating \code{tm_g_bivariate}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_g_distribution.Rd b/man/tm_g_distribution.Rd index 8931ba7b6..b5f5e5111 100644 --- a/man/tm_g_distribution.Rd +++ b/man/tm_g_distribution.Rd @@ -64,11 +64,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}, optional) with text placed after the output to put the output into context. For example the \code{\link[shiny:helpText]{shiny::helpText()}} elements are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_g_distribution}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -78,15 +81,15 @@ Module is designed to explore the distribution of a single variable within a giv It offers several tools, such as histograms, Q-Q plots, and various statistical tests to visually and statistically analyze the variable's distribution. } -\section{Decorating \code{tm_g_distribution}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators:: \itemize{ \item \code{histogram_plot} (\code{ggplot2}) -\item \code{qq_plot} (\code{data.frame}) -\item \code{summary_table} (\code{data.frame}) -\item \code{test_table} (\code{data.frame}) +\item \code{qq_plot} (\code{ggplot2}) +\item \code{summary_table} (\code{listing_df} created with \code{\link[rlistings:listings]{rlistings::as_listing()}}) +\item \code{test_table} (\code{listing_df} created with \code{\link[rlistings:listings]{rlistings::as_listing()}}) } Decorators can be applied to all outputs or only to specific objects using a diff --git a/man/tm_g_response.Rd b/man/tm_g_response.Rd index a75adb823..77cecbf9e 100644 --- a/man/tm_g_response.Rd +++ b/man/tm_g_response.Rd @@ -82,11 +82,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_g_response}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -103,7 +106,7 @@ as frequency or density. For more examples, please see the vignette "Using response plot" via \code{vignette("using-response-plot", package = "teal.modules.general")}. } -\section{Decorating \code{tm_g_response}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_g_scatterplot.Rd b/man/tm_g_scatterplot.Rd index 3e961928c..ae70e136d 100644 --- a/man/tm_g_scatterplot.Rd +++ b/man/tm_g_scatterplot.Rd @@ -95,11 +95,14 @@ The argument is merged with options variable \code{teal.ggplot2_args} and defaul For more details see the vignette: \code{vignette("custom-ggplot2-arguments", package = "teal.widgets")}} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_g_scatterplot}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -114,7 +117,7 @@ trend line additions, and dynamic adjustments of point opacity and size through For more examples, please see the vignette "Using scatterplot" via \code{vignette("using-scatterplot", package = "teal.modules.general")}. } -\section{Decorating \code{tm_g_scatterplot}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_g_scatterplotmatrix.Rd b/man/tm_g_scatterplotmatrix.Rd index 582d08917..ab343c615 100644 --- a/man/tm_g_scatterplotmatrix.Rd +++ b/man/tm_g_scatterplotmatrix.Rd @@ -36,11 +36,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_g_scatterplotmatrix}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -54,7 +57,7 @@ providing the overview of correlations and distributions across selected data. For more examples, please see the vignette "Using scatterplot matrix" via \code{vignette("using-scatterplot-matrix", package = "teal.modules.general")}. } -\section{Decorating \code{tm_g_scatterplotmatrix}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/man/tm_missing_data.Rd b/man/tm_missing_data.Rd index 86517c88c..4194590d3 100644 --- a/man/tm_missing_data.Rd +++ b/man/tm_missing_data.Rd @@ -47,11 +47,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_missing_data}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -62,7 +65,7 @@ gain insights into the completeness of their data. It is useful for clinical data analysis within the context of \code{CDISC} standards and adaptable for general data analysis purposes. } -\section{Decorating \code{tm_missing_data}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: @@ -70,7 +73,7 @@ This module generates the following objects, which can be modified in place usin \item \code{summary_plot} (\code{grob} created with \code{\link[ggplot2:ggplotGrob]{ggplot2::ggplotGrob()}}) \item \code{combination_plot} (\code{grob} created with \code{\link[ggplot2:ggplotGrob]{ggplot2::ggplotGrob()}}) \item \code{by_subject_plot} (\code{ggplot2}) -\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) +\item \code{table} (\code{listing_df} created with \code{\link[rlistings:listings]{rlistings::as_listing()}}) } Decorators can be applied to all outputs or only to specific objects using a diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index 04a0761ed..3d1d57484 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -48,11 +48,14 @@ with text placed before the output to put the output into context. For example a \item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output, adding context or further instructions. Elements like \code{shiny::helpText()} are useful.} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_outliers}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -62,7 +65,7 @@ Module to analyze and identify outliers using different methods such as IQR, Z-score, and Percentiles, and offers visualizations including box plots, density plots, and cumulative distribution plots to help interpret the outliers. } -\section{Decorating \code{tm_outliers}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: @@ -70,7 +73,7 @@ This module generates the following objects, which can be modified in place usin \item \code{box_plot} (\code{ggplot2}) \item \code{density_plot} (\code{ggplot2}) \item \code{cumulative_plot} (\code{ggplot2}) -\item \code{table} (\code{\link[DT:datatable]{DT::datatable()}}) +\item \code{table} (\code{listing_df} created with \code{\link[rlistings:listings]{rlistings::as_listing()}}) } Decorators can be applied to all outputs or only to specific objects using a diff --git a/man/tm_t_crosstable.Rd b/man/tm_t_crosstable.Rd index b44c4ec94..252c8e3c5 100644 --- a/man/tm_t_crosstable.Rd +++ b/man/tm_t_crosstable.Rd @@ -51,11 +51,14 @@ The argument is merged with options variable \code{teal.basic_table_args} and de For more details see the vignette: \code{vignette("custom-basic-table-arguments", package = "teal.widgets")}} -\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, if not \code{NULL}, decorator for tables or plots included in the module. When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. +\item{decorators}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} +(\code{list} of \code{teal_transform_module}, named \code{list} of \code{teal_transform_module} or \code{NULL}) optional, +if not \code{NULL}, decorator for tables or plots included in the module. +When a named list of \code{teal_transform_module}, the decorators are applied to the respective output objects. Otherwise, the decorators are applied to all objects, which is equivalent as using the name \code{default}. -See section "Decorating \code{tm_t_crosstable}" below for more details.} +See section "Decorating Module" below for more details.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -68,7 +71,7 @@ options for showing percentages and sub-totals. For more examples, please see the vignette "Using cross table" via \code{vignette("using-cross-table", package = "teal.modules.general")}. } -\section{Decorating \code{tm_t_crosstable}}{ +\section{Decorating Module}{ This module generates the following objects, which can be modified in place using decorators: diff --git a/teal.modules.general.Rproj b/teal.modules.general.Rproj index 4713d6572..312694e9e 100644 --- a/teal.modules.general.Rproj +++ b/teal.modules.general.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: 2782a0d1-5126-4b5c-b177-1150fb426d43 RestoreWorkspace: No SaveWorkspace: No