diff --git a/R/tm_outliers.R b/R/tm_outliers.R index db3ce782d..e8fb1f994 100644 --- a/R/tm_outliers.R +++ b/R/tm_outliers.R @@ -11,12 +11,62 @@ #' Specifies variable(s) to be analyzed for outliers. #' @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 table_decorator (`teal_transform_module`, `language` or `function`) optional, +#' decorator for the table. +#' @param boxplot_decorator (`teal_transform_module`, `language` or `function`) optional, +#' decorator for the box plot. +#' @param violin_decorator (`teal_transform_module`, `language` or `function`) optional, +#' decorator for the violing plot. +#' @param density_decorator (`teal_transform_module`, `language` or `function`) optional, +#' decorator for the density plot. +#' @param cum_dist_decorator (`teal_transform_module`, `language` or `function`) optional, +#' decorator for the cumulative distribution plot. #' #' @templateVar ggnames "Boxplot","Density Plot","Cumulative Distribution Plot" #' @template ggplot2_args_multi #' #' @inherit shared_params return #' +#' @section Decorating the tables and plots: +#' The act of decoration means to modify the tables and plots output by this module. +#' The module lets app developers do it by allowing them to execute arbitrary R code +#' that modifies the objects displayed by the module. +#' +#' The decorating parameters accept one of the three types of objects as decorators: +#' * `teal_transform_module` +#' * `language` +#' * `function` of the output object. +#' +#' The module will execute the code contained in either of the objects just before +#' rendering the outputs in the application. This lets app developers modify +#' features like: titles, labels, sizes, limits, etc. of the rendered tables +#' and plots. +#' +#' The app developer can pass either of the types. See examples for the proper +#' use of each of the type of the decorator. +#' +#' IMPORTANT +#' The `language` and `teal_transform_module` decorators are required by the module +#' to overwrite the binding of the output, otherwise the effect of the decorator +#' is not going to be visible. E.g.: +#' +#' ```{r} +#' # The module uses `g` variable for the plot +#' +#' # Will work +#' lang_dec <- quote({ +#' g <- g + ggplot2::ggtitle("A new title") +#' }) +#' +#' # Will not work because the decorater overwrites `plot` instead of `g` +#' lang_dec <- quote({ +#' plot <- g + ggplot2::ggtitle("A new title") +#' }) +#' ``` +#' +#' The app developer can discover the bindings used for the outputs by inspecting +#' the R code generated by the module. +#' #' @examples #' library(teal.widgets) #' @@ -120,6 +170,27 @@ #' shinyApp(app$ui, app$server) #' } #' +#' # Decorators +#' function_decorator <- function(p) { +#' p <- p + ggplot2::ggtitle("A new title") +#' } +#' +#' quote_decorator <- quote({ +#' g <- g + ggplot2::ggtitle("A new title") +#' }) +#' +#' module_decorator <- teal_transform_module( +#' ui = function(id) NULL, +#' srv = function(id, data) { +#' within( +#' data, +#' { +#' g <- g + ggplot2::ggtitle("A new title") +#' } +#' ) +#' } +#' ) +#' #' @export #' tm_outliers <- function(label = "Outliers Module", @@ -130,13 +201,24 @@ tm_outliers <- function(label = "Outliers Module", plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL) { + post_output = NULL, + table_decorator = teal_transform_module(), + boxplot_decorator = teal_transform_module(), + violin_decorator = teal_transform_module(), + density_decorator = teal_transform_module(), + cum_dist_decorator = teal_transform_module()) { message("Initializing tm_outliers") # Normalize the parameters if (inherits(outlier_var, "data_extract_spec")) outlier_var <- list(outlier_var) if (inherits(categorical_var, "data_extract_spec")) categorical_var <- list(categorical_var) if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args) + + table_decorator <- decorate_teal_data(table_decorator, output_name = "summary_table") + boxplot_decorator <- decorate_teal_data(boxplot_decorator, output_name = "g") + violin_decorator <- decorate_teal_data(violin_decorator, output_name = "g") + density_decorator <- decorate_teal_data(density_decorator, output_name = "g") + cum_dist_decorator <- decorate_teal_data(cum_dist_decorator, output_name = "g") # Start of assertions checkmate::assert_string(label) @@ -177,15 +259,18 @@ tm_outliers <- function(label = "Outliers Module", categorical_var = categorical_var ) + ans <- module( label = label, server = srv_outliers, server_args = c( data_extract_list, - list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args) + list( + plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args, + decorators = list(table = table_decorator, boxplot = boxplot_decorator, violin = violin_decorator, density = density_decorator, cum_dist = cum_dist_decorator)) ), ui = ui_outliers, - ui_args = args, + ui_args = c(args), datanames = teal.transform::get_extract_datanames(data_extract_list) ) attr(ans, "teal_bookmarkable") <- TRUE @@ -198,24 +283,36 @@ ui_outliers <- function(id, ...) { ns <- NS(id) is_single_dataset_value <- teal.transform::is_single_dataset(args$outlier_var, args$categorical_var) + teal.widgets::standard_layout( output = teal.widgets::white_small_well( uiOutput(ns("total_outliers")), DT::dataTableOutput(ns("summary_table")), + ui_teal_data(ns("table_decorator"), args$table_decorator), uiOutput(ns("total_missing")), tags$br(), tags$hr(), tabsetPanel( id = ns("tabs"), tabPanel( "Boxplot", + conditionalPanel( + condition = sprintf("input['%s'] == 'Box plot'", ns("boxplot_alts")), + ui_teal_data(ns("boxplot_decorator"), args$boxplot_decorator) + ), + conditionalPanel( +condition = sprintf("input['%s'] == 'Violin plot'", ns("boxplot_alts")), + ui_teal_data(ns("violin_decorator"), args$violin_decorator) + ), teal.widgets::plot_with_settings_ui(id = ns("box_plot")) ), tabPanel( "Density Plot", + ui_teal_data(ns("density_decorator"), args$density_decorator), teal.widgets::plot_with_settings_ui(id = ns("density_plot")) ), tabPanel( "Cumulative Distribution Plot", + ui_teal_data(ns("cum_dist_decorator"), args$cum_dist_decorator), teal.widgets::plot_with_settings_ui(id = ns("cum_density_plot")) ) ), @@ -326,7 +423,7 @@ ui_outliers <- function(id, ...) { # Server function for the outliers module srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, - categorical_var, plot_height, plot_width, ggplot2_args) { + categorical_var, plot_height, plot_width, ggplot2_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") @@ -669,13 +766,14 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, qenv }) + decorated_table_q <- srv_teal_data(id = "table_decorator", data = common_code_q, data_module = decorators$table, modules = module()) output$summary_table <- DT::renderDataTable( expr = { if (iv_r()$is_valid()) { categorical_var <- as.vector(merged$anl_input_r()$columns_source$categorical_var) if (!is.null(categorical_var)) { DT::datatable( - common_code_q()[["summary_table"]], + decorated_table_q()[["summary_table"]], options = list( dom = "t", autoWidth = TRUE, @@ -1024,18 +1122,30 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var, } }) - boxplot_r <- reactive({ + undecorated_boxplot_r <- reactive({ teal::validate_inputs(iv_r()) boxplot_q()[["g"]] }) - density_plot_r <- reactive({ + decorated_boxplot_r <- srv_teal_data(id = "boxplot_decorator", data = undecorated_boxplot_r, data_module = decorators$boxplot, modules = module()) + decorated_violin_r <- srv_teal_data(id = "violin_decorator", data = undecorated_boxplot_r, data_module = decorators$violin, modules = module()) + boxplot_r <- reactive({ + req(input$boxplot_alts) + if (input$boxplot_alts == "Box plot") { + decorated_boxplot_r() + } else { + decorated_violin_r() + } + }) + undecorated_density_plot_r <- reactive({ teal::validate_inputs(iv_r()) density_plot_q()[["g"]] }) - cumulative_plot_r <- reactive({ + density_plot_r <- srv_teal_data(id = "density_decorator", data = undecorated_density_plot_r, data_module = decorators$density, modules = module()) + undecorated_cumulative_plot_r <- reactive({ teal::validate_inputs(iv_r()) cumulative_plot_q()[["g"]] }) + cumulative_plot_r <- srv_teal_data(id = "cum_dist_decorator", data = undecorated_cumulative_plot_r, data_module = decorators$cum_dist, modules = module()) box_pws <- teal.widgets::plot_with_settings_srv( id = "box_plot", diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd index dc4f458f3..8bca9f973 100644 --- a/man/tm_a_regression.Rd +++ b/man/tm_a_regression.Rd @@ -18,7 +18,8 @@ tm_a_regression( post_output = NULL, default_plot_type = 1, default_outlier_label = "USUBJID", - label_segment_threshold = c(0.5, 0, 10) + label_segment_threshold = c(0.5, 0, 10), + decorator = list(default = teal_transform_module()) ) } \arguments{ diff --git a/man/tm_outliers.Rd b/man/tm_outliers.Rd index 4ca23deeb..6b4c19145 100644 --- a/man/tm_outliers.Rd +++ b/man/tm_outliers.Rd @@ -13,7 +13,12 @@ tm_outliers( plot_height = c(600, 200, 2000), plot_width = NULL, pre_output = NULL, - post_output = NULL + post_output = NULL, + table_decorator = teal_transform_module(), + boxplot_decorator = teal_transform_module(), + violin_decorator = teal_transform_module(), + density_decorator = teal_transform_module(), + cum_dist_decorator = teal_transform_module() ) } \arguments{ @@ -48,6 +53,21 @@ 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{table_decorator}{(\code{teal_transform_module}, \code{language} or \code{function}) optional, +decorator for the table.} + +\item{boxplot_decorator}{(\code{teal_transform_module}, \code{language} or \code{function}) optional, +decorator for the box plot.} + +\item{violin_decorator}{(\code{teal_transform_module}, \code{language} or \code{function}) optional, +decorator for the violing plot.} + +\item{density_decorator}{(\code{teal_transform_module}, \code{language} or \code{function}) optional, +decorator for the density plot.} + +\item{cum_dist_decorator}{(\code{teal_transform_module}, \code{language} or \code{function}) optional, +decorator for the cumulative distribution plot.} } \value{ Object of class \code{teal_module} to be used in \code{teal} applications. @@ -57,6 +77,49 @@ 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 the tables and plots}{ + +The act of decoration means to modify the tables and plots output by this module. +The module lets app developers do it by allowing them to execute arbitrary R code +that modifies the objects displayed by the module. + +The decorating parameters accept one of the three types of objects as decorators: +\itemize{ +\item \code{teal_transform_module} +\item \code{language} +\item \code{function} of the output object. +} + +The module will execute the code contained in either of the objects just before +rendering the outputs in the application. This lets app developers modify +features like: titles, labels, sizes, limits, etc. of the rendered tables +and plots. + +The app developer can pass either of the types. See examples for the proper +use of each of the type of the decorator. + +IMPORTANT +The \code{language} and \code{teal_transform_module} decorators are required by the module +to overwrite the binding of the output, otherwise the effect of the decorator +is not going to be visible. E.g.: + +\if{html}{\out{
}}\preformatted{# The module uses `g` variable for the plot + +# Will work +lang_dec <- quote(\{ + g <- g + ggplot2::ggtitle("A new title") +\}) + +# Will not work because the decorater overwrites `plot` instead of `g` +lang_dec <- quote(\{ + plot <- g + ggplot2::ggtitle("A new title") +\}) +}\if{html}{\out{
}} + +The app developer can discover the bindings used for the outputs by inspecting +the R code generated by the module. +} + \examples{ library(teal.widgets) @@ -160,4 +223,25 @@ if (interactive()) { shinyApp(app$ui, app$server) } +# Decorators +function_decorator <- function(p) { + p <- p + ggplot2::ggtitle("A new title") +} + +quote_decorator <- quote({ + g <- g + ggplot2::ggtitle("A new title") +}) + +module_decorator <- teal_transform_module( + ui = function(id) NULL, + srv = function(id, data) { + within( + data, + { + g <- g + ggplot2::ggtitle("A new title") + } + ) + } +) + }