From 1afa6e43eb67552311c91cfd437399a31e6181ad Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 19 Nov 2024 10:37:47 +0100 Subject: [PATCH 1/6] enable decorators for tm_a_pca --- R/tm_a_pca.R | 62 ++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 46 insertions(+), 16 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 7753c3101..191917519 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -18,11 +18,25 @@ #' #' @inherit shared_params return #' +#' @inheritSection tm_a_regression Decorating Module Outputs +#' @section Decorating `tm_a_pca`: +#' +#' This module creates below objects that can be modified with decorators: +#' - `plot` (`ggplot2`) +#' +#' #' @examplesShinylive #' library(teal.modules.general) #' interactive <- function() TRUE #' {{ next_example }} #' @examples +#' +#' plot_title <- teal_transform_module( +#' server = make_teal_transform_server(expression( +#' plot <- plot + ggtilte("Custom title") +#' )) +#' ) +#' #' # general data example #' data <- teal_data() #' data <- within(data, { @@ -45,7 +59,8 @@ #' multiple = TRUE #' ), #' filter = NULL -#' ) +#' ), +#' decorators = list(plot_title) #' ) #' ) #' ) @@ -58,6 +73,13 @@ #' interactive <- function() TRUE #' {{ next_example }} #' @examples +#' +#' plot_title <- teal_transform_module( +#' server = make_teal_transform_server(expression( +#' plot <- plot + ggtilte("Custom title") +#' )) +#' ) +#' #' # CDISC data example #' data <- teal_data() #' data <- within(data, { @@ -81,7 +103,8 @@ #' multiple = TRUE #' ), #' filter = NULL -#' ) +#' ), +#' decorators = list(plot_title) #' ) #' ) #' ) @@ -102,7 +125,8 @@ tm_a_pca <- function(label = "Principal Component Analysis", alpha = c(1, 0, 1), size = c(2, 1, 8), pre_output = NULL, - post_output = NULL) { + post_output = NULL, + decorators = list(default = teal_transform_module())) { message("Initializing tm_a_pca") # Normalize the parameters @@ -152,6 +176,8 @@ tm_a_pca <- function(label = "Principal Component Analysis", checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) + + checkmate::assert_list(decorators, "teal_transform_module") # End of assertions # Make UI args @@ -169,7 +195,8 @@ tm_a_pca <- function(label = "Principal Component Analysis", list( plot_height = plot_height, plot_width = plot_width, - ggplot2_args = ggplot2_args + ggplot2_args = ggplot2_args, + decorators = decorators ) ), datanames = teal.transform::get_extract_datanames(data_extract_list) @@ -224,7 +251,8 @@ ui_a_pca <- function(id, ...) { label = "Plot type", choices = args$plot_choices, selected = args$plot_choices[1] - ) + ), + ui_teal_transform_data(ns("decorator"), transformators = args$decorators) ), teal.widgets::panel_item( title = "Pre-processing", @@ -289,7 +317,7 @@ ui_a_pca <- function(id, ...) { } # Server function for the PCA module -srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args) { +srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, 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") @@ -549,7 +577,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) cols <- c(getOption("ggplot2.discrete.colour"), c("lightblue", "darkred", "black"))[1:3] - g <- ggplot(mapping = aes_string(x = "component", y = "value")) + + plot <- ggplot(mapping = aes_string(x = "component", y = "value")) + geom_bar( aes(fill = "Single variance"), data = dplyr::filter(elb_dat, metric == "Proportion of Variance"), @@ -570,7 +598,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ggthemes + themes - print(g) + print(plot) }, env = list( ggthemes = parsed_ggplot2_args$ggtheme, @@ -628,7 +656,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl y = sin(seq(0, 2 * pi, length.out = 100)) ) - g <- ggplot(pca_rot) + + plot <- ggplot(pca_rot) + geom_point(aes_string(x = x_axis, y = y_axis)) + geom_label( aes_string(x = x_axis, y = y_axis, label = "label"), @@ -640,7 +668,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl labs + ggthemes + themes - print(g) + print(plot) }, env = list( x_axis = x_axis, @@ -861,8 +889,8 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl qenv, substitute( expr = { - g <- plot_call - print(g) + plot <- plot_call + print(plot) }, env = list( plot_call = Reduce(function(x, y) call("+", x, y), pca_plot_biplot_expr) @@ -939,9 +967,9 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl pca_rot <- pca$rotation[, pc, drop = FALSE] %>% dplyr::as_tibble(rownames = "Variable") - g <- plot_call + plot <- plot_call - print(g) + print(plot) }, env = list( pc = pc, @@ -966,8 +994,10 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) }) + decorated_output_q <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators) + plot_r <- reactive({ - output_q()[["g"]] + decorated_output_q()[["plot"]] }) pws <- teal.widgets::plot_with_settings_srv( @@ -1034,7 +1064,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl teal.widgets::verbatim_popup_srv( id = "rcode", - verbatim_content = reactive(teal.code::get_code(output_q())), + verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))), title = "R Code for PCA" ) From c37c2ad167700c53afecc3bdb6428d667ac03ad6 Mon Sep 17 00:00:00 2001 From: m7pr Date: Tue, 19 Nov 2024 12:37:58 +0100 Subject: [PATCH 2/6] remove decorators from examples --- R/tm_a_pca.R | 22 +++++----------------- 1 file changed, 5 insertions(+), 17 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 191917519..38b0b2159 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -18,12 +18,14 @@ #' #' @inherit shared_params return #' -#' @inheritSection tm_a_regression Decorating Module Outputs #' @section Decorating `tm_a_pca`: #' #' This module creates below objects that can be modified with decorators: #' - `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) @@ -31,12 +33,6 @@ #' {{ next_example }} #' @examples #' -#' plot_title <- teal_transform_module( -#' server = make_teal_transform_server(expression( -#' plot <- plot + ggtilte("Custom title") -#' )) -#' ) -#' #' # general data example #' data <- teal_data() #' data <- within(data, { @@ -59,8 +55,7 @@ #' multiple = TRUE #' ), #' filter = NULL -#' ), -#' decorators = list(plot_title) +#' ) #' ) #' ) #' ) @@ -74,12 +69,6 @@ #' {{ next_example }} #' @examples #' -#' plot_title <- teal_transform_module( -#' server = make_teal_transform_server(expression( -#' plot <- plot + ggtilte("Custom title") -#' )) -#' ) -#' #' # CDISC data example #' data <- teal_data() #' data <- within(data, { @@ -103,8 +92,7 @@ #' multiple = TRUE #' ), #' filter = NULL -#' ), -#' decorators = list(plot_title) +#' ) #' ) #' ) #' ) From fd889ecbf333c2fc2297424566e772d10cdd35ac Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Wed, 20 Nov 2024 11:54:03 +0100 Subject: [PATCH 3/6] Update R/tm_a_pca.R Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/tm_a_pca.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 38b0b2159..eac83cb0e 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -240,7 +240,7 @@ ui_a_pca <- function(id, ...) { choices = args$plot_choices, selected = args$plot_choices[1] ), - ui_teal_transform_data(ns("decorator"), transformators = args$decorators) + ui_teal_transform_data(ns("decorate"), transformators = args$decorators) ), teal.widgets::panel_item( title = "Pre-processing", From 40344457716605c118e5505fd02c5fdec89ee98e Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 20 Nov 2024 11:55:57 +0100 Subject: [PATCH 4/6] update reported and change documentation --- R/tm_a_pca.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index eac83cb0e..445d14503 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -20,7 +20,7 @@ #' #' @section Decorating `tm_a_pca`: #' -#' This module creates below objects that can be modified with decorators: +#' This module generates the following objects, which can be modified in place using decorators: #' - `plot` (`ggplot2`) #' #' For additional details and examples of decorators, refer to the vignette @@ -1075,7 +1075,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl card$append_text("Comment", "header3") card$append_text(comment) } - card$append_src(teal.code::get_code(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) From 2c661ea72557e31d69a8d4f52ca3812951d38056 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 21 Nov 2024 12:26:53 +0100 Subject: [PATCH 5/6] add req statement so that when srv_teal_transform_data returns NULL you see error from original teal_data --- R/tm_a_pca.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index 445d14503..b0693c1ee 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -114,7 +114,7 @@ tm_a_pca <- function(label = "Principal Component Analysis", size = c(2, 1, 8), pre_output = NULL, post_output = NULL, - decorators = list(default = teal_transform_module())) { + decorators = NULL) { message("Initializing tm_a_pca") # Normalize the parameters @@ -165,7 +165,7 @@ tm_a_pca <- function(label = "Principal Component Analysis", checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE) - checkmate::assert_list(decorators, "teal_transform_module") + checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE) # End of assertions # Make UI args @@ -985,6 +985,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl decorated_output_q <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators) plot_r <- reactive({ + req(output_q()) decorated_output_q()[["plot"]] }) From f9d93c0d1e2821771968acc4e7a5c5265491d6b4 Mon Sep 17 00:00:00 2001 From: m7pr Date: Thu, 21 Nov 2024 15:32:56 +0100 Subject: [PATCH 6/6] remove print from the code, and add after the decorator --- R/tm_a_pca.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R index b0693c1ee..efd0cc2a6 100644 --- a/R/tm_a_pca.R +++ b/R/tm_a_pca.R @@ -585,8 +585,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl scale_fill_manual(values = c("Cumulative variance" = cols[2], "Single variance" = cols[1])) + ggthemes + themes - - print(plot) }, env = list( ggthemes = parsed_ggplot2_args$ggtheme, @@ -656,7 +654,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl labs + ggthemes + themes - print(plot) }, env = list( x_axis = x_axis, @@ -878,7 +875,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl substitute( expr = { plot <- plot_call - print(plot) }, env = list( plot_call = Reduce(function(x, y) call("+", x, y), pca_plot_biplot_expr) @@ -954,10 +950,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl expr = { pca_rot <- pca$rotation[, pc, drop = FALSE] %>% dplyr::as_tibble(rownames = "Variable") - plot <- plot_call - - print(plot) }, env = list( pc = pc, @@ -982,7 +975,10 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl ) }) - decorated_output_q <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators) + decorated_output_q_no_print <- srv_teal_transform_data("decorate", data = output_q, transformators = decorators) + decorated_output_q <- reactive(within(decorated_output_q_no_print(), expr = print(plot))) + + plot_r <- reactive({ req(output_q())