Fixing bugs (#276)

this is part of insightsengineering/coredev-tasks#567 Here bugs are resolved found here - [x] resolved delayed data cases based on insightsengineering/coredev-tasks#558 - [x] Added get_choices function.
insightsengineering · Jun 24, 2024 · 410a48f · 410a48f
1 parent c79b2d5
commit 410a48f
Show file tree

Hide file tree

Showing 5 changed files with 80 additions and 17 deletions.
diff --git a/R/tm_g_patient_profile.R b/R/tm_g_patient_profile.R
@@ -191,6 +191,7 @@ tm_g_patient_profile <- function(label = "Patient Profile Plot",
     ui_args = args,
     server = srv_g_patient_profile,
     server_args = list(
+      patient_id = patient_id,
       sl_dataname = sl_dataname,
       ex_dataname = ex_dataname,
       ae_dataname = ae_dataname,
@@ -223,10 +224,9 @@ ui_g_patient_profile <- function(id, ...) {
         ###
         tags$label("Encodings", class = "text-primary"),
         selectizeInput(
-          ns("patient_id"),
-          "Patient ID",
-          choices = get_choices(a$patient_id$choices),
-          selected = a$patient_id$selected
+          inputId = ns("patient_id"),
+          label = "Patient ID",
+          choices = NULL
         ),
         tags$div(
           tagList(
@@ -341,6 +341,7 @@ srv_g_patient_profile <- function(id,
                                   data,
                                   filter_panel_api,
                                   reporter,
+                                  patient_id,
                                   sl_dataname,
                                   ex_dataname,
                                   ae_dataname,
@@ -367,6 +368,15 @@ srv_g_patient_profile <- function(id,
       vapply(checkboxes, function(x) x %in% input$select_ADaM, logical(1L))
     )
 
+    resolved <- teal.transform::resolve_delayed(patient_id, as.list(isolate(data())@env))
+
+    updateSelectizeInput(
+      session = session,
+      inputId = "patient_id",
+      choices = resolved$choices,
+      selected = resolved$selected
+    )
+
     if (!is.na(lb_dataname)) {
       observeEvent(input$lb_var, ignoreNULL = TRUE, {
         ADLB <- data()[[lb_dataname]]

diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R
@@ -124,7 +124,13 @@ tm_g_spiderplot <- function(label,
     label = label,
     datanames = c("ADSL", dataname),
     server = srv_g_spider,
-    server_args = list(dataname = dataname, label = label, plot_height = plot_height, plot_width = plot_width),
+    server_args = list(
+      dataname = dataname,
+      paramcd = paramcd,
+      label = label,
+      plot_height = plot_height,
+      plot_width = plot_width
+    ),
     ui = ui_g_spider,
     ui_args = args
   )
@@ -133,7 +139,6 @@ tm_g_spiderplot <- function(label,
 ui_g_spider <- function(id, ...) {
   ns <- NS(id)
   a <- list(...)
-
   shiny::tagList(
     include_css_files("custom"),
     teal.widgets::standard_layout(
@@ -151,8 +156,6 @@ ui_g_spider <- function(id, ...) {
           teal.widgets::optionalSelectInput(
             ns("paramcd"),
             paste("Parameter - from", a$dataname),
-            get_choices(a$paramcd$choices),
-            a$paramcd$selected,
             multiple = FALSE
           ),
           teal.widgets::optionalSelectInput(
@@ -236,14 +239,25 @@ ui_g_spider <- function(id, ...) {
   )
 }
 
-srv_g_spider <- function(id, data, filter_panel_api, reporter, dataname, label, plot_height, plot_width) {
+srv_g_spider <- function(id, data, filter_panel_api, paramcd, reporter, dataname, label, plot_height, plot_width) {
   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) {
     teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")
+
+    env <- as.list(isolate(data())@env)
+    resolved_paramcd <- teal.transform::resolve_delayed(paramcd, env)
+
+    teal.widgets::updateOptionalSelectInput(
+      session = session,
+      inputId = "paramcd",
+      choices = resolved_paramcd$choices,
+      selected = resolved_paramcd$selected
+    )
+
     iv <- reactive({
       ADSL <- data()[["ADSL"]]
       ADTR <- data()[[dataname]]

diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R
@@ -139,6 +139,9 @@ tm_g_waterfall <- function(label,
     server_args = list(
       dataname_tr = dataname_tr,
       dataname_rs = dataname_rs,
+      bar_paramcd = bar_paramcd,
+      add_label_paramcd_rs = add_label_paramcd_rs,
+      anno_txt_paramcd_rs = anno_txt_paramcd_rs,
       label = label,
       bar_color_opt = bar_color_opt,
       plot_height = plot_height,
@@ -151,7 +154,6 @@ tm_g_waterfall <- function(label,
 ui_g_waterfall <- function(id, ...) {
   a <- list(...)
   ns <- NS(id)
-
   teal.widgets::standard_layout(
     output = teal.widgets::white_small_well(
       teal.widgets::plot_with_settings_ui(id = ns("waterfallplot"))
@@ -165,8 +167,6 @@ ui_g_waterfall <- function(id, ...) {
       teal.widgets::optionalSelectInput(
         ns("bar_paramcd"),
         "Tumor Burden Parameter",
-        choices = get_choices(a$bar_paramcd$choices),
-        selected = a$bar_paramcd$selected,
         multiple = FALSE
       ),
       teal.widgets::optionalSelectInput(
@@ -202,8 +202,6 @@ ui_g_waterfall <- function(id, ...) {
       teal.widgets::optionalSelectInput(
         ns("add_label_paramcd_rs"),
         "Add ADRS Label to Bars",
-        choices = get_choices(a$add_label_paramcd_rs$choices),
-        selected = a$add_label_paramcd_rs$selected,
         multiple = FALSE
       ),
       teal.widgets::optionalSelectInput(
@@ -217,8 +215,6 @@ ui_g_waterfall <- function(id, ...) {
       teal.widgets::optionalSelectInput(
         ns("anno_txt_paramcd_rs"),
         "Annotation Parameters",
-        choices = get_choices(a$anno_txt_paramcd_rs$choices),
-        selected = a$anno_txt_paramcd_rs$selected,
         multiple = TRUE,
         label_help = helpText("from ", tags$code("ADRS"))
       ),
@@ -275,6 +271,9 @@ srv_g_waterfall <- function(id,
                             data,
                             filter_panel_api,
                             reporter,
+                            bar_paramcd,
+                            add_label_paramcd_rs,
+                            anno_txt_paramcd_rs,
                             dataname_tr,
                             dataname_rs,
                             bar_color_opt,
@@ -288,6 +287,31 @@ srv_g_waterfall <- function(id,
 
   moduleServer(id, function(input, output, session) {
     teal.logger::log_shiny_input_changes(input, namespace = "teal.osprey")
+
+    env <- as.list(isolate(data())@env)
+    resolved_bar_paramcd <- teal.transform::resolve_delayed(bar_paramcd, env)
+    resolved_add_label_paramcd_rs <- teal.transform::resolve_delayed(add_label_paramcd_rs, env)
+    resolved_anno_txt_paramcd_rs <- teal.transform::resolve_delayed(anno_txt_paramcd_rs, env)
+
+    teal.widgets::updateOptionalSelectInput(
+      session = session,
+      inputId = "bar_paramcd",
+      choices = resolved_bar_paramcd$choices,
+      selected = resolved_bar_paramcd$selected
+    )
+    teal.widgets::updateOptionalSelectInput(
+      session = session,
+      inputId = "add_label_paramcd_rs",
+      choices = resolved_add_label_paramcd_rs$choices,
+      selected = resolved_add_label_paramcd_rs$selected
+    )
+    teal.widgets::updateOptionalSelectInput(
+      session = session,
+      inputId = "anno_txt_paramcd_rs",
+      choices = resolved_anno_txt_paramcd_rs$choices,
+      selected = resolved_anno_txt_paramcd_rs$selected
+    )
+
     iv <- reactive({
       adsl <- data()[["ADSL"]]
       adtr <- data()[[dataname_tr]]

diff --git a/R/utils.R b/R/utils.R
@@ -135,14 +135,27 @@ include_css_files <- function(pattern = "*") {
 #'
 #' This function returns choices based on the class of the input.
 #' If the input is of class `delayed_data`, it returns the `subset` of the input.
+#' If `subset` is NULL and the input contains `var_label` and `var_choices`,
+#' it throws an error prompting to resolve delayed inputs.
 #' Otherwise, it returns the input as is.
 #'
 #' @param choices An object that contains choices.
 #' @return A vector of choices.
 #' @keywords internal
 get_choices <- function(choices) {
   if (inherits(choices, "delayed_data")) {
-    choices$subset
+    if (is.null(choices$subset)) {
+      if (!is.null(choices$var_label) && !is.null(choices$var_choices)) {
+        stop(
+          "Resolve delayed inputs by evaluating the code within the provided datasets.
+          Check ?teal.transform::resolve_delayed for more information."
+        )
+      } else {
+        stop("Subset is NULL and necessary fields are missing.")
+      }
+    } else {
+      choices$subset
+    }
   } else {
     choices
   }

diff --git a/man/get_choices.Rd b/man/get_choices.Rd