preparing for next version

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/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,13 +149,19 @@ 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) |>
 #'   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 |> ds2dd_detailed(form.sep="__")
+#' data |> ds2dd_detailed(form.sep = "__")
 ds2dd_detailed <- function(data,
                            add.auto.id = FALSE,
                            date.format = "dmy",
@@ -229,21 +235,27 @@ ds2dd_detailed <- function(data,
   ## form_name and field_name
 
   if (!is.null(form.sep)) {
-    if (form.sep!=""){
-    suppressMessages(nms <- 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
-    dd$form_name <- clean_redcap_name(dplyr::slice(nms,ifelse(form.prefix, 1, 2)))
+    if (form.sep != "") {
+      parts <- strsplit(names(data), split = form.sep)
+
+      ## 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
       ## 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
 

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: 9263605
+url: https://agdamsbo.shinyapps.io/redcapcast/
+version: 1

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
-used to add instrument(s) to a project in production.
+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{
 data <- iris |>
-  ds2dd_detailed(add.auto.id = TRUE,
-  form.name=sample(c("b","c"),size = 6,replace = TRUE,prob=rep(.5,2))) |>
+  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="__")
+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)

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,11 +87,17 @@ 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) |>
   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 |> ds2dd_detailed(form.sep="__")
+data |> ds2dd_detailed(form.sep = "__")
 }

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