From 984f383171f9c61101b5049487073bc46e036ca9 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 27 Feb 2025 13:34:45 +0100 Subject: [PATCH] more improvements to the REDCap module --- R/app_version.R | 2 +- R/redcap_read_shiny_module.R | 216 ++++++++++++++++++-------- inst/apps/freesearcheR/app.R | 265 +++++++++++++++++++++----------- inst/apps/freesearcheR/server.R | 12 +- inst/apps/freesearcheR/ui.R | 35 +++-- 5 files changed, 358 insertions(+), 172 deletions(-) diff --git a/R/app_version.R b/R/app_version.R index 0dade20..dab7d5b 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250226_2108' +app_version <- function()'250227_1333' diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index b224f28..737f223 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -12,26 +12,38 @@ m_redcap_readUI <- function(id, include_title = TRUE) { server_ui <- shiny::tagList( # width = 6, - shiny::tags$h4("REDCap server information"), + shiny::tags$h4("REDCap server"), shiny::textInput( inputId = ns("uri"), - label = "URI/Address", - value = "https://redcap.your.institution/api/" + label = "Web address", + value = "https://redcap.your.institution/" ), + shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::textInput( inputId = ns("api"), label = "API token", value = "" ), + shiny::helpText("The token is a string of 32 numbers and letters."), + shiny::actionButton( + inputId = ns("data_connect"), + label = "Connect", + icon = shiny::icon("link", lib = "glyphicon"), + # width = NULL, + disabled = TRUE + ), + shiny::br(), + shiny::br(), tags$div( id = ns("connect-placeholder"), shinyWidgets::alert( id = ns("connect-result"), status = "info", - tags$p(phosphoricons::ph("info", weight = "bold"),"Please fill in server address (URI) and API token.") + tags$p(phosphoricons::ph("info", weight = "bold"), "Please fill in server address (URI) and API token, then press 'Connect'.") ), dismissible = TRUE - ) + ), + shiny::br() ) @@ -74,27 +86,35 @@ m_redcap_readUI <- function(id, include_title = TRUE) { width = 12, # shiny::actionButton(inputId = ns("import"), label = "Import"), ## TODO: Use busy indicator like on download to have button activate/deactivate - bslib::input_task_button( - id = ns("data_import"), + shiny::actionButton( + inputId = ns("data_import"), label = "Import", icon = shiny::icon("download", lib = "glyphicon"), - label_busy = "Just a minute...", - icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" - ), - type = "primary", - auto_reset = TRUE#,state="busy" + width = "100%", + disabled = TRUE ), + # bslib::input_task_button( + # id = ns("data_import"), + # label = "Import", + # icon = shiny::icon("download", lib = "glyphicon"), + # label_busy = "Just a minute...", + # icon_busy = fontawesome::fa_i("arrows-rotate", + # class = "fa-spin", + # "aria-hidden" = "true" + # ), + # type = "primary", + # auto_reset = TRUE#,state="busy" + # ), shiny::br(), shiny::br(), - shiny::helpText("Press 'Import' after having specified API token and URI to export data from the REDCap server. A preview will show below the DataDictionary."), + shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."), shiny::br(), shiny::br() ) ) } + #' @rdname redcap_read_shiny_module #' #' @return shiny server module @@ -107,25 +127,38 @@ m_redcap_readServer <- function(id) { data_rv <- shiny::reactiveValues( dd_status = NULL, data_status = NULL, + uri = NULL, + project_name = NULL, info = NULL, arms = NULL, dd_list = NULL, data = NULL ) - # tryCatch( - # { + shiny::observeEvent(list(input$api, input$uri), { + uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/") + + if (is_valid_redcap_url(uri) & is_valid_token(input$api)) { + data_rv$uri <- uri + shiny::updateActionButton(inputId = "data_connect", disabled = FALSE) + } else { + shiny::updateActionButton(inputId = "data_connect", disabled = TRUE) + } + }) + + + tryCatch( + { shiny::observeEvent( list( - input$api, - input$uri + input$data_connect ), { shiny::req(input$api) - shiny::req(input$uri) + shiny::req(data_rv$uri) parameters <- list( - redcap_uri = input$uri, + redcap_uri = data_rv$uri, token = input$api ) @@ -134,42 +167,46 @@ m_redcap_readServer <- function(id) { ## TODO: Simplify error messages if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { - if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { mssg <- imported$raw_text } else { mssg <- attr(imported, "condition")$message } - datamods:::insert_error(mssg = mssg,selector = "connect") + datamods:::insert_error(mssg = mssg, selector = "connect") data_rv$dd_status <- "error" data_rv$dd_list <- NULL } else if (isTRUE(imported$success)) { + data_rv$dd_status <- "success" + + data_rv$project_name <- REDCapR::redcap_project_info_read( + redcap_uri = data_rv$uri, + token = input$api + )$data$project_title datamods:::insert_alert( selector = ns("connect"), status = "success", make_success_alert( dataIdName = "see_data", - extra = tags$b(phosphoricons::ph("check", weight = "bold"),"Connected to server! Project data loaded."), + extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$project_name, " loaded."))), btn_show_data = TRUE ) ) - data_rv$dd_status <- "success" data_rv$dd_list <- imported } }, ignoreInit = TRUE ) - # }, - # warning = function(warn) { - # showNotification(paste0(warn), type = "warning") - # }, - # error = function(err) { - # showNotification(paste0(err), type = "err") - # } - # ) + }, + warning = function(warn) { + showNotification(paste0(warn), type = "warning") + }, + error = function(err) { + showNotification(paste0(err), type = "err") + } + ) shiny::observeEvent(input$see_data, { datamods::show_data( @@ -178,15 +215,15 @@ m_redcap_readServer <- function(id) { type = "modal", show_classes = FALSE, tags$b("Preview:") - ) + ) }) arms <- shiny::reactive({ shiny::req(input$api) - shiny::req(input$uri) + shiny::req(data_rv$uri) REDCapR::redcap_event_read( - redcap_uri = input$uri, + redcap_uri = data_rv$uri, token = input$api )$data }) @@ -195,31 +232,26 @@ m_redcap_readServer <- function(id) { shiny::req(data_rv$dd_list) shinyWidgets::virtualSelectInput( inputId = ns("fields"), - label = "Select fields/variables to import:", + label = "Select variables to import:", choices = purrr::pluck(data_rv$dd_list, "data") |> dplyr::select(field_name, form_name) |> (\(.x){ split(.x$field_name, .x$form_name) - })() - , - updateOn = "close", + })(), + updateOn = "change", multiple = TRUE, search = TRUE, showValueAsTags = TRUE ) }) - ## TODO: Get activate/inactivate action button to work - # shiny::observeEvent(input$fields, - # { - # if (is.null(input$fields) | length(input$fields)==1){ - # bslib::update_task_button(id= "data_import", state = "busy") - # # datamods:::toggle_widget(inputId = "data_import", enable = FALSE) - # } else { - # bslib::update_task_button(id= "data_import", state = "ready") - # # datamods:::toggle_widget(inputId = "data_import", enable = TRUE) - # } - # }) + shiny::observeEvent(input$fields, { + if (is.null(input$fields) | length(input$fields) == 0) { + shiny::updateActionButton(inputId = "data_import", disabled = TRUE) + } else { + shiny::updateActionButton(inputId = "data_import", disabled = FALSE) + } + }) output$arms <- shiny::renderUI({ shiny::selectizeInput( @@ -231,24 +263,12 @@ m_redcap_readServer <- function(id) { ) }) - ## Merge project name in success meassage - ## Generate Codebook link - name <- shiny::reactive({ - if (data_rv$dd_status=="success"){ - # browser() - REDCapR::redcap_project_info_read( - redcap_uri = input$uri, - token = input$api - )$data$project_title} - }) - - shiny::observeEvent(input$data_import, { shiny::req(input$fields) record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1] parameters <- list( - uri = input$uri, + uri = data_rv$uri, token = input$api, fields = unique(c(record_id, input$fields)), events = input$arms, @@ -256,12 +276,13 @@ m_redcap_readServer <- function(id) { filter_logic = input$filter ) - imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) + shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", { + imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) + }) code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters) if (inherits(imported, "try-error") || NROW(imported) < 1) { - data_rv$data_status <- "error" data_rv$data_list <- NULL } else { @@ -287,7 +308,7 @@ m_redcap_readServer <- function(id) { #' @importFrom shiny icon getDefaultReactiveDomain make_success_alert <- function(dataIdName = "see_data", btn_show_data, - see_data_text="Click to see data", + see_data_text = "Click to see data", extra = NULL, session = shiny::getDefaultReactiveDomain()) { if (isTRUE(btn_show_data)) { @@ -318,6 +339,67 @@ make_success_alert <- function(dataIdName = "see_data", # ) +#' Title +#' +#' @param url +#' +#' @returns +#' @export +#' +#' @examples +#' url <- c( +#' "www.example.com", +#' "http://example.com", +#' "https://redcap.your.inst/api/" +#' ) +#' is_valid_redcap_url(url) +is_valid_redcap_url <- function(url) { + pattern <- "https://[^ /$.?#].[^\\s]*/api/$" + stringr::str_detect(url, pattern) +} + +#' Validate REDCap token +#' +#' @param token token +#' @param pattern_env pattern +#' +#' @returns +#' @export +#' +#' @examples +#' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "") +#' is_valid_token(token) +is_valid_token <- function(token, pattern_env = NULL, nchar = 32) { + checkmate::assert_character(token, any.missing = TRUE, len = 1) + + if (!is.null(pattern_env)) { + checkmate::assert_character(pattern_env, + any.missing = FALSE, + len = 1 + ) + pattern <- pattern_env + } else { + pattern <- glue::glue("^([0-9A-Fa-f]{})(?:\\n)?$", + .open = "<", + .close = ">" + ) + } + + if (is.na(token)) { + out <- FALSE + } else if (is.null(token)) { + out <- FALSE + } else if (nchar(token) == 0L) { + out <- FALSE + } else if (!grepl(pattern, token, perl = TRUE)) { + out <- FALSE + } else { + out <- TRUE + } + out +} + + #' Test app for the redcap_read_shiny_module #' #' @rdname redcap_read_shiny_module diff --git a/inst/apps/freesearcheR/app.R b/inst/apps/freesearcheR/app.R index 3ca7fee..582ba77 100644 --- a/inst/apps/freesearcheR/app.R +++ b/inst/apps/freesearcheR/app.R @@ -10,7 +10,7 @@ #### Current file: R//app_version.R ######## -app_version <- function()'250226_2108' +app_version <- function()'250227_1333' ######## @@ -2356,26 +2356,38 @@ m_redcap_readUI <- function(id, include_title = TRUE) { server_ui <- shiny::tagList( # width = 6, - shiny::tags$h4("REDCap server information"), + shiny::tags$h4("REDCap server"), shiny::textInput( inputId = ns("uri"), - label = "URI/Address", - value = "https://redcap.your.institution/api/" + label = "Web address", + value = "https://redcap.your.institution/" ), + shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::textInput( inputId = ns("api"), label = "API token", value = "" ), + shiny::helpText("The token is a string of 32 numbers and letters."), + shiny::actionButton( + inputId = ns("data_connect"), + label = "Connect", + icon = shiny::icon("link", lib = "glyphicon"), + # width = NULL, + disabled = TRUE + ), + shiny::br(), + shiny::br(), tags$div( id = ns("connect-placeholder"), shinyWidgets::alert( id = ns("connect-result"), status = "info", - tags$p(phosphoricons::ph("info", weight = "bold"),"Please fill in server address (URI) and API token.") + tags$p(phosphoricons::ph("info", weight = "bold"), "Please fill in server address (URI) and API token, then press 'Connect'.") ), dismissible = TRUE - ) + ), + shiny::br() ) @@ -2418,27 +2430,35 @@ m_redcap_readUI <- function(id, include_title = TRUE) { width = 12, # shiny::actionButton(inputId = ns("import"), label = "Import"), ## TODO: Use busy indicator like on download to have button activate/deactivate - bslib::input_task_button( - id = ns("data_import"), + shiny::actionButton( + inputId = ns("data_import"), label = "Import", icon = shiny::icon("download", lib = "glyphicon"), - label_busy = "Just a minute...", - icon_busy = fontawesome::fa_i("arrows-rotate", - class = "fa-spin", - "aria-hidden" = "true" - ), - type = "primary", - auto_reset = TRUE#,state="busy" + width = "100%", + disabled = TRUE ), + # bslib::input_task_button( + # id = ns("data_import"), + # label = "Import", + # icon = shiny::icon("download", lib = "glyphicon"), + # label_busy = "Just a minute...", + # icon_busy = fontawesome::fa_i("arrows-rotate", + # class = "fa-spin", + # "aria-hidden" = "true" + # ), + # type = "primary", + # auto_reset = TRUE#,state="busy" + # ), shiny::br(), shiny::br(), - shiny::helpText("Press 'Import' after having specified API token and URI to export data from the REDCap server. A preview will show below the DataDictionary."), + shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."), shiny::br(), shiny::br() ) ) } + #' @rdname redcap_read_shiny_module #' #' @return shiny server module @@ -2451,25 +2471,38 @@ m_redcap_readServer <- function(id) { data_rv <- shiny::reactiveValues( dd_status = NULL, data_status = NULL, + uri = NULL, + project_name = NULL, info = NULL, arms = NULL, dd_list = NULL, data = NULL ) - # tryCatch( - # { + shiny::observeEvent(list(input$api, input$uri), { + uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/") + + if (is_valid_redcap_url(uri) & is_valid_token(input$api)) { + data_rv$uri <- uri + shiny::updateActionButton(inputId = "data_connect", disabled = FALSE) + } else { + shiny::updateActionButton(inputId = "data_connect", disabled = TRUE) + } + }) + + + tryCatch( + { shiny::observeEvent( list( - input$api, - input$uri + input$data_connect ), { shiny::req(input$api) - shiny::req(input$uri) + shiny::req(data_rv$uri) parameters <- list( - redcap_uri = input$uri, + redcap_uri = data_rv$uri, token = input$api ) @@ -2478,42 +2511,46 @@ m_redcap_readServer <- function(id) { ## TODO: Simplify error messages if (inherits(imported, "try-error") || NROW(imported) < 1 || ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { - if (ifelse(is.list(imported), !isTRUE(imported$success), FALSE)) { mssg <- imported$raw_text } else { mssg <- attr(imported, "condition")$message } - datamods:::insert_error(mssg = mssg,selector = "connect") + datamods:::insert_error(mssg = mssg, selector = "connect") data_rv$dd_status <- "error" data_rv$dd_list <- NULL } else if (isTRUE(imported$success)) { + data_rv$dd_status <- "success" + + data_rv$project_name <- REDCapR::redcap_project_info_read( + redcap_uri = data_rv$uri, + token = input$api + )$data$project_title datamods:::insert_alert( selector = ns("connect"), status = "success", make_success_alert( dataIdName = "see_data", - extra = tags$b(phosphoricons::ph("check", weight = "bold"),"Connected to server! Project data loaded."), + extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$project_name, " loaded."))), btn_show_data = TRUE ) ) - data_rv$dd_status <- "success" data_rv$dd_list <- imported } }, ignoreInit = TRUE ) - # }, - # warning = function(warn) { - # showNotification(paste0(warn), type = "warning") - # }, - # error = function(err) { - # showNotification(paste0(err), type = "err") - # } - # ) + }, + warning = function(warn) { + showNotification(paste0(warn), type = "warning") + }, + error = function(err) { + showNotification(paste0(err), type = "err") + } + ) shiny::observeEvent(input$see_data, { datamods::show_data( @@ -2522,15 +2559,15 @@ m_redcap_readServer <- function(id) { type = "modal", show_classes = FALSE, tags$b("Preview:") - ) + ) }) arms <- shiny::reactive({ shiny::req(input$api) - shiny::req(input$uri) + shiny::req(data_rv$uri) REDCapR::redcap_event_read( - redcap_uri = input$uri, + redcap_uri = data_rv$uri, token = input$api )$data }) @@ -2539,31 +2576,26 @@ m_redcap_readServer <- function(id) { shiny::req(data_rv$dd_list) shinyWidgets::virtualSelectInput( inputId = ns("fields"), - label = "Select fields/variables to import:", + label = "Select variables to import:", choices = purrr::pluck(data_rv$dd_list, "data") |> dplyr::select(field_name, form_name) |> (\(.x){ split(.x$field_name, .x$form_name) - })() - , - updateOn = "close", + })(), + updateOn = "change", multiple = TRUE, search = TRUE, showValueAsTags = TRUE ) }) - ## TODO: Get activate/inactivate action button to work - # shiny::observeEvent(input$fields, - # { - # if (is.null(input$fields) | length(input$fields)==1){ - # bslib::update_task_button(id= "data_import", state = "busy") - # # datamods:::toggle_widget(inputId = "data_import", enable = FALSE) - # } else { - # bslib::update_task_button(id= "data_import", state = "ready") - # # datamods:::toggle_widget(inputId = "data_import", enable = TRUE) - # } - # }) + shiny::observeEvent(input$fields, { + if (is.null(input$fields) | length(input$fields) == 0) { + shiny::updateActionButton(inputId = "data_import", disabled = TRUE) + } else { + shiny::updateActionButton(inputId = "data_import", disabled = FALSE) + } + }) output$arms <- shiny::renderUI({ shiny::selectizeInput( @@ -2575,24 +2607,12 @@ m_redcap_readServer <- function(id) { ) }) - ## Merge project name in success meassage - ## Generate Codebook link - name <- shiny::reactive({ - if (data_rv$dd_status=="success"){ - # browser() - REDCapR::redcap_project_info_read( - redcap_uri = input$uri, - token = input$api - )$data$project_title} - }) - - shiny::observeEvent(input$data_import, { shiny::req(input$fields) record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1] parameters <- list( - uri = input$uri, + uri = data_rv$uri, token = input$api, fields = unique(c(record_id, input$fields)), events = input$arms, @@ -2600,12 +2620,13 @@ m_redcap_readServer <- function(id) { filter_logic = input$filter ) - imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) + shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", { + imported <- try(rlang::exec(REDCapCAST::read_redcap_tables, !!!parameters), silent = TRUE) + }) code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters) if (inherits(imported, "try-error") || NROW(imported) < 1) { - data_rv$data_status <- "error" data_rv$data_list <- NULL } else { @@ -2631,7 +2652,7 @@ m_redcap_readServer <- function(id) { #' @importFrom shiny icon getDefaultReactiveDomain make_success_alert <- function(dataIdName = "see_data", btn_show_data, - see_data_text="Click to see data", + see_data_text = "Click to see data", extra = NULL, session = shiny::getDefaultReactiveDomain()) { if (isTRUE(btn_show_data)) { @@ -2662,6 +2683,67 @@ make_success_alert <- function(dataIdName = "see_data", # ) +#' Title +#' +#' @param url +#' +#' @returns +#' @export +#' +#' @examples +#' url <- c( +#' "www.example.com", +#' "http://example.com", +#' "https://redcap.your.inst/api/" +#' ) +#' is_valid_redcap_url(url) +is_valid_redcap_url <- function(url) { + pattern <- "https://[^ /$.?#].[^\\s]*/api/$" + stringr::str_detect(url, pattern) +} + +#' Validate REDCap token +#' +#' @param token token +#' @param pattern_env pattern +#' +#' @returns +#' @export +#' +#' @examples +#' token <- paste(sample(c(1:9, LETTERS[1:6]), 32, TRUE), collapse = "") +#' is_valid_token(token) +is_valid_token <- function(token, pattern_env = NULL, nchar = 32) { + checkmate::assert_character(token, any.missing = TRUE, len = 1) + + if (!is.null(pattern_env)) { + checkmate::assert_character(pattern_env, + any.missing = FALSE, + len = 1 + ) + pattern <- pattern_env + } else { + pattern <- glue::glue("^([0-9A-Fa-f]{})(?:\\n)?$", + .open = "<", + .close = ">" + ) + } + + if (is.na(token)) { + out <- FALSE + } else if (is.null(token)) { + out <- FALSE + } else if (nchar(token) == 0L) { + out <- FALSE + } else if (!grepl(pattern, token, perl = TRUE)) { + out <- FALSE + } else { + out <- TRUE + } + out +} + + #' Test app for the redcap_read_shiny_module #' #' @rdname redcap_read_shiny_module @@ -4968,26 +5050,35 @@ ui_elements <- list( shiny::br(), shiny::br(), shiny::h5("Exclude in-complete variables"), - shiny::p("Before going further, you can exclude variables with a low degree of completeness."), - shiny::br(), - shinyWidgets::noUiSliderInput( - inputId = "complete_cutoff", - label = "Choose completeness threshold (%)", - min = 0, - max = 100, - step = 10, - value = 70, - format = shinyWidgets::wNumbFormat(decimals = 0), - color = datamods:::get_primary_color() + shiny::fluidRow( + shiny::column(width=6, + shiny::br(), + shiny::br(), + shiny::p("Filter incomplete variables, by setting a completeness threshold:"), + shiny::br() + ), + shiny::column(width=6, + shinyWidgets::noUiSliderInput( + inputId = "complete_cutoff", + label = NULL, + min = 0, + max = 100, + step = 10, + value = 70, + format = shinyWidgets::wNumbFormat(decimals = 0), + color = datamods:::get_primary_color() + ), + shiny::helpText("Include variables with completeness above the specified percentage.") + ) ), - shiny::helpText("Only include variables with completeness above a specified percentage."), shiny::br(), shiny::br(), shiny::actionButton( inputId = "act_start", label = "Start", width = "100%", - icon = shiny::icon("play") + icon = shiny::icon("play"), + disabled = TRUE ), shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), shiny::br(), @@ -5704,6 +5795,13 @@ server <- function(input, output, session) { # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import") }) + shiny::observeEvent(rv$data_original, { + if (is.null(rv$data_original) | NROW(rv$data_original) == 0) { + shiny::updateActionButton(inputId = "act_start", disabled = TRUE) + } else { + shiny::updateActionButton(inputId = "act_start", disabled = FALSE) + } + }) ############################################################################## ######### @@ -6387,11 +6485,6 @@ server <- function(input, output, session) { condition = "output.uploaded == 'yes'", ) - # observeEvent(input$act_start, { - # nav_show(id = "overview",target = "Import" - # ) - # }) - ############################################################################## ######### ######### Page navigation diff --git a/inst/apps/freesearcheR/server.R b/inst/apps/freesearcheR/server.R index 4af7b28..c6a331e 100644 --- a/inst/apps/freesearcheR/server.R +++ b/inst/apps/freesearcheR/server.R @@ -186,6 +186,13 @@ server <- function(input, output, session) { # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import") }) + shiny::observeEvent(rv$data_original, { + if (is.null(rv$data_original) | NROW(rv$data_original) == 0) { + shiny::updateActionButton(inputId = "act_start", disabled = TRUE) + } else { + shiny::updateActionButton(inputId = "act_start", disabled = FALSE) + } + }) ############################################################################## ######### @@ -869,11 +876,6 @@ server <- function(input, output, session) { condition = "output.uploaded == 'yes'", ) - # observeEvent(input$act_start, { - # nav_show(id = "overview",target = "Import" - # ) - # }) - ############################################################################## ######### ######### Page navigation diff --git a/inst/apps/freesearcheR/ui.R b/inst/apps/freesearcheR/ui.R index 9783490..32ca8ea 100644 --- a/inst/apps/freesearcheR/ui.R +++ b/inst/apps/freesearcheR/ui.R @@ -66,26 +66,35 @@ ui_elements <- list( shiny::br(), shiny::br(), shiny::h5("Exclude in-complete variables"), - shiny::p("Before going further, you can exclude variables with a low degree of completeness."), - shiny::br(), - shinyWidgets::noUiSliderInput( - inputId = "complete_cutoff", - label = "Choose completeness threshold (%)", - min = 0, - max = 100, - step = 10, - value = 70, - format = shinyWidgets::wNumbFormat(decimals = 0), - color = datamods:::get_primary_color() + shiny::fluidRow( + shiny::column(width=6, + shiny::br(), + shiny::br(), + shiny::p("Filter incomplete variables, by setting a completeness threshold:"), + shiny::br() + ), + shiny::column(width=6, + shinyWidgets::noUiSliderInput( + inputId = "complete_cutoff", + label = NULL, + min = 0, + max = 100, + step = 5, + value = 70, + format = shinyWidgets::wNumbFormat(decimals = 0), + color = datamods:::get_primary_color() + ), + shiny::helpText("Include variables with completeness above the specified percentage.") + ) ), - shiny::helpText("Only include variables with completeness above a specified percentage."), shiny::br(), shiny::br(), shiny::actionButton( inputId = "act_start", label = "Start", width = "100%", - icon = shiny::icon("play") + icon = shiny::icon("play"), + disabled = TRUE ), shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), shiny::br(),