From 9e8ff6b4a980f8b66b0baae3213da3f9a5b0ac26 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Mon, 17 Mar 2025 15:00:13 +0100 Subject: [PATCH] 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 df15ad7..8e58845 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 1a5f915..abdb611 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 0a32d91..336ec69 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 8ea2407..aee2764 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 a5737d3..0cdf321 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 6fd30d2..33acf37 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 d444190..5e90500 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 e09742a..9036c5e 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 e6fdce1..2abaf2f 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 419fa9c..9577550 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 6f26ff6..6ed6062 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 738f2b5..55e9ebe 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 0000000..cc37e8f --- /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 0000000..7e6cb2c --- /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 f4c0175..233800e 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 0000000..b6d1182 --- /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 6cb583e..0000000 --- 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 c3b2993..a2cc481 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 0000000..097b241 --- /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 0000000..de990d7 --- /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