From 410a48f3ca30036ab377c79434e37a3ce3f989b1 Mon Sep 17 00:00:00 2001 From: kartikeya kirar Date: Mon, 24 Jun 2024 11:17:06 +0530 Subject: [PATCH] Fixing bugs (#276) this is part of https://github.com/insightsengineering/coredev-tasks/issues/567 Here bugs are resolved found here - [x] resolved delayed data cases based on https://github.com/insightsengineering/coredev-tasks/issues/558 - [x] Added get_choices function. --- R/tm_g_patient_profile.R | 18 ++++++++++++++---- R/tm_g_spiderplot.R | 24 +++++++++++++++++++----- R/tm_g_waterfall.R | 38 +++++++++++++++++++++++++++++++------- R/utils.R | 15 ++++++++++++++- man/get_choices.Rd | 2 ++ 5 files changed, 80 insertions(+), 17 deletions(-) diff --git a/R/tm_g_patient_profile.R b/R/tm_g_patient_profile.R index 998874aa..483b63eb 100644 --- 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 index d332affe..7a0d26b0 100644 --- 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,7 +239,7 @@ 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") @@ -244,6 +247,17 @@ srv_g_spider <- function(id, data, filter_panel_api, reporter, dataname, label, 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 index 6982d979..6d6c5b55 100644 --- 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 index 1cc1813c..a7027b18 100644 --- a/R/utils.R +++ b/R/utils.R @@ -135,6 +135,8 @@ 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. @@ -142,7 +144,18 @@ include_css_files <- function(pattern = "*") { #' @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 index 56cd5af1..a4e7229e 100644 --- a/man/get_choices.Rd +++ b/man/get_choices.Rd @@ -15,6 +15,8 @@ A vector of choices. \description{ This function returns choices based on the class of the input. If the input is of class \code{delayed_data}, it returns the \code{subset} of the input. +If \code{subset} is NULL and the input contains \code{var_label} and \code{var_choices}, +it throws an error prompting to resolve delayed inputs. Otherwise, it returns the input as is. } \keyword{internal}