From 4ad21c7f571013679970efa8c6f923762312a3b4 Mon Sep 17 00:00:00 2001 From: Andreas Gammelgaard Damsbo Date: Tue, 26 Nov 2024 14:46:22 +0100 Subject: [PATCH] restructuring --- NEWS.md | 6 + R/as_factor.R | 49 +++-- R/ds2dd_detailed.R | 132 ++++++++++-- R/export_redcap_instrument.R | 22 +- R/redcapcast_meta.R | 2 +- data-raw/metadata_names.R | 12 +- data-raw/redcapcast_data.R | 2 +- inst/shiny-examples/casting/app.R | 195 ++++++++++++++++++ .../shinyapps.io/agdamsbo/redcapcast.dcf | 2 +- man/create_instrument_meta.Rd | 8 +- man/ds2dd.Rd | 6 +- man/ds2dd_detailed.Rd | 7 +- man/export_redcap_instrument.Rd | 4 +- man/fct2num.Rd | 2 +- man/possibly_roman.Rd | 8 +- man/redcap_meta_default.Rd | 20 ++ man/redcapcast_meta.Rd | 2 +- tests/testthat/test-ds2dd.R | 31 ++- vignettes/Database-creation.Rmd | 2 +- 19 files changed, 432 insertions(+), 80 deletions(-) create mode 100644 inst/shiny-examples/casting/app.R create mode 100644 man/redcap_meta_default.Rd diff --git a/NEWS.md b/NEWS.md index 22acc53..53d392f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# REDCapCAST 24.11.4 + +The hosting on shinyapps.io has given a lot of trouble recently. Modyfied package structure a little around the `shiny_cast()`, to accommodate an alternative hosting approach with all package functions included in a script instead of requiring the package. + +* read_readcap_labelled(): + # REDCapCAST 24.11.3 * BUG: shiny_cast() fails to load as I missed loading REDCapCAST library in ui.r. Fixed. Tests would be great. diff --git a/R/as_factor.R b/R/as_factor.R index d6d7fd1..0f192b6 100644 --- a/R/as_factor.R +++ b/R/as_factor.R @@ -16,7 +16,8 @@ #' structure(c(1, 2, 3, 2, 10, 9), #' labels = c(Unknown = 9, Refused = 10) #' ) |> -#' as_factor() |> dput() +#' as_factor() |> +#' dput() #' #' structure(c(1, 2, 3, 2, 10, 9), #' labels = c(Unknown = 9, Refused = 10), @@ -56,13 +57,13 @@ as_factor.numeric <- function(x, ...) { #' @export as_factor.character <- function(x, ...) { labels <- get_attr(x) - if (possibly_roman(x)){ + if (possibly_roman(x)) { x <- factor(x) } else { - x <- structure( - forcats::fct_inorder(x), - label = attr(x, "label", exact = TRUE) - ) + x <- structure( + forcats::fct_inorder(x), + label = attr(x, "label", exact = TRUE) + ) } set_attr(x, labels, overwrite = FALSE) } @@ -202,8 +203,9 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99) ) } + # Handle empty factors - if (all_na(data)){ + if (all_na(data)) { d <- data.frame( name = levels(data), value = seq_along(levels(data)) @@ -213,15 +215,19 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99) name = levels(data)[data], value = as.numeric(data) ) |> - unique() + unique() |> + stats::na.omit() } ## Applying labels attr_l <- attr(x = data, which = label, exact = TRUE) if (length(attr_l) != 0) { - if (all(names(attr_l) %in% d$name)){ + if (all(names(attr_l) %in% d$name)) { d$value[match(names(attr_l), d$name)] <- unname(attr_l) - }else { + } else if (all(d$name %in% names(attr_l)) && nrow(d) < length(attr_l)){ + d <- data.frame(name = names(attr_l), + value=unname(attr_l)) + } else { d$name[match(attr_l, d$name)] <- names(attr_l) d$value[match(names(attr_l), d$name)] <- unname(attr_l) } @@ -244,13 +250,17 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99) #' @export #' #' @examples -#' sample(1:100,10) |> as.roman() |> possibly_roman() -#' sample(c(TRUE,FALSE),10,TRUE)|> possibly_roman() -#' rep(NA,10)|> possibly_roman() -possibly_roman <- function(data){ +#' sample(1:100, 10) |> +#' as.roman() |> +#' possibly_roman() +#' sample(c(TRUE, FALSE), 10, TRUE) |> possibly_roman() +#' rep(NA, 10) |> possibly_roman() +possibly_roman <- function(data) { # browser() - if (all(is.na(data))) return(FALSE) - identical(as.character(data),as.character(utils::as.roman(data))) + if (all(is.na(data))) { + return(FALSE) + } + identical(as.character(data), as.character(utils::as.roman(data))) } @@ -287,13 +297,13 @@ possibly_roman <- function(data){ #' # as_factor() |> #' # fct2num() #' -#' v <- sample(6:19,20,TRUE) |> factor() +#' v <- sample(6:19, 20, TRUE) |> factor() #' dput(v) #' named_levels(v) #' fct2num(v) fct2num <- function(data) { stopifnot(is.factor(data)) - if (is.character(named_levels(data))){ + if (is.character(named_levels(data))) { values <- as.numeric(named_levels(data)) } else { values <- named_levels(data) @@ -309,7 +319,7 @@ fct2num <- function(data) { unname(out) } -possibly_numeric <- function(data){ +possibly_numeric <- function(data) { length(stats::na.omit(suppressWarnings(as.numeric(names(data))))) == length(data) } @@ -369,7 +379,6 @@ set_attr <- function(data, label, attr = NULL, overwrite = FALSE) { label <- label[!names(label) %in% names(attributes(data))] } attributes(data) <- c(attributes(data), label) - } else { attr(data, attr) <- label } diff --git a/R/ds2dd_detailed.R b/R/ds2dd_detailed.R index 73fb7f0..0352ceb 100644 --- a/R/ds2dd_detailed.R +++ b/R/ds2dd_detailed.R @@ -98,6 +98,116 @@ hms2character <- function(data) { dplyr::bind_cols() } + +#' Default column names of a REDCap data dictionary +#' +#' @param ... ignored for now +#' +#' @return character vector +#' @export +#' +#' @examples +#' dput(redcap_meta_default()) +redcap_meta_default <- function(...) { + c( + "field_name", "form_name", "section_header", "field_type", + "field_label", "select_choices_or_calculations", "field_note", + "text_validation_type_or_show_slider_number", "text_validation_min", + "text_validation_max", "identifier", "branching_logic", "required_field", + "custom_alignment", "question_number", "matrix_group_name", "matrix_ranking", + "field_annotation" + ) +} + +#' (DEPRECATED) Data set to data dictionary function +#' +#' @description +#' Creates a very basic data dictionary skeleton. Please see `ds2dd_detailed()` +#' for a more advanced function. +#' +#' @details +#' Migrated from stRoke ds2dd(). Fits better with the functionality of +#' 'REDCapCAST'. +#' @param ds data set +#' @param record.id name or column number of id variable, moved to first row of +#' data dictionary, character of integer. Default is "record_id". +#' @param form.name vector of form names, character string, length 1 or length +#' equal to number of variables. Default is "basis". +#' @param field.type vector of field types, character string, length 1 or length +#' equal to number of variables. Default is "text. +#' @param field.label vector of form names, character string, length 1 or length +#' equal to number of variables. Default is NULL and is then identical to field +#' names. +#' @param include.column.names Flag to give detailed output including new +#' column names for original data set for upload. +#' @param metadata Metadata column names. Default is the included +#' REDCapCAST::redcap_meta_default. +#' +#' @return data.frame or list of data.frame and vector +#' @export +#' +#' @examples +#' redcapcast_data$record_id <- seq_len(nrow(redcapcast_data)) +#' ds2dd(redcapcast_data, include.column.names=TRUE) + +ds2dd <- + function(ds, + record.id = "record_id", + form.name = "basis", + field.type = "text", + field.label = NULL, + include.column.names = FALSE, + metadata = REDCapCAST::redcap_meta_default() + ) { + dd <- data.frame(matrix(ncol = length(metadata), nrow = ncol(ds))) + colnames(dd) <- metadata + + if (is.character(record.id) && !record.id %in% colnames(ds)) { + stop("Provided record.id is not a variable name in provided data set.") + } + + # renaming to lower case and substitute spaces with underscore + field.name <- gsub(" ", "_", tolower(colnames(ds))) + + # handles both character and integer + colsel <- + colnames(ds) == colnames(ds[record.id]) + + if (summary(colsel)[3] != 1) { + stop("Provided record.id has to be or refer to a uniquely named column.") + } + + dd[, "field_name"] <- + c(field.name[colsel], field.name[!colsel]) + + if (length(form.name) > 1 && length(form.name) != ncol(ds)) { + stop( + "Provided form.name should be of length 1 (value is reused) or equal + length as number of variables in data set." + ) + } + dd[, "form_name"] <- form.name + + if (length(field.type) > 1 && length(field.type) != ncol(ds)) { + stop( + "Provided field.type should be of length 1 (value is reused) or equal + length as number of variables in data set." + ) + } + + dd[, "field_type"] <- field.type + + if (is.null(field.label)) { + dd[, "field_label"] <- dd[, "field_name"] + } else + dd[, "field_label"] <- field.label + + if (include.column.names){ + list("DataDictionary"=dd,"Column names"=field.name) + } else dd + } + + #' Extract data from stata file for data dictionary #' #' @details @@ -134,7 +244,7 @@ hms2character <- function(data) { #' or attribute `factor.labels.attr` for haven_labelled data set (imported .dta #' file with `haven::read_dta()`). #' @param metadata redcap metadata headings. Default is -#' REDCapCAST:::metadata_names. +#' REDCapCAST::redcap_meta_default(). #' @param convert.logicals convert logicals to factor. Default is TRUE. #' #' @return list of length 2 @@ -142,7 +252,8 @@ hms2character <- function(data) { #' #' @examples #' ## Basic parsing with default options -#' REDCapCAST::redcapcast_data |> +#' requireNamespace("REDCapCAST") +#' redcapcast_data |> #' dplyr::select(-dplyr::starts_with("redcap_")) |> #' ds2dd_detailed() #' @@ -175,15 +286,8 @@ ds2dd_detailed <- function(data, field.label = NULL, field.label.attr = "label", field.validation = NULL, - metadata = names(REDCapCAST::redcapcast_meta), + metadata = REDCapCAST::redcap_meta_default(), convert.logicals = TRUE) { - # Repair empty columns - # These where sometimes classed as factors or - # if (any(sapply(data,all_na))){ - # data <- data |> - # ## Converts logical to factor, which overwrites attributes - # dplyr::mutate(dplyr::across(dplyr::where(all_na), as.character)) - # } if (convert.logicals) { data <- data |> @@ -357,8 +461,8 @@ ds2dd_detailed <- function(data, #' @export #' #' @examples -#' rep(NA,4) |> all_na() -all_na <- function(data){ +#' rep(NA, 4) |> all_na() +all_na <- function(data) { all(is.na(data)) } @@ -561,7 +665,7 @@ numchar2fct <- function(data, numeric.threshold = 6, character.throshold = 6) { #' sort() |> #' vec2choice() vec2choice <- function(data) { - compact_vec(data,nm.sep = ", ",val.sep = " | ") + compact_vec(data, nm.sep = ", ", val.sep = " | ") } #' Compacting a vector of any length with or without names @@ -582,7 +686,7 @@ vec2choice <- function(data) { #' 1:6 |> compact_vec() #' "test" |> compact_vec() #' sample(letters[1:9], 20, TRUE) |> compact_vec() -compact_vec <- function(data,nm.sep=": ",val.sep="; ") { +compact_vec <- function(data, nm.sep = ": ", val.sep = "; ") { # browser() if (all(is.na(data))) { return(data) diff --git a/R/export_redcap_instrument.R b/R/export_redcap_instrument.R index e5b7b98..8606cce 100644 --- a/R/export_redcap_instrument.R +++ b/R/export_redcap_instrument.R @@ -17,7 +17,7 @@ #' @export #' #' @examples -#' #iris |> +#' # iris |> #' # ds2dd_detailed( #' # add.auto.id = TRUE, #' # form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2)) @@ -30,7 +30,7 @@ #' # export_redcap_instrument(.x,file=here::here(paste0(.i,Sys.Date(),".zip"))) #' # }) #' -#' #iris |> +#' # iris |> #' # ds2dd_detailed( #' # add.auto.id = TRUE #' # ) |> @@ -38,18 +38,18 @@ #' # export_redcap_instrument(file=here::here(paste0("instrument",Sys.Date(),".zip"))) export_redcap_instrument <- function(data, file, - force=FALSE, + force = FALSE, record.id = "record_id") { # Ensure form name is the same - if (force){ + if (force) { data$form_name <- data$form_name[1] - } else if (length(unique(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 (!is.na(record.id) && record.id %in% data[["field_name"]]){ - data <- data[-match(record.id,data[["field_name"]]),] + if (!is.na(record.id) && record.id %in% data[["field_name"]]) { + data <- data[-match(record.id, data[["field_name"]]), ] } temp_dir <- tempdir() @@ -82,6 +82,7 @@ export_redcap_instrument <- function(data, #' @export #' #' @examples +#' \dontrun{ #' data <- iris |> #' ds2dd_detailed( #' add.auto.id = TRUE, @@ -100,9 +101,10 @@ export_redcap_instrument <- function(data, #' 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) +#' data |> +#' purrr::pluck("meta") |> +#' create_instrument_meta(record.id = FALSE) +#' } create_instrument_meta <- function(data, dir = here::here(""), record.id = TRUE) { diff --git a/R/redcapcast_meta.R b/R/redcapcast_meta.R index 31e5ef5..6442cfa 100644 --- a/R/redcapcast_meta.R +++ b/R/redcapcast_meta.R @@ -1,6 +1,6 @@ #' REDCap metadata from data base #' -#' This metadata dataset from a REDCap database is for demonstrational purposes. +#' This metadata dataset from a REDCap database is for demonstration purposes. #' #' @format A data frame with 22 variables: #' \describe{ diff --git a/data-raw/metadata_names.R b/data-raw/metadata_names.R index bb83e19..3310f14 100644 --- a/data-raw/metadata_names.R +++ b/data-raw/metadata_names.R @@ -7,9 +7,9 @@ # "matrix_ranking", "field_annotation" # ) -metadata_names <- REDCapR::redcap_metadata_read( - redcap_uri = keyring::key_get("DB_URI"), - token = keyring::key_get("cast_api") -)$data |> names() - -usethis::use_data(metadata_names, overwrite = TRUE, internal = TRUE) +# metadata_names <- REDCapR::redcap_metadata_read( +# redcap_uri = keyring::key_get("DB_URI"), +# token = keyring::key_get("cast_api") +# )$data |> names() +# +# usethis::use_data(metadata_names, overwrite = TRUE, internal = TRUE) diff --git a/data-raw/redcapcast_data.R b/data-raw/redcapcast_data.R index d6b8a63..2d35f4b 100644 --- a/data-raw/redcapcast_data.R +++ b/data-raw/redcapcast_data.R @@ -12,4 +12,4 @@ redcapcast_data <- REDCapR::redcap_read( usethis::use_data(redcapcast_data, overwrite = TRUE) -write.csv(redcapcast_data,here::here("data/redcapcast_data.csv"),row.names = FALSE) +# write.csv(redcapcast_data,here::here("data/redcapcast_data.csv"),row.names = FALSE) diff --git a/inst/shiny-examples/casting/app.R b/inst/shiny-examples/casting/app.R new file mode 100644 index 0000000..0275c00 --- /dev/null +++ b/inst/shiny-examples/casting/app.R @@ -0,0 +1,195 @@ +library(bslib) +library(shiny) +library(openxlsx2) +library(haven) +library(readODS) +library(readr) +library(dplyr) +library(gt) +library(devtools) + +if (!requireNamespace("REDCapCAST")) { + install.packages("REDCapCAST") +} +library(REDCapCAST) + +## Load merged files for shinyapps.io hosting +if (file.exists(here::here("functions.R"))) { + source(here::here("functions.R")) +} + +ui <- + bslib::page( + theme = bslib::bs_theme(preset = "united"), + title = "REDCap database creator", + nav_bar_page() + ) + +server <- function(input, output, session) { + v <- shiny::reactiveValues( + file = NULL + ) + + ds <- shiny::reactive({ + shiny::req(input$ds) + + out <- read_input(input$ds$datapath) + + out <- out |> + ## Parses data with readr functions + parse_data() |> + ## Converts logical to factor, preserving attributes with own function + dplyr::mutate(dplyr::across(dplyr::where(is.logical), as_factor)) + + out + }) + + dat <- shiny::reactive({ + out <- ds() + + if (!is.null(input$factor_vars)) { + out <- out |> + dplyr::mutate( + dplyr::across( + dplyr::all_of(input$factor_vars), + as_factor + ) + ) + } + + out + }) + + # getData <- reactive({ + # if(is.null(input$ds$datapath)) return(NULL) + # }) + # output$uploaded <- reactive({ + # return(!is.null(getData())) + # }) + + dd <- shiny::reactive({ + shiny::req(input$ds) + v$file <- "loaded" + ds2dd_detailed( + data = dat(), + add.auto.id = input$add_id == "yes" + ) + }) + + output$uploaded <- shiny::reactive({ + if (is.null(v$file)) { + "no" + } else { + "yes" + } + }) + + shiny::outputOptions(output, "uploaded", suspendWhenHidden = FALSE) + + output$factor_vars <- shiny::renderUI({ + shiny::req(input$ds) + selectizeInput( + inputId = "factor_vars", + selected = colnames(dat())[sapply(dat(), is.factor)], + label = "Covariables to format as categorical", + choices = colnames(dat()), + multiple = TRUE + ) + }) + + ## Specify ID if necessary + # output$id_var <- shiny::renderUI({ + # shiny::req(input$ds) + # selectizeInput( + # inputId = "id_var", + # selected = colnames(dat())[1], + # label = "ID variable", + # choices = colnames(dat())[-match(colnames(dat()),input$factor_vars)], + # multiple = FALSE + # ) + # }) + + output$data.tbl <- gt::render_gt( + dd() |> + cast_data_overview() + ) + + output$meta.tbl <- gt::render_gt( + dd() |> + cast_meta_overview() + ) + + # Downloadable csv of dataset ---- + output$downloadData <- shiny::downloadHandler( + filename = "data_ready.csv", + content = function(file) { + write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE, na = "") + } + ) + + # Downloadable csv of data dictionary ---- + output$downloadMeta <- shiny::downloadHandler( + filename = paste0("REDCapCAST_DataDictionary_", Sys.Date(), ".csv"), + content = function(file) { + write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE, na = "") + } + ) + + # Downloadable .zip of instrument ---- + output$downloadInstrument <- shiny::downloadHandler( + filename = paste0("REDCapCAST_instrument", Sys.Date(), ".zip"), + content = function(file) { + export_redcap_instrument(purrr::pluck(dd(), "meta"), + file = file, + record.id = ifelse(input$add_id == "none", NA, names(dat())[1]) + ) + } + ) + + output_staging <- shiny::reactiveValues() + + output_staging$meta <- output_staging$data <- NA + + shiny::observeEvent(input$upload.meta, { + upload_meta() + }) + + shiny::observeEvent(input$upload.data, { + upload_data() + }) + + upload_meta <- function() { + shiny::req(input$uri) + + shiny::req(input$api) + + output_staging$meta <- REDCapR::redcap_metadata_write( + ds = purrr::pluck(dd(), "meta"), + redcap_uri = input$uri, + token = input$api + ) |> purrr::pluck("success") + } + + upload_data <- function() { + shiny::req(input$uri) + + shiny::req(input$api) + + output_staging$data <- REDCapR::redcap_write( + ds = purrr::pluck(dd(), "data"), + redcap_uri = input$uri, + token = input$api + ) |> purrr::pluck("success") + } + + output$upload.meta.print <- renderText(output_staging$meta) + + output$upload.data.print <- renderText(output_staging$data) + + # session$onSessionEnded(function() { + # # cat("Session Ended\n") + # unlink("www",recursive = TRUE) + # }) +} + +shiny::shinyApp(ui = ui, server = server) diff --git a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf b/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf index 16c7359..bc051b2 100644 --- a/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf +++ b/inst/shiny-examples/casting/rsconnect/shinyapps.io/agdamsbo/redcapcast.dcf @@ -5,6 +5,6 @@ account: agdamsbo server: shinyapps.io hostUrl: https://api.shinyapps.io/v1 appId: 11351429 -bundleId: 9412329 +bundleId: 9418747 url: https://agdamsbo.shinyapps.io/redcapcast/ version: 1 diff --git a/man/create_instrument_meta.Rd b/man/create_instrument_meta.Rd index 4b2d7c3..742b947 100644 --- a/man/create_instrument_meta.Rd +++ b/man/create_instrument_meta.Rd @@ -26,6 +26,7 @@ function can be used to create (an) instrument(s) to add to a project in production. } \examples{ +\dontrun{ data <- iris |> ds2dd_detailed( add.auto.id = TRUE, @@ -44,7 +45,8 @@ 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) +data |> + purrr::pluck("meta") |> + create_instrument_meta(record.id = FALSE) +} } diff --git a/man/ds2dd.Rd b/man/ds2dd.Rd index ba607b8..ea64cce 100644 --- a/man/ds2dd.Rd +++ b/man/ds2dd.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ds2dd.R +% Please edit documentation in R/ds2dd_detailed.R \name{ds2dd} \alias{ds2dd} \title{(DEPRECATED) Data set to data dictionary function} @@ -11,7 +11,7 @@ ds2dd( field.type = "text", field.label = NULL, include.column.names = FALSE, - metadata = metadata_names + metadata = REDCapCAST::redcap_meta_default() ) } \arguments{ @@ -34,7 +34,7 @@ names.} column names for original data set for upload.} \item{metadata}{Metadata column names. Default is the included -REDCapCAST::metadata_names.} +REDCapCAST::redcap_meta_default.} } \value{ data.frame or list of data.frame and vector diff --git a/man/ds2dd_detailed.Rd b/man/ds2dd_detailed.Rd index 0cac82f..ded7be6 100644 --- a/man/ds2dd_detailed.Rd +++ b/man/ds2dd_detailed.Rd @@ -15,7 +15,7 @@ ds2dd_detailed( field.label = NULL, field.label.attr = "label", field.validation = NULL, - metadata = names(REDCapCAST::redcapcast_meta), + metadata = REDCapCAST::redcap_meta_default(), convert.logicals = TRUE ) } @@ -55,7 +55,7 @@ or attribute `factor.labels.attr` for haven_labelled data set (imported .dta file with `haven::read_dta()`).} \item{metadata}{redcap metadata headings. Default is -REDCapCAST:::metadata_names.} +REDCapCAST::redcap_meta_default().} \item{convert.logicals}{convert logicals to factor. Default is TRUE.} } @@ -76,7 +76,8 @@ Ensure, that the data set is formatted with as much information as possible. } \examples{ ## Basic parsing with default options -REDCapCAST::redcapcast_data |> +requireNamespace("REDCapCAST") +redcapcast_data |> dplyr::select(-dplyr::starts_with("redcap_")) |> ds2dd_detailed() diff --git a/man/export_redcap_instrument.Rd b/man/export_redcap_instrument.Rd index 59ea176..3af78d8 100644 --- a/man/export_redcap_instrument.Rd +++ b/man/export_redcap_instrument.Rd @@ -27,7 +27,7 @@ function can be used to create (an) instrument(s) to add to a project in production. } \examples{ -#iris |> +# iris |> # ds2dd_detailed( # add.auto.id = TRUE, # form.name = sample(c("b", "c"), size = 6, replace = TRUE, prob = rep(.5, 2)) @@ -40,7 +40,7 @@ production. # export_redcap_instrument(.x,file=here::here(paste0(.i,Sys.Date(),".zip"))) # }) -#iris |> +# iris |> # ds2dd_detailed( # add.auto.id = TRUE # ) |> diff --git a/man/fct2num.Rd b/man/fct2num.Rd index 76280b3..4708fcb 100644 --- a/man/fct2num.Rd +++ b/man/fct2num.Rd @@ -41,7 +41,7 @@ structure(c(1, 2, 3, 2, 10, 9), # as_factor() |> # fct2num() -v <- sample(6:19,20,TRUE) |> factor() +v <- sample(6:19, 20, TRUE) |> factor() dput(v) named_levels(v) fct2num(v) diff --git a/man/possibly_roman.Rd b/man/possibly_roman.Rd index fad8232..cb5cb34 100644 --- a/man/possibly_roman.Rd +++ b/man/possibly_roman.Rd @@ -16,7 +16,9 @@ logical Test if vector can be interpreted as roman numerals } \examples{ -sample(1:100,10) |> as.roman() |> possibly_roman() -sample(c(TRUE,FALSE),10,TRUE)|> possibly_roman() -rep(NA,10)|> possibly_roman() +sample(1:100, 10) |> + as.roman() |> + possibly_roman() +sample(c(TRUE, FALSE), 10, TRUE) |> possibly_roman() +rep(NA, 10) |> possibly_roman() } diff --git a/man/redcap_meta_default.Rd b/man/redcap_meta_default.Rd new file mode 100644 index 0000000..300e82e --- /dev/null +++ b/man/redcap_meta_default.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ds2dd_detailed.R +\name{redcap_meta_default} +\alias{redcap_meta_default} +\title{Default column names of a REDCap data dictionary} +\usage{ +redcap_meta_default(...) +} +\arguments{ +\item{...}{ignored for now} +} +\value{ +character vector +} +\description{ +Default column names of a REDCap data dictionary +} +\examples{ +dput(redcap_meta_default()) +} diff --git a/man/redcapcast_meta.Rd b/man/redcapcast_meta.Rd index e5cd8b2..357ecdf 100644 --- a/man/redcapcast_meta.Rd +++ b/man/redcapcast_meta.Rd @@ -31,6 +31,6 @@ A data frame with 22 variables: data(redcapcast_meta) } \description{ -This metadata dataset from a REDCap database is for demonstrational purposes. +This metadata dataset from a REDCap database is for demonstration purposes. } \keyword{datasets} diff --git a/tests/testthat/test-ds2dd.R b/tests/testthat/test-ds2dd.R index 0529a03..cc56628 100644 --- a/tests/testthat/test-ds2dd.R +++ b/tests/testthat/test-ds2dd.R @@ -1,9 +1,20 @@ mtcars$id <- seq_len(nrow(mtcars)) +metadata_names <- function(...) { + c( + "field_name", "form_name", "section_header", "field_type", + "field_label", "select_choices_or_calculations", "field_note", + "text_validation_type_or_show_slider_number", "text_validation_min", + "text_validation_max", "identifier", "branching_logic", "required_field", + "custom_alignment", "question_number", "matrix_group_name", "matrix_ranking", + "field_annotation" + ) +} + 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") + expect_equal(ncol(ds2dd(mtcars, record.id = "id",metadata = metadata_names())), 18) + expect_s3_class(ds2dd(mtcars, record.id = "id",metadata = metadata_names()), "data.frame") + expect_s3_class(ds2dd(mtcars, record.id = 12,metadata = metadata_names()), "data.frame") }) @@ -11,19 +22,19 @@ test_that("ds2dd gives output with list of length two", { expect_equal(length(ds2dd( mtcars, record.id = "id", - include.column.names = TRUE + include.column.names = TRUE,metadata = metadata_names() )), 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"))) + expect_error(ds2dd(mtcars,metadata = metadata_names())) + expect_error(ds2dd(mtcars, form.name = c("basis", "incl"),metadata = metadata_names())) + expect_error(ds2dd(mtcars, field.type = c("text", "dropdown"),metadata = metadata_names())) + expect_error(ds2dd(mtcars, field.label = c("Name", "Age"),metadata = metadata_names())) }) test_that("ds2dd correctly renames", { - expect_equal(ncol(ds2dd(mtcars, record.id = "id")), 18) - expect_s3_class(ds2dd(mtcars, record.id = "id"), "data.frame") + expect_equal(ncol(ds2dd(mtcars, record.id = "id",metadata = metadata_names())), 18) + expect_s3_class(ds2dd(mtcars, record.id = "id",metadata = metadata_names()), "data.frame") }) diff --git a/vignettes/Database-creation.Rmd b/vignettes/Database-creation.Rmd index 7c7327c..b3409ce 100644 --- a/vignettes/Database-creation.Rmd +++ b/vignettes/Database-creation.Rmd @@ -32,7 +32,7 @@ In the following I will try to come with a few suggestions on how to use these a The first iteration of a dataset to data dictionary function is the `ds2dd()`, which creates a very basic data dictionary with all variables stored as text. This is sufficient for just storing old datasets/spreadsheets securely in REDCap. -```{r eval=TRUE} +```{r eval=FALSE} d1 <- mtcars |> dplyr::mutate(record_id = seq_len(dplyr::n())) |> ds2dd()