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 <[email protected]> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Marcin <[email protected]>
insightsengineering · Feb 14, 2024 · 7fd5c73 · 7fd5c73
1 parent ac7fec3
commit 7fd5c73
Show file tree

Hide file tree

Showing 9 changed files with 140 additions and 61 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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,14 +323,34 @@ 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")
   checkmate::assert_class(shiny::isolate(data()), "teal_data")
 
   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
@@ -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
@@ -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
diff --git a/man/tm_g_gh_correlationplot.Rd b/man/tm_g_gh_correlationplot.Rd