Skip to content

Commit

Permalink
update tm_a_regression and tm_outliers after changes in teal for the …
Browse files Browse the repository at this point in the history 
…decorators
  • Loading branch information
@m7pr
m7pr committed Nov 18, 2024
1 parent 40f053a commit b6d9bff
Show file tree
Hide file tree
Showing 4 changed files with 244 additions and 161 deletions.
113 changes: 72 additions & 41 deletions R/tm_a_regression.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,22 +43,50 @@
#'
#' @inherit shared_params return
#'
#' @section Decorating module's output:
#' Outputs produced by the module can be modified for any application. To do so, one needs to provide
#' [teal_transform_module()] with `server` modifying outputed object in `data` (`teal_data`). Each
#' module might have a different output object name and it's type, so there is no standard code to achieve this.
#' However, `teal` provides couple wrappers which can simplify the process of decorating module's outputs:
#' - `decorator` as a `language`: provide a simple expression to modify object of interests. For example
#' `g <- g + ggtitle("Custom Title")`. Provided expression must be a working expression within module internals.
#' - `decorator` as a `function`: provide a function which will take the output object and modify it in desired way.
#' When function is provided object names don't need to match module's internal naming. For example
#' `function(x) x <- x + ggtitle("Custom Title")`.
#' @section Decorating Module Outputs:
#'
#' Decorating module outputs involves modifying the tables and plots generated by a module. This module provides the
#' ability to execute custom R code to adjust the visual or structural properties of objects displayed within the
#' application.
#'
#' The code specified in [`teal_transform_module`] is executed prior to rendering the outputs in the application. This
#' allows developers to modify attributes such as titles, labels, sizes, limits, and other features of rendered tables
#' and plots. However, decorators should be applied with careful consideration of the module's internal object names
#' to ensure compatibility.
#'
#' To customize an output, developers need to identify the name of the table or plot to be modified within the
#' `teal_transform_module`. This requires specifying a `server` function that modifies the targeted object in the
#' `data` object (of class `teal_data`). Since each module may use different internal object names or types for its
#' outputs, there is no universal code to achieve this. However, `teal` provides convenient wrappers to simplify the
#' process of decorating module outputs:
#'
#' - **Decorator as a Language/Expression**: Specify a simple R expression to modify the object of interest.
#' For example,`plot <- plot + ggtitle("Custom Title")`. The expression must be valid and compatible with the module's
#' internal environment.
#' - **Decorator as a Function**: Provide a function that accepts the output object and modifies it as desired.
#' When using this approach, the function does not need to align with the module’s internal naming conventions for its
#' objects.
#'
#' For additional details and examples of decorators, refer to the vignette
#' `vignette("decorate-modules-output", package = "teal")` or the [`teal_transform_module()`] documentation.
#'
#' @section Decorating `tm_a_regression`:
#'
#' This module creates below objects that can be modified with decorators:
#' - `plot` (`ggplot2`)#'
#'
#' @examplesShinylive
#' library(teal.modules.general)
#' interactive <- function() TRUE
#' {{ next_example }}
#' @examples
#'
#' footnote_regression <- teal_transform_module(
#' server = make_teal_transform_server(expression(
#' plot <- plot + labs(caption = deparse(summary(fit)[[1]]))
#' ))
#' )
#'
#' # general data example
#' data <- teal_data()
#' data <- within(data, {
Expand Down Expand Up @@ -90,7 +118,8 @@
#' multiple = TRUE,
#' fixed = FALSE
#' )
#' )
#' ),
#' decorators = list(footnote_regression)
#' )
#' )
#' )
Expand Down Expand Up @@ -135,7 +164,8 @@
#' multiple = TRUE,
#' fixed = FALSE
#' )
#' )
#' ),
#' decorators = list(footnote_regression)
#' )
#' )
#' )
Expand Down Expand Up @@ -295,37 +325,37 @@ ui_a_regression <- function(id, decorators, ...) {
conditionalPanel(
condition = "input.plot_type == 'Response vs Regressor'",
ns = ns,
ui_transform_data(ns("d_0"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_0"), transformators = decorators[[1]])
),
conditionalPanel(
condition = "input.plot_type == 'Residuals vs Fitted'",
ns = ns,
ui_transform_data(ns("d_1"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_1"), transformators = decorators[[1]])
),
conditionalPanel(
condition = "input.plot_type == 'Normal Q-Q'",
ns = ns,
ui_transform_data(ns("d_2"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_2"), transformators = decorators[[1]])
),
conditionalPanel(
condition = "input.plot_type == 'Scale-Location'",
ns = ns,
ui_transform_data(ns("d_3"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_3"), transformators = decorators[[1]])
),
conditionalPanel(
condition = "input.plot_type == 'Cook\\'s distance'",
ns = ns,
ui_transform_data(ns("d_4"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_4"), transformators = decorators[[1]])
),
conditionalPanel(
condition = "input.plot_type == 'Residuals vs Leverage'",
ns = ns,
ui_transform_data(ns("d_5"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_5"), transformators = decorators[[1]])
),
conditionalPanel(
condition = "input.plot_type == 'Cook\\'s dist vs Leverage'",
ns = ns,
ui_transform_data(ns("d_6"), transforms = decorators[[1]])
ui_teal_transform_data(ns("d_6"), transformators = decorators[[1]])
),
),
checkboxInput(ns("show_outlier"), label = "Display outlier labels", value = TRUE),
Expand Down Expand Up @@ -610,6 +640,7 @@ srv_a_regression <- function(id,
})

output_plot_0 <- reactive({

fit <- fit_r()[["fit"]]
ANL <- anl_merged_q()[["ANL"]]

Expand Down Expand Up @@ -677,10 +708,10 @@ srv_a_regression <- function(id,
expr = {
class(fit$residuals) <- NULL
data <- fortify(fit)
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
Expand Down Expand Up @@ -721,10 +752,10 @@ srv_a_regression <- function(id,
substitute(
expr = {
smoothy <- smooth(data$.fitted, data$.resid)
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
Expand Down Expand Up @@ -780,10 +811,10 @@ srv_a_regression <- function(id,
plot_base,
substitute(
expr = {
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
Expand Down Expand Up @@ -823,10 +854,10 @@ srv_a_regression <- function(id,
substitute(
expr = {
smoothy <- smooth(data$.fitted, sqrt(abs(data$.stdresid)))
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
Expand Down Expand Up @@ -889,10 +920,10 @@ srv_a_regression <- function(id,
plot_base,
substitute(
expr = {
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
Expand Down Expand Up @@ -944,10 +975,10 @@ srv_a_regression <- function(id,
substitute(
expr = {
smoothy <- smooth(data$.hat, data$.stdresid)
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
Expand Down Expand Up @@ -994,22 +1025,22 @@ srv_a_regression <- function(id,
substitute(
expr = {
smoothy <- smooth(data$.hat, data$.cooksd)
g <- plot
plot <- graph
},
env = list(
plot = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
graph = Reduce(function(x, y) call("+", x, y), c(plot, parsed_ggplot2_args))
)
)
)
})

decorated_output_0 <- srv_transform_data(id = "d_0", data = output_plot_0, transforms = decorators[[1]])
decorated_output_1 <- srv_transform_data(id = "d_1", data = output_plot_1, transforms = decorators[[1]])
decorated_output_2 <- srv_transform_data(id = "d_2", data = output_plot_2, transforms = decorators[[1]])
decorated_output_3 <- srv_transform_data(id = "d_3", data = output_plot_3, transforms = decorators[[1]])
decorated_output_4 <- srv_transform_data(id = "d_4", data = output_plot_4, transforms = decorators[[1]])
decorated_output_5 <- srv_transform_data(id = "d_5", data = output_plot_5, transforms = decorators[[1]])
decorated_output_6 <- srv_transform_data(id = "d_6", data = output_plot_6, transforms = decorators[[1]])
decorated_output_0 <- srv_teal_transform_data(id = "d_0", data = output_plot_0, transformators = decorators[[1]])
decorated_output_1 <- srv_teal_transform_data(id = "d_1", data = output_plot_1, transformators = decorators[[1]])
decorated_output_2 <- srv_teal_transform_data(id = "d_2", data = output_plot_2, transformators = decorators[[1]])
decorated_output_3 <- srv_teal_transform_data(id = "d_3", data = output_plot_3, transformators = decorators[[1]])
decorated_output_4 <- srv_teal_transform_data(id = "d_4", data = output_plot_4, transformators = decorators[[1]])
decorated_output_5 <- srv_teal_transform_data(id = "d_5", data = output_plot_5, transformators = decorators[[1]])
decorated_output_6 <- srv_teal_transform_data(id = "d_6", data = output_plot_6, transformators = decorators[[1]])


output_q <- reactive({
Expand All @@ -1026,7 +1057,7 @@ srv_a_regression <- function(id,
})

fitted <- reactive(output_q()[["fit"]])
plot_r <- reactive(output_q()[["g"]])
plot_r <- reactive(output_q()[["plot"]])

# Insert the plot into a plot_with_settings module from teal.widgets
pws <- teal.widgets::plot_with_settings_srv(
Expand Down
Loading

0 comments on commit b6d9bff

Please sign in to comment.