diff --git a/R/tm_g_ae_oview.R b/R/tm_g_ae_oview.R index 13f5858e..57a7b888 100644 --- a/R/tm_g_ae_oview.R +++ b/R/tm_g_ae_oview.R @@ -105,7 +105,7 @@ tm_g_ae_oview <- function(label, args <- as.list(environment()) - module( + ans <- module( label = label, server = srv_g_ae_oview, server_args = list( @@ -118,6 +118,9 @@ tm_g_ae_oview <- function(label, ui_args = args, datanames = c("ADSL", dataname) ) + # not bookmarkable: ui_g_decorate cannot be moved to server b/c of args$fontsize + attr(ans, "teal_bookmarkable") <- FALSE + ans } ui_g_ae_oview <- function(id, ...) { @@ -138,18 +141,7 @@ ui_g_ae_oview <- function(id, ...) { selected = args$arm_var$selected, multiple = FALSE ), - selectInput( - ns("arm_ref"), - "Control", - choices = args$arm_var$choices, - selected = args$arm_var$selected - ), - selectInput( - ns("arm_trt"), - "Treatment", - choices = args$arm_var$choices, - selected = args$arm_var$selected - ), + uiOutput(ns("container_arm")), selectInput( ns("flag_var_anl"), "Flags", @@ -209,6 +201,8 @@ srv_g_ae_oview <- function(id, checkmate::assert_class(isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + ns <- session$ns + iv <- reactive({ ANL <- data()[[dataname]] @@ -241,11 +235,36 @@ srv_g_ae_oview <- function(id, font_size <- decorate_output$font_size pws <- decorate_output$pws + output$container_arm <- renderUI({ + req(input$arm_var) + + ANL <- data()[[dataname]] + choices <- levels(ANL[[input$arm_var]]) + + trt_index <- if (length(choices) == 1) 1 else 2 + + tagList( + selectInput( + ns("arm_ref"), + "Control", + choices = choices, + selected = choices[1L] + ), + selectInput( + ns("arm_trt"), + "Treatment", + choices = choices, + selected = choices[trt_index] + ) + ) + }) + observeEvent(list(input$diff_ci_method, input$conf_level), { req(!is.null(input$diff_ci_method) && !is.null(input$conf_level)) diff_ci_method <- input$diff_ci_method conf_level <- input$conf_level - updateTextAreaInput(session, + updateTextAreaInput( + session, "foot", value = sprintf( "Note: %d%% CI is calculated using %s", @@ -255,32 +274,6 @@ srv_g_ae_oview <- function(id, ) }) - observeEvent(input$arm_var, ignoreNULL = TRUE, { - ANL <- data()[[dataname]] - arm_var <- input$arm_var - arm_val <- ANL[[arm_var]] - choices <- levels(arm_val) - - if (length(choices) == 1) { - trt_index <- 1 - } else { - trt_index <- 2 - } - - updateSelectInput( - session, - "arm_ref", - selected = choices[1], - choices = choices - ) - updateSelectInput( - session, - "arm_trt", - selected = choices[trt_index], - choices = choices - ) - }) - output_q <- shiny::debounce( millis = 200, r = reactive({ diff --git a/R/tm_g_ae_sub.R b/R/tm_g_ae_sub.R index bed0eda4..2a403dd9 100644 --- a/R/tm_g_ae_sub.R +++ b/R/tm_g_ae_sub.R @@ -76,7 +76,7 @@ tm_g_ae_sub <- function(label, lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width" ) - module( + ans <- module( label = label, server = srv_g_ae_sub, server_args = list( @@ -93,6 +93,9 @@ tm_g_ae_sub <- function(label, ), datanames = c("ADSL", dataname) ) + # not bookmarkable: ui_g_decorate cannot be moved to server b/c of args$fontsize + attr(ans, "teal_bookmarkable") <- FALSE + ans } ui_g_ae_sub <- function(id, ...) { @@ -114,18 +117,7 @@ ui_g_ae_sub <- function(id, ...) { choices = args$arm_var$choices, selected = args$arm_var$selected ), - selectInput( - ns("arm_trt"), - "Treatment", - choices = args$arm_var$choices, - selected = args$arm_var$selected - ), - selectInput( - ns("arm_ref"), - "Control", - choices = args$arm_var$choices, - selected = args$arm_var$selected - ), + uiOutput(ns("arm_container")), checkboxInput( ns("arm_n"), "Show N in each arm", @@ -186,6 +178,8 @@ srv_g_ae_sub <- function(id, checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + ns <- session$ns + iv <- reactive({ ANL <- data()[[dataname]] ADSL <- data()[["ADSL"]] @@ -223,7 +217,8 @@ srv_g_ae_sub <- function(id, font_size <- decorate_output$font_size pws <- decorate_output$pws - observeEvent(input$arm_var, ignoreNULL = TRUE, { + output$arm_container <- renderUI({ + req(input$arm_var) arm_var <- input$arm_var ANL <- data()[[dataname]] @@ -236,17 +231,9 @@ srv_g_ae_sub <- function(id, ref_index <- 2 } - updateSelectInput( - session, - "arm_trt", - selected = choices[1], - choices = choices - ) - updateSelectInput( - session, - "arm_ref", - selected = choices[ref_index], - choices = choices + tagList( + selectInput(ns("arm_trt"), "Treatment", choices = choices, selected = choices[1L]), + selectInput(ns("arm_ref"), "Control", choices = choices, selected = choices[ref_index]) ) }) @@ -271,34 +258,32 @@ srv_g_ae_sub <- function(id, observeEvent(input$groups, { ANL <- data()[[dataname]] output$grouplabel_output <- renderUI({ - grps <- input$groups + grps <- req(input$groups) lo <- lapply(seq_along(grps), function(index) { grp <- grps[index] choices <- levels(ANL[[grp]]) sel <- teal.widgets::optionalSelectInput( - session$ns(sprintf("groups__%s", index)), + ns(sprintf("groups__%s", index)), grp, choices, multiple = TRUE, selected = choices ) textname <- sprintf("text_%s_out", index) - txt <- uiOutput(session$ns(textname)) + txt <- uiOutput(ns(textname)) observeEvent( eventExpr = input[[sprintf("groups__%s", index)]], handlerExpr = { output[[textname]] <- renderUI({ - if (!is.null(input[[sprintf("groups__%s", index)]])) { - l <- input[[sprintf("groups__%s", index)]] - l2 <- lapply(seq_along(l), function(i) { + grps <- req(input[[sprintf("groups__%s", index)]]) + if (!is.null(grps)) { + l2 <- lapply(seq_along(grps), function(i) { nm <- sprintf("groups__%s__level__%s", index, i) - label <- sprintf("Label for %s, Level %s", grp, l[i]) - textInput(session$ns(nm), label, l[i]) + label <- sprintf("Label for %s, Level %s", grp, grps[i]) + textInput(ns(nm), label, grps[i]) }) tagList(textInput( - session$ns( - sprintf("groups__%s__level__%s", index, "all") - ), + ns(sprintf("groups__%s__level__%s", index, "all")), sprintf("Label for %s", grp), grp ), l2) } diff --git a/R/tm_g_butterfly.R b/R/tm_g_butterfly.R index 6f0dd025..aba14443 100644 --- a/R/tm_g_butterfly.R +++ b/R/tm_g_butterfly.R @@ -146,7 +146,7 @@ tm_g_butterfly <- function(label, args <- as.list(environment()) - module( + ans <- module( label = label, datanames = c("ADSL", dataname), server = srv_g_butterfly, @@ -154,6 +154,8 @@ tm_g_butterfly <- function(label, ui = ui_g_butterfly, ui_args = args ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } ui_g_butterfly <- function(id, ...) { @@ -187,16 +189,7 @@ ui_g_butterfly <- function(id, ...) { a$right_var$selected, multiple = FALSE ), - teal.widgets::optionalSelectInput( - ns("right_val"), - "Choose Up To 2:", - multiple = TRUE, - options = list( - `max-options` = 2L, - `max-options-text` = "no more than 2", - `actions-box` = FALSE - ) - ), + uiOutput(ns("right_val_container")), teal.widgets::optionalSelectInput( ns("left_var"), "Left Dichotomization Variable", @@ -204,16 +197,7 @@ ui_g_butterfly <- function(id, ...) { a$left_var$selected, multiple = FALSE ), - teal.widgets::optionalSelectInput( - ns("left_val"), - "Choose Up To 2:", - multiple = TRUE, - options = list( - `max-options` = 2L, - `max-options-text` = "no more than 2", - `actions-box` = FALSE - ) - ), + uiOutput(ns("left_val_container")), teal.widgets::optionalSelectInput( ns("category_var"), "Category Variable", @@ -270,6 +254,8 @@ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, labe checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + ns <- session$ns + iv <- reactive({ ADSL <- data()[["ADSL"]] ANL <- data()[[dataname]] @@ -303,83 +289,99 @@ srv_g_butterfly <- function(id, data, filter_panel_api, reporter, dataname, labe options <- reactiveValues(r = NULL, l = NULL) vars <- reactiveValues(r = NULL, l = NULL) - # dynamic options for dichotomization variable - observeEvent(input$right_var, - handlerExpr = { - right_var <- input$right_var - right_val <- isolate(input$right_val) - current_r_var <- isolate(vars$r) - if (is.null(right_var)) { - teal.widgets::updateOptionalSelectInput( - session, - "right_val", - choices = character(0), - selected = character(0) - ) + # Dynamic UI for dichotomization variables. + output$right_val_container <- renderUI({ + req(input$right_var) + + right_var <- input$right_var + right_val <- isolate(input$right_val) + current_r_var <- isolate(vars$r) + + if (is.null(right_var)) { + choices <- character(0L) + selected <- character(0L) + } else { + options$r <- if (right_var %in% names(data()[["ADSL"]])) { + levels(data()[["ADSL"]][[right_var]]) } else { - options$r <- if (right_var %in% names(data()[["ADSL"]])) { - levels(data()[["ADSL"]][[right_var]]) - } else { - levels(data()[[dataname]][[right_var]]) - } + levels(data()[[dataname]][[right_var]]) + } + choices <- options$r - selected <- if (length(right_val) > 0) { - left_over <- right_val[right_val %in% options$r] - if (length(left_over) > 0 && !is.null(current_r_var) && current_r_var == right_var) { - left_over - } else { - options$r[1] - } + selected <- if (length(right_val) > 0) { + left_over <- right_val[right_val %in% options$r] + if (length(left_over) > 0 && !is.null(current_r_var) && current_r_var == right_var) { + left_over } else { options$r[1] } - teal.widgets::updateOptionalSelectInput( - session, "right_val", - choices = as.character(options$r), selected = selected, label = "Choose Up To 2:" - ) + } else { + options$r[1] } - vars$r <- right_var - }, - ignoreNULL = FALSE - ) + } - observeEvent(input$left_var, - handlerExpr = { - left_var <- input$left_var - left_val <- isolate(input$left_val) - current_l_var <- isolate(vars$l) - if (is.null(left_var)) { - teal.widgets::updateOptionalSelectInput( - session, "left_val", - choices = character(0), selected = character(0) - ) + vars$r <- right_var + + teal.widgets::optionalSelectInput( + inputId = ns("right_val"), + label = "Choose Up To 2:", + choices = choices, + selected = selected, + multiple = TRUE, + options = list( + `max-options` = 2L, + `max-options-text` = "no more than 2", + `actions-box` = FALSE + ) + ) + }) + + + output$left_val_container <- renderUI({ + req(input$left_var) + + left_var <- input$left_var + left_val <- isolate(input$left_val) + current_l_var <- isolate(vars$l) + + if (is.null(left_var)) { + choices <- character(0L) + selected <- character(0L) + } else { + options$l <- if (left_var %in% names(data()[["ADSL"]])) { + levels(data()[["ADSL"]][[left_var]]) } else { - options$l <- if (left_var %in% names(data()[["ADSL"]])) { - levels(data()[["ADSL"]][[left_var]]) - } else { - levels(data()[[dataname]][[left_var]]) - } + levels(data()[[dataname]][[left_var]]) + } + choices <- options$l - selected <- if (length(left_val) > 0) { - left_over <- left_val[left_val %in% options$l] - if (length(left_over) > 0 && !is.null(current_l_var) && current_l_var == left_var) { - left_over - } else { - options$l[1] - } + selected <- if (length(left_val) > 0) { + left_over <- left_val[left_val %in% options$l] + if (length(left_over) > 0 && !is.null(current_l_var) && current_l_var == left_var) { + left_over } else { options$l[1] } - - teal.widgets::updateOptionalSelectInput( - session, "left_val", - choices = as.character(options$l), selected = selected, label = "Choose Up To 2:" - ) + } else { + options$l[1] } - vars$l <- left_var - }, - ignoreNULL = FALSE - ) + } + + vars$l <- left_var + + teal.widgets::optionalSelectInput( + ns("left_val"), + "Choose Up To 2:", + choices = choices, + selected = selected, + multiple = TRUE, + options = list( + `max-options` = 2L, + `max-options-text` = "no more than 2", + `actions-box` = FALSE + ) + ) + }) output_q <- shiny::debounce( millis = 200, diff --git a/R/tm_g_events_term_id.R b/R/tm_g_events_term_id.R index 2539762b..609b80af 100644 --- a/R/tm_g_events_term_id.R +++ b/R/tm_g_events_term_id.R @@ -86,7 +86,7 @@ tm_g_events_term_id <- function(label, args <- as.list(environment()) - module( + ans <- module( label = label, server = srv_g_events_term_id, server_args = list(label = label, dataname = dataname, plot_height = plot_height, plot_width = plot_width), @@ -94,6 +94,9 @@ tm_g_events_term_id <- function(label, ui_args = args, datanames = c("ADSL", dataname) ) + # not bookmarkable: ui_g_decorate cannot be moved to server b/c of args$fontsize + attr(ans, "teal_bookmarkable") <- FALSE + ans } ui_g_events_term_id <- function(id, ...) { @@ -119,18 +122,7 @@ ui_g_events_term_id <- function(id, ...) { choices = args$arm_var$choices, selected = args$arm_var$selected ), - selectInput( - ns("arm_ref"), - "Control", - choices = args$arm_var$choices, - selected = args$arm_var$selected - ), - selectInput( - ns("arm_trt"), - "Treatment", - choices = args$arm_var$choices, - selected = args$arm_var$selected - ), + uiOutput(ns("container_arm")), teal.widgets::optionalSelectInput( ns("sort"), "Sort By", @@ -214,6 +206,8 @@ srv_g_events_term_id <- function(id, checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + ns <- session$ns + iv <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("term", shinyvalidate::sv_required( @@ -252,7 +246,6 @@ srv_g_events_term_id <- function(id, ) }) - observeEvent(input$sort, { sort <- if (is.null(input$sort)) " " else input$sort @@ -273,34 +266,29 @@ srv_g_events_term_id <- function(id, ignoreNULL = FALSE ) - observeEvent(input$arm_var, - { - arm_var <- input$arm_var - ANL <- data()[[dataname]] + output$container_arm <- renderUI({ + req(input$arm_var) - choices <- levels(ANL[[arm_var]]) + ANL <- data()[[dataname]] + choices <- levels(ANL[[input$arm_var]]) - if (length(choices) == 1) { - trt_index <- 1 - } else { - trt_index <- 2 - } + trt_index <- if (length(choices) == 1) 1 else 2 - updateSelectInput( - session, - "arm_ref", - selected = choices[1], - choices = choices - ) - updateSelectInput( - session, - "arm_trt", - selected = choices[trt_index], - choices = choices + tagList( + selectInput( + ns("arm_ref"), + "Control", + choices = choices, + selected = choices[1L] + ), + selectInput( + ns("arm_trt"), + "Treatment", + choices = choices, + selected = choices[trt_index] ) - }, - ignoreNULL = TRUE - ) + ) + }) output_q <- reactive({ ANL <- data()[[dataname]] diff --git a/R/tm_g_heat_bygrade.R b/R/tm_g_heat_bygrade.R index 904ae79c..2e2cfa31 100644 --- a/R/tm_g_heat_bygrade.R +++ b/R/tm_g_heat_bygrade.R @@ -166,7 +166,7 @@ tm_g_heat_bygrade <- function(label, .var.name = "plot_width" ) - module( + ans <- module( label = label, server = srv_g_heatmap_bygrade, server_args = list( @@ -182,6 +182,8 @@ tm_g_heat_bygrade <- function(label, ui_args = args, datanames = "all" ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } ui_g_heatmap_bygrade <- function(id, ...) { @@ -253,13 +255,7 @@ ui_g_heatmap_bygrade <- function(id, ...) { selected = args$conmed_var$selected, multiple = FALSE ), - selectInput( - ns("conmed_level"), - "Conmed Levels", - choices = args$conmed_var$choices, - selected = args$conmed_var$selected, - multiple = TRUE - ) + uiOutput(ns("container_conmed_level")) ), ui_g_decorate( ns(NULL), @@ -297,6 +293,8 @@ srv_g_heatmap_bygrade <- function(id, if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data)) moduleServer(id, function(input, output, session) { + ns <- session$ns + iv <- reactive({ ADSL <- data()[[sl_dataname]] ADEX <- data()[[ex_dataname]] @@ -380,19 +378,21 @@ srv_g_heatmap_bygrade <- function(id, font_size <- decorate_output$font_size pws <- decorate_output$pws - if (!is.na(cm_dataname)) { - observeEvent(input$conmed_var, { - ADCM <- data()[[cm_dataname]] - choices <- levels(ADCM[[input$conmed_var]]) + output$container_conmed_level <- renderUI({ + req(!is.na(cm_dataname)) + req(input$conmed_var) - updateSelectInput( - session, - "conmed_level", - selected = choices[1:3], - choices = choices - ) - }) - } + ADCM <- data()[[cm_dataname]] + choices <- levels(ADCM[[input$conmed_var]]) + + selectInput( + ns("conmed_level"), + "Conmed Levels", + choices = choices, + selected = choices[1:3], + multiple = TRUE + ) + }) output_q <- shiny::debounce( millis = 200, diff --git a/R/tm_g_patient_profile.R b/R/tm_g_patient_profile.R index dd3ba667..42d98136 100644 --- a/R/tm_g_patient_profile.R +++ b/R/tm_g_patient_profile.R @@ -185,7 +185,7 @@ tm_g_patient_profile <- function(label = "Patient Profile Plot", .var.name = "plot_width" ) - module( + ans <- module( label = label, ui = ui_g_patient_profile, ui_args = args, @@ -204,6 +204,8 @@ tm_g_patient_profile <- function(label = "Patient Profile Plot", ), datanames = "all" ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } ui_g_patient_profile <- function(id, ...) { @@ -310,13 +312,7 @@ ui_g_patient_profile <- function(id, ...) { selected = a$lb_var$selected, multiple = FALSE ), - selectInput( - ns("lb_var_show"), - "Lab values", - choices = a$lb_var$choices, - selected = a$lb_var$selected, - multiple = TRUE - ) + uiOutput(ns("container_lb_var_show")), ), textInput( ns("x_limit"), @@ -362,25 +358,30 @@ srv_g_patient_profile <- function(id, if (!is.na(lb_dataname)) checkmate::assert_names(lb_dataname, subset.of = names(data)) if (!is.na(cm_dataname)) checkmate::assert_names(cm_dataname, subset.of = names(data)) checkboxes <- c(ex_dataname, ae_dataname, rs_dataname, lb_dataname, cm_dataname) + moduleServer(id, function(input, output, session) { + ns <- session$ns + select_plot <- reactive( vapply(checkboxes, function(x) x %in% input$select_ADaM, logical(1L)) ) - if (!is.na(lb_dataname)) { - observeEvent(input$lb_var, ignoreNULL = TRUE, { - ADLB <- data()[[lb_dataname]] - choices <- unique(ADLB[[input$lb_var]]) - choices_selected <- if (length(choices) > 5) choices[1:5] else choices - - updateSelectInput( - session, - "lb_var_show", - selected = choices_selected, - choices = choices - ) - }) - } + + output$container_lb_var_show <- renderUI({ + req(!is.na(lb_dataname)) + req(input$lb_var) + + ADLB <- data()[[lb_dataname]] + choices <- unique(ADLB[[input$lb_var]]) + + selectInput( + ns("lb_var_show"), + "Lab values", + choices = choices, + selected = choices[1:5], + multiple = TRUE + ) + }) iv <- reactive({ iv <- shinyvalidate::InputValidator$new() diff --git a/R/tm_g_spiderplot.R b/R/tm_g_spiderplot.R index 6f917fea..092806e5 100644 --- a/R/tm_g_spiderplot.R +++ b/R/tm_g_spiderplot.R @@ -120,7 +120,7 @@ tm_g_spiderplot <- function(label, ) args <- as.list(environment()) - module( + ans <- module( label = label, datanames = c("ADSL", dataname), server = srv_g_spider, @@ -128,6 +128,8 @@ tm_g_spiderplot <- function(label, ui = ui_g_spider, ui_args = args ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } ui_g_spider <- function(id, ...) { diff --git a/R/tm_g_swimlane.R b/R/tm_g_swimlane.R index 90a2871a..bad1d7ef 100644 --- a/R/tm_g_swimlane.R +++ b/R/tm_g_swimlane.R @@ -148,7 +148,7 @@ tm_g_swimlane <- function(label, checkmate::assert_string(x_label) - module( + ans <- module( label = label, ui = ui_g_swimlane, ui_args = args, @@ -167,6 +167,8 @@ tm_g_swimlane <- function(label, ), datanames = c("ADSL", dataname) ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } @@ -280,6 +282,8 @@ srv_g_swimlane <- function(id, checkmate::assert_class(shiny::isolate(data()), "teal_data") moduleServer(id, function(input, output, session) { + ns <- session$ns + iv <- reactive({ iv <- shinyvalidate::InputValidator$new() iv$add_rule("bar_var", shinyvalidate::sv_required( @@ -298,7 +302,6 @@ srv_g_swimlane <- function(id, if (dataname == "ADSL" || is.null(marker_shape_var) || is.null(input$marker_pos_var)) { NULL } else { - ns <- session$ns teal.widgets::optionalSelectInput( ns("marker_shape_var"), "Marker Shape", choices = marker_shape_var$choices, @@ -311,7 +314,6 @@ srv_g_swimlane <- function(id, if (dataname == "ADSL" || is.null(marker_color_var) || is.null(input$marker_pos_var)) { NULL } else { - ns <- session$ns teal.widgets::optionalSelectInput( ns("marker_color_var"), "Marker Color", choices = marker_color_var$choices, diff --git a/R/tm_g_waterfall.R b/R/tm_g_waterfall.R index 1ab5d15d..2cbde96c 100644 --- a/R/tm_g_waterfall.R +++ b/R/tm_g_waterfall.R @@ -131,7 +131,7 @@ tm_g_waterfall <- function(label, args <- as.list(environment()) - module( + ans <- module( label = label, ui = ui_g_waterfall, ui_args = args, @@ -146,6 +146,8 @@ tm_g_waterfall <- function(label, ), datanames = "all" ) + attr(ans, "teal_bookmarkable") <- TRUE + ans } ui_g_waterfall <- function(id, ...) {