updated vignette and formatting

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 = "",
+  sub(
+    pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "",
     filenames,
-      perl = TRUE)
+    perl = TRUE
+  )
 }
 
 #' Flexible file import based on extension
@@ -74,4 +76,3 @@ read_input <- function(file, consider.na = c("NA", '""', "")) {
 
   df
 }
-

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)
+  # })
 }

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 <-
       )
     )
   )
+

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"))
 }

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() |> 
-  ds2dd_detailed()|>  
-  purrr::pluck("data") |> 
-  readr::type_convert( 
-      col_types = readr::cols(.default = readr::col_guess()))
+  redcap_wider() 
+str(ds)
 ```
 
+```{r}
+ds|> 
+  ds2dd_detailed()|>  
+  purrr::pluck("data") |> 
+  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)) |> 
-  readr::type_convert( 
-      col_types = readr::cols(.default = readr::col_guess()))
+  parse_data(ignore.vars = c("record_id","cpr")) |> 
+  str()
 ```
 
 
+```{r}
+
+```
+
+
+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()
+```