From 1a4abebac2c5ed131e2e8290f92db06184d2a1a4 Mon Sep 17 00:00:00 2001 From: Pavel Demin Date: Fri, 8 Nov 2024 14:05:12 +0000 Subject: [PATCH 1/3] fix: avoid id collision for "Submit Order Details" --- inst/shiny/modules/tab_tlg.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index a63701a..bdbf220 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -8,7 +8,7 @@ tab_tlg_ui <- function(id) { actionButton(ns("remove_tlg"), "Remove TLG"), actionButton(ns("submit_tlg_order"), "Submit Order Details"), DTOutput(ns("selected_tlg_table")), - actionButton(ns("submit_tlg_order"), "Submit Order Details") + actionButton(ns("submit_tlg_order_alt"), "Submit Order Details") ), tabPanel( "Tables", @@ -239,7 +239,7 @@ tab_tlg_server <- function(id, data) { }) # When the user submits the TLG order... - observeEvent(input$submit_tlg_order, { + observeEvent(list(input$submit_tlg_order, input$submit_tlg_order_alt), { tlg_order_filt <- tlg_order()[tlg_order()$Selection, ] if (sum(tlg_order_filt$Type == "Table") > 0) { From eca47e62aeaed3c5d446b4f8d5664f29d001970e Mon Sep 17 00:00:00 2001 From: Pavel Demin Date: Fri, 8 Nov 2024 14:16:39 +0000 Subject: [PATCH 2/3] fix: conditional panel correct ids the problem is that the condition argument is evaluated in JavaScript, where a dot is a way to index into an object. However, these keys are clearly undefined, hence an error. --- inst/shiny/tabs/nca.R | 24 ++++++++++++------------ inst/shiny/ui.R | 16 ++++++++-------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index 0f4ed54..bbd7e60 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -135,7 +135,7 @@ observeEvent(input$settings_upload, { # RSADJ if (!is.na(setts$adj.r.squared_threshold[1])) { - updateCheckboxInput(session, inputId = "rule_adj.r.squared", label = "RSQADJ:", value = TRUE) + updateCheckboxInput(session, inputId = "rule_adj_r_squared", label = "RSQADJ:", value = TRUE) updateNumericInput( session, "adj.r.squared_threshold", @@ -143,31 +143,31 @@ observeEvent(input$settings_upload, { value = setts$adj.r.squared_threshold[1] ) } else { - updateCheckboxInput(session, inputId = "rule_adj.r.squared", label = "RSQADJ:", value = FALSE) + updateCheckboxInput(session, inputId = "rule_adj_r_squared", label = "RSQADJ:", value = FALSE) } # AUCPE.Obs if (!is.na(setts$aucpext.obs_threshold[1])) { - updateCheckboxInput(session, inputId = "rule_aucpext.obs", value = TRUE) + updateCheckboxInput(session, inputId = "rule_aucpext_obs", value = TRUE) updateNumericInput(session, "aucpext.obs_threshold", value = setts$aucpext.obs_threshold[1]) } else { - updateCheckboxInput(session, inputId = "rule_aucpext.obs", label = "", value = FALSE) + updateCheckboxInput(session, inputId = "rule_aucpext_obs", label = "", value = FALSE) } # AUCPE.Pred if (!is.na(setts$aucpext.pred_threshold[1])) { - updateCheckboxInput(session, inputId = "rule_aucpext.pred", value = TRUE) + updateCheckboxInput(session, inputId = "rule_aucpext_pred", value = TRUE) updateNumericInput(session, "aucpext.pred_threshold", value = setts$aucpext.pred_threshold[1]) } else { - updateCheckboxInput(session, inputId = "rule_aucpext.pred", value = FALSE) + updateCheckboxInput(session, inputId = "rule_aucpext_pred", value = FALSE) } # SPAN if (!is.na(setts$span.ratio_threshold[1])) { - updateCheckboxInput(session, inputId = "rule_span.ratio", label = "SPAN: ", value = TRUE) + updateCheckboxInput(session, inputId = "rule_span_ratio", label = "SPAN: ", value = TRUE) updateNumericInput(session, "span.ratio_threshold", "", value = setts$span.ratio_threshold[1]) } else { - updateCheckboxInput(session, inputId = "rule_span.ratio", label = "SPAN:", value = FALSE) + updateCheckboxInput(session, inputId = "rule_span_ratio", label = "SPAN:", value = FALSE) } }) @@ -609,16 +609,16 @@ output$settings_save <- downloadHandler( ), method = input$method, adj.r.squared_threshold = ifelse( - input$rule_adj.r.squared, input$adj.r.squared_threshold, NA + input$rule_adj_r_squared, input$adj.r.squared_threshold, NA ), aucpext.obs_threshold = ifelse( - input$rule_aucpext.obs, input$aucpext.obs_threshold, NA + input$rule_aucpext_obs, input$aucpext.obs_threshold, NA ), aucpext.pred_threshold = ifelse( - input$rule_aucpext.pred, input$aucpext.pred_threshold, NA + input$rule_aucpext_pred, input$aucpext.pred_threshold, NA ), span.ratio_threshold = ifelse( - input$rule_span.ratio, input$span.ratio_threshold, NA + input$rule_span_ratio, input$span.ratio_threshold, NA ), auc_mins = if (is.null(auc_mins)) NA else paste(auc_mins, collapse = ","), auc_maxs = if (is.null(auc_maxs)) NA else paste(auc_maxs, collapse = ",") diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index ebd0411..5b327d8 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -82,12 +82,12 @@ fluidPage( fluidRow( column( width = 6, - checkboxInput("rule_adj.r.squared", "RSQADJ:") + checkboxInput("rule_adj_r_squared", "RSQADJ:") ), column( width = 6, conditionalPanel( - condition = "input.rule_adj.r.squared == true", + condition = "input.rule_adj_r_squared == true", div( style = "display: flex; align-items: center;", span(">=", style = "margin-right: 5px;"), @@ -106,12 +106,12 @@ fluidPage( fluidRow( column( width = 6, - checkboxInput("rule_aucpext.obs", "AUCPEO (% ext.observed): ") + checkboxInput("rule_aucpext_obs", "AUCPEO (% ext.observed): ") ), column( width = 6, conditionalPanel( - condition = "input.rule_aucpext.obs == true", + condition = "input.rule_aucpext_obs == true", div( style = "display: flex; align-items: center;", span(">=", style = "margin-right: 5px;"), @@ -130,12 +130,12 @@ fluidPage( fluidRow( column( width = 6, - checkboxInput("rule_aucpext.pred", "AUCPEP (% ext.predicted): "), + checkboxInput("rule_aucpext_pred", "AUCPEP (% ext.predicted): "), ), column( width = 6, conditionalPanel( - condition = "input.rule_aucpext.pred == true", + condition = "input.rule_aucpext_pred == true", div( style = "display: flex; align-items: center;", span(">=", style = "margin-right: 5px;"), @@ -154,12 +154,12 @@ fluidPage( fluidRow( column( width = 6, - checkboxInput("rule_span.ratio", "SPAN: "), + checkboxInput("rule_span_ratio", "SPAN: "), ), column( width = 6, conditionalPanel( - condition = "input.rule_span.ratio == true", + condition = "input.rule_span_ratio == true", div( style = "display: flex; align-items: center;", span(">=", style = "margin-right: 5px;"), From d5d0187df49fdcffa4c014afcb37ae169d4b7f5a Mon Sep 17 00:00:00 2001 From: Pavel Demin Date: Fri, 8 Nov 2024 14:52:31 +0000 Subject: [PATCH 3/3] fix: replace dots with underscores in rule_* inputs this way used ids will conform with the statistical outputs --- inst/shiny/tabs/nca.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index bbd7e60..8f9d72b 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -447,7 +447,9 @@ observeEvent(res_nca(), { for (rule_input in grep("^rule_", names(input), value = TRUE)) { if (!input[[rule_input]]) next - pptestcd <- gsub("rule_", "", rule_input) + pptestcd <- rule_input |> + gsub("^rule_", "", x = _) |> + gsub("_", ".", x = _, fixed = TRUE) if (startsWith(pptestcd, "auc")) { final_res_nca[[paste0("flag_", pptestcd)]] <- { final_res_nca[[pptestcd]] >= input[[paste0(pptestcd, "_threshold")]]