Skip to content

Commit b6d9bff

Browse files
m7prm7pr
committed
update tm_a_regression and tm_outliers after changes in teal for the decorators
1 parent 40f053a commit b6d9bff

File tree

4 files changed

+244
-161
lines changed

4 files changed

+244
-161
lines changed

‎R/tm_a_regression.R‎

Lines changed: 72 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -43,22 +43,50 @@
4343
#'
4444
#' @inherit shared_params return
4545
#'
46-
#' @section Decorating module's output:
47-
#' Outputs produced by the module can be modified for any application. To do so, one needs to provide
48-
#' [teal_transform_module()] with `server` modifying outputed object in `data` (`teal_data`). Each
49-
#' module might have a different output object name and it's type, so there is no standard code to achieve this.
50-
#' However, `teal` provides couple wrappers which can simplify the process of decorating module's outputs:
51-
#' - `decorator` as a `language`: provide a simple expression to modify object of interests. For example
52-
#' `g <- g + ggtitle("Custom Title")`. Provided expression must be a working expression within module internals.
53-
#' - `decorator` as a `function`: provide a function which will take the output object and modify it in desired way.
54-
#' When function is provided object names don't need to match module's internal naming. For example
55-
#' `function(x) x <- x + ggtitle("Custom Title")`.
46+
#' @section Decorating Module Outputs:
47+
#'
48+
#' Decorating module outputs involves modifying the tables and plots generated by a module. This module provides the
49+
#' ability to execute custom R code to adjust the visual or structural properties of objects displayed within the
50+
#' application.
51+
#'
52+
#' The code specified in [`teal_transform_module`] is executed prior to rendering the outputs in the application. This
53+
#' allows developers to modify attributes such as titles, labels, sizes, limits, and other features of rendered tables
54+
#' and plots. However, decorators should be applied with careful consideration of the module's internal object names
55+
#' to ensure compatibility.
56+
#'
57+
#' To customize an output, developers need to identify the name of the table or plot to be modified within the
58+
#' `teal_transform_module`. This requires specifying a `server` function that modifies the targeted object in the
59+
#' `data` object (of class `teal_data`). Since each module may use different internal object names or types for its
60+
#' outputs, there is no universal code to achieve this. However, `teal` provides convenient wrappers to simplify the
61+
#' process of decorating module outputs:
62+
#'
63+
#' - **Decorator as a Language/Expression**: Specify a simple R expression to modify the object of interest.
64+
#' For example,`plot <- plot + ggtitle("Custom Title")`. The expression must be valid and compatible with the module's
65+
#' internal environment.
66+
#' - **Decorator as a Function**: Provide a function that accepts the output object and modifies it as desired.
67+
#' When using this approach, the function does not need to align with the module’s internal naming conventions for its
68+
#' objects.
69+
#'
70+
#' For additional details and examples of decorators, refer to the vignette
71+
#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
72+
#'
73+
#' @section Decorating `tm_a_regression`:
74+
#'
75+
#' This module creates below objects that can be modified with decorators:
76+
#' - `plot` (`ggplot2`)#'
5677
#'
5778
#' @examplesShinylive
5879
#' library(teal.modules.general)
5980
#' interactive <- function() TRUE
6081
#' {{ next_example }}
6182
#' @examples
83+
#'
84+
#' footnote_regression <- teal_transform_module(
85+
#' server = make_teal_transform_server(expression(
86+
#' plot <- plot + labs(caption = deparse(summary(fit)[[1]]))
87+
#' ))
88+
#' )
89+
#'
6290
#' # general data example
6391
#' data <- teal_data()
6492
#' data <- within(data, {
@@ -90,7 +118,8 @@
90118
#' multiple = TRUE,
91119
#' fixed = FALSE
92120
#' )
93-
#' )
121+
#' ),
122+
#' decorators = list(footnote_regression)
94123
#' )
95124
#' )
96125
#' )
@@ -135,7 +164,8 @@
135164
#' multiple = TRUE,
136165
#' fixed = FALSE
137166
#' )
138-
#' )
167+
#' ),
168+
#' decorators = list(footnote_regression)
139169
#' )
140170
#' )
141171
#' )
@@ -295,37 +325,37 @@ ui_a_regression <- function(id, decorators, ...) {
295325
conditionalPanel(
296326
condition = "input.plot_type == 'Response vs Regressor'",
297327
ns = ns,
298-
ui_transform_data(ns("d_0"), transforms = decorators[[1]])
328+
ui_teal_transform_data(ns("d_0"), transformators = decorators[[1]])
299329
),
300330
conditionalPanel(
301331
condition = "input.plot_type == 'Residuals vs Fitted'",
302332
ns = ns,
303-
ui_transform_data(ns("d_1"), transforms = decorators[[1]])
333+
ui_teal_transform_data(ns("d_1"), transformators = decorators[[1]])
304334
),
305335
conditionalPanel(
306336
condition = "input.plot_type == 'Normal Q-Q'",
307337
ns = ns,
308-
ui_transform_data(ns("d_2"), transforms = decorators[[1]])
338+
ui_teal_transform_data(ns("d_2"), transformators = decorators[[1]])
309339
),
310340
conditionalPanel(
311341
condition = "input.plot_type == 'Scale-Location'",
312342
ns = ns,
313-
ui_transform_data(ns("d_3"), transforms = decorators[[1]])
343+
ui_teal_transform_data(ns("d_3"), transformators = decorators[[1]])
314344
),
315345
conditionalPanel(
316346
condition = "input.plot_type == 'Cook\\'s distance'",
317347
ns = ns,
318-
ui_transform_data(ns("d_4"), transforms = decorators[[1]])
348+
ui_teal_transform_data(ns("d_4"), transformators = decorators[[1]])
319349
),
320350
conditionalPanel(
321351
condition = "input.plot_type == 'Residuals vs Leverage'",
322352
ns = ns,
323-
ui_transform_data(ns("d_5"), transforms = decorators[[1]])
353+
ui_teal_transform_data(ns("d_5"), transformators = decorators[[1]])
324354
),
325355
conditionalPanel(
326356
condition = "input.plot_type == 'Cook\\'s dist vs Leverage'",
327357
ns = ns,
328-
ui_transform_data(ns("d_6"), transforms = decorators[[1]])
358+
ui_teal_transform_data(ns("d_6"), transformators = decorators[[1]])
329359
),
330360
),
331361
checkboxInput(ns("show_outlier"), label = "Display outlier labels", value = TRUE),
@@ -610,6 +640,7 @@ srv_a_regression <- function(id,
610640
})
611641

612642
output_plot_0 <- reactive({
643+
613644
fit <- fit_r()[["fit"]]
614645
ANL <- anl_merged_q()[["ANL"]]
615646

@@ -677,10 +708,10 @@ srv_a_regression <- function(id,
677708
expr = {
678709
class(fit$residuals) <- NULL
679710
data <- fortify(fit)
680-
g <- plot
711+
plot <- graph
681712
},
682713
env = list(
683-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
714+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
684715
)
685716
)
686717
)
@@ -721,10 +752,10 @@ srv_a_regression <- function(id,
721752
substitute(
722753
expr = {
723754
smoothy <- smooth(data$.fitted, data$.resid)
724-
g <- plot
755+
plot <- graph
725756
},
726757
env = list(
727-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
758+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
728759
)
729760
)
730761
)
@@ -780,10 +811,10 @@ srv_a_regression <- function(id,
780811
plot_base,
781812
substitute(
782813
expr = {
783-
g <- plot
814+
plot <- graph
784815
},
785816
env = list(
786-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
817+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
787818
)
788819
)
789820
)
@@ -823,10 +854,10 @@ srv_a_regression <- function(id,
823854
substitute(
824855
expr = {
825856
smoothy <- smooth(data$.fitted, sqrt(abs(data$.stdresid)))
826-
g <- plot
857+
plot <- graph
827858
},
828859
env = list(
829-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
860+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
830861
)
831862
)
832863
)
@@ -889,10 +920,10 @@ srv_a_regression <- function(id,
889920
plot_base,
890921
substitute(
891922
expr = {
892-
g <- plot
923+
plot <- graph
893924
},
894925
env = list(
895-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
926+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
896927
)
897928
)
898929
)
@@ -944,10 +975,10 @@ srv_a_regression <- function(id,
944975
substitute(
945976
expr = {
946977
smoothy <- smooth(data$.hat, data$.stdresid)
947-
g <- plot
978+
plot <- graph
948979
},
949980
env = list(
950-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
981+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
951982
)
952983
)
953984
)
@@ -994,22 +1025,22 @@ srv_a_regression <- function(id,
9941025
substitute(
9951026
expr = {
9961027
smoothy <- smooth(data$.hat, data$.cooksd)
997-
g <- plot
1028+
plot <- graph
9981029
},
9991030
env = list(
1000-
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
1031+
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
10011032
)
10021033
)
10031034
)
10041035
})
10051036

1006-
decorated_output_0 <- srv_transform_data(id = "d_0", data = output_plot_0, transforms = decorators[[1]])
1007-
decorated_output_1 <- srv_transform_data(id = "d_1", data = output_plot_1, transforms = decorators[[1]])
1008-
decorated_output_2 <- srv_transform_data(id = "d_2", data = output_plot_2, transforms = decorators[[1]])
1009-
decorated_output_3 <- srv_transform_data(id = "d_3", data = output_plot_3, transforms = decorators[[1]])
1010-
decorated_output_4 <- srv_transform_data(id = "d_4", data = output_plot_4, transforms = decorators[[1]])
1011-
decorated_output_5 <- srv_transform_data(id = "d_5", data = output_plot_5, transforms = decorators[[1]])
1012-
decorated_output_6 <- srv_transform_data(id = "d_6", data = output_plot_6, transforms = decorators[[1]])
1037+
decorated_output_0 <- srv_teal_transform_data(id = "d_0", data = output_plot_0, transformators = decorators[[1]])
1038+
decorated_output_1 <- srv_teal_transform_data(id = "d_1", data = output_plot_1, transformators = decorators[[1]])
1039+
decorated_output_2 <- srv_teal_transform_data(id = "d_2", data = output_plot_2, transformators = decorators[[1]])
1040+
decorated_output_3 <- srv_teal_transform_data(id = "d_3", data = output_plot_3, transformators = decorators[[1]])
1041+
decorated_output_4 <- srv_teal_transform_data(id = "d_4", data = output_plot_4, transformators = decorators[[1]])
1042+
decorated_output_5 <- srv_teal_transform_data(id = "d_5", data = output_plot_5, transformators = decorators[[1]])
1043+
decorated_output_6 <- srv_teal_transform_data(id = "d_6", data = output_plot_6, transformators = decorators[[1]])
10131044

10141045

10151046
output_q <- reactive({
@@ -1026,7 +1057,7 @@ srv_a_regression <- function(id,
10261057
})
10271058

10281059
fitted <- reactive(output_q()[["fit"]])
1029-
plot_r <- reactive(output_q()[["g"]])
1060+
plot_r <- reactive(output_q()[["plot"]])
10301061

10311062
# Insert the plot into a plot_with_settings module from teal.widgets
10321063
pws <- teal.widgets::plot_with_settings_srv(

0 commit comments

Comments
 (0)