diff --git a/NAMESPACE b/NAMESPACE index c906cb24..e10fcef6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,7 +42,6 @@ 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 80911be9..35e474b0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,3 @@ -# 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 9938e103..78dde90f 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'Version: 25.4.1.250403_1409' +app_version <- function()'250402_1131' diff --git a/R/correlations-module.R b/R/correlations-module.R index adfd0ae9..fd7c2820 100644 --- a/R/correlations-module.R +++ b/R/correlations-module.R @@ -128,7 +128,7 @@ sentence_paste <- function(data, and.str = "and") { } else if (length(data) == 2) { paste(data, collapse = glue::glue(" {and.str} ")) } else if (length(data) > 2) { - paste(paste(data[-length(data)], collapse = ", "), data[length(data)], sep = glue::glue(" {and.str} ")) + paste(paste(data[-length(data)], collapse = ", "), data[length(data)], collapse = glue::glue(" {and.str} ")) } } diff --git a/R/helpers.R b/R/helpers.R index 13dcf5d6..f09528b3 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -335,7 +335,7 @@ data_description <- function(data) { p_complete <- n_complete/n sprintf( - i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases."), + i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases"), n, n_var, n_complete, @@ -369,26 +369,3 @@ 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 82986dea..9036c5e2 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, url = NULL) { +m_redcap_readUI <- function(id, title = TRUE) { ns <- shiny::NS(id) if (isTRUE(title)) { @@ -23,7 +23,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { shiny::textInput( inputId = ns("uri"), label = "Web address", - value = if_not_missing(url, "https://redcap.your.institution/") + value = "https://redcap.your.institution/" ), shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::textInput( @@ -32,13 +32,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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 = "100%", + # width = NULL, disabled = TRUE ), shiny::br(), @@ -55,15 +53,6 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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( @@ -71,28 +60,41 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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", @@ -100,18 +102,6 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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", @@ -124,20 +114,12 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { # type = "primary", # auto_reset = TRUE#,state="busy" # ), - # shiny::br(), - # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.") + 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::fluidPage( - title = title, - server_ui, - shiny::conditionalPanel( - condition = "output.connect_success == true", - params_ui, - ns = ns - ), - shiny::br() ) } @@ -167,8 +149,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 } @@ -222,11 +204,9 @@ 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!"), - glue::glue("The {data_rv$info$project_title} project is loaded.")), + extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))), btn_show_data = TRUE ) ) @@ -245,9 +225,6 @@ 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"), @@ -336,21 +313,17 @@ m_redcap_readServer <- function(id) { }) output$arms <- shiny::renderUI({ - if (NROW(arms()) > 0) { - vectorSelectInput( - inputId = ns("arms"), - selected = NULL, - label = "Filter by events/arms", - choices = stats::setNames(arms()[[3]], arms()[[1]]), - multiple = TRUE - ) - } + 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] @@ -361,11 +334,7 @@ m_redcap_readServer <- function(id) { events = input$arms, raw_or_label = "both", filter_logic = input$filter, - split_forms = ifelse( - input$data_type == "long" && !is.null(input$data_type), - "none", - "all" - ) + split_forms = if (input$data_type == "long") "none" else "all" ) shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", { @@ -373,24 +342,19 @@ 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 (parameters$split_form == "all") { + if (input$data_type != "long") { # browser() out <- imported |> # redcap_wider() @@ -414,20 +378,6 @@ 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 |> @@ -437,33 +387,13 @@ m_redcap_readServer <- function(id) { } }) - 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 - ) - ) - } - } - ) + # shiny::observe({ + # shiny::req(data_rv$imported) + # + # imported <- data_rv$imported + # + # + # }) return(list( status = shiny::reactive(data_rv$data_status), @@ -623,12 +553,13 @@ drop_empty_event <- function(data, event = "redcap_event_name") { #' } redcap_demo_app <- function() { ui <- shiny::fluidPage( - m_redcap_readUI("data", url = NULL), + m_redcap_readUI("data"), 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 a85789c0..5c61294b 100644 --- a/R/regression_plot.R +++ b/R/regression_plot.R @@ -2,14 +2,12 @@ #' #' @param x (`tbl_regression`, `tbl_uvregression`)\cr #' A 'tbl_regression' or 'tbl_uvregression' object -#' @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 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 4eae8a8a..7f48480e 100644 --- a/R/update-variables-ext.R +++ b/R/update-variables-ext.R @@ -118,8 +118,8 @@ update_variables_server <- function(id, output$data_info <- shiny::renderUI({ shiny::req(data_r()) - data_description(data_r()) - # sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data)) + data <- data_r() + sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data)) }) variables_r <- shiny::reactive({ @@ -645,10 +645,10 @@ convert_to <- function(data, setNames(list(expr(as.character(!!sym(variable)))), variable) ) } else if (identical(new_class, "factor")) { - data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]]) + data[[variable]] <- as.factor(x = data[[variable]]) attr(data, "code_03_convert") <- c( attr(data, "code_03_convert"), - setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable) + setNames(list(expr(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 60e0bea7..aa2fc128 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()'Version: 25.4.1.250403_1409' +app_version <- function()'250402_1131' ######## @@ -287,7 +287,7 @@ sentence_paste <- function(data, and.str = "and") { } else if (length(data) == 2) { paste(data, collapse = glue::glue(" {and.str} ")) } else if (length(data) > 2) { - paste(paste(data[-length(data)], collapse = ", "), data[length(data)], sep = glue::glue(" {and.str} ")) + paste(paste(data[-length(data)], collapse = ", "), data[length(data)], collapse = glue::glue(" {and.str} ")) } } @@ -2808,7 +2808,7 @@ data_description <- function(data) { p_complete <- n_complete/n sprintf( - i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases."), + i18n("Data has %s observations and %s variables, with %s (%s%%) complete cases"), n, n_var, n_complete, @@ -2844,29 +2844,6 @@ 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 ######## @@ -4191,7 +4168,7 @@ plot_download_server <- function(id, #' #' @return shiny ui element #' @export -m_redcap_readUI <- function(id, title = TRUE, url = NULL) { +m_redcap_readUI <- function(id, title = TRUE) { ns <- shiny::NS(id) if (isTRUE(title)) { @@ -4207,7 +4184,7 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { shiny::textInput( inputId = ns("uri"), label = "Web address", - value = if_not_missing(url, "https://redcap.your.institution/") + value = "https://redcap.your.institution/" ), shiny::helpText("Format should be either 'https://redcap.your.institution/' or 'https://your.institution/redcap/'"), shiny::textInput( @@ -4216,13 +4193,11 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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 = "100%", + # width = NULL, disabled = TRUE ), shiny::br(), @@ -4239,15 +4214,6 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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( @@ -4255,28 +4221,41 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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", @@ -4284,18 +4263,6 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { 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", @@ -4308,20 +4275,12 @@ m_redcap_readUI <- function(id, title = TRUE, url = NULL) { # type = "primary", # auto_reset = TRUE#,state="busy" # ), - # shiny::br(), - # shiny::helpText("Press 'Import' to get data from the REDCap server. Check the preview below before proceeding.") + 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::fluidPage( - title = title, - server_ui, - shiny::conditionalPanel( - condition = "output.connect_success == true", - params_ui, - ns = ns - ), - shiny::br() ) } @@ -4351,8 +4310,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 } @@ -4406,11 +4365,9 @@ 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!"), - glue::glue("The {data_rv$info$project_title} project is loaded.")), + extra = tags$p(tags$b(phosphoricons::ph("check", weight = "bold"), "Connected to server!"), tags$p(paste0(data_rv$info$project_title, " loaded."))), btn_show_data = TRUE ) ) @@ -4429,9 +4386,6 @@ 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"), @@ -4520,21 +4474,17 @@ m_redcap_readServer <- function(id) { }) output$arms <- shiny::renderUI({ - if (NROW(arms()) > 0) { - vectorSelectInput( - inputId = ns("arms"), - selected = NULL, - label = "Filter by events/arms", - choices = stats::setNames(arms()[[3]], arms()[[1]]), - multiple = TRUE - ) - } + 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] @@ -4545,11 +4495,7 @@ m_redcap_readServer <- function(id) { events = input$arms, raw_or_label = "both", filter_logic = input$filter, - split_forms = ifelse( - input$data_type == "long" && !is.null(input$data_type), - "none", - "all" - ) + split_forms = if (input$data_type == "long") "none" else "all" ) shiny::withProgress(message = "Downloading REDCap data. Hold on for a moment..", { @@ -4557,24 +4503,19 @@ 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 (parameters$split_form == "all") { + if (input$data_type != "long") { # browser() out <- imported |> # redcap_wider() @@ -4598,20 +4539,6 @@ 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 |> @@ -4621,33 +4548,13 @@ m_redcap_readServer <- function(id) { } }) - 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 - ) - ) - } - } - ) + # shiny::observe({ + # shiny::req(data_rv$imported) + # + # imported <- data_rv$imported + # + # + # }) return(list( status = shiny::reactive(data_rv$data_status), @@ -4807,12 +4714,13 @@ drop_empty_event <- function(data, event = "redcap_event_name") { #' } redcap_demo_app <- function() { ui <- shiny::fluidPage( - m_redcap_readUI("data", url = NULL), + m_redcap_readUI("data"), 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( @@ -5514,14 +5422,12 @@ regression_model_uv_list <- function(data, #' #' @param x (`tbl_regression`, `tbl_uvregression`)\cr #' A 'tbl_regression' or 'tbl_uvregression' object -#' @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 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 @@ -7005,8 +6911,8 @@ update_variables_server <- function(id, output$data_info <- shiny::renderUI({ shiny::req(data_r()) - data_description(data_r()) - # sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data)) + data <- data_r() + sprintf(i18n("Data has %s observations and %s variables."), nrow(data), ncol(data)) }) variables_r <- shiny::reactive({ @@ -7532,10 +7438,10 @@ convert_to <- function(data, setNames(list(expr(as.character(!!sym(variable)))), variable) ) } else if (identical(new_class, "factor")) { - data[[variable]] <- REDCapCAST::as_factor(x = data[[variable]]) + data[[variable]] <- as.factor(x = data[[variable]]) attr(data, "code_03_convert") <- c( attr(data, "code_03_convert"), - setNames(list(expr(REDCapCAST::as_factor(!!sym(variable)))), variable) + setNames(list(expr(as.factor(!!sym(variable)))), variable) ) } else if (identical(new_class, "numeric")) { data[[variable]] <- as.numeric(data[[variable]], ...) @@ -7934,8 +7840,6 @@ 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"), @@ -7952,7 +7856,7 @@ ui_elements <- list( shinyWidgets::noUiSliderInput( inputId = "complete_cutoff", label = NULL, - update_on = "end", + update_on = "change", min = 0, max = 100, step = 5, @@ -7960,13 +7864,12 @@ ui_elements <- list( format = shinyWidgets::wNumbFormat(decimals = 0), color = datamods:::get_primary_color() ), - shiny::helpText("Exclude variables with completeness below the specified percentage."), + shiny::helpText("Filter variables with completeness above the specified percentage."), shiny::br(), shiny::br(), shiny::uiOutput(outputId = "import_var"), shiny::uiOutput(outputId = "data_info_import", inline = TRUE) ) - ) ), shiny::br(), shiny::br(), @@ -8049,47 +7952,90 @@ ui_elements <- list( fluidRow( shiny::column( width = 9, - shiny::tags$p(shiny::markdown("Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."), - shiny::tags$p("There are also more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code. At the bottom you can restore the original data.")) + shiny::tags$p(shiny::markdown("Below, are several options to update variables (rename, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).), modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code.")) ) ), - # shiny::tags$br(), + shiny::tags$br(), + shiny::tags$br(), update_variables_ui("modal_variables"), shiny::tags$br(), shiny::tags$br(), - tags$h4("Advanced data manipulation"), - shiny::tags$br(), - shiny::tags$br(), - shiny::fluidRow( + fluidRow( shiny::column( - width = 4, - shiny::actionButton( - inputId = "modal_update", - label = "Reorder factor levels", - width = "100%" - ), - shiny::tags$br(), - shiny::helpText("Reorder the levels of factor/categorical variables."), + width = 2 ), shiny::column( - width = 4, - shiny::actionButton( - inputId = "modal_cut", - label = "New factor", - width = "100%" - ), + width = 8, + tags$h4("Advanced data manipulation"), shiny::tags$br(), - shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time).") + fluidRow( + shiny::column( + width = 6, + # tags$h4("Update or modify variables"), + # shiny::tags$br(), + # shiny::actionButton( + # inputId = "modal_variables", + # label = "Subset, rename and change class/type", + # width = "100%" + # ), + # shiny::tags$br(), + # shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"), + # shiny::tags$br(), + # shiny::tags$br(), + shiny::actionButton( + inputId = "modal_update", + label = "Reorder factor levels", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText("Reorder the levels of factor/categorical variables."), + shiny::tags$br(), + shiny::tags$br(), + shiny::actionButton( + inputId = "data_reset", + label = "Restore original data", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."), + shiny::tags$br(), + shiny::tags$br() + ), + shiny::column( + width = 6, + # tags$h4("Create new variables"), + # shiny::tags$br(), + shiny::actionButton( + inputId = "modal_cut", + label = "New factor", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."), + shiny::tags$br(), + shiny::tags$br(), + shiny::actionButton( + inputId = "modal_column", + label = "New variable", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")), + shiny::tags$br(), + shiny::tags$br() + ) + ) # , + # tags$h4("Restore"), + # shiny::actionButton( + # inputId = "data_reset", + # label = "Restore original data", + # width = "100%" + # ), + # shiny::tags$br(), + # shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.") ), shiny::column( - width = 4, - shiny::actionButton( - inputId = "modal_column", - label = "New variable", - width = "100%" - ), - shiny::tags$br(), - shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")) + width = 2 ) ), shiny::tags$br(), @@ -8097,32 +8043,24 @@ ui_elements <- list( tags$h4("Compare modified data to original"), shiny::tags$br(), shiny::tags$p( - "Raw print of the original vs the modified data." + "Here is a overview of the original vs the modified data." ), shiny::tags$br(), - shiny::fluidRow( - shiny::column( + shiny::tags$br(), + fluidRow( + column( width = 6, - shiny::tags$b("Original data:"), + tags$b("Original data:"), # verbatimTextOutput("original"), - shiny::verbatimTextOutput("original_str") + verbatimTextOutput("original_str") ), - shiny::column( + column( width = 6, - shiny::tags$b("Modified data:"), + tags$b("Modified data:"), # verbatimTextOutput("modified"), - shiny::verbatimTextOutput("modified_str") + verbatimTextOutput("modified_str") ) - ), - shiny::tags$br(), - shiny::actionButton( - inputId = "data_reset", - label = "Restore original data", - width = "100%" - ), - shiny::tags$br(), - shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."), - shiny::tags$br() + ) ) ) ), @@ -8665,34 +8603,19 @@ 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, - rv$data_temp + input$complete_cutoff ), handlerExpr = { shiny::req(rv$data_temp) # browser() - 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 |> + rv$data_original <- rv$data_temp |> + dplyr::select(input$import_var) |> default_parsing() - rv$code$import <- rv$code$import |> deparse() |> paste(collapse = "") |> @@ -8705,7 +8628,7 @@ server <- function(input, output, session) { rv$code$filter <- NULL rv$code$modify <- NULL - },ignoreNULL = FALSE + } ) output$data_info_import <- shiny::renderUI({ @@ -8730,7 +8653,8 @@ server <- function(input, output, session) { shiny::observeEvent( eventExpr = list( - rv$data_original + rv$data_original, + input$complete_cutoff ), handlerExpr = { shiny::req(rv$data_original) diff --git a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index 1950a327..b4bce6b3 100644 --- a/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/FreesearchR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 13611288 -bundleId: 10049531 +bundleId: 10042980 url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/FreesearchR/server.R b/inst/apps/FreesearchR/server.R index 1ee93487..6e66330e 100644 --- a/inst/apps/FreesearchR/server.R +++ b/inst/apps/FreesearchR/server.R @@ -158,34 +158,19 @@ 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, - rv$data_temp + input$complete_cutoff ), handlerExpr = { shiny::req(rv$data_temp) # browser() - 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 |> + rv$data_original <- rv$data_temp |> + dplyr::select(input$import_var) |> default_parsing() - rv$code$import <- rv$code$import |> deparse() |> paste(collapse = "") |> @@ -198,7 +183,7 @@ server <- function(input, output, session) { rv$code$filter <- NULL rv$code$modify <- NULL - },ignoreNULL = FALSE + } ) output$data_info_import <- shiny::renderUI({ @@ -223,7 +208,8 @@ server <- function(input, output, session) { shiny::observeEvent( eventExpr = list( - rv$data_original + rv$data_original, + input$complete_cutoff ), handlerExpr = { shiny::req(rv$data_original) diff --git a/inst/apps/FreesearchR/ui.R b/inst/apps/FreesearchR/ui.R index 32f9cb57..81c0fa89 100644 --- a/inst/apps/FreesearchR/ui.R +++ b/inst/apps/FreesearchR/ui.R @@ -68,8 +68,6 @@ 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"), @@ -86,7 +84,7 @@ ui_elements <- list( shinyWidgets::noUiSliderInput( inputId = "complete_cutoff", label = NULL, - update_on = "end", + update_on = "change", min = 0, max = 100, step = 5, @@ -94,13 +92,12 @@ ui_elements <- list( format = shinyWidgets::wNumbFormat(decimals = 0), color = datamods:::get_primary_color() ), - shiny::helpText("Exclude variables with completeness below the specified percentage."), + shiny::helpText("Filter variables with completeness above the specified percentage."), shiny::br(), shiny::br(), shiny::uiOutput(outputId = "import_var"), shiny::uiOutput(outputId = "data_info_import", inline = TRUE) ) - ) ), shiny::br(), shiny::br(), @@ -183,47 +180,90 @@ ui_elements <- list( fluidRow( shiny::column( width = 9, - shiny::tags$p(shiny::markdown("Below, are several options for simple data manipulation like update variables by renaming, creating new labels (for nicer tables in the report) and changing variable classes (numeric, factor/categorical etc.)."), - shiny::tags$p("There are also more advanced options to modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code. At the bottom you can restore the original data.")) + shiny::tags$p(shiny::markdown("Below, are several options to update variables (rename, set new labels (for nicer tables in the report) and change variable classes (numeric, factor/categorical etc.).), modify factor/categorical variables as well as create new factor from a continous variable or new variables with *R* code.")) ) ), - # shiny::tags$br(), + shiny::tags$br(), + shiny::tags$br(), update_variables_ui("modal_variables"), shiny::tags$br(), shiny::tags$br(), - tags$h4("Advanced data manipulation"), - shiny::tags$br(), - shiny::tags$br(), - shiny::fluidRow( + fluidRow( shiny::column( - width = 4, - shiny::actionButton( - inputId = "modal_update", - label = "Reorder factor levels", - width = "100%" - ), - shiny::tags$br(), - shiny::helpText("Reorder the levels of factor/categorical variables."), + width = 2 ), shiny::column( - width = 4, - shiny::actionButton( - inputId = "modal_cut", - label = "New factor", - width = "100%" - ), + width = 8, + tags$h4("Advanced data manipulation"), shiny::tags$br(), - shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time).") + fluidRow( + shiny::column( + width = 6, + # tags$h4("Update or modify variables"), + # shiny::tags$br(), + # shiny::actionButton( + # inputId = "modal_variables", + # label = "Subset, rename and change class/type", + # width = "100%" + # ), + # shiny::tags$br(), + # shiny::helpText("Subset variables, rename variables and labels, and apply new class to variables"), + # shiny::tags$br(), + # shiny::tags$br(), + shiny::actionButton( + inputId = "modal_update", + label = "Reorder factor levels", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText("Reorder the levels of factor/categorical variables."), + shiny::tags$br(), + shiny::tags$br(), + shiny::actionButton( + inputId = "data_reset", + label = "Restore original data", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."), + shiny::tags$br(), + shiny::tags$br() + ), + shiny::column( + width = 6, + # tags$h4("Create new variables"), + # shiny::tags$br(), + shiny::actionButton( + inputId = "modal_cut", + label = "New factor", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText("Create factor/categorical variable from a continous variable (number/date/time)."), + shiny::tags$br(), + shiny::tags$br(), + shiny::actionButton( + inputId = "modal_column", + label = "New variable", + width = "100%" + ), + shiny::tags$br(), + shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")), + shiny::tags$br(), + shiny::tags$br() + ) + ) # , + # tags$h4("Restore"), + # shiny::actionButton( + # inputId = "data_reset", + # label = "Restore original data", + # width = "100%" + # ), + # shiny::tags$br(), + # shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing.") ), shiny::column( - width = 4, - shiny::actionButton( - inputId = "modal_column", - label = "New variable", - width = "100%" - ), - shiny::tags$br(), - shiny::helpText(shiny::markdown("Create a new variable/column based on an *R*-expression.")) + width = 2 ) ), shiny::tags$br(), @@ -231,32 +271,24 @@ ui_elements <- list( tags$h4("Compare modified data to original"), shiny::tags$br(), shiny::tags$p( - "Raw print of the original vs the modified data." + "Here is a overview of the original vs the modified data." ), shiny::tags$br(), - shiny::fluidRow( - shiny::column( + shiny::tags$br(), + fluidRow( + column( width = 6, - shiny::tags$b("Original data:"), + tags$b("Original data:"), # verbatimTextOutput("original"), - shiny::verbatimTextOutput("original_str") + verbatimTextOutput("original_str") ), - shiny::column( + column( width = 6, - shiny::tags$b("Modified data:"), + tags$b("Modified data:"), # verbatimTextOutput("modified"), - shiny::verbatimTextOutput("modified_str") + verbatimTextOutput("modified_str") ) - ), - shiny::tags$br(), - shiny::actionButton( - inputId = "data_reset", - label = "Restore original data", - width = "100%" - ), - shiny::tags$br(), - shiny::helpText("Reset to original imported dataset. Careful! There is no un-doing."), - shiny::tags$br() + ) ) ) ), diff --git a/man/if_not_missing.Rd b/man/if_not_missing.Rd deleted file mode 100644 index 035f69bc..00000000 --- a/man/if_not_missing.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% 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 df789041..daa741a2 100644 --- a/man/plot.tbl_regression.Rd +++ b/man/plot.tbl_regression.Rd @@ -16,17 +16,6 @@ \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 b9fd01ff..4c4f221b 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, url = NULL) +m_redcap_readUI(id, title = TRUE) m_redcap_readServer(id) diff --git a/vignettes/FreesearchR.Rmd b/vignettes/FreesearchR.Rmd index 9f9a3436..86ea6ec0 100644 --- a/vignettes/FreesearchR.Rmd +++ b/vignettes/FreesearchR.Rmd @@ -9,7 +9,6 @@ vignette: > ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE,eval = FALSE) -source(here::here("functions.R")) ``` # Getting started with ***FreesearchR*** @@ -58,25 +57,7 @@ Currently several data file formats are supported for easy import (csv, txt, xls ## Visualise -Below are the available plot types listed. - -```{r echo = FALSE, eval = TRUE} -c("continuous", "dichotomous", "ordinal", "categorical") |> - lapply(\(.x){ - dplyr::bind_cols( - dplyr::tibble("Data type"=.x), - supported_plots() |> - lapply(\(.y){ - if (.x %in% .y$primary.type){ - .y[c("descr","note")]|> dplyr::bind_cols() - } -})|> - dplyr::bind_rows() |> - setNames(c("Plot type","Description"))) - }) |> - dplyr::bind_rows() |> - toastui::datagrid(filters=TRUE,theme="striped") -``` +- Would be nice to have a table of possible plots, their description and data options ## Regression