feat: refactored outliers to allow for decorators (#788)

Author: kpagacz

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