major overhaul with new functions. docs are lacking

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'

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)

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

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

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 <- '<table style="border-collapse: collapse; width: 100%;" border="0"> <tbody>'
+  end <- "</tbody> </table>"
+
+  # Extension would allow defining number of columns and specify styling
+  items <- purrr::map2(text, variable, function(.x, .y) {
+    glue::glue('<tr> <td style="width: 58%;"> <h5><span style="font-weight: normal;">{.x}<br /></span></h5> </td> <td style="width: 42%; text-align: left;"> <h5><span style="font-weight: bold;">{.y}</span></h5> </td> </tr>')
+  })
+
+  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}</{tag}>")
+}
+
+
+#' 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"'
+                   )
+  )
+}

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

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

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
-}

app/ui.R

@@ -1,5 +1,6 @@
 ui <- shiny::shinyUI(
   shiny::fluidPage(
+    theme = shinythemes::shinytheme("united"),
 
     ## -----------------------------------------------------------------------------
     ## Application title

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

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

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

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

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

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

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}

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

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

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

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

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

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

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

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

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}

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",

renv/activate.R

@@ -2,10 +2,12 @@
 local({
 
   # the requested version of renv
-  version <- "1.0.5"
+  version <- "1.0.7"
   attr(version, "sha") <- NULL
 
   # the project directory
+  project <- Sys.getenv("RENV_PROJECT")
+  if (!nzchar(project))
     project <- getwd()
 
   # use start-up diagnostics if enabled
@@ -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(
+    fmt <- heredoc("
-      "renv %1$s was loaded from project library, but this project is configured to use renv %2$s.",
+      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::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.",
+      - Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.
-      sep = "\n"
+    ")
-    )
     catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote)
   
     FALSE

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)