diff --git a/DESCRIPTION b/DESCRIPTION index 329e36c..09f5b73 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: REDCapCAST Title: REDCap Castellated Data Handling -Version: 24.4.1 +Version: 24.5.1 Authors@R: c( person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk", role = c("aut", "cre"),comment = c(ORCID = "0000-0002-7559-1154")), @@ -35,7 +35,8 @@ Suggests: roxygen2, spelling, glue, - rhub + rhub, + shinythemes License: GPL (>= 3) Encoding: UTF-8 LazyData: true @@ -55,15 +56,18 @@ Imports: openxlsx2, haven, readODS, - zip + zip, + assertthat Collate: 'utils.r' 'process_user_input.r' 'REDCap_split.r' 'create_instrument_meta.R' + 'doc2dd.R' 'ds2dd.R' 'ds2dd_detailed.R' 'easy_redcap.R' + 'html_styling.R' 'mtcars_redcap.R' 'read_redcap_instrument.R' 'read_redcap_tables.R' diff --git a/NAMESPACE b/NAMESPACE index a5597c6..670ff33 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,18 +1,30 @@ # Generated by roxygen2: do not edit by hand +S3method(process_user_input,character) +S3method(process_user_input,data.frame) +S3method(process_user_input,default) +S3method(process_user_input,response) export(REDCap_split) +export(case_match_regex_list) +export(char2choice) +export(char2cond) export(clean_redcap_name) +export(create_html_table) export(create_instrument_meta) export(d2w) +export(doc2dd) export(ds2dd) export(ds2dd_detailed) export(easy_redcap) export(file_extension) export(focused_metadata) +export(format_subheader) export(get_api_key) export(guess_time_only_filter) +export(html_tag_wrap) export(is_repeated_longitudinal) export(match_fields_to_form) +export(process_user_input) export(read_input) export(read_redcap_instrument) export(read_redcap_tables) diff --git a/NEWS.md b/NEWS.md index 2e2ebef..6574886 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# REDCapCAST 24.4.1 - in development +# REDCapCAST 24.5.1 ### Functions @@ -8,9 +8,12 @@ * New: `create_instrument_meta()`: creates zip with instrument files to allow adding new instruments to project in production. Takes data dictionary as input and creates a zip for each instrument specified by the `form_name` column. +* New: `doc2dd()`: function to convert document table to data dictionary. This allows to specify instrument or whole data dictionary in text document, which for most is easier to work with and easily modifiable. The generic case is a data frame with variable names as values in a column. This is a format like the REDCap data dictionary, but gives a few options for formatting. Has a few related functions for data handling and formatting. One interesting function is `case_match_regex_list()`, which allows for a dynamic `dplyr::case_when()`-like approach for regex-matching. I think it is neat at least. + + ### Documentation and more -* Dependencies: In order to deploy `shiny_cast()` with `shinylive`, I need to remove `curl` as a dependency. To accomplish this, the `shiny_deploy()` helper functions has been moved to the package [`pacakge.aid`](https://github.com/agdamsbo/package.aid). This is for a rainy day: https://r-wasm.github.io/rwasm/. The whole shiny part may be migrated to its own project to try to separate things and be easy on dependencies. Time will tell. +* Dependencies: In order to deploy `shiny_cast()` with `shinylive`, I need to remove `curl` as a dependency. To accomplish this, the `shiny_deploy()` helper functions has been moved to the package [`pacakge.aid`](https://github.com/agdamsbo/package.aid). This was before realising that `REDCapR` has `curl` as dependency, which is the culprit. `REDCapCAST` is not going to be a `shinylive` web-app without removing `REDCapR` dependency, which in the app is used for easy data upload and data dictionary deployment. # REDCapCAST 24.2.1 diff --git a/R/doc2dd.R b/R/doc2dd.R new file mode 100644 index 0000000..1eaf190 --- /dev/null +++ b/R/doc2dd.R @@ -0,0 +1,290 @@ +utils::globalVariables(c("calculations", "choices")) +#' Doc table to data dictionary - EARLY, DOCS MISSING +#' +#' @description +#' Works well with `project.aid::docx2list()`. +#' Allows defining a database in a text document (see provided template) for +#' an easier to use data base creation. This approach allows easier +#' collaboration when defining the database. The generic case is a data frame +#' with variable names as values in a column. This is a format like the REDCap +#' data dictionary, but gives a few options for formatting. +#' +#' @param data tibble or data.frame with all variable names in one column +#' @param instrument.name character vector length one. Instrument name. +#' @param col.variables variable names column (default = 1), allows dplyr +#' subsetting +#' @param list.datetime.format formatting for date/time detection. +#' See `case_match_regex_list()` +#' @param col.description descriptions column, allows dplyr +#' subsetting. If empty, variable names will be used. +#' @param col.condition conditions for branching column, allows dplyr +#' subsetting. See `char2cond()`. +#' @param col.subheader sub-header column, allows dplyr subsetting. +#' See `format_subheader()`. +#' @param subheader.tag formatting tag. Default is "h2" +#' @param condition.minor.sep condition split minor. See `char2cond()`. +#' Default is ",". +#' @param condition.major.sep condition split major. See `char2cond()`. +#' Default is ";". +#' @param col.calculation calculations column. Has to be written exact. +#' Character vector. +#' @param col.choices choices column. See `char2choice()`. +#' @param choices.char.sep choices split. See `char2choice()`. Default is "/". +#' @param missing.default value for missing fields. Default is NA. +#' +#' @return tibble or data.frame (same as data) +#' @export +#' +#' @examples +#' # data <- dd_inst +#' # data |> doc2dd(instrument.name = "evt", +#' # col.description = 3, +#' # col.condition = 4, +#' # col.subheader = 2, +#' # col.calculation = 5, +#' # col.choices = 6) +doc2dd <- function(data, + instrument.name, + col.variables = 1, + list.datetime.format = list( + date_dmy = "_dat[eo]$", + time_hh_mm_ss = "_ti[md]e?$" + ), + col.description = NULL, + col.condition = NULL, + col.subheader = NULL, + subheader.tag = "h2", + condition.minor.sep = ",", + condition.major.sep = ";", + col.calculation = NULL, + col.choices = NULL, + choices.char.sep = "/", + missing.default = NA) { + data <- data |> + dplyr::mutate(dplyr::across(dplyr::everything(), ~ dplyr::na_if(.x, c("")))) + + + ## Defining the field name + out <- data |> + dplyr::mutate( + field_name = dplyr::pick(col.variables) |> unlist() + ) + + ## Defining the field label. Field name is used if no label is provided. + if (is_missing(col.description)) { + out <- out |> + dplyr::mutate( + field_label = field_name + ) + } else { + out <- out |> + dplyr::mutate( + field_label = dplyr::pick(col.description) |> unlist() + ) + } + + ## Defining the sub-header + if (!is_missing(col.subheader)) { + out <- out |> + dplyr::mutate( + section_header = dplyr::pick(col.subheader) |> + unlist() |> + format_subheader(tag = subheader.tag) + ) + } + + ## Defining the choices + if (is_missing(col.choices)) { + out <- out |> + dplyr::mutate( + choices = missing.default + ) + } else { + out <- out |> + dplyr::mutate( + choices = dplyr::pick(col.choices) |> + unlist() |> + char2choice(char.split = choices.char.sep) + ) + } + + ## Defining the calculations + if (is_missing(col.calculation)) { + out <- out |> + dplyr::mutate( + calculations = missing.default + ) + } else { + out <- out |> + dplyr::mutate( + calculations = dplyr::pick(col.calculation) |> + unlist() |> + tolower() |> + (\(.x) gsub("’", "'", .x))() + ) + } + + ## Merging choices and calculations, defining field type and setting form name + out <- out |> + dplyr::mutate( + select_choices_or_calculations = dplyr::coalesce(calculations, choices), + field_type = dplyr::case_when(!is.na(choices) ~ "radio", + !is.na(calculations) ~ "calc", + .default = "text" + ), + form_name = instrument.name + ) + + ## Defining branching logic from conditions + if (is_missing(col.condition)) { + out <- out |> + dplyr::mutate( + branching_logic = missing.default + ) + } else { + out <- out |> + dplyr::mutate( + branching_logic = dplyr::pick(col.condition) |> + unlist() |> + char2cond(minor.split = condition.minor.sep, + major.split = condition.major.sep) + ) + } + + ## Detecting data/time formatting from systematic field names + if (is.null(list.datetime.format)) { + out <- out |> + dplyr::mutate( + text_validation_type_or_show_slider_number = missing.default + ) + } else { + out <- out |> + dplyr::mutate( + text_validation_type_or_show_slider_number = case_match_regex_list( + field_name, + list.datetime.format + ) + ) + } + + ## Selecting relevant columns + out <- out |> + dplyr::select(dplyr::any_of(names(REDCapCAST::redcapcast_meta))) + + ## Merging and ordering columns for upload + out |> + list(REDCapCAST::redcapcast_meta |> dplyr::slice(0)) |> + dplyr::bind_rows() |> + dplyr::select(names(REDCapCAST::redcapcast_meta)) +} + + + + +#' Simple function to generate REDCap choices from character vector +#' +#' @param data vector +#' @param char.split splitting character(s) +#' @param raw specific values. Can be used for options of same length. +#' @param .default default value for missing. Default is NA. +#' +#' @return vector +#' @export +#' +#' @examples +#' char2choice(c("yes/no"," yep. / nope ","",NA,"what"),.default=NA) +char2choice <- function(data, char.split = "/", raw = NULL,.default=NA) { + ls <- strsplit(x = data, split = char.split) + + ls |> + purrr::map(function(.x) { + if (is.null(raw)) { + raw <- seq_len(length(.x)) + } + if (length(.x) == 0 | all(is.na(.x))) { + .default + } else { + paste(paste0(raw, ", ",trimws(.x)), collapse = " | ") + } + }) |> + purrr::list_c() +} + +#' Simple function to generate REDCap branching logic from character vector +#' +#' @param data vector +#' @param .default default value for missing. Default is NA. +#' @param minor.split minor split +#' @param major.split major split +#' @param major.sep argument separation. Default is " or ". +#' +#' @return vector +#' @export +#' +#' @examples +#' #data <- dd_inst$betingelse +#' #c("Extubation_novent, 2; Pacu_delay, 1") |> char2cond() +char2cond <- function(data, minor.split = ",", major.split = ";", major.sep = " or ", .default = NA) { + strsplit(x = data, split = major.split) |> + purrr::map(function(.y) { + strsplit(x = .y, split = minor.split) |> + purrr::map(function(.x) { + if (length(.x) == 0 | all(is.na(.x))) { + .default + } else { + glue::glue("[{trimws(tolower(.x[1]))}]='{trimws(.x[2])}'") + } + }) |> + purrr::list_c() |> + glue::glue_collapse(sep = major.sep) + }) |> + purrr::list_c() +} + +#' List-base regex case_when +#' +#' @description +#' Mimics case_when for list of regex patterns and values. Used for date/time +#' validation generation from name vector. Like case_when, the matches are in +#' order of priority. +#' Primarily used in REDCapCAST to do data type coding from systematic variable +#' naming. +#' +#' @param data vector +#' @param match.list list of case matches +#' @param .default Default value for non-matches. Default is NA. +#' +#' @return vector +#' @export +#' +#' @examples +#' case_match_regex_list( +#' c("test_date", "test_time", "test_tida", "test_tid"), +#' list(date_dmy = "_dat[eo]$", time_hh_mm_ss = "_ti[md]e?$") +#' ) +case_match_regex_list <- function(data, match.list, .default = NA) { + match.list |> + purrr::imap(function(.z, .i) { + dplyr::if_else(grepl(.z, data), .i, NA) + }) |> + (\(.x){ + dplyr::coalesce(!!!.x) + })() |> + (\(.x){ + dplyr::if_else(is.na(.x), .default, .x) + })() +} + +#' Multi missing check +#' +#' @param data character vector +#' @param nas character vector of strings considered as NA +#' +#' @return logical vector +is_missing <- function(data,nas=c("", "NA")) { + if (is.null(data)) { + TRUE + } else { + is.na(data) | data %in% nas + } +} diff --git a/R/html_styling.R b/R/html_styling.R new file mode 100644 index 0000000..83dcb54 --- /dev/null +++ b/R/html_styling.R @@ -0,0 +1,68 @@ +#' Create two-column HTML table for data piping in REDCap instruments +#' +#' @param text descriptive text +#' @param variable variable to pipe +#' +#' @return character vector +#' @export +#' +#' @examples +#' create_html_table(text = "Patient ID", variable = c("[cpr]")) +#' create_html_table(text = paste("assessor", 1:2, sep = "_"), variable = c("[cpr]")) +#' # create_html_table(text = c("CPR nummer","Word"), variable = c("[cpr][1]", "[cpr][2]", "[test]")) +create_html_table <- function(text, variable) { + assertthat::assert_that(length(text)>1 & length(variable)==1 | + length(text)==1 & length(variable)>1 | + length(text)==length(variable), + msg = "text and variable has to have same length, or one has to have length 1") + + start <- '' + end <- "
" + + # Extension would allow defining number of columns and specify styling + items <- purrr::map2(text, variable, function(.x, .y) { + glue::glue('
{.x}
{.y}
') + }) + + glue::glue(start, glue::glue_collapse(purrr::list_c(items)), end) +} + +#' Simple html tag wrapping for REDCap text formatting +#' +#' @param data character vector +#' @param tag character vector length 1 +#' @param extra character vector +#' +#' @return character vector +#' @export +#' +#' @examples +#' html_tag_wrap("Titel", tag = "div", extra = 'class="rich-text-field-label"') +#' html_tag_wrap("Titel", tag = "h2") +html_tag_wrap <- function(data, tag = "h2", extra = NULL) { + et <- ifelse(is.null(extra), "", paste0(" ", extra)) + glue::glue("<{tag}{et}>{data}") +} + + +#' Sub-header formatting wrapper +#' +#' @param data character vector +#' @param tag character vector length 1 +#' +#' @return character vector +#' @export +#' +#' @examples +#' "Instrument header" |> format_subheader() +format_subheader <- function(data, tag = "h2") { + dplyr::if_else(is.na(data) | data == "", + NA, + data |> + html_tag_wrap(tag = tag) |> + html_tag_wrap( + tag = "div", + extra = 'class="rich-text-field-label"' + ) + ) +} diff --git a/R/process_user_input.r b/R/process_user_input.r index ec61a1d..ea705f2 100644 --- a/R/process_user_input.r +++ b/R/process_user_input.r @@ -1,7 +1,20 @@ +#' User input processing +#' +#' @param x input +#' +#' @return processed input +#' @export process_user_input <- function(x) { UseMethod("process_user_input", x) } +#' User input processing default +#' +#' @param x input +#' @param ... ignored +#' +#' @return processed input +#' @export process_user_input.default <- function(x, ...) { stop( deparse(substitute(x)), @@ -12,10 +25,25 @@ process_user_input.default <- function(x, ...) { ) } + +#' User input processing data.frame +#' +#' @param x input +#' @param ... ignored +#' +#' @return processed input +#' @export process_user_input.data.frame <- function(x, ...) { x } +#' User input processing character +#' +#' @param x input +#' @param ... ignored +#' +#' @return processed input +#' @export process_user_input.character <- function(x, ...) { if (!requireNamespace("jsonlite", quietly = TRUE)) { stop( @@ -32,6 +60,14 @@ process_user_input.character <- function(x, ...) { jsonlite::fromJSON(x) } + +#' User input processing response +#' +#' @param x input +#' @param ... ignored +#' +#' @return processed input +#' @export process_user_input.response <- function(x, ...) { process_user_input(rawToChar(x$content)) } diff --git a/R/shiny_cast.R b/R/shiny_cast.R index be827b1..b0c9f9d 100644 --- a/R/shiny_cast.R +++ b/R/shiny_cast.R @@ -34,3 +34,57 @@ shiny_cast <- function() { ) } + +#' Helper to import files correctly +#' +#' @param filenames file names +#' +#' @return character vector +#' @export +#' +#' @examples +#' file_extension(list.files(here::here(""))[[2]])[[1]] +#' file_extension(c("file.cd..ks","file")) +file_extension <- function(filenames) { + sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "", + filenames, + perl = TRUE) +} + +#' Flexible file import based on extension +#' +#' @param file file name +#' @param consider.na character vector of strings to consider as NAs +#' +#' @return tibble +#' @export +#' +#' @examples +#' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv") +read_input <- function(file, consider.na = c("NA", '""', "")) { + ext <- file_extension(file) + + tryCatch( + { + if (ext == "csv") { + df <- readr::read_csv(file = file, na = consider.na) + } else if (ext %in% c("xls", "xlsx")) { + df <- openxlsx2::read_xlsx(file = file, na.strings = consider.na) + } else if (ext == "dta") { + df <- haven::read_dta(file = file) + } else if (ext == "ods") { + df <- readODS::read_ods(file = file) + } else { + stop("Input file format has to be on of: + '.csv', '.xls', '.xlsx', '.dta' or '.ods'") + } + }, + error = function(e) { + # return a safeError if a parsing error occurs + stop(shiny::safeError(e)) + } + ) + + df +} + diff --git a/R/utils.r b/R/utils.r index 04e1b4e..d3757ea 100644 --- a/R/utils.r +++ b/R/utils.r @@ -497,55 +497,4 @@ is_repeated_longitudinal <- function(data, generics = c( -#' Helper to import files correctly -#' -#' @param filenames file names -#' -#' @return character vector -#' @export -#' -#' @examples -#' file_extension(list.files(here::here(""))[[2]])[[1]] -#' file_extension(c("file.cd..ks","file")) -file_extension <- function(filenames) { - sub(pattern = "^(.*\\.|[^.]+)(?=[^.]*)", replacement = "", - filenames, - perl = TRUE) -} -#' Flexible file import based on extension -#' -#' @param file file name -#' @param consider.na character vector of strings to consider as NAs -#' -#' @return tibble -#' @export -#' -#' @examples -#' read_input("https://raw.githubusercontent.com/agdamsbo/cognitive.index.lookup/main/data/sample.csv") -read_input <- function(file, consider.na = c("NA", '""', "")) { - ext <- file_extension(file) - - tryCatch( - { - if (ext == "csv") { - df <- readr::read_csv(file = file, na = consider.na) - } else if (ext %in% c("xls", "xlsx")) { - df <- openxlsx2::read_xlsx(file = file, na.strings = consider.na) - } else if (ext == "dta") { - df <- haven::read_dta(file = file) - } else if (ext == "ods") { - df <- readODS::read_ods(file = file) - } else { - stop("Input file format has to be on of: - '.csv', '.xls', '.xlsx', '.dta' or '.ods'") - } - }, - error = function(e) { - # return a safeError if a parsing error occurs - stop(shiny::safeError(e)) - } - ) - - df -} diff --git a/app/ui.R b/app/ui.R index aa4f342..beb1820 100644 --- a/app/ui.R +++ b/app/ui.R @@ -1,5 +1,6 @@ ui <- shiny::shinyUI( shiny::fluidPage( + theme = shinythemes::shinytheme("united"), ## ----------------------------------------------------------------------------- ## Application title diff --git a/inst/WORDLIST b/inst/WORDLIST index a8fcd3b..0bb698a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -21,12 +21,14 @@ al api attr charater +cond da dafault datetime demonstrational dir dmy +docx doi dplyr ds @@ -61,10 +63,10 @@ shinylive stRoke stata strsplit +subheader thorugh tibble tidyverse -transistion ui uri wil diff --git a/man/case_match_regex_list.Rd b/man/case_match_regex_list.Rd new file mode 100644 index 0000000..3e2bcc6 --- /dev/null +++ b/man/case_match_regex_list.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doc2dd.R +\name{case_match_regex_list} +\alias{case_match_regex_list} +\title{List-base regex case_when} +\usage{ +case_match_regex_list(data, match.list, .default = NA) +} +\arguments{ +\item{data}{vector} + +\item{match.list}{list of case matches} + +\item{.default}{Default value for non-matches. Default is NA.} +} +\value{ +vector +} +\description{ +Mimics case_when for list of regex patterns and values. Used for date/time +validation generation from name vector. Like case_when, the matches are in +order of priority. +Primarily used in REDCapCAST to do data type coding from systematic variable +naming. +} +\examples{ +case_match_regex_list( + c("test_date", "test_time", "test_tida", "test_tid"), + list(date_dmy = "_dat[eo]$", time_hh_mm_ss = "_ti[md]e?$") +) +} diff --git a/man/char2choice.Rd b/man/char2choice.Rd new file mode 100644 index 0000000..0c51393 --- /dev/null +++ b/man/char2choice.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doc2dd.R +\name{char2choice} +\alias{char2choice} +\title{Simple function to generate REDCap choices from character vector} +\usage{ +char2choice(data, char.split = "/", raw = NULL, .default = NA) +} +\arguments{ +\item{data}{vector} + +\item{char.split}{splitting character(s)} + +\item{raw}{specific values. Can be used for options of same length.} + +\item{.default}{default value for missing. Default is NA.} +} +\value{ +vector +} +\description{ +Simple function to generate REDCap choices from character vector +} +\examples{ +char2choice(c("yes/no"," yep. / nope ","",NA,"what"),.default=NA) +} diff --git a/man/char2cond.Rd b/man/char2cond.Rd new file mode 100644 index 0000000..74c9c95 --- /dev/null +++ b/man/char2cond.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doc2dd.R +\name{char2cond} +\alias{char2cond} +\title{Simple function to generate REDCap branching logic from character vector} +\usage{ +char2cond( + data, + minor.split = ",", + major.split = ";", + major.sep = " or ", + .default = NA +) +} +\arguments{ +\item{data}{vector} + +\item{minor.split}{minor split} + +\item{major.split}{major split} + +\item{major.sep}{argument separation. Default is " or ".} + +\item{.default}{default value for missing. Default is NA.} +} +\value{ +vector +} +\description{ +Simple function to generate REDCap branching logic from character vector +} +\examples{ +#data <- dd_inst$betingelse +#c("Extubation_novent, 2; Pacu_delay, 1") |> char2cond() +} diff --git a/man/create_html_table.Rd b/man/create_html_table.Rd new file mode 100644 index 0000000..6ca097e --- /dev/null +++ b/man/create_html_table.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/html_styling.R +\name{create_html_table} +\alias{create_html_table} +\title{Create two-column HTML table for data piping in REDCap instruments} +\usage{ +create_html_table(text, variable) +} +\arguments{ +\item{text}{descriptive text} + +\item{variable}{variable to pipe} +} +\value{ +character vector +} +\description{ +Create two-column HTML table for data piping in REDCap instruments +} +\examples{ +create_html_table(text = "Patient ID", variable = c("[cpr]")) +create_html_table(text = paste("assessor", 1:2, sep = "_"), variable = c("[cpr]")) +# create_html_table(text = c("CPR nummer","Word"), variable = c("[cpr][1]", "[cpr][2]", "[test]")) +} diff --git a/man/doc2dd.Rd b/man/doc2dd.Rd new file mode 100644 index 0000000..4954310 --- /dev/null +++ b/man/doc2dd.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doc2dd.R +\name{doc2dd} +\alias{doc2dd} +\title{Doc table to data dictionary - EARLY, DOCS MISSING} +\usage{ +doc2dd( + data, + instrument.name, + col.variables = 1, + list.datetime.format = list(date_dmy = "_dat[eo]$", time_hh_mm_ss = "_ti[md]e?$"), + col.description = NULL, + col.condition = NULL, + col.subheader = NULL, + subheader.tag = "h2", + condition.minor.sep = ",", + condition.major.sep = ";", + col.calculation = NULL, + col.choices = NULL, + choices.char.sep = "/", + missing.default = NA +) +} +\arguments{ +\item{data}{tibble or data.frame with all variable names in one column} + +\item{instrument.name}{character vector length one. Instrument name.} + +\item{col.variables}{variable names column (default = 1), allows dplyr +subsetting} + +\item{list.datetime.format}{formatting for date/time detection. +See `case_match_regex_list()`} + +\item{col.description}{descriptions column, allows dplyr +subsetting. If empty, variable names will be used.} + +\item{col.condition}{conditions for branching column, allows dplyr +subsetting. See `char2cond()`.} + +\item{col.subheader}{sub-header column, allows dplyr subsetting. +See `format_subheader()`.} + +\item{subheader.tag}{formatting tag. Default is "h2"} + +\item{condition.minor.sep}{condition split minor. See `char2cond()`. +Default is ",".} + +\item{condition.major.sep}{condition split major. See `char2cond()`. +Default is ";".} + +\item{col.calculation}{calculations column. Has to be written exact. +Character vector.} + +\item{col.choices}{choices column. See `char2choice()`.} + +\item{choices.char.sep}{choices split. See `char2choice()`. Default is "/".} + +\item{missing.default}{value for missing fields. Default is NA.} +} +\value{ +tibble or data.frame (same as data) +} +\description{ +Works well with `project.aid::docx2list()`. +Allows defining a database in a text document (see provided template) for +an easier to use data base creation. This approach allows easier +collaboration when defining the database. The generic case is a data frame +with variable names as values in a column. This is a format like the REDCap +data dictionary, but gives a few options for formatting. +} +\examples{ +# data <- dd_inst +# data |> doc2dd(instrument.name = "evt", +# col.description = 3, +# col.condition = 4, +# col.subheader = 2, +# col.calculation = 5, +# col.choices = 6) +} diff --git a/man/file_extension.Rd b/man/file_extension.Rd index 397510f..c060902 100644 --- a/man/file_extension.Rd +++ b/man/file_extension.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.r +% Please edit documentation in R/shiny_cast.R \name{file_extension} \alias{file_extension} \title{Helper to import files correctly} diff --git a/man/format_subheader.Rd b/man/format_subheader.Rd new file mode 100644 index 0000000..b1fe6ea --- /dev/null +++ b/man/format_subheader.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/html_styling.R +\name{format_subheader} +\alias{format_subheader} +\title{Sub-header formatting wrapper} +\usage{ +format_subheader(data, tag = "h2") +} +\arguments{ +\item{data}{character vector} + +\item{tag}{character vector length 1} +} +\value{ +character vector +} +\description{ +Sub-header formatting wrapper +} +\examples{ +"Instrument header" |> format_subheader() +} diff --git a/man/html_tag_wrap.Rd b/man/html_tag_wrap.Rd new file mode 100644 index 0000000..c98549a --- /dev/null +++ b/man/html_tag_wrap.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/html_styling.R +\name{html_tag_wrap} +\alias{html_tag_wrap} +\title{Simple html tag wrapping for REDCap text formatting} +\usage{ +html_tag_wrap(data, tag = "h2", extra = NULL) +} +\arguments{ +\item{data}{character vector} + +\item{tag}{character vector length 1} + +\item{extra}{character vector} +} +\value{ +character vector +} +\description{ +Simple html tag wrapping for REDCap text formatting +} +\examples{ +html_tag_wrap("Titel", tag = "div", extra = 'class="rich-text-field-label"') +html_tag_wrap("Titel", tag = "h2") +} diff --git a/man/is_missing.Rd b/man/is_missing.Rd new file mode 100644 index 0000000..4dcadae --- /dev/null +++ b/man/is_missing.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/doc2dd.R +\name{is_missing} +\alias{is_missing} +\title{Multi missing check} +\usage{ +is_missing(data, nas = c("", "NA")) +} +\arguments{ +\item{data}{character vector} + +\item{nas}{character vector of strings considered as NA} +} +\value{ +logical vector +} +\description{ +Multi missing check +} diff --git a/man/process_user_input.Rd b/man/process_user_input.Rd new file mode 100644 index 0000000..684e7c0 --- /dev/null +++ b/man/process_user_input.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_user_input.r +\name{process_user_input} +\alias{process_user_input} +\title{User input processing} +\usage{ +process_user_input(x) +} +\arguments{ +\item{x}{input} +} +\value{ +processed input +} +\description{ +User input processing +} diff --git a/man/process_user_input.character.Rd b/man/process_user_input.character.Rd new file mode 100644 index 0000000..4146734 --- /dev/null +++ b/man/process_user_input.character.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_user_input.r +\name{process_user_input.character} +\alias{process_user_input.character} +\title{User input processing character} +\usage{ +\method{process_user_input}{character}(x, ...) +} +\arguments{ +\item{x}{input} + +\item{...}{ignored} +} +\value{ +processed input +} +\description{ +User input processing character +} diff --git a/man/process_user_input.data.frame.Rd b/man/process_user_input.data.frame.Rd new file mode 100644 index 0000000..2ad15c1 --- /dev/null +++ b/man/process_user_input.data.frame.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_user_input.r +\name{process_user_input.data.frame} +\alias{process_user_input.data.frame} +\title{User input processing data.frame} +\usage{ +\method{process_user_input}{data.frame}(x, ...) +} +\arguments{ +\item{x}{input} + +\item{...}{ignored} +} +\value{ +processed input +} +\description{ +User input processing data.frame +} diff --git a/man/process_user_input.default.Rd b/man/process_user_input.default.Rd new file mode 100644 index 0000000..ad9c83b --- /dev/null +++ b/man/process_user_input.default.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_user_input.r +\name{process_user_input.default} +\alias{process_user_input.default} +\title{User input processing default} +\usage{ +\method{process_user_input}{default}(x, ...) +} +\arguments{ +\item{x}{input} + +\item{...}{ignored} +} +\value{ +processed input +} +\description{ +User input processing default +} diff --git a/man/process_user_input.response.Rd b/man/process_user_input.response.Rd new file mode 100644 index 0000000..b69b5f3 --- /dev/null +++ b/man/process_user_input.response.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_user_input.r +\name{process_user_input.response} +\alias{process_user_input.response} +\title{User input processing response} +\usage{ +\method{process_user_input}{response}(x, ...) +} +\arguments{ +\item{x}{input} + +\item{...}{ignored} +} +\value{ +processed input +} +\description{ +User input processing response +} diff --git a/man/read_input.Rd b/man/read_input.Rd index f762f75..f9dd32f 100644 --- a/man/read_input.Rd +++ b/man/read_input.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.r +% Please edit documentation in R/shiny_cast.R \name{read_input} \alias{read_input} \title{Flexible file import based on extension} diff --git a/renv.lock b/renv.lock index d6713e8..a0e4b90 100644 --- a/renv.lock +++ b/renv.lock @@ -1,6 +1,6 @@ { "R": { - "Version": "4.3.1", + "Version": "4.3.3", "Repositories": [ { "Name": "CRAN", @@ -324,14 +324,14 @@ }, "fs": { "Package": "fs", - "Version": "1.6.3", + "Version": "1.6.4", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R", "methods" ], - "Hash": "47b5f30c720c23999b913a1a635cf0bb" + "Hash": "15aeb8c27f5ea5161f9f6a641fafd93a" }, "generics": { "Package": "generics", @@ -533,17 +533,17 @@ }, "openssl": { "Package": "openssl", - "Version": "2.1.1", + "Version": "2.1.2", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "askpass" ], - "Hash": "2a0dc8c6adfb6f032e4d4af82d258ab5" + "Hash": "ea2475b073243d9d338aa8f086ce973e" }, "openxlsx2": { "Package": "openxlsx2", - "Version": "1.5", + "Version": "1.6", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -556,7 +556,7 @@ "utils", "zip" ], - "Hash": "60138955e79b56bf75a99f2b04918d48" + "Hash": "6122f5f24dfa643c1ef69bcbb130da85" }, "pillar": { "Package": "pillar", @@ -700,13 +700,13 @@ }, "renv": { "Package": "renv", - "Version": "1.0.5", + "Version": "1.0.7", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "utils" ], - "Hash": "32c3f93e8360f667ca5863272ec8ba6a" + "Hash": "397b7b2a265bc5a7a06852524dabae20" }, "rlang": { "Package": "rlang", diff --git a/renv/activate.R b/renv/activate.R index 9b2e7f1..d13f993 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,11 +2,13 @@ local({ # the requested version of renv - version <- "1.0.5" + version <- "1.0.7" attr(version, "sha") <- NULL # the project directory - project <- getwd() + project <- Sys.getenv("RENV_PROJECT") + if (!nzchar(project)) + project <- getwd() # use start-up diagnostics if enabled diagnostics <- Sys.getenv("RENV_STARTUP_DIAGNOSTICS", unset = "FALSE") @@ -129,6 +131,21 @@ local({ } + heredoc <- function(text, leave = 0) { + + # remove leading, trailing whitespace + trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text) + + # split into lines + lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]] + + # compute common indent + indent <- regexpr("[^[:space:]]", lines) + common <- min(setdiff(indent, -1L)) - leave + paste(substring(lines, common), collapse = "\n") + + } + startswith <- function(string, prefix) { substring(string, 1, nchar(prefix)) == prefix } @@ -631,6 +648,9 @@ local({ # if the user has requested an automatic prefix, generate it auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA) + if (is.na(auto) && getRversion() >= "4.4.0") + auto <- "TRUE" + if (auto %in% c("TRUE", "True", "true", "1")) return(renv_bootstrap_platform_prefix_auto()) @@ -822,24 +842,23 @@ local({ # the loaded version of renv doesn't match the requested version; # give the user instructions on how to proceed - remote <- if (!is.null(description[["RemoteSha"]])) { + dev <- identical(description[["RemoteType"]], "github") + remote <- if (dev) paste("rstudio/renv", description[["RemoteSha"]], sep = "@") - } else { + else paste("renv", description[["Version"]], sep = "@") - } # display both loaded version + sha if available friendly <- renv_bootstrap_version_friendly( version = description[["Version"]], - sha = description[["RemoteSha"]] + sha = if (dev) description[["RemoteSha"]] ) - fmt <- paste( - "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.", - "- Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.", - "- Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.", - sep = "\n" - ) + fmt <- heredoc(" + renv %1$s was loaded from project library, but this project is configured to use renv %2$s. + - Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile. + - Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library. + ") catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote) FALSE diff --git a/vignettes/Shiny-app.Rmd b/vignettes/Shiny-app.Rmd index f379153..1c194ab 100644 --- a/vignettes/Shiny-app.Rmd +++ b/vignettes/Shiny-app.Rmd @@ -18,7 +18,7 @@ knitr::opts_chunk$set( library(REDCapCAST) ``` -To make the easiest possible transistion from spreadsheet/dataset to REDCap, I have created a small Shiny app, which adds a graphical interface to the casting of a data dictionary and data upload. Install the package and run the app as follows: +To make the easiest possible transition from spreadsheet/dataset to REDCap, I have created a small Shiny app, which adds a graphical interface to the casting of a data dictionary and data upload. Install the package and run the app as follows: ```{r eval=FALSE} require(REDCapCAST)