From 7fd5c73750953fff7375d072f2ec8b1ea68f34f9 Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Wed, 14 Feb 2024 21:21:58 +0530 Subject: [PATCH] Handle delayed choices (#256) Closes #255 Fixes the modules to get delayed choices: - [x] tm_g_gh_boxplot - [x] tm_g_gh_correlationplot - [x] tm_g_gh_density_distribution_plot - [x] tm_g_gh_lineplot - [x] tm_g_gh_scatterplot - [x] tm_g_gh_spaghettiplot --------- Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/tm_g_gh_boxplot.R | 35 +++++++++++++++++---------- R/tm_g_gh_correlationplot.R | 35 +++++++++++++++++++-------- R/tm_g_gh_density_distribution_plot.R | 26 ++++++++++++++------ R/tm_g_gh_lineplot.R | 33 ++++++++++++++++++------- R/tm_g_gh_scatterplot.R | 32 +++++++++++++++++------- R/tm_g_gh_spaghettiplot.R | 34 ++++++++++++++++++-------- man/tm_g_gh_boxplot.Rd | 2 +- man/tm_g_gh_correlationplot.Rd | 2 +- man/tm_g_gh_spaghettiplot.Rd | 2 +- 9 files changed, 140 insertions(+), 61 deletions(-) diff --git a/R/tm_g_gh_boxplot.R b/R/tm_g_gh_boxplot.R index 24d8e6d4..3063779f 100644 --- a/R/tm_g_gh_boxplot.R +++ b/R/tm_g_gh_boxplot.R @@ -108,7 +108,7 @@ #' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" #' #' # add LLOQ and ULOQ variables -#' ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB) +#' ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") #' ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM") #' }) #' @@ -210,7 +210,8 @@ tm_g_gh_boxplot <- function(label, plot_height = plot_height, plot_width = plot_width, hline_vars_colors = hline_vars_colors, - hline_vars_labels = hline_vars_labels + hline_vars_labels = hline_vars_labels, + module_args = args ), ui = ui_g_boxplot, ui_args = args @@ -251,16 +252,7 @@ ui_g_boxplot <- function(id, ...) { selected = a$trt_group$selected, multiple = FALSE ), - templ_ui_params_vars( - ns, - xparam_choices = a$param$choices, - xparam_selected = a$param$selected, - xparam_label = "Select a Biomarker", - xchoices = a$xaxis_var$choices, - xselected = a$xaxis_var$selected, - ychoices = a$yaxis_var$choices, - yselected = a$yaxis_var$selected - ), + uiOutput(ns("axis_selections")), teal.widgets::optionalSelectInput( ns("facet_var"), label = "Facet by", @@ -324,13 +316,30 @@ srv_g_boxplot <- function(id, plot_height, plot_width, hline_vars_colors, - hline_vars_labels) { + hline_vars_labels, + module_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + output$axis_selections <- renderUI({ + env <- shiny::isolate(as.list(data()@env)) + resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env) + resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env) + resolved_param <- teal.transform::resolve_delayed(module_args$param, env) + templ_ui_params_vars( + session$ns, + xparam_choices = resolved_param$choices, + xparam_selected = resolved_param$selected, + xparam_label = module_args$"Select a Biomarker", + xchoices = resolved_x$choices, + xselected = resolved_x$selected, + ychoices = resolved_y$choices, + yselected = resolved_y$selected + ) + }) # reused in all modules anl_q_output <- constr_anl_q( session, input, data, dataname, diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R index 3697abb1..6b1dfe24 100644 --- a/R/tm_g_gh_correlationplot.R +++ b/R/tm_g_gh_correlationplot.R @@ -130,7 +130,7 @@ #' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit" #' #' # add LLOQ and ULOQ variables -#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB) +#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") #' ADLB <- dplyr::left_join(ADLB, ADLB_LOQS, by = "PARAM") #' }) #' @@ -259,7 +259,8 @@ tm_g_gh_correlationplot <- function(label, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels, vline_vars_colors = vline_vars_colors, - vline_vars_labels = vline_vars_labels + vline_vars_labels = vline_vars_labels, + module_args = args ), ui = ui_g_correlationplot, ui_args = args @@ -284,13 +285,7 @@ ui_g_correlationplot <- function(id, ...) { selected = a$trt_group$selected, multiple = FALSE ), - templ_ui_params_vars( - ns, - xparam_choices = a$xaxis_param$choices, xparam_selected = a$xaxis_param$selected, - xchoices = a$xaxis_var$choices, xselected = a$xaxis_var$selected, - yparam_choices = a$yaxis_param$choices, yparam_selected = a$yaxis_param$selected, - ychoices = a$yaxis_var$choices, yselected = a$yaxis_var$selected - ), + uiOutput(ns("axis_selections")), templ_ui_constraint(ns, "X-Axis Data Constraint"), # required by constr_anl_q if (length(a$hline_vars) > 0) { teal.widgets::optionalSelectInput( @@ -375,13 +370,33 @@ srv_g_correlationplot <- function(id, hline_vars_colors, hline_vars_labels, vline_vars_colors, - vline_vars_labels) { + vline_vars_labels, + module_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + output$axis_selections <- renderUI({ + env <- shiny::isolate(as.list(data()@env)) + resolved_x_param <- teal.transform::resolve_delayed(module_args$xaxis_param, env) + resolved_x_var <- teal.transform::resolve_delayed(module_args$xaxis_var, env) + resolved_y_param <- teal.transform::resolve_delayed(module_args$yaxis_param, env) + resolved_y_var <- teal.transform::resolve_delayed(module_args$yaxis_var, env) + templ_ui_params_vars( + session$ns, + xparam_choices = resolved_x_param$choices, + xparam_selected = resolved_x_param$selected, + xchoices = resolved_x_var$choices, + xselected = resolved_x_var$selected, + yparam_choices = resolved_y_param$choices, + yparam_selected = resolved_y_param$selected, + ychoices = resolved_y_var$choices, + yselected = resolved_y_var$selected + ) + }) + iv_r <- reactive({ iv <- shinyvalidate::InputValidator$new() diff --git a/R/tm_g_gh_density_distribution_plot.R b/R/tm_g_gh_density_distribution_plot.R index 424e801f..ca5da653 100644 --- a/R/tm_g_gh_density_distribution_plot.R +++ b/R/tm_g_gh_density_distribution_plot.R @@ -166,7 +166,8 @@ tm_g_gh_density_distribution_plot <- function(label, # nolint color_manual = color_manual, color_comb = color_comb, plot_height = plot_height, - plot_width = plot_width + plot_width = plot_width, + module_args = args ), ui = ui_g_density_distribution_plot, ui_args = args @@ -201,11 +202,7 @@ ui_g_density_distribution_plot <- function(id, ...) { selected = a$trt_group$selected, multiple = FALSE ), - templ_ui_params_vars( - ns, - xparam_choices = a$param$choices, xparam_selected = a$param$selected, xparam_label = "Select a Biomarker", - xchoices = a$xaxis_var$choices, xselected = a$xaxis_var$selected - ), + uiOutput(ns("axis_selections")), templ_ui_constraint(ns, label = "Data Constraint"), ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color), teal.widgets::panel_group( @@ -263,13 +260,28 @@ srv_g_density_distribution_plot <- function(id, # nolint color_manual, color_comb, plot_height, - plot_width) { + plot_width, + module_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + output$axis_selections <- renderUI({ + env <- shiny::isolate(as.list(data()@env)) + resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env) + resolved_param <- teal.transform::resolve_delayed(module_args$param, env) + templ_ui_params_vars( + session$ns, + xparam_choices = resolved_param$choices, + xparam_selected = resolved_param$selected, + xparam_label = "Select a Biomarker", + xchoices = resolved_x$choices, + xselected = resolved_x$selected + ) + }) + anl_q_output <- constr_anl_q( session, input, data, dataname, param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2 diff --git a/R/tm_g_gh_lineplot.R b/R/tm_g_gh_lineplot.R index 64717ec5..b5ca9648 100644 --- a/R/tm_g_gh_lineplot.R +++ b/R/tm_g_gh_lineplot.R @@ -198,7 +198,8 @@ tm_g_gh_lineplot <- function(label, xtick = xtick, xlabel = xlabel, plot_height = plot_height, - plot_width = plot_width + plot_width = plot_width, + module_args = args ), ui = ui_lineplot, ui_args = args, @@ -226,13 +227,7 @@ ui_lineplot <- function(id, ...) { selected = a$trt_group$selected, multiple = FALSE ), - templ_ui_params_vars( - ns, - # xparam and yparam are identical, so we only show the user one - xparam_choices = a$param$choices, xparam_selected = a$param$selected, xparam_label = "Select a Biomarker", - xchoices = a$xaxis_var$choices, xselected = a$xaxis_var$selected, - ychoices = a$yaxis_var$choices, yselected = a$yaxis_var$selected - ), + uiOutput(ns("axis_selections")), uiOutput(ns("shape_ui")), radioButtons(ns("stat"), "Select a Statistic:", c("mean", "median"), a$stat), checkboxInput(ns("include_stat"), "Include Statistic Table", value = TRUE), @@ -328,7 +323,8 @@ srv_lineplot <- function(id, xtick, xlabel, plot_height, - plot_width) { + plot_width, + module_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") @@ -336,6 +332,25 @@ srv_lineplot <- function(id, moduleServer(id, function(input, output, session) { ns <- session$ns + + output$axis_selections <- renderUI({ + env <- shiny::isolate(as.list(data()@env)) + resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env) + resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env) + resolved_param <- teal.transform::resolve_delayed(module_args$param, env) + templ_ui_params_vars( + ns, + # xparam and yparam are identical, so we only show the user one + xparam_choices = resolved_param$choices, + xparam_selected = resolved_param$selected, + xparam_label = "Select a Biomarker", + xchoices = resolved_x$choices, + xselected = resolved_x$selected, + ychoices = resolved_y$choices, + yselected = resolved_y$selected + ) + }) + output$shape_ui <- renderUI({ if (!is.null(shape_choices)) { if (methods::is(shape_choices, "choices_selected")) { diff --git a/R/tm_g_gh_scatterplot.R b/R/tm_g_gh_scatterplot.R index 3d38120f..07b62898 100644 --- a/R/tm_g_gh_scatterplot.R +++ b/R/tm_g_gh_scatterplot.R @@ -175,7 +175,8 @@ tm_g_gh_scatterplot <- function(label, color_manual = color_manual, shape_manual = shape_manual, plot_height = plot_height, - plot_width = plot_width + plot_width = plot_width, + module_args = args ), ui = ui_g_scatterplot, ui_args = args @@ -200,13 +201,7 @@ ui_g_scatterplot <- function(id, ...) { selected = a$trt_group$selected, multiple = FALSE ), - templ_ui_params_vars( - ns, - # xparam and yparam are identical, so we only show the user one - xparam_choices = a$param$choices, xparam_selected = a$param$selected, xparam_label = "Select a Biomarker", - xchoices = a$xaxis_var$choices, xselected = a$xaxis_var$selected, - ychoices = a$yaxis_var$choices, yselected = a$yaxis_var$selected - ), + uiOutput(ns("axis_selections")), templ_ui_constraint(ns), # required by constr_anl_q teal.widgets::panel_group( teal.widgets::panel_item( @@ -263,13 +258,32 @@ srv_g_scatterplot <- function(id, color_manual, shape_manual, plot_height, - plot_width) { + plot_width, + module_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + output$axis_selections <- renderUI({ + env <- shiny::isolate(as.list(data()@env)) + resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env) + resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env) + resolved_param <- teal.transform::resolve_delayed(module_args$param, env) + templ_ui_params_vars( + session$ns, + # xparam and yparam are identical, so we only show the user one + xparam_choices = resolved_param$choices, + xparam_selected = resolved_param$selected, + xparam_label = "Select a Biomarker", + xchoices = resolved_x$choices, + xselected = resolved_x$selected, + ychoices = resolved_y$choices, + yselected = resolved_y$selected + ) + }) + # reused in all modules anl_q_output <- constr_anl_q( session, input, data, dataname, diff --git a/R/tm_g_gh_spaghettiplot.R b/R/tm_g_gh_spaghettiplot.R index 6458fb0b..899729a1 100644 --- a/R/tm_g_gh_spaghettiplot.R +++ b/R/tm_g_gh_spaghettiplot.R @@ -113,7 +113,7 @@ #' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" #' #' # add LLOQ and ULOQ variables -#' ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB) +#' ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") #' ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM") #' }) #' @@ -222,7 +222,8 @@ tm_g_gh_spaghettiplot <- function(label, plot_height = plot_height, plot_width = plot_width, hline_vars_colors = hline_vars_colors, - hline_vars_labels = hline_vars_labels + hline_vars_labels = hline_vars_labels, + module_args = args ), ui = g_ui_spaghettiplot, ui_args = args, @@ -250,13 +251,7 @@ g_ui_spaghettiplot <- function(id, ...) { selected = a$trt_group$selected, multiple = FALSE ), - templ_ui_params_vars( - ns, - # xparam and yparam are identical, so we only show the user one - xparam_choices = a$param$choices, xparam_selected = a$param$selected, xparam_label = "Select a Biomarker", - xchoices = a$xaxis_var$choices, xselected = a$xaxis_var$selected, - ychoices = a$yaxis_var$choices, yselected = a$yaxis_var$selected - ), + uiOutput(ns("axis_selections")), radioButtons( ns("group_stats"), "Group Statistics", @@ -339,13 +334,32 @@ srv_g_spaghettiplot <- function(id, plot_height, plot_width, hline_vars_colors, - hline_vars_labels) { + hline_vars_labels, + module_args) { with_reporter <- !missing(reporter) && inherits(reporter, "Reporter") with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI") checkmate::assert_class(data, "reactive") checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + output$axis_selections <- renderUI({ + env <- shiny::isolate(as.list(data()@env)) + resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env) + resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env) + resolved_param <- teal.transform::resolve_delayed(module_args$param, env) + templ_ui_params_vars( + session$ns, + # xparam and yparam are identical, so we only show the user one + xparam_choices = resolved_param$choices, + xparam_selected = resolved_param$selected, + xparam_label = "Select a Biomarker", + xchoices = resolved_x$choices, + xselected = resolved_x$selected, + ychoices = resolved_y$choices, + yselected = resolved_y$selected + ) + }) + # reused in all modules anl_q_output <- constr_anl_q( session, input, data, dataname, diff --git a/man/tm_g_gh_boxplot.Rd b/man/tm_g_gh_boxplot.Rd index 60a0f540..be5fb770 100644 --- a/man/tm_g_gh_boxplot.Rd +++ b/man/tm_g_gh_boxplot.Rd @@ -166,7 +166,7 @@ data <- within(data, { attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" # add LLOQ and ULOQ variables - ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB) + ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM") }) diff --git a/man/tm_g_gh_correlationplot.Rd b/man/tm_g_gh_correlationplot.Rd index 306f46e1..9afecf84 100644 --- a/man/tm_g_gh_correlationplot.Rd +++ b/man/tm_g_gh_correlationplot.Rd @@ -206,7 +206,7 @@ data <- within(data, { attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit" # add LLOQ and ULOQ variables - ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB) + ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") ADLB <- dplyr::left_join(ADLB, ADLB_LOQS, by = "PARAM") }) diff --git a/man/tm_g_gh_spaghettiplot.Rd b/man/tm_g_gh_spaghettiplot.Rd index f5a72c83..8549cd93 100644 --- a/man/tm_g_gh_spaghettiplot.Rd +++ b/man/tm_g_gh_spaghettiplot.Rd @@ -182,7 +182,7 @@ data <- within(data, { attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit" # add LLOQ and ULOQ variables - ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB) + ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL") ADLB <- dplyr::left_join(ADLB, ALB_LOQS, by = "PARAM") })