diff --git a/R/shiny_cast.R b/R/shiny_cast.R index 1ca76c0..17e2faa 100644 --- a/R/shiny_cast.R +++ b/R/shiny_cast.R @@ -31,11 +31,13 @@ shiny_cast <- function(...) { #' #' @examples #' file_extension(list.files(here::here(""))[[2]])[[1]] -#' file_extension(c("file.cd..ks","file")) +#' file_extension(c("file.cd..ks", "file")) file_extension <- function(filenames) { - sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "", - filenames, - perl = TRUE) + sub( + pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "", + filenames, + perl = TRUE + ) } #' Flexible file import based on extension @@ -74,4 +76,3 @@ read_input <- function(file, consider.na = c("NA", '""', "")) { df } - diff --git a/inst/shiny-examples/casting/server.R b/inst/shiny-examples/casting/server.R index 119e198..94c3bd7 100644 --- a/inst/shiny-examples/casting/server.R +++ b/inst/shiny-examples/casting/server.R @@ -1,4 +1,3 @@ -library(REDCapCAST) library(bslib) library(shiny) library(openxlsx2) @@ -7,9 +6,14 @@ library(readODS) library(readr) library(dplyr) library(here) +library(devtools) +if (!requireNamespace("REDCapCAST")){ + devtools::install_github("agdamsbo/REDCapCAST", quiet = TRUE, upgrade = "never") +} +library(REDCapCAST) + server <- function(input, output, session) { - v <- shiny::reactiveValues( file = NULL ) @@ -64,7 +68,7 @@ server <- function(input, output, session) { output$downloadData <- shiny::downloadHandler( filename = "data_ready.csv", content = function(file) { - write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE,na = "") + write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE, na = "") } ) @@ -72,13 +76,13 @@ server <- function(input, output, session) { output$downloadMeta <- shiny::downloadHandler( filename = "datadictionary_ready.csv", content = function(file) { - write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE,na = "") + write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE, na = "") } ) # Downloadable .zip of instrument ---- output$downloadInstrument <- shiny::downloadHandler( - filename = paste0("REDCapCAST_instrument",Sys.Date(),".zip"), + filename = paste0("REDCapCAST_instrument", Sys.Date(), ".zip"), content = function(file) { export_redcap_instrument(purrr::pluck(dd(), "meta"), file) } @@ -88,12 +92,15 @@ server <- function(input, output, session) { output_staging$meta <- output_staging$data <- NA - shiny::observeEvent(input$upload.meta,{ upload_meta() }) + shiny::observeEvent(input$upload.meta, { + upload_meta() + }) - shiny::observeEvent(input$upload.data,{ upload_data() }) - - upload_meta <- function(){ + shiny::observeEvent(input$upload.data, { + upload_data() + }) + upload_meta <- function() { shiny::req(input$uri) shiny::req(input$api) @@ -102,11 +109,10 @@ server <- function(input, output, session) { ds = purrr::pluck(dd(), "meta"), redcap_uri = input$uri, token = input$api - )|> purrr::pluck("success") + ) |> purrr::pluck("success") } - upload_data <- function(){ - + upload_data <- function() { shiny::req(input$uri) shiny::req(input$api) @@ -122,4 +128,8 @@ server <- function(input, output, session) { output$upload.data.print <- renderText(output_staging$data) + # session$onSessionEnded(function() { + # # cat("Session Ended\n") + # unlink("www",recursive = TRUE) + # }) } diff --git a/inst/shiny-examples/casting/ui.R b/inst/shiny-examples/casting/ui.R index 6288d91..b9ae32b 100644 --- a/inst/shiny-examples/casting/ui.R +++ b/inst/shiny-examples/casting/ui.R @@ -19,20 +19,27 @@ ui <- ".ods" ) ), - shiny::helpText("Have a look at the preview panels to show download options."), + shiny::actionButton( + inputId = "load_data", + label = "Load data", + icon = shiny::icon("circle-down") + ), + shiny::helpText("Have a look at the preview panels to validate the data dictionary and imported data."), # For some odd reason this only unfolds when the preview panel is shown.. + # This has been solved by adding an arbitrary button to load data shiny::conditionalPanel( - condition = "output.uploaded=='yes'", - shiny::helpText("Below you can download the dataset formatted for upload and the - corresponding data dictionary for a new data base, if you want to upload manually."), + # condition = "output.uploaded=='yes'", + condition = "input.load_data", + # shiny::helpText("Below you can download the dataset formatted for upload and the + # corresponding data dictionary for a new data base, if you want to upload manually."), # Button - shiny::downloadButton("downloadData", "Download renamed data"), + shiny::downloadButton(outputId = "downloadData", label = "Download renamed data"), # Button - shiny::downloadButton("downloadMeta", "Download data dictionary"), + shiny::downloadButton(outputId = "downloadMeta", label = "Download data dictionary"), # Button - shiny::downloadButton("downloadInstrument", "Download as instrument"), + shiny::downloadButton(outputId = "downloadInstrument", label = "Download as instrument"), # Horizontal line ---- shiny::tags$hr(), @@ -108,3 +115,4 @@ ui <- ) ) ) + diff --git a/man/file_extension.Rd b/man/file_extension.Rd index fb90fbb..4820cd4 100644 --- a/man/file_extension.Rd +++ b/man/file_extension.Rd @@ -17,5 +17,5 @@ DEPRECATED Helper to import files correctly } \examples{ file_extension(list.files(here::here(""))[[2]])[[1]] -file_extension(c("file.cd..ks","file")) +file_extension(c("file.cd..ks", "file")) } diff --git a/vignettes/Shiny-app.Rmd b/vignettes/Shiny-app.Rmd index 34a43b6..7796ece 100644 --- a/vignettes/Shiny-app.Rmd +++ b/vignettes/Shiny-app.Rmd @@ -23,25 +23,70 @@ REDCapCAST::shiny_cast() The app primarily wraps one function: `ds2dd_detailed()`. ```{r} -REDCap_split( +library(REDCapCAST) +ds <- REDCap_split( records = redcapcast_data, metadata = redcapcast_meta, forms = "all" ) |> - sanitize_split() |> - redcap_wider() |> + sanitize_split() |> + redcap_wider() +str(ds) +``` + +```{r} +ds|> ds2dd_detailed()|> purrr::pluck("data") |> - readr::type_convert( - col_types = readr::cols(.default = readr::col_guess())) + str() +``` + +```{r} +ds|> + ds2dd_detailed()|> + purrr::pluck("meta") |> + head(10) +``` + +Different data formats are accepted, which all mostly implements the `readr::col_guess()` functionality to parse column classes. + +To ensure uniformity in data import this parsing has been implemented on its own to use with `ds2dd_detailed()` or any other data set for that matter: + +```{r} +ds_parsed <- redcapcast_data |> + dplyr::mutate(dplyr::across(dplyr::everything(),as.character)) |> + parse_data() +str(ds_parsed) +``` + +It will ignore specified columns, which is neat for numeric-looking strings like cpr-with a leading 0: + +```{r} +redcapcast_data |> + dplyr::mutate(dplyr::across(dplyr::everything(),as.character)) |> + parse_data(ignore.vars = c("record_id","cpr")) |> + str() ``` ```{r} -redcapcast_data |> - dplyr::mutate(dplyr::across(dplyr::everything(),as.character)) |> - readr::type_convert( - col_types = readr::cols(.default = readr::col_guess())) + ``` +Column classes can be passed to `parse_data()`. + +Making a few crude assumption for factorising data, `numchar2fct()` factorises numerical and character vectors based on a set threshold for unique values: + +```{r} +mtcars |> str() +mtcars |> + numchar2fct(numeric.threshold = 6) |> + str() +``` + +```{r} +ds_parsed|> + numchar2fct(numeric.threshold = 2) |> + str() +```