Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

introduce decorators for tm_outliers #805

Merged
merged 8 commits into from
Nov 26, 2024
+44 −17
Merged

introduce decorators for tm_outliers #805

Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
388d5c9
WIP on tm_outliers
m7pr Nov 20, 2024
3f506ea
Merge branch '1187_decorate_output@main' into tm_outliers@1187_decora…
m7pr Nov 21, 2024
6a36fe5
add req statement so that when srv_teal_transform_data returns NULL y…
m7pr Nov 21, 2024
c657134
Merge branch '1187_decorate_output@main' into tm_outliers@1187_decora…
m7pr Nov 25, 2024
efab961
finalize tm_outliers
m7pr Nov 25, 2024
fd80fe6
rename plots
m7pr Nov 25, 2024
da1fa0f
Update R/tm_outliers.R
averissimo Nov 26, 2024
6092b2d
Merge branch '1187_decorate_output@main' into tm_outliers@1187_decora…
averissimo Nov 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
61 changes: 44 additions & 17 deletions R/tm_outliers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,11 +17,22 @@
#'
#' @inherit shared_params return
#'
#' @section Decorating `tm_outliers`:
#'
#' This module generates the following objects, which can be modified in place using decorators:
#' - `box_plot` (`ggplot2`)
#' - `density_plot` (`ggplot2`)
#' - `cum_dist_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)
#' interactive <- function() TRUE
#' {{ next_example }}
#' @examples
#'
#' # general data example
#' data <- teal_data()
#' data <- within(data, {
Expand Down Expand Up @@ -71,6 +82,7 @@
#' interactive <- function() TRUE
#' {{ next_example }}
#' @examples
#'
#' # CDISC data example
#' data <- teal_data()
#' data <- within(data, {
Expand All @@ -81,6 +93,8 @@
#' fact_vars_adsl <- names(Filter(isTRUE, sapply(data[["ADSL"]], is.factor)))
#' vars <- choices_selected(variable_choices(data[["ADSL"]], fact_vars_adsl))
#'
#'
#'
#' app <- init(
#' data = data,
#' modules = modules(
Expand Down Expand Up @@ -125,7 +139,8 @@ tm_outliers <- function(label = "Outliers Module",
plot_height = c(600, 200, 2000),
plot_width = NULL,
pre_output = NULL,
post_output = NULL) {
post_output = NULL,
decorators = NULL) {
message("Initializing tm_outliers")

# Normalize the parameters
Expand Down Expand Up @@ -162,6 +177,9 @@ tm_outliers <- function(label = "Outliers Module",

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", null.ok = TRUE)

# End of assertions

# Make UI args
Expand All @@ -172,12 +190,16 @@ tm_outliers <- function(label = "Outliers Module",
categorical_var = categorical_var
)


ans <- module(
label = label,
server = srv_outliers,
server_args = c(
data_extract_list,
list(plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args)
list(
plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args,
decorators = decorators
)
),
ui = ui_outliers,
ui_args = args,
Expand All @@ -197,6 +219,7 @@ ui_outliers <- function(id, ...) {
output = teal.widgets::white_small_well(
uiOutput(ns("total_outliers")),
DT::dataTableOutput(ns("summary_table")),

uiOutput(ns("total_missing")),
tags$br(), tags$hr(),
tabsetPanel(
Expand Down Expand Up @@ -300,6 +323,7 @@ ui_outliers <- function(id, ...) {
uiOutput(ns("ui_outlier_help"))
)
),
ui_transform_teal_data(ns("decorate"), transformators = args$decorators),
teal.widgets::panel_item(
title = "Plot settings",
selectInput(
Expand All @@ -319,9 +343,10 @@ ui_outliers <- function(id, ...) {
)
}

# Server function for the outliers module
# Server function for the outliers module
srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
categorical_var, plot_height, plot_width, ggplot2_args) {
categorical_var, 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")
Expand Down Expand Up @@ -761,7 +786,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
teal.code::eval_code(
common_code_q(),
substitute(
expr = g <- plot_call +
expr = box_plot <- plot_call +
scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) +
labs + ggthemes + themes,
env = list(
Expand All @@ -771,8 +796,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
themes = parsed_ggplot2_args$theme
)
)
) %>%
teal.code::eval_code(quote(print(g)))
)
})

# density plot
Expand Down Expand Up @@ -823,16 +847,15 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
teal.code::eval_code(
common_code_q(),
substitute(
expr = g <- plot_call + labs + ggthemes + themes,
expr = density_plot <- plot_call + labs + ggthemes + themes,
env = list(
plot_call = plot_call,
labs = parsed_ggplot2_args$labs,
themes = parsed_ggplot2_args$theme,
ggthemes = parsed_ggplot2_args$ggtheme
)
)
) %>%
teal.code::eval_code(quote(print(g)))
)
})

# Cumulative distribution plot
Expand Down Expand Up @@ -925,7 +948,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
teal.code::eval_code(
qenv,
substitute(
expr = g <- plot_call +
expr = cum_dist_plot <- plot_call +
geom_point(data = outlier_points, aes(x = outlier_var_name, y = y, color = is_outlier_selected)) +
scale_color_manual(values = c("TRUE" = "red", "FALSE" = "black")) +
labs + ggthemes + themes,
Expand All @@ -937,8 +960,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
ggthemes = parsed_ggplot2_args$ggtheme
)
)
) %>%
teal.code::eval_code(quote(print(g)))
)
})

final_q <- reactive({
Expand Down Expand Up @@ -971,6 +993,8 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
)
})

decorated_final_q <- srv_transform_teal_data("decorate", data = final_q, transformators = decorators)

# slider text
output$ui_outlier_help <- renderUI({
req(input$method)
Expand Down Expand Up @@ -1021,15 +1045,18 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,

boxplot_r <- reactive({
teal::validate_inputs(iv_r())
boxplot_q()[["g"]]
req(boxplot_q())
decorated_final_q()[["box_plot"]]
})
density_plot_r <- reactive({
teal::validate_inputs(iv_r())
density_plot_q()[["g"]]
req(density_plot_q())
decorated_final_q()[["density_plot"]]
})
cumulative_plot_r <- reactive({
teal::validate_inputs(iv_r())
cumulative_plot_q()[["g"]]
req(cumulative_plot_q())
decorated_final_q()[["cum_dist_plot"]]
})

box_pws <- teal.widgets::plot_with_settings_srv(
Expand Down Expand Up @@ -1217,7 +1244,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,

teal.widgets::verbatim_popup_srv(
id = "rcode",
verbatim_content = reactive(teal.code::get_code(final_q())),
verbatim_content = reactive(teal.code::get_code(req(decorated_final_q()))),
title = "Show R Code for Outlier"
)

Expand Down Expand Up @@ -1249,7 +1276,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
card$append_text("Comment", "header3")
card$append_text(comment)
}
card$append_src(teal.code::get_code(final_q()))
card$append_src(teal.code::get_code(req(decorated_final_q())))
card
}
teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
Expand Down
Loading