Merge branch '1187_decorate_output@main' into tm_pca@1187_decorate_ou…

…tput@main
insightsengineering · Nov 21, 2024 · ddbc5a0 · ddbc5a0
2 parents 4034445 + 6dcb2ef
commit ddbc5a0
Show file tree

Hide file tree

Showing 6 changed files with 59 additions and 129 deletions.
diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R
@@ -156,7 +156,7 @@ tm_a_regression <- function(label = "Regression Analysis",
                             default_plot_type = 1,
                             default_outlier_label = "USUBJID",
                             label_segment_threshold = c(0.5, 0, 10),
-                            decorators = list(default = teal_transform_module())) {
+                            decorators = NULL) {
   message("Initializing tm_a_regression")
 
   # Normalize the parameters
@@ -210,7 +210,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")
+  checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
 
   if (length(label_segment_threshold) == 1) {
     checkmate::assert_numeric(label_segment_threshold, any.missing = FALSE, finite = TRUE)
@@ -1010,6 +1010,19 @@ srv_a_regression <- function(id,
 
 
     output_q <- reactive({
+      teal::validate_inputs(iv_r())
+      switch(input$plot_type,
+        "Response vs Regressor" = output_plot_0(),
+        "Residuals vs Fitted" = output_plot_1(),
+        "Normal Q-Q" = output_plot_2(),
+        "Scale-Location" = output_plot_3(),
+        "Cook's distance" = output_plot_4(),
+        "Residuals vs Leverage" = output_plot_5(),
+        "Cook's dist vs Leverage" = output_plot_6()
+      )
+    })
+
+    decorated_output_q <- reactive({
       teal::validate_inputs(iv_r())
       switch(input$plot_type,
         "Response vs Regressor" = decorated_output_0(),
@@ -1022,8 +1035,14 @@ srv_a_regression <- function(id,
       )
     })
 
-    fitted <- reactive(output_q()[["fit"]])
-    plot_r <- reactive(output_q()[["plot"]])
+    fitted <- reactive({
+      req(output_q())
+      decorated_output_q()[["fit"]]
+    })
+    plot_r <- reactive({
+      req(output_q())
+      decorated_output_q()[["plot"]]
+    })
 
     # Insert the plot into a plot_with_settings module from teal.widgets
     pws <- teal.widgets::plot_with_settings_srv(
@@ -1043,7 +1062,7 @@ srv_a_regression <- function(id,
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(req(output_q()))),
+      verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
       title = "R code for the regression plot",
     )
 
@@ -1062,7 +1081,7 @@ srv_a_regression <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(teal.code::get_code(req(output_q())))
+        card$append_src(teal.code::get_code(req(decorated_output_q())))
         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
@@ -11,37 +11,17 @@
 #' 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 (`list` of `teal_transform_module`) optional,
-#' decorator for the table.
-#' @param boxplot_decorator (`list` of `teal_transform_module`) optional,
-#' decorator for the box plot.
-#' @param violin_decorator (`list` of `teal_transform_module`) optional,
-#' decorator for the violin plot.
-#' @param density_decorator (`list` of `teal_transform_module`) optional,
-#' decorator for the density plot.
-#' @param cum_dist_decorator (`list` of `teal_transform_module`) 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 `tm_outliers`:
-#'
-#' This module generates the following objects, which can be modified in place using decorators:
-#' - `table` (`data.frame`)
-#' - `plot` (`ggplot2`)
-#'
-#' For additional details and examples of decorators, refer to the vignette
-#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
-#'
 #' @examplesShinylive
 #' library(teal.modules.general)
 #' interactive <- function() TRUE
 #' {{ next_example }}
 #' @examples
-#'
 #' # general data example
 #' data <- teal_data()
 #' data <- within(data, {
@@ -91,7 +71,6 @@
 #' interactive <- function() TRUE
 #' {{ next_example }}
 #' @examples
-#'
 #' # CDISC data example
 #' data <- teal_data()
 #' data <- within(data, {
@@ -102,8 +81,6 @@
 #' fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor)))
 #' vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl))
 #'
-#'
-#'
 #' app <- init(
 #'   data = data,
 #'   modules = modules(
@@ -148,12 +125,7 @@ tm_outliers <- function(label = "Outliers Module",
                         plot_height = c(600, 200, 2000),
                         plot_width = NULL,
                         pre_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()) {
+                        post_output = NULL) {
   message("Initializing tm_outliers")
 
   # Normalize the parameters
@@ -200,19 +172,15 @@ 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,
-        decorators = list(table = table_decorator, boxplot = boxplot_decorator, violin = violin_decorator, density = density_decorator, cum_dist = cum_dist_decorator)
-      )
+      list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args)
     ),
     ui = ui_outliers,
-    ui_args = c(args),
+    ui_args = args,
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
   attr(ans, "teal_bookmarkable") <- TRUE
@@ -229,31 +197,20 @@ ui_outliers <- function(id, ...) {
     output = teal.widgets::white_small_well(
       uiOutput(ns("total_outliers")),
       DT::dataTableOutput(ns("summary_table")),
-      ui_teal_transform_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_transform_data(ns("boxplot_decorator"), args$boxplot_decorator)
-          ),
-          conditionalPanel(
-            condition = sprintf("input['%s'] == 'Violin plot'", ns("boxplot_alts")),
-            ui_teal_transform_data(ns("violin_decorator"), args$violin_decorator)
-          ),
           teal.widgets::plot_with_settings_ui(id = ns("box_plot"))
         ),
         tabPanel(
           "Density Plot",
-          ui_teal_transform_data(ns("density_decorator"), args$density_decorator),
           teal.widgets::plot_with_settings_ui(id = ns("density_plot"))
         ),
         tabPanel(
           "Cumulative Distribution Plot",
-          ui_teal_transform_data(ns("cum_dist_decorator"), args$cum_dist_decorator),
           teal.widgets::plot_with_settings_ui(id = ns("cum_density_plot"))
         )
       ),
@@ -362,10 +319,9 @@ ui_outliers <- function(id, ...) {
   )
 }
 
-# Server function for the outliers module
 # 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, decorators) {
+                         categorical_var, plot_height, plot_width, ggplot2_args) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
@@ -805,7 +761,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       teal.code::eval_code(
         common_code_q(),
         substitute(
-          expr = plot <- plot_call +
+          expr = g <- plot_call +
             scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) +
             labs + ggthemes + themes,
           env = list(
@@ -815,7 +771,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
             themes = parsed_ggplot2_args$theme
           )
         )
-      )
+      ) %>%
+        teal.code::eval_code(quote(print(g)))
     })
 
     # density plot
@@ -866,15 +823,16 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       teal.code::eval_code(
         common_code_q(),
         substitute(
-          expr = plot <- plot_call + labs + ggthemes + themes,
+          expr = g <- plot_call + labs + ggthemes + themes,
           env = list(
             plot_call = plot_call,
             labs = parsed_ggplot2_args$labs,
             themes = parsed_ggplot2_args$theme,
             ggthemes = parsed_ggplot2_args$ggtheme
           )
         )
-      )
+      ) %>%
+        teal.code::eval_code(quote(print(g)))
     })
 
     # Cumulative distribution plot
@@ -967,7 +925,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       teal.code::eval_code(
         qenv,
         substitute(
-          expr = plot <- plot_call +
+          expr = g <- plot_call +
             geom_point(data = outlier_points, aes(x = outlier_var_name, y = y, color = is_outlier_selected)) +
             scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) +
             labs + ggthemes + themes,
@@ -979,24 +937,19 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
             ggthemes = parsed_ggplot2_args$ggtheme
           )
         )
-      )
+      ) %>%
+        teal.code::eval_code(quote(print(g)))
     })
 
-    decorated_boxplot_q <- srv_teal_transform_data("boxplot_decorator", data = boxplot_q, transformators = decorators$boxplot)
-    decorated_violin_q <- srv_teal_transform_data("violin_decorator", data = boxplot_q, transformators = decorators$violin)
-    # TODO decorated_violin_q is not used anywhere
-    decorated_density_plot_q <- srv_teal_transform_data("density_decorator", data = density_plot_q, transformators = decorators$density)
-    decorated_cumulative_plot_q <- srv_teal_transform_data("cum_dist_decorator", data = cumulative_plot_q, transformators = decorators$cum_dist)
-
     final_q <- reactive({
       req(input$tabs)
       tab_type <- input$tabs
       result_q <- if (tab_type == "Boxplot") {
-        decorated_boxplot_q()
+        boxplot_q()
       } else if (tab_type == "Density Plot") {
-        decorated_density_plot_q()
+        density_plot_q()
       } else if (tab_type == "Cumulative Distribution Plot") {
-        decorated_cumulative_plot_q()
+        cumulative_plot_q()
       }
       # used to display table when running show-r-code code
       #  added after the plots so that a change in selected columns doesn't affect
@@ -1009,7 +962,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
               setdiff(names(ANL_OUTLIER), c("is_outlier_selected", "order")),
               table_columns
             )
-            table <- ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index]
+            ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index]
           },
           env = list(
             table_columns = input$table_ui_columns
@@ -1018,11 +971,6 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
       )
     })
 
-
-    decorated_final_q <-
-      srv_teal_transform_data("cum_dist_decorator", data = final_q, transformators = decorators$table_decorator)
-    # TODO: reuse decorated_final_q in table generation
-
     # slider text
     output$ui_outlier_help <- renderUI({
       req(input$method)
@@ -1073,15 +1021,15 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
 
     boxplot_r <- reactive({
       teal::validate_inputs(iv_r())
-      decorated_boxplot_q()[["plot"]]
+      boxplot_q()[["g"]]
     })
     density_plot_r <- reactive({
       teal::validate_inputs(iv_r())
-      decorated_density_plot_q()[["plot"]]
+      density_plot_q()[["g"]]
     })
     cumulative_plot_r <- reactive({
       teal::validate_inputs(iv_r())
-      decorated_cumulative_plot_q()[["plot"]]
+      cumulative_plot_q()[["g"]]
     })
 
     box_pws <- teal.widgets::plot_with_settings_srv(
@@ -1269,7 +1217,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
 
     teal.widgets::verbatim_popup_srv(
       id = "rcode",
-      verbatim_content = reactive(teal.code::get_code(req(final_q()))),
+      verbatim_content = reactive(teal.code::get_code(final_q())),
       title = "Show R Code for Outlier"
     )
 
@@ -1301,7 +1249,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(final_q())))
+        card$append_src(teal.code::get_code(final_q()))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

diff --git a/R/utils.R b/R/utils.R
@@ -25,8 +25,8 @@
 #'  with text placed before the output to put the output into context. For example a title.
 #' @param post_output (`shiny.tag`) optional, text or UI element to be displayed after the module's output,
 #' adding context or further instructions. Elements like `shiny::helpText()` are useful.
-#' @param decorators `r lifecycle::badge("experimental")` (`list` of `teal_transform_module`) optional,
-#' decorator for tables or plots included in the module.
+#' @param decorators `r lifecycle::badge("experimental")` (`list` of `teal_transform_module` or `NULL`) optional,
+#' if not `NULL`, decorator for tables or plots included in the module.
 #'
 #' @param alpha (`integer(1)` or `integer(3)`) optional, specifies point opacity.
 #' - When the length of `alpha` is one: the plot points will have a fixed opacity.

diff --git a/man/shared_params.Rd b/man/shared_params.Rd
diff --git a/man/tm_a_regression.Rd b/man/tm_a_regression.Rd