disabling examples

.Renviron

@@ -0,0 +1 @@
+_R_CHECK_SYSTEM_CLOCK_=0

DESCRIPTION

@@ -63,11 +63,11 @@ Collate:
     'utils.r'
     'process_user_input.r'
     'REDCap_split.r'
-    'create_instrument_meta.R'
     'doc2dd.R'
     'ds2dd.R'
     'ds2dd_detailed.R'
     'easy_redcap.R'
+    'export_redcap_instrument.R'
     'html_styling.R'
     'mtcars_redcap.R'
     'read_redcap_instrument.R'

NEWS.md

@@ -1,3 +1,19 @@
+# REDCapCAST 24.10.4
+
+Revised tests.
+
+### Functions:
+
+* Bug: 'form.name' specified to 'ds2dd_detailed()' was ignored. Corrected to only be ignored if 'form.sep' is specified. Added handling of re-occurring `form.sep` pattern.
+
+* New: `export_redcap_instrument()` is a new version of `create_instrument_meta()`, that will only export a single instrument. Multiple instrument export can be done with `lapply()` or `purrr::map()`. This allows for inclusion of this functionality in the Shiny implementation and is easier to handle. `create_instrument_meta()` is deprecated.
+
+### Shiny:
+
+* New: Export a REDCap instrument ready to add to your database based on an uploaded spreadsheet. This is thanks to the `export_redcap_instrument()` function. THis functionality is intended for projects in production and adding instruments should be handled manually and not by API upload.
+
+The shiny implementation is included with this package. Implementing in shinylive may be looked into again later.
+
 # REDCapCAST 24.10.3
 
 Updated links and spelling.

R/create_instrument_meta.R

@@ -1,50 +0,0 @@
-#' 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 can be
-#' used to add instrument(s) 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")
-#' names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
-#' replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
-#' data <- data |> 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) {
-  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
-    )
-  })
-
-}

R/ds2dd_detailed.R

@@ -117,7 +117,7 @@ hms2character <- function(data) {
 #' ncol(data). Default is NULL and "data" is used.
 #' @param form.sep If supplied dataset has form names as suffix or prefix to the
 #' column/variable names, the seperator can be specified. If supplied, the
-#' form.sep is ignored. Default is NULL.
+#' form.name is ignored. Default is NULL.
 #' @param form.prefix Flag to set if form is prefix (TRUE) or suffix (FALSE) to
 #' the column names. Assumes all columns have pre- or suffix if specified.
 #' @param field.type manually specify field type(s). Vector of length 1 or
@@ -149,6 +149,12 @@ hms2character <- function(data) {
 #' data |> ds2dd_detailed(validate.time = TRUE)
 #' data |> ds2dd_detailed()
 #' iris |> ds2dd_detailed(add.auto.id = TRUE)
+#' iris |>
+#'   ds2dd_detailed(
+#'     add.auto.id = TRUE,
+#'     form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
+#'   ) |>
+#'   purrr::pluck("meta")
 #' mtcars |> ds2dd_detailed(add.auto.id = TRUE)
 #' data <- iris |>
 #'   ds2dd_detailed(add.auto.id = TRUE) |>
@@ -230,20 +236,26 @@ ds2dd_detailed <- function(data,
 
   if (!is.null(form.sep)) {
     if (form.sep != "") {
-    suppressMessages(nms <- strsplit(names(data), split = form.sep) |>
+      parts <- strsplit(names(data), split = form.sep)
-      dplyr::bind_cols())
+
-    ## Assumes form.sep only occurs once and form.prefix defines if form is prefix or suffix
+      ## form.sep should be unique, but handles re-occuring pattern (by only considering first or last) and form.prefix defines if form is prefix or suffix
-    dd$form_name <- clean_redcap_name(dplyr::slice(nms,ifelse(form.prefix, 1, 2)))
       ## The other split part is used as field names
-    dd$field_name <- dplyr::slice(nms,ifelse(!form.prefix, 1, 2)) |> as.character()
+      if (form.prefix){
+        dd$form_name <- clean_redcap_name(Reduce(c,lapply(parts,\(.x) .x[[1]])))
+        dd$field_name <- Reduce(c,lapply(parts,\(.x) paste(.x[seq_len(length(.x))[-1]],collapse=form.sep)))
+      } else {
+        dd$form_name <- clean_redcap_name(Reduce(c,lapply(parts,\(.x) .x[[length(.x)]])))
+        dd$field_name <- Reduce(c,lapply(parts,\(.x) paste(.x[seq_len(length(.x)-1)],collapse=form.sep)))
+      }
     } else {
       dd$form_name <- "data"
       dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
     }
-  } else if (is.null(form.sep)) {
+  } else {
     ## if no form name prefix, the colnames are used as field_names
     dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
-  } else if (is.null(form.name)) {
+
+    if (is.null(form.name)) {
       dd$form_name <- "data"
     } else {
       if (length(form.name) == 1 || length(form.name) == nrow(dd)) {
@@ -252,6 +264,7 @@ ds2dd_detailed <- function(data,
         stop("Length of supplied 'form.name' has to be one (1) or ncol(data).")
       }
     }
+  }
 
   ## field_label
 

R/export_redcap_instrument.R

@@ -0,0 +1,123 @@
+#' 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 file destination file name.
+#' @param force force instrument creation and ignore different form names by
+#' just using the first.
+#' @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/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf

@@ -0,0 +1,10 @@
+name: redcapcast
+title:
+username: agdamsbo
+account: agdamsbo
+server: shinyapps.io
+hostUrl: https://api.shinyapps.io/v1
+appId: 11351429
+bundleId: 9264087
+url: https://agdamsbo.shinyapps.io/redcapcast/
+version: 1

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."
     ),
 
 
@@ -51,6 +51,9 @@ ui <- shiny::shinyUI(
       # Button
       shiny::downloadButton("downloadMeta", "Download data dictionary"),
 
+      # Button
+      shiny::downloadButton("downloadInstrument", "Download as instrument"),
+
 
       # Horizontal line ----
       shiny::tags$hr(),

man/create_instrument_meta.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/create_instrument_meta.R
+% Please edit documentation in R/export_redcap_instrument.R
 \name{create_instrument_meta}
 \alias{create_instrument_meta}
-\title{Create zips file with necessary content based on data set}
+\title{DEPRICATED Create zips file with necessary content based on data set}
 \usage{
 create_instrument_meta(data, dir = here::here(""), record.id = TRUE)
 }
@@ -21,22 +21,29 @@ list
 }
 \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 can be
+initial design phase. If you want to later add new instruments, this
-used to add instrument(s) to a project in production.
+function can be used to create (an) instrument(s) to add to a project in
+production.
 }
 \examples{
 data <- iris |>
-  ds2dd_detailed(add.auto.id = TRUE,
+  ds2dd_detailed(
-  form.name=sample(c("b","c"),size = 6,replace = TRUE,prob=rep(.5,2))) |>
+    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")
-names(data) <- glue::glue("{sample(x = c('a','b'),size = length(names(data)),
+iris |>
-replace=TRUE,prob = rep(x=.5,2))}__{names(data)}")
+  setNames(glue::glue("{sample(x = c('a','b'),size = length(ncol(iris)),
-data <- data |> ds2dd_detailed(form.sep="__")
+replace=TRUE,prob = rep(x=.5,2))}__{names(iris)}")) |>
+  ds2dd_detailed(form.sep = "__")
 # data |>
 #   purrr::pluck("meta") |>
 #   create_instrument_meta(record.id = FALSE)

man/ds2dd_detailed.Rd

@@ -34,7 +34,7 @@ ncol(data). Default is NULL and "data" is used.}
 
 \item{form.sep}{If supplied dataset has form names as suffix or prefix to the
 column/variable names, the seperator can be specified. If supplied, the
-form.sep is ignored. Default is NULL.}
+form.name is ignored. Default is NULL.}
 
 \item{form.prefix}{Flag to set if form is prefix (TRUE) or suffix (FALSE) to
 the column names. Assumes all columns have pre- or suffix if specified.}
@@ -87,6 +87,12 @@ data <- REDCapCAST::redcapcast_data
 data |> ds2dd_detailed(validate.time = TRUE)
 data |> ds2dd_detailed()
 iris |> ds2dd_detailed(add.auto.id = TRUE)
+iris |>
+  ds2dd_detailed(
+    add.auto.id = TRUE,
+    form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2))
+  ) |>
+  purrr::pluck("meta")
 mtcars |> ds2dd_detailed(add.auto.id = TRUE)
 data <- iris |>
   ds2dd_detailed(add.auto.id = TRUE) |>

man/export_redcap_instrument.Rd

@@ -0,0 +1,49 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/export_redcap_instrument.R
+\name{export_redcap_instrument}
+\alias{export_redcap_instrument}
+\title{Creates zip-file with necessary content to manually add instrument to database}
+\usage{
+export_redcap_instrument(data, file, force = FALSE, record.id = "record_id")
+}
+\arguments{
+\item{data}{metadata for the relevant instrument.
+Could be from `ds2dd_detailed()`}
+
+\item{file}{destination file name.}
+
+\item{force}{force instrument creation and ignore different form names by
+just using the first.}
+
+\item{record.id}{record id variable name. Default is 'record_id'.}
+}
+\value{
+exports zip-file
+}
+\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.
+}
+\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")))
+}

tests/testthat/test-ds2dd.R

@@ -0,0 +1,29 @@
+mtcars$id <- seq_len(nrow(mtcars))
+
+test_that("ds2dd gives desired output", {
+  expect_equal(ncol(ds2dd(mtcars, record.id = "id")), 18)
+  expect_s3_class(ds2dd(mtcars, record.id = "id"), "data.frame")
+  expect_s3_class(ds2dd(mtcars, record.id = 12), "data.frame")
+})
+
+
+test_that("ds2dd gives output with list of length two", {
+  expect_equal(length(ds2dd(
+    mtcars,
+    record.id = "id",
+    include.column.names = TRUE
+  )), 2)
+})
+
+
+test_that("ds2dd gives correct errors", {
+  expect_error(ds2dd(mtcars))
+  expect_error(ds2dd(mtcars, form.name = c("basis", "incl")))
+  expect_error(ds2dd(mtcars, field.type = c("text", "dropdown")))
+  expect_error(ds2dd(mtcars, field.label = c("Name", "Age")))
+})
+
+test_that("ds2dd correctly renames", {
+  expect_equal(ncol(ds2dd(mtcars, record.id = "id")), 18)
+  expect_s3_class(ds2dd(mtcars, record.id = "id"), "data.frame")
+})