fix after teal

Author: gogonzo

R/tm_a_regression.R

@@ -36,7 +36,7 @@
 #'
 #'     It takes the form of `c(value, min, max)` and it is passed to the `value_min_max`
 #'     argument in `teal.widgets::optionalSliderInputValMinMax`.
-#' @param decorator (`teal_transform_module`, `language`, `function`)
+#' @param decorators (`list` of `teal_transform_module`)
 #'
 #' @templateVar ggnames `r regression_names`
 #' @template ggplot2_args_multi
@@ -162,14 +162,13 @@ tm_a_regression <- function(label = "Regression Analysis",
                             default_plot_type = 1,
                             default_outlier_label = "USUBJID",
                             label_segment_threshold = c(0.5, 0, 10),
-                            decorator = list(default = teal_transform_module())) {
+                            decorators = list(default = teal_transform_module())) {
   message("Initializing tm_a_regression")
 
   # Normalize the parameters
   if (inherits(regressor, "data_extract_spec")) regressor <- list(regressor)
   if (inherits(response, "data_extract_spec")) response <- list(response)
   if (inherits(ggplot2_args, "ggplot2_args")) ggplot2_args <- list(default = ggplot2_args)
-  decorate_objs <- lapply(decorator, FUN = decorate_teal_data, output_name = "g")
 
   # Start of assertions
   checkmate::assert_string(label)
@@ -217,6 +216,7 @@ tm_a_regression <- function(label = "Regression Analysis",
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   checkmate::assert_choice(default_plot_type, seq.int(1L, length(plot_choices)))
   checkmate::assert_string(default_outlier_label)
+  checkmate::assert_list(decorators, "teal_transform_module")
 
   if (length(label_segment_threshold) == 1) {
     checkmate::assert_numeric(label_segment_threshold, any.missing = FALSE, finite = TRUE)
@@ -243,15 +243,15 @@ tm_a_regression <- function(label = "Regression Analysis",
     label = label,
     server = srv_a_regression,
     ui = ui_a_regression,
-    ui_args = c(args, decorate_objs = decorate_objs),
+    ui_args = args,
     server_args = c(
       data_extract_list,
       list(
         plot_height = plot_height,
         plot_width = plot_width,
         default_outlier_label = default_outlier_label,
         ggplot2_args = ggplot2_args,
-        decorate_objs = decorate_objs
+        decorators = decorators
       )
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
@@ -261,7 +261,7 @@ tm_a_regression <- function(label = "Regression Analysis",
 }
 
 # UI function for the regression module
-ui_a_regression <- function(id, decorate_objs, ...) {
+ui_a_regression <- function(id, decorators, ...) {
   ns <- NS(id)
   args <- list(...)
   is_single_dataset_value <- teal.transform::is_single_dataset(args$regressor, args$response)
@@ -298,37 +298,37 @@ ui_a_regression <- function(id, decorate_objs, ...) {
         conditionalPanel(
           condition = "input.plot_type == 'Response vs Regressor'",
           ns = ns,
-          ui_transform_data(ns("d_0"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_0"), transforms = decorators[[1]])
         ),
         conditionalPanel(
           condition = "input.plot_type == 'Residuals vs Fitted'",
           ns = ns,
-          ui_transform_data(ns("d_1"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_1"), transforms = decorators[[1]])
         ),
         conditionalPanel(
           condition = "input.plot_type == 'Normal Q-Q'",
           ns = ns,
-          ui_transform_data(ns("d_2"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_2"), transforms = decorators[[1]])
         ),
         conditionalPanel(
           condition = "input.plot_type == 'Scale-Location'",
           ns = ns,
-          ui_transform_data(ns("d_3"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_3"), transforms = decorators[[1]])
         ),
         conditionalPanel(
           condition = "input.plot_type == 'Cook\\'s distance'",
           ns = ns,
-          ui_transform_data(ns("d_4"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_4"), transforms = decorators[[1]])
         ),
         conditionalPanel(
           condition = "input.plot_type == 'Residuals vs Leverage'",
           ns = ns,
-          ui_transform_data(ns("d_5"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_5"), transforms = decorators[[1]])
         ),
         conditionalPanel(
           condition = "input.plot_type == 'Cook\\'s dist vs Leverage'",
           ns = ns,
-          ui_transform_data(ns("d_6"), transforms = decorate_objs[[1]])
+          ui_teal_transform_module(ns("d_6"), transforms = decorators[[1]])
         ),
       ),
       checkboxInput(ns("show_outlier"), label = "Display outlier labels", value = TRUE),
@@ -417,7 +417,7 @@ srv_a_regression <- function(id,
                              plot_width,
                              ggplot2_args,
                              default_outlier_label,
-                             decorate_objs) {
+                             decorators) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -1006,13 +1006,13 @@ srv_a_regression <- function(id,
       )
     })
 
-    decorated_output_0 <- srv_transform_data(id = "d_0", data = output_plot_0, transforms = decorate_objs[[1]])
-    decorated_output_1 <- srv_transform_data(id = "d_1", data = output_plot_1, transforms = decorate_objs[[1]])
-    decorated_output_2 <- srv_transform_data(id = "d_2", data = output_plot_2, transforms = decorate_objs[[1]])
-    decorated_output_3 <- srv_transform_data(id = "d_3", data = output_plot_3, transforms = decorate_objs[[1]])
-    decorated_output_4 <- srv_transform_data(id = "d_4", data = output_plot_4, transforms = decorate_objs[[1]])
-    decorated_output_5 <- srv_transform_data(id = "d_5", data = output_plot_5, transforms = decorate_objs[[1]])
-    decorated_output_6 <- srv_transform_data(id = "d_6", data = output_plot_6, transforms = decorate_objs[[1]])
+    decorated_output_0 <- srv_teal_transform_module(id = "d_0", data = output_plot_0, transforms = decorators[[1]])
+    decorated_output_1 <- srv_teal_transform_module(id = "d_1", data = output_plot_1, transforms = decorators[[1]])
+    decorated_output_2 <- srv_teal_transform_module(id = "d_2", data = output_plot_2, transforms = decorators[[1]])
+    decorated_output_3 <- srv_teal_transform_module(id = "d_3", data = output_plot_3, transforms = decorators[[1]])
+    decorated_output_4 <- srv_teal_transform_module(id = "d_4", data = output_plot_4, transforms = decorators[[1]])
+    decorated_output_5 <- srv_teal_transform_module(id = "d_5", data = output_plot_5, transforms = decorators[[1]])
+    decorated_output_6 <- srv_teal_transform_module(id = "d_6", data = output_plot_6, transforms = decorators[[1]])
 
 
     output_q <- reactive({

R/tm_outliers.R

@@ -11,15 +11,15 @@
 #' 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,
+#' @param table_decorator (`list` of `teal_transform_module`) optional,
 #' decorator for the table.
-#' @param boxplot_decorator (`teal_transform_module`, `language` or `function`) optional,
+#' @param boxplot_decorator (`list` of `teal_transform_module`) optional,
 #' decorator for the box plot.
-#' @param violin_decorator (`teal_transform_module`, `language` or `function`) optional,
+#' @param violin_decorator (`list` of `teal_transform_module`) optional,
 #' decorator for the violing plot.
-#' @param density_decorator (`teal_transform_module`, `language` or `function`) optional,
+#' @param density_decorator (`list` of `teal_transform_module`) optional,
 #' decorator for the density plot.
-#' @param cum_dist_decorator (`teal_transform_module`, `language` or `function`) optional,
+#' @param cum_dist_decorator (`list` of `teal_transform_module`) optional,
 #' decorator for the cumulative distribution plot.
 #'
 #' @templateVar ggnames "Boxplot","Density Plot","Cumulative Distribution Plot"
@@ -32,40 +32,14 @@
 #' 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
+#' The module will execute the code contained in [`teal_transform_module`] 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.
+#' The app developer should apply decorators carefuly with respect to the module's internal
+#' object names. To modify an output, app developer needs to find out the name of the table or plot
+#' that is being modified by the code in the `teal_transform_module` list element.
 #'
 #' @examples
 #' library(teal.widgets)
@@ -214,12 +188,6 @@ tm_outliers <- function(label = "Outliers Module",
   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)
   checkmate::assert_list(outlier_var, types = "data_extract_spec")
@@ -284,12 +252,11 @@ 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_transform_data(ns("table_decorator"), transforms = args$table_decorator),
+      ui_teal_transform_module(ns("table_decorator"), transforms = args$table_decorator),
       uiOutput(ns("total_missing")),
       tags$br(), tags$hr(),
       tabsetPanel(
@@ -298,22 +265,22 @@ ui_outliers <- function(id, ...) {
           "Boxplot",
           conditionalPanel(
             condition = sprintf("input['%s'] == 'Box plot'", ns("boxplot_alts")),
-            ui_transform_data(ns("boxplot_decorator"), args$boxplot_decorator)
+            ui_teal_transform_module(ns("boxplot_decorator"), args$boxplot_decorator)
           ),
           conditionalPanel(
             condition = sprintf("input['%s'] == 'Violin plot'", ns("boxplot_alts")),
-            ui_transform_data(ns("violin_decorator"), args$violin_decorator)
+            ui_teal_transform_module(ns("violin_decorator"), args$violin_decorator)
           ),
           teal.widgets::plot_with_settings_ui(id = ns("box_plot"))
         ),
         tabPanel(
           "Density Plot",
-          ui_transform_data(ns("density_decorator"), args$density_decorator),
+          ui_teal_transform_module(ns("density_decorator"), args$density_decorator),
           teal.widgets::plot_with_settings_ui(id = ns("density_plot"))
         ),
         tabPanel(
           "Cumulative Distribution Plot",
-          ui_transform_data(ns("cum_dist_decorator"), args$cum_dist_decorator),
+          ui_teal_transform_module(ns("cum_dist_decorator"), args$cum_dist_decorator),
           teal.widgets::plot_with_settings_ui(id = ns("cum_density_plot"))
         )
       ),
@@ -1042,10 +1009,10 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       )
     })
 
-    decorated_boxplot_q <- srv_transform_data("boxplot_decorator", data = boxplot_q, transforms = decorators$boxplot)
-    decorated_violin_q <- srv_transform_data("violin_decorator", data = boxplot_q, transforms = decorators$violin)
-    decorated_density_plot_q <- srv_transform_data("density_decorator", data = density_plot_q, transforms = decorators$density)
-    decorated_cumulative_plot_q <- srv_transform_data("cum_dist_decorator", data = cumulative_plot_q, transforms = decorators$cum_dist)
+    decorated_boxplot_q <- srv_teal_transform_module("boxplot_decorator", data = boxplot_q, transforms = decorators$boxplot)
+    decorated_violin_q <- srv_teal_transform_module("violin_decorator", data = boxplot_q, transforms = decorators$violin)
+    decorated_density_plot_q <- srv_teal_transform_module("density_decorator", data = density_plot_q, transforms = decorators$density)
+    decorated_cumulative_plot_q <- srv_teal_transform_module("cum_dist_decorator", data = cumulative_plot_q, transforms = decorators$cum_dist)
 
     final_q <- reactive({
       req(input$tabs)