diff --git a/.gitignore b/.gitignore index 8e58845e..df15ad79 100644 --- a/.gitignore +++ b/.gitignore @@ -9,4 +9,3 @@ app/rsconnect inst/shiny-examples/casting/functions.R functions.R docs -inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index abdb6117..1a5f9157 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -77,9 +77,6 @@ Suggests: usethis, roxygen2, pak, - rsconnect, - knitr, - rmarkdown + rsconnect 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 336ec69e..0a32d91a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,12 +36,8 @@ 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 aee2764d..8ea24077 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,8 +6,6 @@ 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/QA.md b/QA.md index 8317ecf9..d200e378 100644 --- a/QA.md +++ b/QA.md @@ -6,6 +6,3 @@ 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 bc4f4f66..a5737d3c 100644 --- a/R/app_version.R +++ b/R/app_version.R @@ -1 +1 @@ -app_version <- function()'250317_2113' +app_version <- function()'250313_1502' diff --git a/R/data-import.R b/R/data-import.R index 8b74135f..6fd30d25 100644 --- a/R/data-import.R +++ b/R/data-import.R @@ -1,171 +1,250 @@ -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()) - - 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 +#' data_import_ui <- function(id, include_title = TRUE) { +#' ns <- shiny::NS(id) #' -#' @rdname data-import +#' 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) +#' ) +#' ) +#' } #' -#' @examples -#' \dontrun{ -#' data_import_demo_app() +#' +#' 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) #' } -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 05ac7b64..d4441908 100644 --- a/R/import-file-ext.R +++ b/R/import-file-ext.R @@ -85,9 +85,7 @@ import_file_ui <- function(id, buttonLabel = datamods:::i18n("Browse..."), placeholder = datamods:::i18n("No file selected"), accept = file_extensions, - width = "100%", - ## A solution to allow multiple file upload is being considered - multiple = FALSE + width = "100%" ), class = "mb-0" ) @@ -147,23 +145,35 @@ 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 #' @@ -174,17 +184,16 @@ 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( - ods = "import_ods", - dta = "import_dta", - csv = "import_delim", - tsv = "import_delim", - txt = "import_delim", - xls = "import_xls", - xlsx = "import_xls", - rds = "import_rds" - ) + 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) + } + } trigger_return <- match.arg(trigger_return) return_class <- match.arg(return_class) @@ -239,7 +248,10 @@ 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( @@ -250,11 +262,9 @@ 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(get(read_fns[[extension]])))] - # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(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)), .ns = "freesearcheR") + code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name))) if (inherits(imported, "try-error")) { imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE) @@ -351,19 +361,11 @@ is_workbook <- function(path) { is_excel(path) || is_ods(path) } - -# File import functions --------------------------------------------------- - -#' Wrapper to ease data file import +#' Wrapper of data.table::fread to import delim files with few presets #' -#' @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 +#' @param file file +#' @param encoding encoding +#' @param na.strings na.strings #' #' @returns data.frame #' @export @@ -382,12 +384,6 @@ 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( { @@ -413,12 +409,6 @@ 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( { @@ -442,30 +432,6 @@ 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, @@ -549,7 +515,35 @@ import_file_demo_app <- function() { id = "myid", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame" + 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" + ) + } + ) ) output$status <- shiny::renderPrint({ diff --git a/R/redcap_read_shiny_module.R b/R/redcap_read_shiny_module.R index 9036c5e2..e09742a5 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, - code = NULL + imported = NULL ) shiny::observeEvent(list(input$api, input$uri), { @@ -340,10 +340,7 @@ 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("read_redcap_tables", - !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")), - , .ns = "REDCapCAST") + code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters) if (inherits(imported, "try-error") || NROW(imported) < 1) { @@ -378,8 +375,6 @@ 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)) |> @@ -395,13 +390,7 @@ m_redcap_readServer <- function(id) { # # }) - 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) - )) + return(shiny::reactive(data_rv$data)) } shiny::moduleServer( @@ -554,15 +543,15 @@ drop_empty_event <- function(data, event = "redcap_event_name") { redcap_demo_app <- function() { ui <- shiny::fluidPage( m_redcap_readUI("data"), - DT::DTOutput("data"), - shiny::tags$b("Code:"), - shiny::verbatimTextOutput(outputId = "code") + DT::DTOutput("data_summary") ) server <- function(input, output, session) { + data_val <- shiny::reactiveValues(data = NULL) - data_val <- m_redcap_readServer(id = "data") - output$data <- DT::renderDataTable( + data_val$data <- m_redcap_readServer(id = "data") + + output$data_summary <- DT::renderDataTable( { shiny::req(data_val$data) data_val$data() @@ -572,10 +561,6 @@ 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 2abaf2fd..e6fdce1f 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 - - [x] Grotta bars for ordianl outcomes (and sankey) 2025-3-17 + - [ ] Grotta bars for ordianl outcomes - [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 608725c8..419fa9c8 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_2113' +app_version <- function()'250313_1502' ######## @@ -1671,177 +1671,256 @@ allign_axes <- function(...) { #### Current file: R//data-import.R ######## -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()) - - 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 +#' data_import_ui <- function(id, include_title = TRUE) { +#' ns <- shiny::NS(id) #' -#' @rdname data-import +#' 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) +#' ) +#' ) +#' } #' -#' @examples -#' \dontrun{ -#' data_import_demo_app() +#' +#' 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) #' } -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) -} ######## @@ -2689,9 +2768,7 @@ import_file_ui <- function(id, buttonLabel = datamods:::i18n("Browse..."), placeholder = datamods:::i18n("No file selected"), accept = file_extensions, - width = "100%", - ## A solution to allow multiple file upload is being considered - multiple = FALSE + width = "100%" ), class = "mb-0" ) @@ -2751,23 +2828,35 @@ 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 #' @@ -2778,17 +2867,16 @@ 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( - ods = "import_ods", - dta = "import_dta", - csv = "import_delim", - tsv = "import_delim", - txt = "import_delim", - xls = "import_xls", - xlsx = "import_xls", - rds = "import_rds" - ) + 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) + } + } trigger_return <- match.arg(trigger_return) return_class <- match.arg(return_class) @@ -2843,7 +2931,10 @@ 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( @@ -2854,11 +2945,9 @@ 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(get(read_fns[[extension]])))] - # parameters <- parameters[which(names(parameters) %in% rlang::fn_fmls_names(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)), .ns = "freesearcheR") + code <- rlang::call2(read_fns[[extension]], !!!modifyList(parameters, list(file = input$file$name))) if (inherits(imported, "try-error")) { imported <- try(rlang::exec(rio::import, !!!parameters[1]), silent = TRUE) @@ -2955,19 +3044,11 @@ is_workbook <- function(path) { is_excel(path) || is_ods(path) } - -# File import functions --------------------------------------------------- - -#' Wrapper to ease data file import +#' Wrapper of data.table::fread to import delim files with few presets #' -#' @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 +#' @param file file +#' @param encoding encoding +#' @param na.strings na.strings #' #' @returns data.frame #' @export @@ -2986,12 +3067,6 @@ 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( { @@ -3017,12 +3092,6 @@ 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( { @@ -3046,30 +3115,6 @@ 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, @@ -3153,7 +3198,35 @@ import_file_demo_app <- function() { id = "myid", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame" + 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" + ) + } + ) ) output$status <- shiny::renderPrint({ @@ -3864,7 +3937,7 @@ m_redcap_readServer <- function(id) { dd_list = NULL, data = NULL, rep_fields = NULL, - code = NULL + imported = NULL ) shiny::observeEvent(list(input$api, input$uri), { @@ -4061,10 +4134,7 @@ 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("read_redcap_tables", - !!!utils::modifyList(parameters,list(token="PERSONAL_API_TOKEN")), - , .ns = "REDCapCAST") + code <- rlang::call2(REDCapCAST::read_redcap_tables, !!!parameters) if (inherits(imported, "try-error") || NROW(imported) < 1) { @@ -4099,8 +4169,6 @@ 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)) |> @@ -4116,13 +4184,7 @@ m_redcap_readServer <- function(id) { # # }) - 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) - )) + return(shiny::reactive(data_rv$data)) } shiny::moduleServer( @@ -4275,15 +4337,15 @@ drop_empty_event <- function(data, event = "redcap_event_name") { redcap_demo_app <- function() { ui <- shiny::fluidPage( m_redcap_readUI("data"), - DT::DTOutput("data"), - shiny::tags$b("Code:"), - shiny::verbatimTextOutput(outputId = "code") + DT::DTOutput("data_summary") ) server <- function(input, output, session) { + data_val <- shiny::reactiveValues(data = NULL) - data_val <- m_redcap_readServer(id = "data") - output$data <- DT::renderDataTable( + data_val$data <- m_redcap_readServer(id = "data") + + output$data_summary <- DT::renderDataTable( { shiny::req(data_val$data) data_val$data() @@ -4293,10 +4355,6 @@ redcap_demo_app <- function() { pageLength = 5 ), ) - output$code <- shiny::renderPrint({ - shiny::req(data_val$code) - data_val$code() - }) } shiny::shinyApp(ui, server) } @@ -6715,7 +6773,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", ".ods", ".dta") + file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") ) ), shiny::conditionalPanel( @@ -7232,7 +7290,7 @@ ui_elements <- list( "docs" = bslib::nav_item( # shiny::img(shiny::icon("book")), shiny::tags$a( - href = "https://agdamsbo.github.io/FreesearchR/", + href = "https://agdamsbo.github.io/freesearcheR/", "Docs (external)", target = "_blank", rel = "noopener noreferrer" @@ -7288,7 +7346,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/FreesearchR/", target = "_blank", rel = "noopener noreferrer") + "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer") ), ) ) @@ -7398,7 +7456,34 @@ server <- function(input, output, session) { id = "file_import", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame" + 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(), { @@ -7407,19 +7492,18 @@ server <- function(input, output, session) { rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") }) - from_redcap <- m_redcap_readServer( + data_redcap <- m_redcap_readServer( id = "redcap_import" ) - shiny::observeEvent(from_redcap$data(), { + shiny::observeEvent(data_redcap(), { # rv$data_original <- purrr::pluck(data_redcap(), "data")() - rv$data_temp <- from_redcap$data() - rv$code <- append_list(data = from_redcap$code(),list = rv$code,index = "import") + rv$data_temp <- data_redcap() }) output$redcap_prev <- DT::renderDT( { - DT::datatable(head(from_redcap$data(), 5), + DT::datatable(head(data_redcap(), 5), # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5), caption = "First 5 observations" ) @@ -7468,20 +7552,8 @@ 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(",paste(input$import_var,collapse=","),") |> - freesearcheR::default_parsing()") |> - (\(.x){ - paste0("data <- ",.x) - })() - - rv$code$filter <- NULL - rv$code$modify <- NULL } ) @@ -7518,8 +7590,6 @@ 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 @@ -7577,10 +7647,7 @@ server <- function(input, output, session) { data_r = shiny::reactive(rv$data) ) - shiny::observeEvent(data_modal_cut(), { - rv$data <- data_modal_cut() - rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") - }) + shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut()) ######### Modify factor @@ -7597,7 +7664,6 @@ 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 @@ -7618,7 +7684,6 @@ 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") } ) @@ -7646,9 +7711,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( @@ -7721,16 +7786,33 @@ 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({ - 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/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf b/inst/apps/freesearcheR/rsconnect/shinyapps.io/agdamsbo/freesearcheR.dcf index 8d0b3996..ec31612e 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: +bundleId: 9937654 url: https://agdamsbo.shinyapps.io/freesearcheR/ version: 1 diff --git a/inst/apps/freesearcheR/server.R b/inst/apps/freesearcheR/server.R index b49bb283..6f26ff67 100644 --- a/inst/apps/freesearcheR/server.R +++ b/inst/apps/freesearcheR/server.R @@ -97,7 +97,34 @@ server <- function(input, output, session) { id = "file_import", show_data_in = "popup", trigger_return = "change", - return_class = "data.frame" + 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(), { @@ -106,19 +133,18 @@ server <- function(input, output, session) { rv$code <- append_list(data = data_file$code(), list = rv$code, index = "import") }) - from_redcap <- m_redcap_readServer( + data_redcap <- m_redcap_readServer( id = "redcap_import" ) - shiny::observeEvent(from_redcap$data(), { + shiny::observeEvent(data_redcap(), { # rv$data_original <- purrr::pluck(data_redcap(), "data")() - rv$data_temp <- from_redcap$data() - rv$code <- append_list(data = from_redcap$code(),list = rv$code,index = "import") + rv$data_temp <- data_redcap() }) output$redcap_prev <- DT::renderDT( { - DT::datatable(head(from_redcap$data(), 5), + DT::datatable(head(data_redcap(), 5), # DT::datatable(head(purrr::pluck(data_redcap(), "data")(), 5), caption = "First 5 observations" ) @@ -167,20 +193,8 @@ 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(",paste(input$import_var,collapse=","),") |> - freesearcheR::default_parsing()") |> - (\(.x){ - paste0("data <- ",.x) - })() - - rv$code$filter <- NULL - rv$code$modify <- NULL } ) @@ -217,8 +231,6 @@ 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 @@ -276,10 +288,7 @@ server <- function(input, output, session) { data_r = shiny::reactive(rv$data) ) - shiny::observeEvent(data_modal_cut(), { - rv$data <- data_modal_cut() - rv$code$modify[[length(rv$code$modify)+1]] <- attr(rv$data,"code") - }) + shiny::observeEvent(data_modal_cut(), rv$data <- data_modal_cut()) ######### Modify factor @@ -296,7 +305,6 @@ 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 @@ -317,7 +325,6 @@ 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") } ) @@ -345,9 +352,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( @@ -420,16 +427,33 @@ 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({ - 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/ui.R b/inst/apps/freesearcheR/ui.R index 8af8c19a..738f2b58 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", ".ods", ".dta") + file_extensions = c(".csv", ".tsv", ".txt", ".xls", ".xlsx", ".rds", ".sas7bdat", ".ods", ".dta") ) ), shiny::conditionalPanel( @@ -567,7 +567,7 @@ ui_elements <- list( "docs" = bslib::nav_item( # shiny::img(shiny::icon("book")), shiny::tags$a( - href = "https://agdamsbo.github.io/FreesearchR/", + href = "https://agdamsbo.github.io/freesearcheR/", "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/FreesearchR/", target = "_blank", rel = "noopener noreferrer") + "AG Damsbo | v", app_version(), " | AGPLv3 license | ", shiny::tags$a("Source on Github", href = "https://github.com/agdamsbo/freesearcheR/", target = "_blank", rel = "noopener noreferrer") ), ) ) diff --git a/man/data-import.Rd b/man/data-import.Rd deleted file mode 100644 index cc37e8f4..00000000 --- a/man/data-import.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% 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 deleted file mode 100644 index 7e6cb2c0..00000000 --- a/man/import-file-type.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% 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 233800e2..f4c01758 100644 --- a/man/import-file.Rd +++ b/man/import-file.Rd @@ -21,7 +21,8 @@ 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) + reset = reactive(NULL), + read_fns = list() ) } \arguments{ @@ -30,6 +31,21 @@ 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 deleted file mode 100644 index b6d1182d..00000000 --- a/man/import-file_module.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% 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 new file mode 100644 index 00000000..6cb583e6 --- /dev/null +++ b/man/import_delim.Rd @@ -0,0 +1,21 @@ +% 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 a2cc4815..c3b29939 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 = "") +update_variables_ui(id, title = TRUE) update_variables_server( id, diff --git a/vignettes/.gitignore b/vignettes/.gitignore deleted file mode 100644 index 097b2416..00000000 --- a/vignettes/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.html -*.R diff --git a/vignettes/freesearcheR.Rmd b/vignettes/freesearcheR.Rmd deleted file mode 100644 index 566cc953..00000000 --- a/vignettes/freesearcheR.Rmd +++ /dev/null @@ -1,74 +0,0 @@ ---- -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 - - -## 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