.Renviron

@@ -1 +0,0 @@
-_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,19 +1,3 @@
-# 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

@@ -0,0 +1,50 @@
+#' 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.name is ignored. Default is NULL.
+#' form.sep 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,19 +149,13 @@ 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",
@@ -235,34 +229,27 @@ ds2dd_detailed <- function(data,
   ## form_name and field_name
 
   if (!is.null(form.sep)) {
-    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
-      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)))
-      }
+    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)))
+    ## The other split part is used as field names
+    dd$field_name <- dplyr::slice(nms,ifelse(!form.prefix, 1, 2)) |> as.character()
     } else {
       dd$form_name <- "data"
       dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
     }
-  } else {
+  } else if (is.null(form.sep)) {
     ## if no form name prefix, the colnames are used as field_names
     dd$field_name <- gsub(" ", "_", tolower(colnames(data)))
-
-    if (is.null(form.name)) {
-      dd$form_name <- "data"
+  } else if (is.null(form.name)) {
+    dd$form_name <- "data"
+  } else {
+    if (length(form.name) == 1 || length(form.name) == nrow(dd)) {
+      dd$form_name <- form.name
     } else {
-      if (length(form.name) == 1 || length(form.name) == nrow(dd)) {
-        dd$form_name <- form.name
-      } else {
-        stop("Length of supplied 'form.name' has to be one (1) or ncol(data).")
-      }
+      stop("Length of supplied 'form.name' has to be one (1) or ncol(data).")
     }
   }
 

R/export_redcap_instrument.R

@@ -1,123 +0,0 @@
-#' 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

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

man/create_instrument_meta.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/export_redcap_instrument.R
+% Please edit documentation in R/create_instrument_meta.R
 \name{create_instrument_meta}
 \alias{create_instrument_meta}
-\title{DEPRICATED Create zips file with necessary content based on data set}
+\title{Create zips file with necessary content based on data set}
 \usage{
 create_instrument_meta(data, dir = here::here(""), record.id = TRUE)
 }
@@ -21,29 +21,22 @@ 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
-function can be used to create (an) instrument(s) to add to a project in
-production.
+initial design phase. If you want to later add new instruments, this can be
+used to add instrument(s) 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")
-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 = "__")
+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)

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.name is ignored. Default is NULL.}
+form.sep 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,17 +87,11 @@ 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="__")
 }

man/export_redcap_instrument.Rd

@@ -1,49 +0,0 @@
-% 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

@@ -1,29 +0,0 @@
-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")
-})