exporting redcap instrument from shiny app

R/export_redcap_instrument.R

@@ -0,0 +1,121 @@
+#' Creates zip-file with necessary content to manually add instrument to database
+#'
+#' @description
+#' Metadata can be added by editing the data dictionary of a project in the
+#' initial design phase. If you want to later add new instruments, this
+#' function can be used to create (an) instrument(s) to add to a project in
+#' production.
+#'
+#' @param data metadata for the relevant instrument.
+#' Could be from `ds2dd_detailed()`
+#' @param dir destination dir for the instrument zip. Default is the current WD.
+#' @param record.id record id variable name. Default is 'record_id'.
+#'
+#' @return exports zip-file
+#'
+#' @examples
+#' iris |>
+#'   ds2dd_detailed(
+#'     add.auto.id = TRUE,
+#'     form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
+#'   ) |>
+#'   purrr::pluck("meta") |>
+#'   (\(.x){
+#'   split(.x, .x$form_name)
+#'   })() |>
+#'   purrr::imap(function(.x, .i){
+#'   export_redcap_instrument(.x,file=here::here(paste0(.i,Sys.Date(),".zip")))
+#'   })
+#'
+#' iris |>
+#'   ds2dd_detailed(
+#'     add.auto.id = TRUE
+#'   ) |>
+#'   purrr::pluck("meta") |>
+#'   export_redcap_instrument(file=here::here(paste0("instrument",Sys.Date(),".zip")))
+export_redcap_instrument <- function(data,
+                                     file,
+                                     force=FALSE,
+                                     record.id = "record_id") {
+  # Ensure form name is the same
+  if (force){
+    data$form_name <- data$form_name[1]
+  } else if (length(unique(data$form_name))!=1){
+    stop("Please provide metadata for a single form only. See examples for
+         ideas on exporting multiple instruments.")
+  }
+
+  if (record.id %in% data[["field_name"]]){
+    data <- data[-match(record.id,data[["field_name"]]),]
+  }
+
+  temp_dir <- tempdir()
+  utils::write.csv(data, paste0(temp_dir, "/instrument.csv"), row.names = FALSE, na = "")
+  writeLines("REDCapCAST", paste0(temp_dir, "/origin.txt"))
+  zip::zip(
+    zipfile = file,
+    files = c("origin.txt", "instrument.csv"),
+    root = temp_dir
+  )
+}
+
+
+#' DEPRICATED Create zips file with necessary content based on data set
+#'
+#' @description
+#' Metadata can be added by editing the data dictionary of a project in the
+#' initial design phase. If you want to later add new instruments, this
+#' function can be used to create (an) instrument(s) to add to a project in
+#' production.
+#'
+#' @param data metadata for the relevant instrument.
+#' Could be from `ds2dd_detailed()`
+#' @param dir destination dir for the instrument zip. Default is the current WD.
+#' @param record.id flag to omit the first row of the data dictionary assuming
+#' this is the record_id field which should not be included in the instrument.
+#' Default is TRUE.
+#'
+#' @return list
+#' @export
+#'
+#' @examples
+#' data <- iris |>
+#'   ds2dd_detailed(
+#'     add.auto.id = TRUE,
+#'     form.name = sample(c("b", "c"),
+#'       size = 6,
+#'       replace = TRUE, prob = rep(.5, 2)
+#'     )
+#'   ) |>
+#'   purrr::pluck("meta")
+#' # data |> create_instrument_meta()
+#'
+#' data <- iris |>
+#'   ds2dd_detailed(add.auto.id = FALSE) |>
+#'   purrr::pluck("data")
+#' iris |>
+#'   setNames(glue::glue("{sample(x = c('a','b'),size = length(ncol(iris)),
+#' replace=TRUE,prob = rep(x=.5,2))}__{names(iris)}")) |>
+#'   ds2dd_detailed(form.sep = "__")
+#' # data |>
+#' #   purrr::pluck("meta") |>
+#' #   create_instrument_meta(record.id = FALSE)
+create_instrument_meta <- function(data,
+                                   dir = here::here(""),
+                                   record.id = TRUE) {
+  # browser()
+  if (record.id) {
+    data <- data[-1, ]
+  }
+  temp_dir <- tempdir()
+  split(data, data$form_name) |> purrr::imap(function(.x, .i) {
+    utils::write.csv(.x, paste0(temp_dir, "/instrument.csv"),
+      row.names = FALSE, na = ""
+    )
+    writeLines("REDCapCAST", paste0(temp_dir, "/origin.txt"))
+    zip::zip(paste0(dir, "/", .i, Sys.Date(), ".zip"),
+      files = c("origin.txt", "instrument.csv"),
+      root = temp_dir
+    )
+  })
+}

app/server.R

@@ -41,6 +41,14 @@ server <- function(input, output, session) {
     }
   )
 
+  # Downloadable .zip of instrument ----
+  output$downloadInstrument <- shiny::downloadHandler(
+    filename = paste0("REDCapCAST_instrument",Sys.Date(),".zip"),
+    content = function(file) {
+      create_instrument_meta_single(purrr::pluck(dd(), "meta"), file)
+    }
+  )
+
   output_staging <- shiny::reactiveValues()
   output_staging$meta <- output_staging$data <- NA
 

app/ui.R

@@ -19,11 +19,11 @@ ui <- shiny::shinyUI(
       windowTitle = "REDCap database creator"
     ),
     shiny::h4(
-      "This tool includes to convenient functions:",
+      "THese are the functionalities to create and migrate data from a spreadsheet to a REDCap database:",
       shiny::br(),
-      "1) creating a REDCap data dictionary based on a spreadsheet (.csv/.xls(x)/.dta/.ods) and",
+      "1) create a REDCap data dictionary or instrument based on a spreadsheet (.csv/.xls(x)/.dta/.ods) and",
       shiny::br(),
-      "2) creating said database on a given REDCap server and uploading the dataset via API access."
+      "2) upload said database file on a given REDCap server and upload the dataset via API access or download for all manual upload."
     ),
 
 
@@ -49,7 +49,10 @@ ui <- shiny::shinyUI(
       shiny::downloadButton("downloadData", "Download data"),
 
       # Button
-      shiny::downloadButton("downloadMeta", "Download datadictionary"),
+      shiny::downloadButton("downloadMeta", "Download data dictionary"),
+
+      # Button
+      shiny::downloadButton("downloadInstrument", "Download as instrument"),
 
 
       # Horizontal line ----