Skip to content

Commit c657134

Browse files
m7prm7pr
authored
Merge branch '1187_decorate_output@main' into tm_outliers@1187_decorate_output@main
2 parents 6a36fe5 + 9ef1032 commit c657134

19 files changed

+552
-168
lines changed

‎R/tm_a_pca.R‎

Lines changed: 31 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -18,11 +18,21 @@
1818
#'
1919
#' @inherit shared_params return
2020
#'
21+
#' @section Decorating `tm_a_pca`:
22+
#'
23+
#' This module generates the following objects, which can be modified in place using decorators:
24+
#' - `plot` (`ggplot2`)
25+
#'
26+
#' For additional details and examples of decorators, refer to the vignette
27+
#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
28+
#'
29+
#'
2130
#' @examplesShinylive
2231
#' library(teal.modules.general)
2332
#' interactive <- function() TRUE
2433
#' {{ next_example }}
2534
#' @examples
35+
#'
2636
#' # general data example
2737
#' data <- teal_data()
2838
#' data <- within(data, {
@@ -58,6 +68,7 @@
5868
#' interactive <- function() TRUE
5969
#' {{ next_example }}
6070
#' @examples
71+
#'
6172
#' # CDISC data example
6273
#' data <- teal_data()
6374
#' data <- within(data, {
@@ -102,7 +113,8 @@ tm_a_pca <- function(label = "Principal Component Analysis",
102113
alpha = c(1, 0, 1),
103114
size = c(2, 1, 8),
104115
pre_output = NULL,
105-
post_output = NULL) {
116+
post_output = NULL,
117+
decorators = NULL) {
106118
message("Initializing tm_a_pca")
107119

108120
# Normalize the parameters
@@ -152,6 +164,8 @@ tm_a_pca <- function(label = "Principal Component Analysis",
152164

153165
checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
154166
checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
167+
168+
checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)
155169
# End of assertions
156170

157171
# Make UI args
@@ -169,7 +183,8 @@ tm_a_pca <- function(label = "Principal Component Analysis",
169183
list(
170184
plot_height = plot_height,
171185
plot_width = plot_width,
172-
ggplot2_args = ggplot2_args
186+
ggplot2_args = ggplot2_args,
187+
decorators = decorators
173188
)
174189
),
175190
datanames = teal.transform::get_extract_datanames(data_extract_list)
@@ -224,7 +239,8 @@ ui_a_pca <- function(id, ...) {
224239
label = "Plot type",
225240
choices = args$plot_choices,
226241
selected = args$plot_choices[1]
227-
)
242+
),
243+
ui_transform_teal_data(ns("decorate"), transformators = args$decorators)
228244
),
229245
teal.widgets::panel_item(
230246
title = "Pre-processing",
@@ -289,7 +305,7 @@ ui_a_pca <- function(id, ...) {
289305
}
290306

291307
# Server function for the PCA module
292-
srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args) {
308+
srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args, decorators) {
293309
with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
294310
with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
295311
checkmate::assert_class(data, "reactive")
@@ -549,7 +565,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
549565
)
550566

551567
cols <- c(getOption("ggplot2.discrete.colour"), c("lightblue", "darkred", "black"))[1:3]
552-
g <- ggplot(mapping = aes_string(x = "component", y = "value")) +
568+
plot <- ggplot(mapping = aes_string(x = "component", y = "value")) +
553569
geom_bar(
554570
aes(fill = "Single variance"),
555571
data = dplyr::filter(elb_dat, metric == "Proportion of Variance"),
@@ -569,8 +585,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
569585
scale_fill_manual(values = c("Cumulative variance" = cols[2], "Single variance" = cols[1])) +
570586
ggthemes +
571587
themes
572-
573-
print(g)
574588
},
575589
env = list(
576590
ggthemes = parsed_ggplot2_args$ggtheme,
@@ -628,7 +642,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
628642
y = sin(seq(0, 2 * pi, length.out = 100))
629643
)
630644

631-
g <- ggplot(pca_rot) +
645+
plot <- ggplot(pca_rot) +
632646
geom_point(aes_string(x = x_axis, y = y_axis)) +
633647
geom_label(
634648
aes_string(x = x_axis, y = y_axis, label = "label"),
@@ -640,7 +654,6 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
640654
labs +
641655
ggthemes +
642656
themes
643-
print(g)
644657
},
645658
env = list(
646659
x_axis = x_axis,
@@ -861,8 +874,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
861874
qenv,
862875
substitute(
863876
expr = {
864-
g <- plot_call
865-
print(g)
877+
plot <- plot_call
866878
},
867879
env = list(
868880
plot_call = Reduce(function(x, y) call("+", x, y), pca_plot_biplot_expr)
@@ -938,10 +950,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
938950
expr = {
939951
pca_rot <- pca$rotation[, pc, drop = FALSE] %>%
940952
dplyr::as_tibble(rownames = "Variable")
941-
942-
g <- plot_call
943-
944-
print(g)
953+
plot <- plot_call
945954
},
946955
env = list(
947956
pc = pc,
@@ -966,8 +975,12 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
966975
)
967976
})
968977

978+
decorated_output_q_no_print <- srv_transform_teal_data("decorate", data = output_q, transformators = decorators)
979+
decorated_output_q <- reactive(within(decorated_output_q_no_print(), expr = print(plot)))
980+
969981
plot_r <- reactive({
970-
output_q()[["g"]]
982+
req(output_q())
983+
decorated_output_q()[["plot"]]
971984
})
972985

973986
pws <- teal.widgets::plot_with_settings_srv(
@@ -1034,7 +1047,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
10341047

10351048
teal.widgets::verbatim_popup_srv(
10361049
id = "rcode",
1037-
verbatim_content = reactive(teal.code::get_code(output_q())),
1050+
verbatim_content = reactive(teal.code::get_code(req(decorated_output_q()))),
10381051
title = "R Code for PCA"
10391052
)
10401053

@@ -1057,7 +1070,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
10571070
card$append_text("Comment", "header3")
10581071
card$append_text(comment)
10591072
}
1060-
card$append_src(teal.code::get_code(output_q()))
1073+
card$append_src(teal.code::get_code(req(decorated_output_q())))
10611074
card
10621075
}
10631076
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

‎R/tm_a_regression.R‎

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -292,37 +292,37 @@ ui_a_regression <- function(id, ...) {
292292
conditionalPanel(
293293
condition = "input.plot_type == 'Response vs Regressor'",
294294
ns = ns,
295-
ui_teal_transform_data(ns("d_0"), transformators = args$decorators[[1]])
295+
ui_transform_teal_data(ns("d_0"), transformators = args$decorators)
296296
),
297297
conditionalPanel(
298298
condition = "input.plot_type == 'Residuals vs Fitted'",
299299
ns = ns,
300-
ui_teal_transform_data(ns("d_1"), transformators = args$decorators[[1]])
300+
ui_transform_teal_data(ns("d_1"), transformators = args$decorators)
301301
),
302302
conditionalPanel(
303303
condition = "input.plot_type == 'Normal Q-Q'",
304304
ns = ns,
305-
ui_teal_transform_data(ns("d_2"), transformators = args$decorators[[1]])
305+
ui_transform_teal_data(ns("d_2"), transformators = args$decorators)
306306
),
307307
conditionalPanel(
308308
condition = "input.plot_type == 'Scale-Location'",
309309
ns = ns,
310-
ui_teal_transform_data(ns("d_3"), transformators = args$decorators[[1]])
310+
ui_transform_teal_data(ns("d_3"), transformators = args$decorators)
311311
),
312312
conditionalPanel(
313313
condition = "input.plot_type == 'Cook\\'s distance'",
314314
ns = ns,
315-
ui_teal_transform_data(ns("d_4"), transformators = args$decorators[[1]])
315+
ui_transform_teal_data(ns("d_4"), transformators = args$decorators)
316316
),
317317
conditionalPanel(
318318
condition = "input.plot_type == 'Residuals vs Leverage'",
319319
ns = ns,
320-
ui_teal_transform_data(ns("d_5"), transformators = args$decorators[[1]])
320+
ui_transform_teal_data(ns("d_5"), transformators = args$decorators)
321321
),
322322
conditionalPanel(
323323
condition = "input.plot_type == 'Cook\\'s dist vs Leverage'",
324324
ns = ns,
325-
ui_teal_transform_data(ns("d_6"), transformators = args$decorators[[1]])
325+
ui_transform_teal_data(ns("d_6"), transformators = args$decorators)
326326
),
327327
),
328328
checkboxInput(ns("show_outlier"), label = "Display outlier labels", value = TRUE),
@@ -1000,13 +1000,13 @@ srv_a_regression <- function(id,
10001000
)
10011001
})
10021002

1003-
decorated_output_0 <- srv_teal_transform_data(id = "d_0", data = output_plot_0, transformators = decorators[[1]])
1004-
decorated_output_1 <- srv_teal_transform_data(id = "d_1", data = output_plot_1, transformators = decorators[[1]])
1005-
decorated_output_2 <- srv_teal_transform_data(id = "d_2", data = output_plot_2, transformators = decorators[[1]])
1006-
decorated_output_3 <- srv_teal_transform_data(id = "d_3", data = output_plot_3, transformators = decorators[[1]])
1007-
decorated_output_4 <- srv_teal_transform_data(id = "d_4", data = output_plot_4, transformators = decorators[[1]])
1008-
decorated_output_5 <- srv_teal_transform_data(id = "d_5", data = output_plot_5, transformators = decorators[[1]])
1009-
decorated_output_6 <- srv_teal_transform_data(id = "d_6", data = output_plot_6, transformators = decorators[[1]])
1003+
decorated_output_0 <- srv_transform_teal_data(id = "d_0", data = output_plot_0, transformators = decorators)
1004+
decorated_output_1 <- srv_transform_teal_data(id = "d_1", data = output_plot_1, transformators = decorators)
1005+
decorated_output_2 <- srv_transform_teal_data(id = "d_2", data = output_plot_2, transformators = decorators)
1006+
decorated_output_3 <- srv_transform_teal_data(id = "d_3", data = output_plot_3, transformators = decorators)
1007+
decorated_output_4 <- srv_transform_teal_data(id = "d_4", data = output_plot_4, transformators = decorators)
1008+
decorated_output_5 <- srv_transform_teal_data(id = "d_5", data = output_plot_5, transformators = decorators)
1009+
decorated_output_6 <- srv_transform_teal_data(id = "d_6", data = output_plot_6, transformators = decorators)
10101010

10111011

10121012
output_q <- reactive({

0 commit comments

Comments
 (0)