From 2800177fc5b0a0fdd7769d07e44f2280b56bc966 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 3 Apr 2025 13:11:02 +0200 Subject: [PATCH] improved import ui and redcap import with status messages --- NAMESPACE | 1 + NEWS.md | 4 + R/app_version.R | 2 +- R/helpers.R | 23 +++ R/redcap_read_shiny_module.R | 199 +++++++++++++++-------- R/regression_plot.R | 14 +- R/update-variables-ext.R | 4 +- inst/apps/FreesearchR/app.R | 275 ++++++++++++++++++++++---------- inst/apps/FreesearchR/server.R | 26 ++- inst/apps/FreesearchR/ui.R | 7 +- man/if_not_missing.Rd | 24 +++ man/plot.tbl_regression.Rd | 11 ++ man/redcap_read_shiny_module.Rd | 2 +- 13 files changed, 427 insertions(+), 165 deletions(-) create mode 100644 man/if_not_missing.Rd diff --git a/NAMESPACE b/NAMESPACE index e10fcef..c906cb2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,6 +42,7 @@ export(getfun) export(gg_theme_export) export(gg_theme_shiny) export(grepl_fix) +export(if_not_missing) export(import_delim) export(import_dta) export(import_file_server) diff --git a/NEWS.md b/NEWS.md index 35e474b..80911be 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# FreesearchR 25.4.12 + +Polished and simplified data import module including a much improved REDCap import module. + # FreesearchR 25.4.1 Focus is on polish and improved ui/ux. diff --git a/R/app_version.R b/R/app_version.R index e266f7b..8994287 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250403_0630' +app_version <- function()'Version: 25.4.1.250403_1309' diff --git a/R/helpers.R b/R/helpers.R index a78ad78..13dcf5d 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -369,3 +369,26 @@ get_ggplot_label <- function(data,label){ assertthat::assert_that(ggplot2::is.ggplot(data)) data$labels[[label]] } + + +#' Return if available +#' +#' @param data vector +#' @param default assigned value for missings +#' +#' @returns vector +#' @export +#' +#' @examples +#' NULL |> if_not_missing("new") +#' c(2,"a",NA) |> if_not_missing() +#' "See" |> if_not_missing() +if_not_missing <- function(data,default=NULL){ + if (length(data)>1){ + Reduce(c,lapply(data,if_not_missing)) + } else if (is.na(data) || is.null(data)){ + return(default) + } else { + return(data) + } +} diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 9036c5e..82986de 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -7,7 +7,7 @@ #' #' @return shiny ui element #' @export -m_redcap_readUI <- function(id, title = TRUE) { +m_redcap_readUI <- function(id, title = TRUE, url = NULL) { ns <- shiny::NS(id) if (isTRUE(title)) { @@ -23,7 +23,7 @@ m_redcap_readUI <- function(id, title = TRUE) { shiny::textInput( inputId = ns("uri"), label = "Web address", - value = "https://redcap.your.institution/" + value = if_not_missing(url, "https://redcap.your.institution/") ), shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::textInput( @@ -32,11 +32,13 @@ m_redcap_readUI <- function(id, title = TRUE) { value = "" ), shiny::helpText("The token is a string of 32 numbers and letters."), + shiny::br(), + shiny::br(), shiny::actionButton( inputId = ns("data_connect"), label = "Connect", icon = shiny::icon("link", lib = "glyphicon"), - # width = NULL, + width = "100%", disabled = TRUE ), shiny::br(), @@ -53,6 +55,15 @@ m_redcap_readUI <- function(id, title = TRUE) { shiny::br() ) + filter_ui <- + shiny::tagList( + # width = 6, + shiny::uiOutput(outputId = ns("arms")), + shiny::textInput( + inputId = ns("filter"), + label = "Optional filter logic (e.g., ⁠[gender] = 'female')" + ) + ) params_ui <- shiny::tagList( @@ -60,41 +71,28 @@ m_redcap_readUI <- function(id, title = TRUE) { shiny::tags$h4("Data import parameters"), shiny::helpText("Options here will show, when API and uri are typed"), shiny::uiOutput(outputId = ns("fields")), + shiny::tags$div( + class = "shiny-input-container", + shiny::tags$label( + class = "control-label", + `for` = ns("dropdown_params"), + "...", + style = htmltools::css(visibility = "hidden") + ), + shinyWidgets::dropMenu( + shiny::actionButton( + inputId = ns("dropdown_params"), + label = "Add data filters", + icon = shiny::icon("filter"), + width = "100%", + class = "px-1" + ), + filter_ui + ), + shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters") + ), shiny::uiOutput(outputId = ns("data_type")), shiny::uiOutput(outputId = ns("fill")), - shinyWidgets::switchInput( - inputId = "do_filter", - label = "Apply filter?", - value = FALSE, - inline = FALSE, - onLabel = "YES", - offLabel = "NO" - ), - shiny::conditionalPanel( - condition = "input.do_filter", - shiny::uiOutput(outputId = ns("arms")), - shiny::textInput( - inputId = ns("filter"), - label = "Optional filter logic (e.g., ⁠[gender] = 'female')" - ) - ) - ) - - - shiny::fluidPage( - title=title, - bslib::layout_columns( - server_ui, - params_ui, - col_widths = bslib::breakpoints( - sm = c(12, 12), - md = c(12, 12) - ) - ), - shiny::column( - width = 12, - # shiny::actionButton(inputId = ns("import"), label = "Import"), - ## TODO: Use busy indicator like on download to have button activate/deactivate shiny::actionButton( inputId = ns("data_import"), label = "Import", @@ -102,6 +100,18 @@ m_redcap_readUI <- function(id, title = TRUE) { width = "100%", disabled = TRUE ), + shiny::tags$br(), + shiny::tags$br(), + tags$div( + id = ns("retrieved-placeholder"), + shinyWidgets::alert( + id = ns("retrieved-result"), + status = "info", + tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.") + ), + dismissible = TRUE + )#, + ## TODO: Use busy indicator like on download to have button activate/deactivate # bslib::input_task_button( # id = ns("data_import"), # label = "Import", @@ -114,12 +124,20 @@ m_redcap_readUI <- function(id, title = TRUE) { # type = "primary", # auto_reset = TRUE#,state="busy" # ), - shiny::br(), - shiny::br(), - shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."), - shiny::br(), - shiny::br() + # shiny::br(), + # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.") ) + + + shiny::fluidPage( + title = title, + server_ui, + shiny::conditionalPanel( + condition = "output.connect_success == true", + params_ui, + ns = ns + ), + shiny::br() ) } @@ -149,8 +167,8 @@ m_redcap_readServer <- function(id) { shiny::observeEvent(list(input$api, input$uri), { shiny::req(input$api) shiny::req(input$uri) - if (!is.null(input$uri)){ - uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/") + if (!is.null(input$uri)) { + uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/") } else { uri <- input$uri } @@ -204,9 +222,11 @@ m_redcap_readServer <- function(id) { datamods:::insert_alert( selector = ns("connect"), status = "success", - include_data_alert(see_data_text = "Click to see data dictionary", + include_data_alert( + see_data_text = "Click to see data dictionary", dataIdName = "see_data", - extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))), + extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), + glue::glue("The {data_rv$info$project_title} project is loaded.")), btn_show_data = TRUE ) ) @@ -225,6 +245,9 @@ m_redcap_readServer <- function(id) { } ) + output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success")) + shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE) + shiny::observeEvent(input$see_data, { datamods::show_data( purrr::pluck(data_rv$dd_list, "data"), @@ -313,17 +336,21 @@ m_redcap_readServer <- function(id) { }) output$arms <- shiny::renderUI({ - vectorSelectInput( - inputId = ns("arms"), - selected = NULL, - label = "Filter by events/arms", - choices = stats::setNames(arms()[[3]], arms()[[1]]), - multiple = TRUE - ) + if (NROW(arms()) > 0) { + vectorSelectInput( + inputId = ns("arms"), + selected = NULL, + label = "Filter by events/arms", + choices = stats::setNames(arms()[[3]], arms()[[1]]), + multiple = TRUE + ) + } }) shiny::observeEvent(input$data_import, { shiny::req(input$fields) + + # browser() record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1] @@ -334,7 +361,11 @@ m_redcap_readServer <- function(id) { events = input$arms, raw_or_label = "both", filter_logic = input$filter, - split_forms = if (input$data_type == "long") "none" else "all" + split_forms = ifelse( + input$data_type == "long" && !is.null(input$data_type), + "none", + "all" + ) ) shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", { @@ -342,19 +373,24 @@ m_redcap_readServer <- function(id) { }) code <- rlang::call2("read_redcap_tables", - !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")), - , .ns = "REDCapCAST") + !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , + .ns = "REDCapCAST" + ) + # browser() if (inherits(imported, "try-error") || NROW(imported) < 1) { data_rv$data_status <- "error" data_rv$data_list <- NULL + data_rv$data_message <- imported$raw_text } else { data_rv$data_status <- "success" + data_rv$data_message <- "Requested data was retrieved!" ## The data management below should be separated to allow for changing ## "wide"/"long" without re-importing data - if (input$data_type != "long") { + + if (parameters$split_form == "all") { # browser() out <- imported |> # redcap_wider() @@ -378,6 +414,20 @@ m_redcap_readServer <- function(id) { } } + # browser() + in_data_check <- parameters$fields %in% names(out) | + sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y)))) + + if (!any(in_data_check[-1])) { + data_rv$data_status <- "warning" + data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access." + } + + if (!all(in_data_check)) { + data_rv$data_status <- "warning" + data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access." + } + data_rv$code <- code data_rv$data <- out |> @@ -387,13 +437,33 @@ m_redcap_readServer <- function(id) { } }) - # shiny::observe({ - # shiny::req(data_rv$imported) - # - # imported <- data_rv$imported - # - # - # }) + shiny::observeEvent( + data_rv$data_status, + { + # browser() + if (identical(data_rv$data_status, "error")) { + datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved")) + } else if (identical(data_rv$data_status, "success")) { + datamods:::insert_alert( + selector = ns("retrieved"), + status = data_rv$data_status, + tags$p( + tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + data_rv$data_message + ) + ) + } else { + datamods:::insert_alert( + selector = ns("retrieved"), + status = data_rv$data_status, + tags$p( + tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"), + data_rv$data_message + ) + ) + } + } + ) return(list( status = shiny::reactive(data_rv$data_status), @@ -553,13 +623,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") { #' } redcap_demo_app <- function() { ui <- shiny::fluidPage( - m_redcap_readUI("data"), + m_redcap_readUI("data", url = NULL), DT::DTOutput("data"), shiny::tags$b("Code:"), shiny::verbatimTextOutput(outputId = "code") ) server <- function(input, output, session) { - data_val <- m_redcap_readServer(id = "data") output$data <- DT::renderDataTable( diff --git a/R/regression_plot.R b/R/regression_plot.R index 5c61294..a85789c 100644 --- a/R/regression_plot.R +++ b/R/regression_plot.R @@ -2,12 +2,14 @@ #' #' @param x (`tbl_regression`, `tbl_uvregression`)\cr #' A 'tbl_regression' or 'tbl_uvregression' object -## #' @param remove_header_rows (scalar `logical`)\cr -## #' logical indicating whether to remove header rows -## #' for categorical variables. Default is `TRUE` -## #' @param remove_reference_rows (scalar `logical`)\cr -## #' logical indicating whether to remove reference rows -## #' for categorical variables. Default is `FALSE`. +#' @param plot_ref (scalar `logical`)\cr +#' plot reference values +#' @param remove_header_rows (scalar `logical`)\cr +#' logical indicating whether to remove header rows +#' for categorical variables. Default is `TRUE` +#' @param remove_reference_rows (scalar `logical`)\cr +#' logical indicating whether to remove reference rows +#' for categorical variables. Default is `FALSE`. #' @param ... arguments passed to `ggstats::ggcoef_plot(...)` #' #' @returns ggplot object diff --git a/R/update-variables-ext.R b/R/update-variables-ext.R index 8699330..4eae8a8 100644 --- a/R/update-variables-ext.R +++ b/R/update-variables-ext.R @@ -645,10 +645,10 @@ convert_to <- function(data, setNames(list(expr(as.character(!!sym(variable)))), variable) ) } else if (identical(new_class, "factor")) { - data[[variable]] <- as.factor(x = data[[variable]]) + data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]]) attr(data, "code_03_convert") <- c( attr(data, "code_03_convert"), - setNames(list(expr(as.factor(!!sym(variable)))), variable) + setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable) ) } else if (identical(new_class, "numeric")) { data[[variable]] <- as.numeric(data[[variable]], ...) diff --git a/inst/apps/FreesearchR/app.R b/inst/apps/FreesearchR/app.R index f9735d7..2684ed6 100644 --- a/inst/apps/FreesearchR/app.R +++ b/inst/apps/FreesearchR/app.R @@ -10,7 +10,7 @@ #### Current file: /Users/au301842/FreesearchR/R//app_version.R ######## -app_version <- function()'250403_0630' +app_version <- function()'Version: 25.4.1.250403_1309' ######## @@ -2844,6 +2844,29 @@ get_ggplot_label <- function(data,label){ } +#' Return if available +#' +#' @param data vector +#' @param default assigned value for missings +#' +#' @returns vector +#' @export +#' +#' @examples +#' NULL |> if_not_missing("new") +#' c(2,"a",NA) |> if_not_missing() +#' "See" |> if_not_missing() +if_not_missing <- function(data,default=NULL){ + if (length(data)>1){ + Reduce(c,lapply(data,if_not_missing)) + } else if (is.na(data) || is.null(data)){ + return(default) + } else { + return(data) + } +} + + ######## #### Current file: /Users/au301842/FreesearchR/R//import-file-ext.R ######## @@ -4168,7 +4191,7 @@ plot_download_server <- function(id, #' #' @return shiny ui element #' @export -m_redcap_readUI <- function(id, title = TRUE) { +m_redcap_readUI <- function(id, title = TRUE, url = NULL) { ns <- shiny::NS(id) if (isTRUE(title)) { @@ -4184,7 +4207,7 @@ m_redcap_readUI <- function(id, title = TRUE) { shiny::textInput( inputId = ns("uri"), label = "Web address", - value = "https://redcap.your.institution/" + value = if_not_missing(url, "https://redcap.your.institution/") ), shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::textInput( @@ -4193,11 +4216,13 @@ m_redcap_readUI <- function(id, title = TRUE) { value = "" ), shiny::helpText("The token is a string of 32 numbers and letters."), + shiny::br(), + shiny::br(), shiny::actionButton( inputId = ns("data_connect"), label = "Connect", icon = shiny::icon("link", lib = "glyphicon"), - # width = NULL, + width = "100%", disabled = TRUE ), shiny::br(), @@ -4214,6 +4239,15 @@ m_redcap_readUI <- function(id, title = TRUE) { shiny::br() ) + filter_ui <- + shiny::tagList( + # width = 6, + shiny::uiOutput(outputId = ns("arms")), + shiny::textInput( + inputId = ns("filter"), + label = "Optional filter logic (e.g., ⁠[gender] = 'female')" + ) + ) params_ui <- shiny::tagList( @@ -4221,41 +4255,28 @@ m_redcap_readUI <- function(id, title = TRUE) { shiny::tags$h4("Data import parameters"), shiny::helpText("Options here will show, when API and uri are typed"), shiny::uiOutput(outputId = ns("fields")), + shiny::tags$div( + class = "shiny-input-container", + shiny::tags$label( + class = "control-label", + `for` = ns("dropdown_params"), + "...", + style = htmltools::css(visibility = "hidden") + ), + shinyWidgets::dropMenu( + shiny::actionButton( + inputId = ns("dropdown_params"), + label = "Add data filters", + icon = shiny::icon("filter"), + width = "100%", + class = "px-1" + ), + filter_ui + ), + shiny::helpText("Optionally filter project arms if logitudinal or apply server side data filters") + ), shiny::uiOutput(outputId = ns("data_type")), shiny::uiOutput(outputId = ns("fill")), - shinyWidgets::switchInput( - inputId = "do_filter", - label = "Apply filter?", - value = FALSE, - inline = FALSE, - onLabel = "YES", - offLabel = "NO" - ), - shiny::conditionalPanel( - condition = "input.do_filter", - shiny::uiOutput(outputId = ns("arms")), - shiny::textInput( - inputId = ns("filter"), - label = "Optional filter logic (e.g., ⁠[gender] = 'female')" - ) - ) - ) - - - shiny::fluidPage( - title=title, - bslib::layout_columns( - server_ui, - params_ui, - col_widths = bslib::breakpoints( - sm = c(12, 12), - md = c(12, 12) - ) - ), - shiny::column( - width = 12, - # shiny::actionButton(inputId = ns("import"), label = "Import"), - ## TODO: Use busy indicator like on download to have button activate/deactivate shiny::actionButton( inputId = ns("data_import"), label = "Import", @@ -4263,6 +4284,18 @@ m_redcap_readUI <- function(id, title = TRUE) { width = "100%", disabled = TRUE ), + shiny::tags$br(), + shiny::tags$br(), + tags$div( + id = ns("retrieved-placeholder"), + shinyWidgets::alert( + id = ns("retrieved-result"), + status = "info", + tags$p(phosphoricons::ph("info", weight = "bold"), "Please specify data to download, then press 'Import'.") + ), + dismissible = TRUE + )#, + ## TODO: Use busy indicator like on download to have button activate/deactivate # bslib::input_task_button( # id = ns("data_import"), # label = "Import", @@ -4275,12 +4308,20 @@ m_redcap_readUI <- function(id, title = TRUE) { # type = "primary", # auto_reset = TRUE#,state="busy" # ), - shiny::br(), - shiny::br(), - shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding."), - shiny::br(), - shiny::br() + # shiny::br(), + # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.") ) + + + shiny::fluidPage( + title = title, + server_ui, + shiny::conditionalPanel( + condition = "output.connect_success == true", + params_ui, + ns = ns + ), + shiny::br() ) } @@ -4310,8 +4351,8 @@ m_redcap_readServer <- function(id) { shiny::observeEvent(list(input$api, input$uri), { shiny::req(input$api) shiny::req(input$uri) - if (!is.null(input$uri)){ - uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/") + if (!is.null(input$uri)) { + uri <- paste0(ifelse(endsWith(input$uri, "/"), input$uri, paste0(input$uri, "/")), "api/") } else { uri <- input$uri } @@ -4365,9 +4406,11 @@ m_redcap_readServer <- function(id) { datamods:::insert_alert( selector = ns("connect"), status = "success", - include_data_alert(see_data_text = "Click to see data dictionary", + include_data_alert( + see_data_text = "Click to see data dictionary", dataIdName = "see_data", - extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))), + extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), + glue::glue("The {data_rv$info$project_title} project is loaded.")), btn_show_data = TRUE ) ) @@ -4386,6 +4429,9 @@ m_redcap_readServer <- function(id) { } ) + output$connect_success <- shiny::reactive(identical(data_rv$dd_status, "success")) + shiny::outputOptions(output, "connect_success", suspendWhenHidden = FALSE) + shiny::observeEvent(input$see_data, { datamods::show_data( purrr::pluck(data_rv$dd_list, "data"), @@ -4474,17 +4520,21 @@ m_redcap_readServer <- function(id) { }) output$arms <- shiny::renderUI({ - vectorSelectInput( - inputId = ns("arms"), - selected = NULL, - label = "Filter by events/arms", - choices = stats::setNames(arms()[[3]], arms()[[1]]), - multiple = TRUE - ) + if (NROW(arms()) > 0) { + vectorSelectInput( + inputId = ns("arms"), + selected = NULL, + label = "Filter by events/arms", + choices = stats::setNames(arms()[[3]], arms()[[1]]), + multiple = TRUE + ) + } }) shiny::observeEvent(input$data_import, { shiny::req(input$fields) + + # browser() record_id <- purrr::pluck(data_rv$dd_list, "data")[[1]][1] @@ -4495,7 +4545,11 @@ m_redcap_readServer <- function(id) { events = input$arms, raw_or_label = "both", filter_logic = input$filter, - split_forms = if (input$data_type == "long") "none" else "all" + split_forms = ifelse( + input$data_type == "long" && !is.null(input$data_type), + "none", + "all" + ) ) shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", { @@ -4503,19 +4557,24 @@ m_redcap_readServer <- function(id) { }) code <- rlang::call2("read_redcap_tables", - !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")), - , .ns = "REDCapCAST") + !!!utils::modifyList(parameters, list(token = "PERSONAL_API_TOKEN")), , + .ns = "REDCapCAST" + ) + # browser() if (inherits(imported, "try-error") || NROW(imported) < 1) { data_rv$data_status <- "error" data_rv$data_list <- NULL + data_rv$data_message <- imported$raw_text } else { data_rv$data_status <- "success" + data_rv$data_message <- "Requested data was retrieved!" ## The data management below should be separated to allow for changing ## "wide"/"long" without re-importing data - if (input$data_type != "long") { + + if (parameters$split_form == "all") { # browser() out <- imported |> # redcap_wider() @@ -4539,6 +4598,20 @@ m_redcap_readServer <- function(id) { } } + # browser() + in_data_check <- parameters$fields %in% names(out) | + sapply(names(out), \(.x) any(sapply(parameters$fields, \(.y) startsWith(.x, .y)))) + + if (!any(in_data_check[-1])) { + data_rv$data_status <- "warning" + data_rv$data_message <- "Data retrieved, but it looks like only the ID was retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access." + } + + if (!all(in_data_check)) { + data_rv$data_status <- "warning" + data_rv$data_message <- "Data retrieved, but it looks like not all requested fields were retrieved from the server. Please check with your REDCap administrator that you have required permissions for data access." + } + data_rv$code <- code data_rv$data <- out |> @@ -4548,13 +4621,33 @@ m_redcap_readServer <- function(id) { } }) - # shiny::observe({ - # shiny::req(data_rv$imported) - # - # imported <- data_rv$imported - # - # - # }) + shiny::observeEvent( + data_rv$data_status, + { + # browser() + if (identical(data_rv$data_status, "error")) { + datamods:::insert_error(mssg = data_rv$data_message, selector = ns("retrieved")) + } else if (identical(data_rv$data_status, "success")) { + datamods:::insert_alert( + selector = ns("retrieved"), + status = data_rv$data_status, + tags$p( + tags$b(phosphoricons::ph("check", weight = "bold"), "Success!"), + data_rv$data_message + ) + ) + } else { + datamods:::insert_alert( + selector = ns("retrieved"), + status = data_rv$data_status, + tags$p( + tags$b(phosphoricons::ph("warning", weight = "bold"), "Warning!"), + data_rv$data_message + ) + ) + } + } + ) return(list( status = shiny::reactive(data_rv$data_status), @@ -4714,13 +4807,12 @@ drop_empty_event <- function(data, event = "redcap_event_name") { #' } redcap_demo_app <- function() { ui <- shiny::fluidPage( - m_redcap_readUI("data"), + m_redcap_readUI("data", url = NULL), DT::DTOutput("data"), shiny::tags$b("Code:"), shiny::verbatimTextOutput(outputId = "code") ) server <- function(input, output, session) { - data_val <- m_redcap_readServer(id = "data") output$data <- DT::renderDataTable( @@ -5422,12 +5514,14 @@ regression_model_uv_list <- function(data, #' #' @param x (`tbl_regression`, `tbl_uvregression`)\cr #' A 'tbl_regression' or 'tbl_uvregression' object -## #' @param remove_header_rows (scalar `logical`)\cr -## #' logical indicating whether to remove header rows -## #' for categorical variables. Default is `TRUE` -## #' @param remove_reference_rows (scalar `logical`)\cr -## #' logical indicating whether to remove reference rows -## #' for categorical variables. Default is `FALSE`. +#' @param plot_ref (scalar `logical`)\cr +#' plot reference values +#' @param remove_header_rows (scalar `logical`)\cr +#' logical indicating whether to remove header rows +#' for categorical variables. Default is `TRUE` +#' @param remove_reference_rows (scalar `logical`)\cr +#' logical indicating whether to remove reference rows +#' for categorical variables. Default is `FALSE`. #' @param ... arguments passed to `ggstats::ggcoef_plot(...)` #' #' @returns ggplot object @@ -7438,10 +7532,10 @@ convert_to <- function(data, setNames(list(expr(as.character(!!sym(variable)))), variable) ) } else if (identical(new_class, "factor")) { - data[[variable]] <- as.factor(x = data[[variable]]) + data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]]) attr(data, "code_03_convert") <- c( attr(data, "code_03_convert"), - setNames(list(expr(as.factor(!!sym(variable)))), variable) + setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable) ) } else if (identical(new_class, "numeric")) { data[[variable]] <- as.numeric(data[[variable]], ...) @@ -7840,6 +7934,8 @@ ui_elements <- list( condition = "input.source=='redcap'", DT::DTOutput(outputId = "redcap_prev") ), + shiny::conditionalPanel( + condition = "output.data_loaded == true", shiny::br(), shiny::br(), shiny::h5("Specify variables to include"), @@ -7856,7 +7952,7 @@ ui_elements <- list( shinyWidgets::noUiSliderInput( inputId = "complete_cutoff", label = NULL, - update_on = "change", + update_on = "end", min = 0, max = 100, step = 5, @@ -7864,12 +7960,13 @@ ui_elements <- list( format = shinyWidgets::wNumbFormat(decimals = 0), color = datamods:::get_primary_color() ), - shiny::helpText("Filter variables with completeness above the specified percentage."), + shiny::helpText("Exclude variables with completeness below the specified percentage."), shiny::br(), shiny::br(), shiny::uiOutput(outputId = "import_var"), shiny::uiOutput(outputId = "data_info_import", inline = TRUE) ) + ) ), shiny::br(), shiny::br(), @@ -8568,19 +8665,34 @@ server <- function(input, output, session) { ) }) + output$data_loaded <- shiny::reactive({ + !is.null(rv$data_temp) + }) + + shiny::observeEvent(input$source,{ + rv$data_temp <- NULL + }) + + shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE) shiny::observeEvent( eventExpr = list( input$import_var, - input$complete_cutoff + input$complete_cutoff, + rv$data_temp ), handlerExpr = { shiny::req(rv$data_temp) # browser() - rv$data_original <- rv$data_temp |> - dplyr::select(input$import_var) |> + temp_data <- rv$data_temp + if (all(input$import_var %in% names(temp_data))){ + temp_data <- temp_data |> dplyr::select(input$import_var) + } + + rv$data_original <- temp_data |> default_parsing() + rv$code$import <- rv$code$import |> deparse() |> paste(collapse = "") |> @@ -8593,7 +8705,7 @@ server <- function(input, output, session) { rv$code$filter <- NULL rv$code$modify <- NULL - } + },ignoreNULL = FALSE ) output$data_info_import <- shiny::renderUI({ @@ -8618,8 +8730,7 @@ server <- function(input, output, session) { shiny::observeEvent( eventExpr = list( - rv$data_original, - input$complete_cutoff + rv$data_original ), handlerExpr = { shiny::req(rv$data_original) diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index 6e66330..1ee9348 100644 --- a/inst/apps/FreesearchR/server.R +++ b/inst/apps/FreesearchR/server.R @@ -158,19 +158,34 @@ server <- function(input, output, session) { ) }) + output$data_loaded <- shiny::reactive({ + !is.null(rv$data_temp) + }) + + shiny::observeEvent(input$source,{ + rv$data_temp <- NULL + }) + + shiny::outputOptions(output, "data_loaded", suspendWhenHidden = FALSE) shiny::observeEvent( eventExpr = list( input$import_var, - input$complete_cutoff + input$complete_cutoff, + rv$data_temp ), handlerExpr = { shiny::req(rv$data_temp) # browser() - rv$data_original <- rv$data_temp |> - dplyr::select(input$import_var) |> + temp_data <- rv$data_temp + if (all(input$import_var %in% names(temp_data))){ + temp_data <- temp_data |> dplyr::select(input$import_var) + } + + rv$data_original <- temp_data |> default_parsing() + rv$code$import <- rv$code$import |> deparse() |> paste(collapse = "") |> @@ -183,7 +198,7 @@ server <- function(input, output, session) { rv$code$filter <- NULL rv$code$modify <- NULL - } + },ignoreNULL = FALSE ) output$data_info_import <- shiny::renderUI({ @@ -208,8 +223,7 @@ server <- function(input, output, session) { shiny::observeEvent( eventExpr = list( - rv$data_original, - input$complete_cutoff + rv$data_original ), handlerExpr = { shiny::req(rv$data_original) diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 063438d..32f9cb5 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -68,6 +68,8 @@ ui_elements <- list( condition = "input.source=='redcap'", DT::DTOutput(outputId = "redcap_prev") ), + shiny::conditionalPanel( + condition = "output.data_loaded == true", shiny::br(), shiny::br(), shiny::h5("Specify variables to include"), @@ -84,7 +86,7 @@ ui_elements <- list( shinyWidgets::noUiSliderInput( inputId = "complete_cutoff", label = NULL, - update_on = "change", + update_on = "end", min = 0, max = 100, step = 5, @@ -92,12 +94,13 @@ ui_elements <- list( format = shinyWidgets::wNumbFormat(decimals = 0), color = datamods:::get_primary_color() ), - shiny::helpText("Filter variables with completeness above the specified percentage."), + shiny::helpText("Exclude variables with completeness below the specified percentage."), shiny::br(), shiny::br(), shiny::uiOutput(outputId = "import_var"), shiny::uiOutput(outputId = "data_info_import", inline = TRUE) ) + ) ), shiny::br(), shiny::br(), diff --git a/man/if_not_missing.Rd b/man/if_not_missing.Rd new file mode 100644 index 0000000..035f69b --- /dev/null +++ b/man/if_not_missing.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{if_not_missing} +\alias{if_not_missing} +\title{Return if available} +\usage{ +if_not_missing(data, default = NULL) +} +\arguments{ +\item{data}{vector} + +\item{default}{assigned value for missings} +} +\value{ +vector +} +\description{ +Return if available +} +\examples{ +NULL |> if_not_missing("new") +c(2,"a",NA) |> if_not_missing() +"See" |> if_not_missing() +} diff --git a/man/plot.tbl_regression.Rd b/man/plot.tbl_regression.Rd index daa741a..df78904 100644 --- a/man/plot.tbl_regression.Rd +++ b/man/plot.tbl_regression.Rd @@ -16,6 +16,17 @@ \item{x}{(\code{tbl_regression}, \code{tbl_uvregression})\cr A 'tbl_regression' or 'tbl_uvregression' object} +\item{plot_ref}{(scalar \code{logical})\cr +plot reference values} + +\item{remove_header_rows}{(scalar \code{logical})\cr +logical indicating whether to remove header rows +for categorical variables. Default is \code{TRUE}} + +\item{remove_reference_rows}{(scalar \code{logical})\cr +logical indicating whether to remove reference rows +for categorical variables. Default is \code{FALSE}.} + \item{...}{arguments passed to \code{ggstats::ggcoef_plot(...)}} } \value{ diff --git a/man/redcap_read_shiny_module.Rd b/man/redcap_read_shiny_module.Rd index 4c4f221..b9fd01f 100644 --- a/man/redcap_read_shiny_module.Rd +++ b/man/redcap_read_shiny_module.Rd @@ -6,7 +6,7 @@ \alias{redcap_demo_app} \title{Shiny module to browser and export REDCap data} \usage{ -m_redcap_readUI(id, title = TRUE) +m_redcap_readUI(id, title = TRUE, url = NULL) m_redcap_readServer(id)