Skip to content

Commit

Permalink
finalize tm_outliers
Browse files Browse the repository at this point in the history
  • Loading branch information
@m7pr
m7pr committed Nov 25, 2024
1 parent c657134 commit efab961
Showing 1 changed file with 18 additions and 53 deletions.
71 changes: 18 additions & 53 deletions R/tm_outliers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,16 +11,6 @@
#' Specifies variable(s) to be analyzed for outliers.
#' @param categorical_var (`data_extract_spec` or `list` of multiple `data_extract_spec`) optional,
#' specifies the categorical variable(s) to split the selected outlier variables on.
#' @param table_decorator (`list` of `teal_transform_module` or `NULL`) optional,
#' decorator for the table.
#' @param boxplot_decorator (`list` of `teal_transform_module` or `NULL`) optional,
#' decorator for the box plot.
#' @param violin_decorator (`list` of `teal_transform_module` or `NULL`) optional,
#' decorator for the violin plot.
#' @param density_decorator (`list` of `teal_transform_module` or `NULL`) optional,
#' decorator for the density plot.
#' @param cum_dist_decorator (`list` of `teal_transform_module` or `NULL`) optional,
#' decorator for the cumulative distribution plot.
#'
#' @templateVar ggnames "Boxplot","Density Plot","Cumulative Distribution Plot"
#' @template ggplot2_args_multi
Expand All @@ -30,8 +20,9 @@
#' @section Decorating `tm_outliers`:
#'
#' This module generates the following objects, which can be modified in place using decorators:
#' - `table` (`data.frame`)
#' - `plot` (`ggplot2`)
#' - `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.
Expand Down Expand Up @@ -149,11 +140,7 @@ tm_outliers <- function(label = "Outliers Module",
plot_width = NULL,
pre_output = NULL,
post_output = NULL,
table_decorator = NULL,
boxplot_decorator = NULL,
violin_decorator = NULL,
density_decorator = NULL,
cum_dist_decorator = NULL) {
decorators = NULL) {
message("Initializing tm_outliers")

# Normalize the parameters
Expand Down Expand Up @@ -191,11 +178,7 @@ 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::check_class(table_decorator, "teal_transform_module", null.ok = TRUE)
checkmate::check_class(boxplot_decorator, "teal_transform_module", null.ok = TRUE)
checkmate::check_class(violin_decorator, "teal_transform_module", null.ok = TRUE)
checkmate::check_class(density_decorator, "teal_transform_module", null.ok = TRUE)
checkmate::check_class(cum_dist_decorator, "teal_transform_module", null.ok = TRUE)
checkmate::assert_list(decorators, "teal_transform_module", null.ok = TRUE)

# End of assertions

Expand All @@ -215,7 +198,7 @@ tm_outliers <- function(label = "Outliers Module",
data_extract_list,
list(
plot_height = plot_height, plot_width = plot_width, ggplot2_args = ggplot2_args,
decorators = list(table = table_decorator, boxplot = boxplot_decorator, violin = violin_decorator, density = density_decorator, cum_dist = cum_dist_decorator)
decorators = decorators
)
),
ui = ui_outliers,
Expand All @@ -236,31 +219,21 @@ ui_outliers <- function(id, ...) {
output = teal.widgets::white_small_well(
uiOutput(ns("total_outliers")),
DT::dataTableOutput(ns("summary_table")),
ui_teal_transform_data(ns("table_decorator"), args$table_decorator),

uiOutput(ns("total_missing")),
tags$br(), tags$hr(),
tabsetPanel(
id = ns("tabs"),
tabPanel(
"Boxplot",
conditionalPanel(
condition = sprintf("input['%s'] == 'Box plot'", ns("boxplot_alts")),
ui_teal_transform_data(ns("boxplot_decorator"), args$boxplot_decorator)
),
conditionalPanel(
condition = sprintf("input['%s'] == 'Violin plot'", ns("boxplot_alts")),
ui_teal_transform_data(ns("violin_decorator"), args$violin_decorator)
),
teal.widgets::plot_with_settings_ui(id = ns("box_plot"))
),
tabPanel(
"Density Plot",
ui_teal_transform_data(ns("density_decorator"), args$density_decorator),
teal.widgets::plot_with_settings_ui(id = ns("density_plot"))
),
tabPanel(
"Cumulative Distribution Plot",
ui_teal_transform_data(ns("cum_dist_decorator"), args$cum_dist_decorator),
teal.widgets::plot_with_settings_ui(id = ns("cum_density_plot"))
)
),
Expand Down Expand Up @@ -350,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 Down Expand Up @@ -989,21 +963,15 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
)
})

decorated_boxplot_q <- srv_teal_transform_data("boxplot_decorator", data = boxplot_q, transformators = decorators$boxplot)
decorated_violin_q <- srv_teal_transform_data("violin_decorator", data = boxplot_q, transformators = decorators$violin)
# TODO decorated_violin_q is not used anywhere
decorated_density_plot_q <- srv_teal_transform_data("density_decorator", data = density_plot_q, transformators = decorators$density)
decorated_cumulative_plot_q <- srv_teal_transform_data("cum_dist_decorator", data = cumulative_plot_q, transformators = decorators$cum_dist)

final_q <- reactive({
req(input$tabs)
tab_type <- input$tabs
result_q <- if (tab_type == "Boxplot") {
decorated_boxplot_q()
boxplot_q()
} else if (tab_type == "Density Plot") {
decorated_density_plot_q()
density_plot_q()
} else if (tab_type == "Cumulative Distribution Plot") {
decorated_cumulative_plot_q()
cumulative_plot_q()
}
# used to display table when running show-r-code code
# added after the plots so that a change in selected columns doesn't affect
Expand All @@ -1016,7 +984,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
setdiff(names(ANL_OUTLIER), c("is_outlier_selected", "order")),
table_columns
)
table <- ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index]
ANL_OUTLIER_EXTENDED[ANL_OUTLIER_EXTENDED$is_outlier_selected, columns_index]
},
env = list(
table_columns = input$table_ui_columns
Expand All @@ -1025,10 +993,7 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
)
})


decorated_final_q <-
srv_teal_transform_data("cum_dist_decorator", data = final_q, transformators = decorators$table_decorator)
# TODO: reuse decorated_final_q in table generation
decorated_final_q <- srv_transform_teal_data("decorate", data = final_q, transformators = decorators)

# slider text
output$ui_outlier_help <- renderUI({
Expand Down Expand Up @@ -1081,17 +1046,17 @@ srv_outliers <- function(id, data, reporter, filter_panel_api, outlier_var,
boxplot_r <- reactive({
teal::validate_inputs(iv_r())
req(boxplot_q())
decorated_boxplot_q()[["plot"]]
decorated_final_q()[["box_plot"]]
})
density_plot_r <- reactive({
teal::validate_inputs(iv_r())
req(density_plot_q())
decorated_density_plot_q()[["plot"]]
decorated_final_q()[["density_plot"]]
})
cumulative_plot_r <- reactive({
teal::validate_inputs(iv_r())
req(cumulative_plot_q())
decorated_cumulative_plot_q()[["plot"]]
decorated_final_q()[["cum_dist_plot"]]
})

box_pws <- teal.widgets::plot_with_settings_srv(
Expand Down Expand Up @@ -1279,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(req(final_q()))),
verbatim_content = reactive(teal.code::get_code(req(decorated_final_q()))),
title = "Show R Code for Outlier"
)

Expand Down Expand Up @@ -1311,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(req(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

0 comments on commit efab961

Please sign in to comment.