From 4c4d214f4cb348234136ca4bb6931878b41cb46a Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 21 Nov 2024 11:50:11 +0100 Subject: [PATCH] add req statement so that when srv_teal_transform_data returns NULL you see error from original teal_data --- R/tm_a_regression.R | 31 +++++++++++++++++++++++++------ R/utils.R | 4 ++-- 2 files changed, 27 insertions(+), 8 deletions(-) diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R index 7e4ed6718..158e79a20 100644 --- 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/utils.R b/R/utils.R index a2cade37b..ec83a41ee 100644 --- 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.