From 28beea676c7a1235c399151321d2c6741f8a23d2 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Thu, 24 Oct 2024 11:41:48 +0200 Subject: [PATCH] preparing for next version --- DESCRIPTION | 2 +- NEWS.md | 16 +++++++ R/ds2dd_detailed.R | 45 ++++++++++++------- .../shinyapps.io/agdamsbo/redcapcast.dcf | 10 +++++ man/create_instrument_meta.Rd | 25 +++++++---- man/ds2dd_detailed.Rd | 10 ++++- tests/testthat/test-ds2dd.R | 29 ++++++++++++ 7 files changed, 109 insertions(+), 28 deletions(-) create mode 100644 app/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf create mode 100644 tests/testthat/test-ds2dd.R diff --git a/DESCRIPTION b/DESCRIPTION index b368927..6eac03b 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NEWS.md b/NEWS.md index 629c382..07d35a3 100644 --- a/NEWS.md +++ b/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. diff --git a/R/ds2dd_detailed.R b/R/ds2dd_detailed.R index 731e3b5..a39e681 100644 --- a/R/ds2dd_detailed.R +++ b/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,27 +235,34 @@ 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))) - ## The other split part is used as field names - dd$field_name <- dplyr::slice(nms,ifelse(!form.prefix, 1, 2)) |> as.character() + 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))) + } } 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)) { - dd$form_name <- "data" - } else { - if (length(form.name) == 1 || length(form.name) == nrow(dd)) { - dd$form_name <- form.name + + if (is.null(form.name)) { + dd$form_name <- "data" } else { - stop("Length of supplied 'form.name' has to be one (1) or ncol(data).") + 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).") + } } } diff --git a/app/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf b/app/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf new file mode 100644 index 0000000..0b7d596 --- /dev/null +++ b/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 diff --git a/man/create_instrument_meta.Rd b/man/create_instrument_meta.Rd index de88eff..4b2d7c3 100644 --- a/man/create_instrument_meta.Rd +++ b/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) diff --git a/man/ds2dd_detailed.Rd b/man/ds2dd_detailed.Rd index a4dfe3e..f8a062a 100644 --- a/man/ds2dd_detailed.Rd +++ b/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 = "__") } diff --git a/tests/testthat/test-ds2dd.R b/tests/testthat/test-ds2dd.R new file mode 100644 index 0000000..0529a03 --- /dev/null +++ b/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") +})