From 9e8ff6b4a980f8b66b0baae3213da3f9a5b0ac26 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 17 Mar 2025 15:00:13 +0100 Subject: [PATCH 1/3] improved code output --- .gitignore | 1 + DESCRIPTION | 5 +- NAMESPACE | 4 + NEWS.md | 2 + R/app_version.R | 2 +- R/data-import.R | 415 ++++++++----------- R/import-file-ext.R | 141 ++++--- R/redcap_read_shiny_module.R | 31 +- ROADMAP.md | 2 +- inst/apps/freesearcheR/app.R | 688 ++++++++++++++------------------ inst/apps/freesearcheR/server.R | 94 ++--- inst/apps/freesearcheR/ui.R | 2 +- man/data-import.Rd | 16 + man/import-file-type.Rd | 46 +++ man/import-file.Rd | 18 +- man/import-file_module.Rd | 16 + man/import_delim.Rd | 21 - man/update-variables.Rd | 2 +- vignettes/.gitignore | 2 + vignettes/freesearcheR.Rmd | 48 +++ 20 files changed, 750 insertions(+), 806 deletions(-) create mode 100644 man/data-import.Rd create mode 100644 man/import-file-type.Rd create mode 100644 man/import-file_module.Rd delete mode 100644 man/import_delim.Rd create mode 100644 vignettes/.gitignore create mode 100644 vignettes/freesearcheR.Rmd diff --git a/.gitignore b/.gitignore index df15ad79..8e58845e 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ app/rsconnect inst/shiny-examples/casting/functions.R functions.R docs +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index 1a5f9157..abdb6117 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -77,6 +77,9 @@ Suggests: usethis, roxygen2, pak, - rsconnect + rsconnect, + knitr, + rmarkdown URL: https://github.com/agdamsbo/freesearcheR, https://agdamsbo.github.io/freesearcheR/ BugReports: https://github.com/agdamsbo/freesearcheR/issues +VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 0a32d91a..336ec69e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,8 +36,12 @@ export(gg_theme_export) export(gg_theme_shiny) export(grepl_fix) export(import_delim) +export(import_dta) export(import_file_server) export(import_file_ui) +export(import_ods) +export(import_rds) +export(import_xls) export(index_embed) export(is_any_class) export(is_consecutive) diff --git a/NEWS.md b/NEWS.md index 8ea24077..aee2764d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ First steps towards an updated name (will be FreesearchR), with renamed reposito Testing file upload conducted and improved. +Working on omproving code export. + # freesearcheR 25.3.1 First steps towards a more focused and simplified interface. diff --git a/R/app_version.R b/R/app_version.R index a5737d3c..0cdf3212 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250313_1502' +app_version <- function()'250317_1458' diff --git a/R/data-import.R b/R/data-import.R index 6fd30d25..33acf37e 100644 --- a/R/data-import.R +++ b/R/data-import.R @@ -1,250 +1,171 @@ -#' data_import_ui <- function(id, include_title = TRUE) { -#' ns <- shiny::NS(id) +data_import_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::fluidRow( + shiny::column(width = 2), + shiny::column( + width = 8, + shiny::h4("Choose your data source"), + shiny::br(), + shinyWidgets::radioGroupButtons( + inputId = "source", + selected = "env", + choices = c( + "File upload" = "file", + "REDCap server export" = "redcap", + "Local or sample data" = "env" + ), + width = "100%" + ), + shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."), + shiny::br(), + shiny::br(), + shiny::conditionalPanel( + condition = "input.source=='file'", + import_file_ui( + id = ns("file_import"), + layout_params = "dropdown", + title = "Choose a datafile to upload", + file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") + ) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + m_redcap_readUI(id = ns("redcap_import")) + ), + shiny::conditionalPanel( + condition = "input.source=='env'", + import_globalenv_ui(id = ns("env"), title = NULL) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + DT::DTOutput(outputId = ns("redcap_prev")) + ) + ) + ) + } + + +data_import_server <- function(id) { + module <- function(input, output, session) { + ns <- session$ns + + rv <- shiny::reactiveValues( + data_temp = NULL, + code = list() + ) + + data_file <- import_file_server( + id = ns("file_import"), + show_data_in = "popup", + trigger_return = "change", + return_class = "data.frame", + read_fns = list( + ods = import_ods, + dta = function(file) { + haven::read_dta( + file = file, + .name_repair = "unique_quiet" + ) + }, + csv = import_delim, + tsv = import_delim, + txt = import_delim, + xls = import_xls, + xlsx = import_xls, + rds = function(file) { + readr::read_rds( + file = file, + name_repair = "unique_quiet" + ) + } + ) + ) + + shiny::observeEvent(data_file$data(), { + shiny::req(data_file$data()) + browser() + rv$data_temp <- data_file$data() + rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") + }) + + data_redcap <- m_redcap_readServer( + id = "redcap_import" + ) + + shiny::observeEvent(data_redcap(), { + # rv$data_original <- purrr::pluck(data_redcap(), "data")() + rv$data_temp <- data_redcap() + }) + + from_env <- datamods::import_globalenv_server( + id = "env", + trigger_return = "change", + btn_show_data = FALSE, + reset = reactive(input$hidden) + ) + + shiny::observeEvent(from_env$data(), { + shiny::req(from_env$data()) + + rv$data_temp <- from_env$data() + # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import") + }) + + return(list( + # status = reactive(temporary_rv$status), + # name = reactive(temporary_rv$name), + # code = reactive(temporary_rv$code), + data = shiny::reactive(rv$data_temp) + )) + + } + + shiny::moduleServer( + id = id, + module = module + ) + + } + + +#' Test app for the data-import module #' -#' shiny::fluidRow( -#' shiny::column(width = 2), -#' shiny::column( -#' width = 8, -#' shiny::h4("Choose your data source"), -#' shiny::br(), -#' shinyWidgets::radioGroupButtons( -#' inputId = "source", -#' selected = "env", -#' choices = c( -#' "File upload" = "file", -#' "REDCap server export" = "redcap", -#' "Local or sample data" = "env" -#' ), -#' width = "100%" -#' ), -#' shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."), -#' shiny::br(), -#' shiny::br(), -#' shiny::conditionalPanel( -#' condition = "input.source=='file'", -#' import_file_ui( -#' id = "file_import", -#' layout_params = "dropdown", -#' title = "Choose a datafile to upload", -#' file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") -#' ) -#' ), -#' shiny::conditionalPanel( -#' condition = "input.source=='redcap'", -#' m_redcap_readUI("redcap_import") -#' ), -#' shiny::conditionalPanel( -#' condition = "input.source=='env'", -#' import_globalenv_ui(id = "env", title = NULL) -#' ), -#' shiny::conditionalPanel( -#' condition = "input.source=='redcap'", -#' DT::DTOutput(outputId = "redcap_prev") -#' ), -#' shiny::br(), -#' shiny::br(), -#' shiny::h5("Specify variables to include"), -#' shiny::fluidRow( -#' shiny::column( -#' width = 6, -#' shiny::br(), -#' shiny::p("Filter by completeness threshold and manual selection:"), -#' shiny::br(), -#' 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("Filter variables with completeness above the specified percentage."), -#' shiny::br(), -#' shiny::br(), -#' shiny::uiOutput(outputId = "import_var") -#' ) -#' ), -#' shiny::br(), -#' shiny::br(), -#' shiny::actionButton( -#' inputId = "act_start", -#' label = "Start", -#' width = "100%", -#' icon = shiny::icon("play"), -#' disabled = TRUE -#' ), -#' shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), -#' shiny::br(), -#' shiny::br(), -#' shiny::column(width = 2) -#' ) -#' ) -#' } +#' @rdname data-import #' -#' -#' data_import_server <- function(id) { -#' module <- function(input, output, session) { -#' ns <- session$ns -#' -#' rv <- shiny::reactiveValues( -#' data_original = NULL, -#' data_temp = NULL, -#' data = NULL, -#' code = list() -#' ) -#' -#' data_file <- import_file_server( -#' id = "file_import", -#' show_data_in = "popup", -#' trigger_return = "change", -#' return_class = "data.frame", -#' read_fns = list( -#' ods = import_ods, -#' dta = function(file) { -#' haven::read_dta( -#' file = file, -#' .name_repair = "unique_quiet" -#' ) -#' }, -#' # csv = function(file) { -#' # readr::read_csv( -#' # file = file, -#' # na = consider.na, -#' # name_repair = "unique_quiet" -#' # ) -#' # }, -#' csv = import_delim, -#' tsv = import_delim, -#' txt = import_delim, -#' xls = import_xls, -#' xlsx = import_xls, -#' rds = function(file) { -#' readr::read_rds( -#' file = file, -#' name_repair = "unique_quiet" -#' ) -#' } -#' ) -#' ) -#' -#' shiny::observeEvent(data_file$data(), { -#' shiny::req(data_file$data()) -#' rv$data_temp <- data_file$data() -#' rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") -#' }) -#' -#' data_redcap <- m_redcap_readServer( -#' id = "redcap_import" # , -#' # output.format = "list" -#' ) -#' -#' shiny::observeEvent(data_redcap(), { -#' # rv$data_original <- purrr::pluck(data_redcap(), "data")() -#' rv$data_temp <- data_redcap() -#' }) -#' -#' output$redcap_prev <- DT::renderDT( -#' { -#' DT::datatable(head(data_redcap(), 5), -#' # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5), -#' caption = "First 5 observations" -#' ) -#' }, -#' server = TRUE -#' ) -#' -#' from_env <- datamods::import_globalenv_server( -#' id = "env", -#' trigger_return = "change", -#' btn_show_data = FALSE, -#' reset = reactive(input$hidden) -#' ) -#' -#' shiny::observeEvent(from_env$data(), { -#' shiny::req(from_env$data()) -#' -#' rv$data_temp <- from_env$data() -#' # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import") -#' }) -#' -#' output$import_var <- shiny::renderUI({ -#' shiny::req(rv$data_temp) -#' -#' preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100] -#' -#' shinyWidgets::virtualSelectInput( -#' inputId = "import_var", -#' label = "Select variables to include", -#' selected = preselect, -#' choices = names(rv$data_temp), -#' updateOn = "close", -#' multiple = TRUE, -#' search = TRUE, -#' showValueAsTags = TRUE -#' ) -#' }) -#' -#' -#' shiny::observeEvent( -#' eventExpr = list( -#' input$import_var -#' ), -#' handlerExpr = { -#' shiny::req(rv$data_temp) -#' -#' rv$data_original <- rv$data_temp |> -#' dplyr::select(input$import_var) |> -#' # janitor::clean_names() |> -#' default_parsing() -#' } -#' ) -#' -#' return(shiny::reactive(rv$data_original)) -#' -#' } -#' -#' shiny::moduleServer( -#' id = id, -#' module = module -#' ) -#' -#' } -#' -#' -#' #' Test app for the data-import module -#' #' -#' #' @rdname data-import -#' #' -#' #' @examples -#' #' \dontrun{ -#' #' data_import_demo_app() -#' #' } -#' data_import_demo_app <- function() { -#' ui <- shiny::fluidPage( -#' data_import_ui("data") -#' ) -#' server <- function(input, output, session) { -#' data_val <- shiny::reactiveValues(data = NULL) -#' -#' -#' data_val$data <- data_import_server(id = "data") -#' -#' output$data_summary <- DT::renderDataTable( -#' { -#' shiny::req(data_val$data) -#' data_val$data() -#' }, -#' options = list( -#' scrollX = TRUE, -#' pageLength = 5 -#' ), -#' ) -#' } -#' shiny::shinyApp(ui, server) +#' @examples +#' \dontrun{ +#' data_import_demo_app() #' } +data_import_demo_app <- function() { + ui <- shiny::fluidPage( + data_import_ui("data_import"), + toastui::datagridOutput2(outputId = "table"), + DT::DTOutput("data_summary") + ) + server <- function(input, output, session) { + imported <- shiny::reactive(data_import_server(id = "data_import")) + + # output$data_summary <- DT::renderDataTable( + # { + # shiny::req(data_val$data) + # data_val$data + # }, + # options = list( + # scrollX = TRUE, + # pageLength = 5 + # ) + # ) + output$table <- toastui::renderDatagrid2({ + req(imported$data) + toastui::datagrid( + data = head(imported$data, 5), + theme = "striped", + colwidths = "guess", + minBodyHeight = 250 + ) + }) + + } + shiny::shinyApp(ui, server) +} diff --git a/R/import-file-ext.R b/R/import-file-ext.R index d4441908..5e905009 100644 --- a/R/import-file-ext.R +++ b/R/import-file-ext.R @@ -85,7 +85,9 @@ import_file_ui <- function(id, buttonLabel = datamods:::i18n("Browse..."), placeholder = datamods:::i18n("No file selected"), accept = file_extensions, - width = "100%" + width = "100%", + ## A solution to allow multiple file upload is being considered + multiple = FALSE ), class = "mb-0" ) @@ -145,35 +147,23 @@ import_file_ui <- function(id, ) ), if (isTRUE(preview_data)) { - toastui::datagridOutput2(outputId = ns("table")) - } - , + toastui::datagridOutput2(outputId = ns("table")) + }, shiny::uiOutput( outputId = ns("container_confirm_btn"), style = "margin-top: 20px;" - ) , + ), tags$div( style = htmltools::css(display = "none"), - shiny::checkboxInput( - inputId = ns("preview_data"), - label = NULL, - value = isTRUE(preview_data) - ) + shiny::checkboxInput( + inputId = ns("preview_data"), + label = NULL, + value = isTRUE(preview_data) + ) ) ) } - -#' @param read_fns Named list with custom function(s) to read data: -#' * the name must be the extension of the files to which the function will be applied -#' * the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names), -#' passed by user through the interface: -#' + `file`: path to the file -#' + `sheet`: for Excel files, sheet to read -#' + `skip`: number of row to skip -#' + `dec`: decimal separator -#' + `encoding`: file encoding -#' + `na.strings`: character(s) to interpret as missing values. #' #' @export #' @@ -184,16 +174,17 @@ import_file_server <- function(id, show_data_in = c("popup", "modal"), trigger_return = c("button", "change"), return_class = c("data.frame", "data.table", "tbl_df", "raw"), - reset = reactive(NULL), - read_fns = list()) { - if (length(read_fns) > 0) { - if (!rlang::is_named(read_fns)) { - stop("import_file_server: `read_fns` must be a named list.", call. = FALSE) - } - if (!all(vapply(read_fns, rlang::is_function, logical(1)))) { - stop("import_file_server: `read_fns` must be list of function(s).", call. = FALSE) - } - } + reset = reactive(NULL)) { + read_fns <- list( + ods = "import_ods", + dta = "import_dta", + csv = "import_delim", + tsv = "import_delim", + txt = "import_delim", + xls = "import_xls", + xlsx = "import_xls", + rds = "import_rds" + ) trigger_return <- match.arg(trigger_return) return_class <- match.arg(return_class) @@ -262,9 +253,11 @@ import_file_server <- function(id, encoding = input$encoding, na.strings = datamods:::split_char(input$na_label) ) - parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))] + # browser() + parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))] + # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))] imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE) - code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name))) + code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR") if (inherits(imported, "try-error")) { imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE) @@ -361,11 +354,19 @@ is_workbook <- function(path) { is_excel(path) || is_ods(path) } -#' Wrapper of data.table::fread to import delim files with few presets + +# File import functions --------------------------------------------------- + +#' Wrapper to ease data file import #' -#' @param file file -#' @param encoding encoding -#' @param na.strings na.strings +#' @param file path to the file +#' @param sheet for Excel files, sheet to read +#' @param skip number of row to skip +#' @param encoding file encoding +#' @param na.strings character(s) to interpret as missing values. +#' +#' +#' @name import-file-type #' #' @returns data.frame #' @export @@ -384,6 +385,12 @@ import_delim <- function(file, skip, encoding, na.strings) { ) } + +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' import_xls <- function(file, sheet, skip, na.strings) { tryCatch( { @@ -409,6 +416,12 @@ import_xls <- function(file, sheet, skip, na.strings) { ) } + +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' import_ods <- function(file, sheet, skip, na.strings) { tryCatch( { @@ -432,6 +445,30 @@ import_ods <- function(file, sheet, skip, na.strings) { ) } +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' +import_dta <- function(file) { + haven::read_dta( + file = file, + .name_repair = "unique_quiet" + ) +} + +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' +import_rds <- function(file) { + readr::read_rds( + file = file, + name_repair = "unique_quiet" + ) +} + #' @title Create a select input control with icon(s) #' #' @description Extend form controls by adding text or icons before, @@ -515,35 +552,7 @@ import_file_demo_app <- function() { id = "myid", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame", - # Custom functions to read data - read_fns = list( - ods = import_ods, - dta = function(file) { - haven::read_dta( - file = file, - .name_repair = "unique_quiet" - ) - }, - # csv = function(file) { - # readr::read_csv( - # file = file, - # na = consider.na, - # name_repair = "unique_quiet" - # ) - # }, - csv = import_delim, - tsv = import_delim, - txt = import_delim, - xls = import_xls, - xlsx = import_xls, - rds = function(file) { - readr::read_rds( - file = file, - name_repair = "unique_quiet" - ) - } - ) + return_class = "data.frame" ) output$status <- shiny::renderPrint({ diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index e09742a5..9036c5e2 100644 --- a/R/redcap_read_shiny_module.R +++ b/R/redcap_read_shiny_module.R @@ -143,7 +143,7 @@ m_redcap_readServer <- function(id) { dd_list = NULL, data = NULL, rep_fields = NULL, - imported = NULL + code = NULL ) shiny::observeEvent(list(input$api, input$uri), { @@ -340,7 +340,10 @@ m_redcap_readServer <- function(id) { 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) + + code <- rlang::call2("read_redcap_tables", + !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")), + , .ns = "REDCapCAST") if (inherits(imported, "try-error") || NROW(imported) < 1) { @@ -375,6 +378,8 @@ m_redcap_readServer <- function(id) { } } + data_rv$code <- code + data_rv$data <- out |> dplyr::select(-dplyr::ends_with("_complete")) |> # dplyr::select(-dplyr::any_of(record_id)) |> @@ -390,7 +395,13 @@ m_redcap_readServer <- function(id) { # # }) - return(shiny::reactive(data_rv$data)) + return(list( + status = shiny::reactive(data_rv$data_status), + name = shiny::reactive(data_rv$info$project_title), + info = shiny::reactive(data_rv$info), + code = shiny::reactive(data_rv$code), + data = shiny::reactive(data_rv$data) + )) } shiny::moduleServer( @@ -543,15 +554,15 @@ drop_empty_event <- function(data, event = "redcap_event_name") { redcap_demo_app <- function() { ui <- shiny::fluidPage( m_redcap_readUI("data"), - DT::DTOutput("data_summary") + DT::DTOutput("data"), + shiny::tags$b("Code:"), + shiny::verbatimTextOutput(outputId = "code") ) server <- function(input, output, session) { - data_val <- shiny::reactiveValues(data = NULL) + data_val <- m_redcap_readServer(id = "data") - data_val$data <- m_redcap_readServer(id = "data") - - output$data_summary <- DT::renderDataTable( + output$data <- DT::renderDataTable( { shiny::req(data_val$data) data_val$data() @@ -561,6 +572,10 @@ redcap_demo_app <- function() { pageLength = 5 ), ) + output$code <- shiny::renderPrint({ + shiny::req(data_val$code) + data_val$code() + }) } shiny::shinyApp(ui, server) } diff --git a/ROADMAP.md b/ROADMAP.md index e6fdce1f..2abaf2fd 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -38,6 +38,6 @@ Below are some (the actual list is quite long and growing) of the planned featur - [x] Correlation matrix plot for data exploration 2025-2-20 - - [ ] Grotta bars for ordianl outcomes + - [x] Grotta bars for ordianl outcomes (and sankey) 2025-3-17 - [x] Coefficient plotting for regression analyses (forest plot) 2025-2-20 diff --git a/inst/apps/freesearcheR/app.R b/inst/apps/freesearcheR/app.R index 419fa9c8..95775503 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()'250313_1502' +app_version <- function()'250317_1458' ######## @@ -1671,256 +1671,177 @@ allign_axes <- function(...) { #### Current file: R//data-import.R ######## -#' data_import_ui <- function(id, include_title = TRUE) { -#' ns <- shiny::NS(id) +data_import_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::fluidRow( + shiny::column(width = 2), + shiny::column( + width = 8, + shiny::h4("Choose your data source"), + shiny::br(), + shinyWidgets::radioGroupButtons( + inputId = "source", + selected = "env", + choices = c( + "File upload" = "file", + "REDCap server export" = "redcap", + "Local or sample data" = "env" + ), + width = "100%" + ), + shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."), + shiny::br(), + shiny::br(), + shiny::conditionalPanel( + condition = "input.source=='file'", + import_file_ui( + id = ns("file_import"), + layout_params = "dropdown", + title = "Choose a datafile to upload", + file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") + ) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + m_redcap_readUI(id = ns("redcap_import")) + ), + shiny::conditionalPanel( + condition = "input.source=='env'", + import_globalenv_ui(id = ns("env"), title = NULL) + ), + shiny::conditionalPanel( + condition = "input.source=='redcap'", + DT::DTOutput(outputId = ns("redcap_prev")) + ) + ) + ) + } + + +data_import_server <- function(id) { + module <- function(input, output, session) { + ns <- session$ns + + rv <- shiny::reactiveValues( + data_temp = NULL, + code = list() + ) + + data_file <- import_file_server( + id = ns("file_import"), + show_data_in = "popup", + trigger_return = "change", + return_class = "data.frame", + read_fns = list( + ods = import_ods, + dta = function(file) { + haven::read_dta( + file = file, + .name_repair = "unique_quiet" + ) + }, + csv = import_delim, + tsv = import_delim, + txt = import_delim, + xls = import_xls, + xlsx = import_xls, + rds = function(file) { + readr::read_rds( + file = file, + name_repair = "unique_quiet" + ) + } + ) + ) + + shiny::observeEvent(data_file$data(), { + shiny::req(data_file$data()) + browser() + rv$data_temp <- data_file$data() + rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") + }) + + data_redcap <- m_redcap_readServer( + id = "redcap_import" + ) + + shiny::observeEvent(data_redcap(), { + # rv$data_original <- purrr::pluck(data_redcap(), "data")() + rv$data_temp <- data_redcap() + }) + + from_env <- datamods::import_globalenv_server( + id = "env", + trigger_return = "change", + btn_show_data = FALSE, + reset = reactive(input$hidden) + ) + + shiny::observeEvent(from_env$data(), { + shiny::req(from_env$data()) + + rv$data_temp <- from_env$data() + # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import") + }) + + return(list( + # status = reactive(temporary_rv$status), + # name = reactive(temporary_rv$name), + # code = reactive(temporary_rv$code), + data = shiny::reactive(rv$data_temp) + )) + + } + + shiny::moduleServer( + id = id, + module = module + ) + + } + + +#' Test app for the data-import module #' -#' shiny::fluidRow( -#' shiny::column(width = 2), -#' shiny::column( -#' width = 8, -#' shiny::h4("Choose your data source"), -#' shiny::br(), -#' shinyWidgets::radioGroupButtons( -#' inputId = "source", -#' selected = "env", -#' choices = c( -#' "File upload" = "file", -#' "REDCap server export" = "redcap", -#' "Local or sample data" = "env" -#' ), -#' width = "100%" -#' ), -#' shiny::helpText("Upload a file from your device, get data directly from REDCap or select a sample data set for testing from the app."), -#' shiny::br(), -#' shiny::br(), -#' shiny::conditionalPanel( -#' condition = "input.source=='file'", -#' import_file_ui( -#' id = "file_import", -#' layout_params = "dropdown", -#' title = "Choose a datafile to upload", -#' file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") -#' ) -#' ), -#' shiny::conditionalPanel( -#' condition = "input.source=='redcap'", -#' m_redcap_readUI("redcap_import") -#' ), -#' shiny::conditionalPanel( -#' condition = "input.source=='env'", -#' import_globalenv_ui(id = "env", title = NULL) -#' ), -#' shiny::conditionalPanel( -#' condition = "input.source=='redcap'", -#' DT::DTOutput(outputId = "redcap_prev") -#' ), -#' shiny::br(), -#' shiny::br(), -#' shiny::h5("Specify variables to include"), -#' shiny::fluidRow( -#' shiny::column( -#' width = 6, -#' shiny::br(), -#' shiny::p("Filter by completeness threshold and manual selection:"), -#' shiny::br(), -#' 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("Filter variables with completeness above the specified percentage."), -#' shiny::br(), -#' shiny::br(), -#' shiny::uiOutput(outputId = "import_var") -#' ) -#' ), -#' shiny::br(), -#' shiny::br(), -#' shiny::actionButton( -#' inputId = "act_start", -#' label = "Start", -#' width = "100%", -#' icon = shiny::icon("play"), -#' disabled = TRUE -#' ), -#' shiny::helpText('After importing, hit "Start" or navigate to the desired tab.'), -#' shiny::br(), -#' shiny::br(), -#' shiny::column(width = 2) -#' ) -#' ) -#' } +#' @rdname data-import #' -#' -#' data_import_server <- function(id) { -#' module <- function(input, output, session) { -#' ns <- session$ns -#' -#' rv <- shiny::reactiveValues( -#' data_original = NULL, -#' data_temp = NULL, -#' data = NULL, -#' code = list() -#' ) -#' -#' data_file <- import_file_server( -#' id = "file_import", -#' show_data_in = "popup", -#' trigger_return = "change", -#' return_class = "data.frame", -#' read_fns = list( -#' ods = import_ods, -#' dta = function(file) { -#' haven::read_dta( -#' file = file, -#' .name_repair = "unique_quiet" -#' ) -#' }, -#' # csv = function(file) { -#' # readr::read_csv( -#' # file = file, -#' # na = consider.na, -#' # name_repair = "unique_quiet" -#' # ) -#' # }, -#' csv = import_delim, -#' tsv = import_delim, -#' txt = import_delim, -#' xls = import_xls, -#' xlsx = import_xls, -#' rds = function(file) { -#' readr::read_rds( -#' file = file, -#' name_repair = "unique_quiet" -#' ) -#' } -#' ) -#' ) -#' -#' shiny::observeEvent(data_file$data(), { -#' shiny::req(data_file$data()) -#' rv$data_temp <- data_file$data() -#' rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") -#' }) -#' -#' data_redcap <- m_redcap_readServer( -#' id = "redcap_import" # , -#' # output.format = "list" -#' ) -#' -#' shiny::observeEvent(data_redcap(), { -#' # rv$data_original <- purrr::pluck(data_redcap(), "data")() -#' rv$data_temp <- data_redcap() -#' }) -#' -#' output$redcap_prev <- DT::renderDT( -#' { -#' DT::datatable(head(data_redcap(), 5), -#' # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5), -#' caption = "First 5 observations" -#' ) -#' }, -#' server = TRUE -#' ) -#' -#' from_env <- datamods::import_globalenv_server( -#' id = "env", -#' trigger_return = "change", -#' btn_show_data = FALSE, -#' reset = reactive(input$hidden) -#' ) -#' -#' shiny::observeEvent(from_env$data(), { -#' shiny::req(from_env$data()) -#' -#' rv$data_temp <- from_env$data() -#' # rv$code <- append_list(data = from_env$code(),list = rv$code,index = "import") -#' }) -#' -#' output$import_var <- shiny::renderUI({ -#' shiny::req(rv$data_temp) -#' -#' preselect <- names(rv$data_temp)[sapply(rv$data_temp, missing_fraction) <= input$complete_cutoff / 100] -#' -#' shinyWidgets::virtualSelectInput( -#' inputId = "import_var", -#' label = "Select variables to include", -#' selected = preselect, -#' choices = names(rv$data_temp), -#' updateOn = "close", -#' multiple = TRUE, -#' search = TRUE, -#' showValueAsTags = TRUE -#' ) -#' }) -#' -#' -#' shiny::observeEvent( -#' eventExpr = list( -#' input$import_var -#' ), -#' handlerExpr = { -#' shiny::req(rv$data_temp) -#' -#' rv$data_original <- rv$data_temp |> -#' dplyr::select(input$import_var) |> -#' # janitor::clean_names() |> -#' default_parsing() -#' } -#' ) -#' -#' return(shiny::reactive(rv$data_original)) -#' -#' } -#' -#' shiny::moduleServer( -#' id = id, -#' module = module -#' ) -#' -#' } -#' -#' -#' #' Test app for the data-import module -#' #' -#' #' @rdname data-import -#' #' -#' #' @examples -#' #' \dontrun{ -#' #' data_import_demo_app() -#' #' } -#' data_import_demo_app <- function() { -#' ui <- shiny::fluidPage( -#' data_import_ui("data") -#' ) -#' server <- function(input, output, session) { -#' data_val <- shiny::reactiveValues(data = NULL) -#' -#' -#' data_val$data <- data_import_server(id = "data") -#' -#' output$data_summary <- DT::renderDataTable( -#' { -#' shiny::req(data_val$data) -#' data_val$data() -#' }, -#' options = list( -#' scrollX = TRUE, -#' pageLength = 5 -#' ), -#' ) -#' } -#' shiny::shinyApp(ui, server) +#' @examples +#' \dontrun{ +#' data_import_demo_app() #' } +data_import_demo_app <- function() { + ui <- shiny::fluidPage( + data_import_ui("data_import"), + toastui::datagridOutput2(outputId = "table"), + DT::DTOutput("data_summary") + ) + server <- function(input, output, session) { + imported <- shiny::reactive(data_import_server(id = "data_import")) + + # output$data_summary <- DT::renderDataTable( + # { + # shiny::req(data_val$data) + # data_val$data + # }, + # options = list( + # scrollX = TRUE, + # pageLength = 5 + # ) + # ) + output$table <- toastui::renderDatagrid2({ + req(imported$data) + toastui::datagrid( + data = head(imported$data, 5), + theme = "striped", + colwidths = "guess", + minBodyHeight = 250 + ) + }) + + } + shiny::shinyApp(ui, server) +} ######## @@ -2768,7 +2689,9 @@ import_file_ui <- function(id, buttonLabel = datamods:::i18n("Browse..."), placeholder = datamods:::i18n("No file selected"), accept = file_extensions, - width = "100%" + width = "100%", + ## A solution to allow multiple file upload is being considered + multiple = FALSE ), class = "mb-0" ) @@ -2828,35 +2751,23 @@ import_file_ui <- function(id, ) ), if (isTRUE(preview_data)) { - toastui::datagridOutput2(outputId = ns("table")) - } - , + toastui::datagridOutput2(outputId = ns("table")) + }, shiny::uiOutput( outputId = ns("container_confirm_btn"), style = "margin-top: 20px;" - ) , + ), tags$div( style = htmltools::css(display = "none"), - shiny::checkboxInput( - inputId = ns("preview_data"), - label = NULL, - value = isTRUE(preview_data) - ) + shiny::checkboxInput( + inputId = ns("preview_data"), + label = NULL, + value = isTRUE(preview_data) + ) ) ) } - -#' @param read_fns Named list with custom function(s) to read data: -#' * the name must be the extension of the files to which the function will be applied -#' * the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names), -#' passed by user through the interface: -#' + `file`: path to the file -#' + `sheet`: for Excel files, sheet to read -#' + `skip`: number of row to skip -#' + `dec`: decimal separator -#' + `encoding`: file encoding -#' + `na.strings`: character(s) to interpret as missing values. #' #' @export #' @@ -2867,16 +2778,17 @@ import_file_server <- function(id, show_data_in = c("popup", "modal"), trigger_return = c("button", "change"), return_class = c("data.frame", "data.table", "tbl_df", "raw"), - reset = reactive(NULL), - read_fns = list()) { - if (length(read_fns) > 0) { - if (!rlang::is_named(read_fns)) { - stop("import_file_server: `read_fns` must be a named list.", call. = FALSE) - } - if (!all(vapply(read_fns, rlang::is_function, logical(1)))) { - stop("import_file_server: `read_fns` must be list of function(s).", call. = FALSE) - } - } + reset = reactive(NULL)) { + read_fns <- list( + ods = "import_ods", + dta = "import_dta", + csv = "import_delim", + tsv = "import_delim", + txt = "import_delim", + xls = "import_xls", + xlsx = "import_xls", + rds = "import_rds" + ) trigger_return <- match.arg(trigger_return) return_class <- match.arg(return_class) @@ -2945,9 +2857,11 @@ import_file_server <- function(id, encoding = input$encoding, na.strings = datamods:::split_char(input$na_label) ) - parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))] + # browser() + parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))] + # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))] imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE) - code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name))) + code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name)), .ns = "freesearcheR") if (inherits(imported, "try-error")) { imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE) @@ -3044,11 +2958,19 @@ is_workbook <- function(path) { is_excel(path) || is_ods(path) } -#' Wrapper of data.table::fread to import delim files with few presets + +# File import functions --------------------------------------------------- + +#' Wrapper to ease data file import #' -#' @param file file -#' @param encoding encoding -#' @param na.strings na.strings +#' @param file path to the file +#' @param sheet for Excel files, sheet to read +#' @param skip number of row to skip +#' @param encoding file encoding +#' @param na.strings character(s) to interpret as missing values. +#' +#' +#' @name import-file-type #' #' @returns data.frame #' @export @@ -3067,6 +2989,12 @@ import_delim <- function(file, skip, encoding, na.strings) { ) } + +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' import_xls <- function(file, sheet, skip, na.strings) { tryCatch( { @@ -3092,6 +3020,12 @@ import_xls <- function(file, sheet, skip, na.strings) { ) } + +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' import_ods <- function(file, sheet, skip, na.strings) { tryCatch( { @@ -3115,6 +3049,30 @@ import_ods <- function(file, sheet, skip, na.strings) { ) } +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' +import_dta <- function(file) { + haven::read_dta( + file = file, + .name_repair = "unique_quiet" + ) +} + +#' @name import-file-type +#' +#' @returns data.frame +#' @export +#' +import_rds <- function(file) { + readr::read_rds( + file = file, + name_repair = "unique_quiet" + ) +} + #' @title Create a select input control with icon(s) #' #' @description Extend form controls by adding text or icons before, @@ -3198,35 +3156,7 @@ import_file_demo_app <- function() { id = "myid", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame", - # Custom functions to read data - read_fns = list( - ods = import_ods, - dta = function(file) { - haven::read_dta( - file = file, - .name_repair = "unique_quiet" - ) - }, - # csv = function(file) { - # readr::read_csv( - # file = file, - # na = consider.na, - # name_repair = "unique_quiet" - # ) - # }, - csv = import_delim, - tsv = import_delim, - txt = import_delim, - xls = import_xls, - xlsx = import_xls, - rds = function(file) { - readr::read_rds( - file = file, - name_repair = "unique_quiet" - ) - } - ) + return_class = "data.frame" ) output$status <- shiny::renderPrint({ @@ -3937,7 +3867,7 @@ m_redcap_readServer <- function(id) { dd_list = NULL, data = NULL, rep_fields = NULL, - imported = NULL + code = NULL ) shiny::observeEvent(list(input$api, input$uri), { @@ -4134,7 +4064,10 @@ m_redcap_readServer <- function(id) { 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) + + code <- rlang::call2("read_redcap_tables", + !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")), + , .ns = "REDCapCAST") if (inherits(imported, "try-error") || NROW(imported) < 1) { @@ -4169,6 +4102,8 @@ m_redcap_readServer <- function(id) { } } + data_rv$code <- code + data_rv$data <- out |> dplyr::select(-dplyr::ends_with("_complete")) |> # dplyr::select(-dplyr::any_of(record_id)) |> @@ -4184,7 +4119,13 @@ m_redcap_readServer <- function(id) { # # }) - return(shiny::reactive(data_rv$data)) + return(list( + status = shiny::reactive(data_rv$data_status), + name = shiny::reactive(data_rv$info$project_title), + info = shiny::reactive(data_rv$info), + code = shiny::reactive(data_rv$code), + data = shiny::reactive(data_rv$data) + )) } shiny::moduleServer( @@ -4337,15 +4278,15 @@ drop_empty_event <- function(data, event = "redcap_event_name") { redcap_demo_app <- function() { ui <- shiny::fluidPage( m_redcap_readUI("data"), - DT::DTOutput("data_summary") + DT::DTOutput("data"), + shiny::tags$b("Code:"), + shiny::verbatimTextOutput(outputId = "code") ) server <- function(input, output, session) { - data_val <- shiny::reactiveValues(data = NULL) + data_val <- m_redcap_readServer(id = "data") - data_val$data <- m_redcap_readServer(id = "data") - - output$data_summary <- DT::renderDataTable( + output$data <- DT::renderDataTable( { shiny::req(data_val$data) data_val$data() @@ -4355,6 +4296,10 @@ redcap_demo_app <- function() { pageLength = 5 ), ) + output$code <- shiny::renderPrint({ + shiny::req(data_val$code) + data_val$code() + }) } shiny::shinyApp(ui, server) } @@ -6773,7 +6718,7 @@ ui_elements <- list( id = "file_import", layout_params = "dropdown", # title = "Choose a datafile to upload", - file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") + file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta") ) ), shiny::conditionalPanel( @@ -7456,34 +7401,7 @@ server <- function(input, output, session) { id = "file_import", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame", - read_fns = list( - ods = import_ods, - dta = function(file) { - haven::read_dta( - file = file, - .name_repair = "unique_quiet" - ) - }, - # csv = function(file) { - # readr::read_csv( - # file = file, - # na = consider.na, - # name_repair = "unique_quiet" - # ) - # }, - csv = import_delim, - tsv = import_delim, - txt = import_delim, - xls = import_xls, - xlsx = import_xls, - rds = function(file) { - readr::read_rds( - file = file, - name_repair = "unique_quiet" - ) - } - ) + return_class = "data.frame" ) shiny::observeEvent(data_file$data(), { @@ -7492,18 +7410,19 @@ server <- function(input, output, session) { rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") }) - data_redcap <- m_redcap_readServer( + from_redcap <- m_redcap_readServer( id = "redcap_import" ) - shiny::observeEvent(data_redcap(), { + shiny::observeEvent(from_redcap$data(), { # rv$data_original <- purrr::pluck(data_redcap(), "data")() - rv$data_temp <- data_redcap() + rv$data_temp <- from_redcap$data() + rv$code <- append_list(data = from_redcap$code(),list = rv$code,index = "import") }) output$redcap_prev <- DT::renderDT( { - DT::datatable(head(data_redcap(), 5), + DT::datatable(head(from_redcap$data(), 5), # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5), caption = "First 5 observations" ) @@ -7552,8 +7471,20 @@ server <- function(input, output, session) { rv$data_original <- rv$data_temp |> dplyr::select(input$import_var) |> - # janitor::clean_names() |> default_parsing() + + rv$code$import <- rv$code$import |> + deparse() |> + paste(collapse="") |> + paste("|> + dplyr::select(tidyselect::all_of(c(",paste(input$import_var,collapse=","),"))) |> + freesearcheR::default_parsing()") |> + (\(.x){ + paste0("data <- ",.x) + })() + + rv$code$filter <- NULL + rv$code$modify <- NULL } ) @@ -7590,6 +7521,8 @@ server <- function(input, output, session) { if (isTRUE(input$reset_confirm)) { shiny::req(rv$data_original) rv$data <- rv$data_original + rv$code$filter <- NULL + rv$code$modify <- NULL } }, ignoreNULL = TRUE @@ -7647,7 +7580,10 @@ server <- function(input, output, session) { data_r = shiny::reactive(rv$data) ) - shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut()) + shiny::observeEvent(data_modal_cut(), { + rv$data <- data_modal_cut() + rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") + }) ######### Modify factor @@ -7664,6 +7600,7 @@ server <- function(input, output, session) { shiny::observeEvent(data_modal_update(), { shiny::removeModal() rv$data <- data_modal_update() + rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") }) ######### Create column @@ -7684,6 +7621,7 @@ server <- function(input, output, session) { data_modal_r(), { rv$data <- data_modal_r() + rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") } ) @@ -7711,9 +7649,9 @@ server <- function(input, output, session) { } ) - output$code <- renderPrint({ - attr(rv$data, "code") - }) + # output$code <- renderPrint({ + # attr(rv$data, "code") + # }) # updated_data <- datamods::update_variables_server( updated_data <- update_variables_server( @@ -7786,33 +7724,17 @@ server <- function(input, output, session) { } ) - # output$filtered_code <- shiny::renderPrint({ - # out <- gsub( - # "filter", "dplyr::filter", - # gsub( - # "\\s{2,}", " ", - # paste0( - # capture.output(attr(rv$data_filtered, "code")), - # collapse = " " - # ) - # ) - # ) - # - # out <- strsplit(out, "%>%") |> - # unlist() |> - # (\(.x){ - # paste(c("data", .x[-1]), collapse = "|> \n ") - # })() - # - # cat(out) - # }) - output$code_import <- shiny::renderPrint({ - cat(rv$code$import) + rv$code$import }) output$code_data <- shiny::renderPrint({ - attr(rv$data, "code") + ls <- rv$code$modify |> unique() + out <- paste("data |> \n", + sapply(ls,\(.x) paste(deparse(.x),collapse=",")), + collapse="|> \n") + cat(out) + # attr(rv$data, "code") }) output$code_filter <- shiny::renderPrint({ diff --git a/inst/apps/freesearcheR/server.R b/inst/apps/freesearcheR/server.R index 6f26ff67..6ed60622 100644 --- a/inst/apps/freesearcheR/server.R +++ b/inst/apps/freesearcheR/server.R @@ -97,34 +97,7 @@ server <- function(input, output, session) { id = "file_import", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame", - read_fns = list( - ods = import_ods, - dta = function(file) { - haven::read_dta( - file = file, - .name_repair = "unique_quiet" - ) - }, - # csv = function(file) { - # readr::read_csv( - # file = file, - # na = consider.na, - # name_repair = "unique_quiet" - # ) - # }, - csv = import_delim, - tsv = import_delim, - txt = import_delim, - xls = import_xls, - xlsx = import_xls, - rds = function(file) { - readr::read_rds( - file = file, - name_repair = "unique_quiet" - ) - } - ) + return_class = "data.frame" ) shiny::observeEvent(data_file$data(), { @@ -133,18 +106,19 @@ server <- function(input, output, session) { rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") }) - data_redcap <- m_redcap_readServer( + from_redcap <- m_redcap_readServer( id = "redcap_import" ) - shiny::observeEvent(data_redcap(), { + shiny::observeEvent(from_redcap$data(), { # rv$data_original <- purrr::pluck(data_redcap(), "data")() - rv$data_temp <- data_redcap() + rv$data_temp <- from_redcap$data() + rv$code <- append_list(data = from_redcap$code(),list = rv$code,index = "import") }) output$redcap_prev <- DT::renderDT( { - DT::datatable(head(data_redcap(), 5), + DT::datatable(head(from_redcap$data(), 5), # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5), caption = "First 5 observations" ) @@ -193,8 +167,20 @@ server <- function(input, output, session) { rv$data_original <- rv$data_temp |> dplyr::select(input$import_var) |> - # janitor::clean_names() |> default_parsing() + + rv$code$import <- rv$code$import |> + deparse() |> + paste(collapse="") |> + paste("|> + dplyr::select(tidyselect::all_of(c(",paste(input$import_var,collapse=","),"))) |> + freesearcheR::default_parsing()") |> + (\(.x){ + paste0("data <- ",.x) + })() + + rv$code$filter <- NULL + rv$code$modify <- NULL } ) @@ -231,6 +217,8 @@ server <- function(input, output, session) { if (isTRUE(input$reset_confirm)) { shiny::req(rv$data_original) rv$data <- rv$data_original + rv$code$filter <- NULL + rv$code$modify <- NULL } }, ignoreNULL = TRUE @@ -288,7 +276,10 @@ server <- function(input, output, session) { data_r = shiny::reactive(rv$data) ) - shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut()) + shiny::observeEvent(data_modal_cut(), { + rv$data <- data_modal_cut() + rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") + }) ######### Modify factor @@ -305,6 +296,7 @@ server <- function(input, output, session) { shiny::observeEvent(data_modal_update(), { shiny::removeModal() rv$data <- data_modal_update() + rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") }) ######### Create column @@ -325,6 +317,7 @@ server <- function(input, output, session) { data_modal_r(), { rv$data <- data_modal_r() + rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") } ) @@ -352,9 +345,9 @@ server <- function(input, output, session) { } ) - output$code <- renderPrint({ - attr(rv$data, "code") - }) + # output$code <- renderPrint({ + # attr(rv$data, "code") + # }) # updated_data <- datamods::update_variables_server( updated_data <- update_variables_server( @@ -427,33 +420,16 @@ server <- function(input, output, session) { } ) - # output$filtered_code <- shiny::renderPrint({ - # out <- gsub( - # "filter", "dplyr::filter", - # gsub( - # "\\s{2,}", " ", - # paste0( - # capture.output(attr(rv$data_filtered, "code")), - # collapse = " " - # ) - # ) - # ) - # - # out <- strsplit(out, "%>%") |> - # unlist() |> - # (\(.x){ - # paste(c("data", .x[-1]), collapse = "|> \n ") - # })() - # - # cat(out) - # }) - output$code_import <- shiny::renderPrint({ cat(rv$code$import) }) output$code_data <- shiny::renderPrint({ - attr(rv$data, "code") + ls <- rv$code$modify |> unique() + out <- paste("data |> \n", + sapply(ls,\(.x) paste(deparse(.x),collapse=",")), + collapse="|> \n") + cat(out) }) output$code_filter <- shiny::renderPrint({ diff --git a/inst/apps/freesearcheR/ui.R b/inst/apps/freesearcheR/ui.R index 738f2b58..55e9ebec 100644 --- a/inst/apps/freesearcheR/ui.R +++ b/inst/apps/freesearcheR/ui.R @@ -50,7 +50,7 @@ ui_elements <- list( id = "file_import", layout_params = "dropdown", # title = "Choose a datafile to upload", - file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") + file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".ods", ".dta") ) ), shiny::conditionalPanel( diff --git a/man/data-import.Rd b/man/data-import.Rd new file mode 100644 index 00000000..cc37e8f4 --- /dev/null +++ b/man/data-import.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-import.R +\name{data_import_demo_app} +\alias{data_import_demo_app} +\title{Test app for the data-import module} +\usage{ +data_import_demo_app() +} +\description{ +Test app for the data-import module +} +\examples{ +\dontrun{ +data_import_demo_app() +} +} diff --git a/man/import-file-type.Rd b/man/import-file-type.Rd new file mode 100644 index 00000000..7e6cb2c0 --- /dev/null +++ b/man/import-file-type.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/import-file-ext.R +\name{import-file-type} +\alias{import-file-type} +\alias{import_delim} +\alias{import_xls} +\alias{import_ods} +\alias{import_dta} +\alias{import_rds} +\title{Wrapper to ease data file import} +\usage{ +import_delim(file, skip, encoding, na.strings) + +import_xls(file, sheet, skip, na.strings) + +import_ods(file, sheet, skip, na.strings) + +import_dta(file) + +import_rds(file) +} +\arguments{ +\item{file}{path to the file} + +\item{skip}{number of row to skip} + +\item{encoding}{file encoding} + +\item{na.strings}{character(s) to interpret as missing values.} + +\item{sheet}{for Excel files, sheet to read} +} +\value{ +data.frame + +data.frame + +data.frame + +data.frame + +data.frame +} +\description{ +Wrapper to ease data file import +} diff --git a/man/import-file.Rd b/man/import-file.Rd index f4c01758..233800e2 100644 --- a/man/import-file.Rd +++ b/man/import-file.Rd @@ -21,8 +21,7 @@ import_file_server( show_data_in = c("popup", "modal"), trigger_return = c("button", "change"), return_class = c("data.frame", "data.table", "tbl_df", "raw"), - reset = reactive(NULL), - read_fns = list() + reset = reactive(NULL) ) } \arguments{ @@ -31,21 +30,6 @@ import_file_server( \item{file_extensions}{File extensions accepted by \code{\link[shiny:fileInput]{shiny::fileInput()}}, can also be MIME type.} \item{layout_params}{How to display import parameters : in a dropdown button or inline below file input.} - -\item{read_fns}{Named list with custom function(s) to read data: -\itemize{ -\item the name must be the extension of the files to which the function will be applied -\item the value must be a function that can have 5 arguments (you can ignore some of them, but you have to use the same names), -passed by user through the interface: -\itemize{ -\item \code{file}: path to the file -\item \code{sheet}: for Excel files, sheet to read -\item \code{skip}: number of row to skip -\item \code{dec}: decimal separator -\item \code{encoding}: file encoding -\item \code{na.strings}: character(s) to interpret as missing values. -} -}} } \description{ Let user upload a file and import data diff --git a/man/import-file_module.Rd b/man/import-file_module.Rd new file mode 100644 index 00000000..b6d1182d --- /dev/null +++ b/man/import-file_module.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/import-file-ext.R +\name{import_file_demo_app} +\alias{import_file_demo_app} +\title{Test app for the import_file module} +\usage{ +import_file_demo_app() +} +\description{ +Test app for the import_file module +} +\examples{ +\dontrun{ +import_file_demo_app() +} +} diff --git a/man/import_delim.Rd b/man/import_delim.Rd deleted file mode 100644 index 6cb583e6..00000000 --- a/man/import_delim.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/import-file-ext.R -\name{import_delim} -\alias{import_delim} -\title{Wrapper of data.table::fread to import delim files with few presets} -\usage{ -import_delim(file, skip, encoding, na.strings) -} -\arguments{ -\item{file}{file} - -\item{encoding}{encoding} - -\item{na.strings}{na.strings} -} -\value{ -data.frame -} -\description{ -Wrapper of data.table::fread to import delim files with few presets -} diff --git a/man/update-variables.Rd b/man/update-variables.Rd index c3b29939..a2cc4815 100644 --- a/man/update-variables.Rd +++ b/man/update-variables.Rd @@ -6,7 +6,7 @@ \alias{update_variables_server} \title{Select, rename and convert variables} \usage{ -update_variables_ui(id, title = TRUE) +update_variables_ui(id, title = "") update_variables_server( id, diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..097b2416 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/freesearcheR.Rmd b/vignettes/freesearcheR.Rmd new file mode 100644 index 00000000..de990d73 --- /dev/null +++ b/vignettes/freesearcheR.Rmd @@ -0,0 +1,48 @@ +--- +title: "freesearcheR" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{freesearcheR} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE,eval = FALSE) +``` + +# Getting started with ***freesearcheR*** + +Below is a simple walk-trough and basic instructions for the functions on the freesearcheR app. + +## Launching + +The easiest way to get started is to launch [the hosted version of the app on shinyapps.io (click this link)](https://agdamsbo.shinyapps.io/freesearcheR/). + +Additionally you have the option to run the app locally with access to any data in your current working environment. + +To do this, open *R* (or RStudio or similar), and run the following code to install the latest version of ***freesearcheR*** and launch the app: + +``` {r} +require("pak") +pak::pak("agdamsbo/freesearcheR") +library(freesearcheR) +freesearcheR::launch_freesearcheR() +``` + +As a small note, a standalone Windows app version is on the drawing board as well, but no time frame is available. + +## Importing data + +Once in the app and in the "*Import*", you have three options available for importing data: file upload, REDCap server export and local or sample data. + +After choosing a data source, you can set a threshold to filter data be completenes and further manually specify variables to include for analyses. + +### File upload + +Currently several data file formats are supported for easy import (csv, txt, xls(x), ods, rds, dta). If importing workbooks (xls(x) or ods), you are prompted to specify sheet(s) to import. If choosing multiple sheets, these are automatically merged by common variable(s), so please make sure that key variables are correctly named identically. + +### REDCap server export + + +### Local or sample data From a8ab648eda3bdb848d300075f28d78ba7655cb20 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 17 Mar 2025 20:26:30 +0100 Subject: [PATCH 2/3] deployed latest --- R/app_version.R | 2 +- R/data-import.R | 2 +- R/import-file-ext.R | 5 +---- inst/apps/freesearcheR/app.R | 14 +++++--------- .../shinyapps.io/agdamsbo/freesearcheR.dcf | 2 +- inst/apps/freesearcheR/server.R | 2 +- 6 files changed, 10 insertions(+), 17 deletions(-) diff --git a/R/app_version.R b/R/app_version.R index 0cdf3212..c2f44c18 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250317_1458' +app_version <- function()'250317_2026' diff --git a/R/data-import.R b/R/data-import.R index 33acf37e..8b74135f 100644 --- a/R/data-import.R +++ b/R/data-import.R @@ -84,7 +84,7 @@ data_import_server <- function(id) { shiny::observeEvent(data_file$data(), { shiny::req(data_file$data()) - browser() + rv$data_temp <- data_file$data() rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") }) diff --git a/R/import-file-ext.R b/R/import-file-ext.R index 5e905009..05ac7b64 100644 --- a/R/import-file-ext.R +++ b/R/import-file-ext.R @@ -239,10 +239,7 @@ import_file_server <- function(id, { req(input$file) if (is_workbook(input$file$datapath)) shiny::req(input$sheet) - # browser() - # browser() - # req(input$skip_rows) extension <- tools::file_ext(input$file$datapath) parameters <- list( @@ -253,7 +250,7 @@ import_file_server <- function(id, encoding = input$encoding, na.strings = datamods:::split_char(input$na_label) ) - # browser() + parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))] # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))] imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE) diff --git a/inst/apps/freesearcheR/app.R b/inst/apps/freesearcheR/app.R index 95775503..02ef7d95 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()'250317_1458' +app_version <- function()'250317_2026' ######## @@ -1757,7 +1757,7 @@ data_import_server <- function(id) { shiny::observeEvent(data_file$data(), { shiny::req(data_file$data()) - browser() + rv$data_temp <- data_file$data() rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") }) @@ -2843,10 +2843,7 @@ import_file_server <- function(id, { req(input$file) if (is_workbook(input$file$datapath)) shiny::req(input$sheet) - # browser() - # browser() - # req(input$skip_rows) extension <- tools::file_ext(input$file$datapath) parameters <- list( @@ -2857,7 +2854,7 @@ import_file_server <- function(id, encoding = input$encoding, na.strings = datamods:::split_char(input$na_label) ) - # browser() + parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(get(read_fns[[extension]])))] # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(read_fns[[extension]]))] imported <- try(rlang::exec(read_fns[[extension]], !!!parameters), silent = TRUE) @@ -7477,7 +7474,7 @@ server <- function(input, output, session) { deparse() |> paste(collapse="") |> paste("|> - dplyr::select(tidyselect::all_of(c(",paste(input$import_var,collapse=","),"))) |> + dplyr::select(",paste(input$import_var,collapse=","),") |> freesearcheR::default_parsing()") |> (\(.x){ paste0("data <- ",.x) @@ -7725,7 +7722,7 @@ server <- function(input, output, session) { ) output$code_import <- shiny::renderPrint({ - rv$code$import + cat(rv$code$import) }) output$code_data <- shiny::renderPrint({ @@ -7734,7 +7731,6 @@ server <- function(input, output, session) { sapply(ls,\(.x) paste(deparse(.x),collapse=",")), collapse="|> \n") cat(out) - # attr(rv$data, "code") }) output$code_filter <- shiny::renderPrint({ diff --git a/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index ec31612e..a180caa3 100644 --- a/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 13611288 -bundleId: 9937654 +bundleId: 9958659 url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/freesearcheR/server.R b/inst/apps/freesearcheR/server.R index 6ed60622..b49bb283 100644 --- a/inst/apps/freesearcheR/server.R +++ b/inst/apps/freesearcheR/server.R @@ -173,7 +173,7 @@ server <- function(input, output, session) { deparse() |> paste(collapse="") |> paste("|> - dplyr::select(tidyselect::all_of(c(",paste(input$import_var,collapse=","),"))) |> + dplyr::select(",paste(input$import_var,collapse=","),") |> freesearcheR::default_parsing()") |> (\(.x){ paste0("data <- ",.x) From 0994cb42ecffa9afc5de10c0df999200892f82a2 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 17 Mar 2025 21:13:49 +0100 Subject: [PATCH 3/3] qa --- QA.md | 3 +++ R/app_version.R | 2 +- inst/apps/freesearcheR/app.R | 6 ++--- .../shinyapps.io/agdamsbo/freesearcheR.dcf | 2 +- inst/apps/freesearcheR/ui.R | 4 +-- vignettes/freesearcheR.Rmd | 26 +++++++++++++++++++ 6 files changed, 36 insertions(+), 7 deletions(-) diff --git a/QA.md b/QA.md index d200e378..8317ecf9 100644 --- a/QA.md +++ b/QA.md @@ -6,3 +6,6 @@ A complete instructions set is not available, but below are a collection of ques No! All uploaded data is deleted when the session ends, so only stored for your analyses and the immediately deleted. +## How do I merge multiple datasets? + +You can merge multiple sheets from ods or xls(x) files on import when a common key variable is present in selected sheets. Multiple file upload/merge is currently not supported. diff --git a/R/app_version.R b/R/app_version.R index c2f44c18..bc4f4f66 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250317_2026' +app_version <- function()'250317_2113' diff --git a/inst/apps/freesearcheR/app.R b/inst/apps/freesearcheR/app.R index 02ef7d95..608725c8 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()'250317_2026' +app_version <- function()'250317_2113' ######## @@ -7232,7 +7232,7 @@ ui_elements <- list( "docs" = bslib::nav_item( # shiny::img(shiny::icon("book")), shiny::tags$a( - href = "https://agdamsbo.github.io/freesearcheR/", + href = "https://agdamsbo.github.io/FreesearchR/", "Docs (external)", target = "_blank", rel = "noopener noreferrer" @@ -7288,7 +7288,7 @@ ui <- bslib::page_fixed( ), shiny::p( style = "margin: 1; color: #888;", - "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer") + "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer") ), ) ) diff --git a/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index a180caa3..8d0b3996 100644 --- a/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf +++ b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 13611288 -bundleId: 9958659 +bundleId: url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/freesearcheR/ui.R b/inst/apps/freesearcheR/ui.R index 55e9ebec..8af8c19a 100644 --- a/inst/apps/freesearcheR/ui.R +++ b/inst/apps/freesearcheR/ui.R @@ -567,7 +567,7 @@ ui_elements <- list( "docs" = bslib::nav_item( # shiny::img(shiny::icon("book")), shiny::tags$a( - href = "https://agdamsbo.github.io/freesearcheR/", + href = "https://agdamsbo.github.io/FreesearchR/", "Docs (external)", target = "_blank", rel = "noopener noreferrer" @@ -623,7 +623,7 @@ ui <- bslib::page_fixed( ), shiny::p( style = "margin: 1; color: #888;", - "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer") + "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/FreesearchR/", target = "_blank", rel = "noopener noreferrer") ), ) ) diff --git a/vignettes/freesearcheR.Rmd b/vignettes/freesearcheR.Rmd index de990d73..566cc953 100644 --- a/vignettes/freesearcheR.Rmd +++ b/vignettes/freesearcheR.Rmd @@ -46,3 +46,29 @@ Currently several data file formats are supported for easy import (csv, txt, xls ### Local or sample data + + +## Evaluate + +### Baseline + +### Correlation matrix + + +## Visualise + +- Would be nice to have a table of possible plots, their description and data options + + +## Regression + + +## Download + +### Report + + +### Data + + +### Code