spelling

DESCRIPTION

@@ -61,7 +61,8 @@ Imports:
     gt,
     bslib,
     here,
-    glue
+    glue,
+    gtsummary
 Collate: 
     'REDCapCAST-package.R'
     'utils.r'

NAMESPACE

@@ -7,7 +7,6 @@ S3method(as_factor,haven_labelled)
 S3method(as_factor,labelled)
 S3method(as_factor,logical)
 S3method(as_factor,numeric)
-S3method(as_factor,redcapcast_labelled)
 S3method(process_user_input,character)
 S3method(process_user_input,data.frame)
 S3method(process_user_input,default)
@@ -38,6 +37,7 @@ export(fct_drop)
 export(fct_drop.data.frame)
 export(file_extension)
 export(focused_metadata)
+export(format_redcap_factor)
 export(format_subheader)
 export(get_api_key)
 export(get_attr)
@@ -52,6 +52,7 @@ export(named_levels)
 export(nav_bar_page)
 export(numchar2fct)
 export(parse_data)
+export(possibly_numeric)
 export(possibly_roman)
 export(process_user_input)
 export(read_input)

R/REDCap_split.r

@@ -11,11 +11,10 @@
 #'   \code{data.frame}, \code{response}, or \code{character} vector containing
 #'   JSON from an API call.
 #' @param primary_table_name Name given to the list element for the primary
-#'   output table (as described in \emph{README.md}). Ignored if
+#'   output table. Ignored if \code{forms = 'all'}.
-#'   \code{forms = 'all'}.
 #' @param forms Indicate whether to create separate tables for repeating
 #'   instruments only or for all forms.
-#' @author Paul W. Egeler, M.S., GStat
+#' @author Paul W. Egeler
 #' @examples
 #' \dontrun{
 #' # Using an API call -------------------------------------------------------
@@ -40,7 +39,7 @@
 #' )
 #'
 #' # Convert exported JSON strings into a list of data.frames
-#' REDCapRITS::REDCap_split(records, metadata)
+#' REDCapCAST::REDCap_split(records, metadata)
 #'
 #' # Using a raw data export -------------------------------------------------
 #'
@@ -53,7 +52,7 @@
 #' )
 #'
 #' # Split the tables
-#' REDCapRITS::REDCap_split(records, metadata)
+#' REDCapCAST::REDCap_split(records, metadata)
 #'
 #' # In conjunction with the R export script ---------------------------------
 #'
@@ -70,7 +69,7 @@
 #' metadata <- read.csv("ExampleProject_DataDictionary_2018-06-03.csv")
 #'
 #' # Split the tables
-#' REDCapRITS::REDCap_split(data, metadata)
+#' REDCapCAST::REDCap_split(data, metadata)
 #' setwd(old)
 #' }
 #' @return A list of \code{"data.frame"}s. The number of tables will differ

R/as_factor.R

@@ -1,6 +1,6 @@
 #' Convert labelled vectors to factors while preserving attributes
 #'
-#' This extends [forcats::as_factor()] as well as [haven::as_factor()], by appending
+#' This extends \link[forcats]{as_factor} as well as \link[haven]{as_factor}, by appending
 #' original attributes except for "class" after converting to factor to avoid
 #' ta loss in case of rich formatted and labelled data.
 #'
@@ -128,10 +128,6 @@ as_factor.haven_labelled <- function(x, levels = c("default", "labels", "values"
 #' @rdname as_factor
 as_factor.labelled <- as_factor.haven_labelled
 
-#' @export
-#' @rdname as_factor
-as_factor.redcapcast_labelled <- as_factor.haven_labelled
-
 #' @rdname as_factor
 #' @export
 as_factor.data.frame <- function(x, ..., only_labelled = TRUE) {
@@ -158,7 +154,7 @@ as_factor.data.frame <- function(x, ..., only_labelled = TRUE) {
 #'   labels = c(Unknown = 9, Refused = 10),
 #'   class = "haven_labelled"
 #' ) |> is.labelled()
-is.labelled <- function(x, classes = c("redcapcast_labelled", "haven_labelled", "labelled")) {
+is.labelled <- function(x, classes = c("haven_labelled", "labelled")) {
   classes |>
     sapply(\(.class){
       inherits(x, .class)
@@ -166,7 +162,6 @@ is.labelled <- function(x, classes = c("redcapcast_labelled", "haven_labelled",
     any()
 }
 
-
 replace_with <- function(x, from, to) {
   stopifnot(length(from) == length(to))
 
@@ -200,20 +195,25 @@ replace_with <- function(x, from, to) {
 #' @param na.label character string to refactor NA values. Default is NULL.
 #' @param na.value new value for NA strings. Ignored if na.label is NULL.
 #' Default is 99.
+#' @param sort.numeric sort factor levels if levels are numeric. Default is TRUE
 #'
 #' @return named vector
 #' @export
 #'
 #' @examples
-#' \dontrun{
 #' structure(c(1, 2, 3, 2, 10, 9),
 #'   labels = c(Unknown = 9, Refused = 10),
 #'   class = "haven_labelled"
 #' ) |>
 #'   as_factor() |>
 #'   named_levels()
-#' }
+#' structure(c(1, 2, 3, 2, 10, 9),
-named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99) {
+#'   labels = c(Unknown = 9, Refused = 10),
+#'   class = "labelled"
+#' ) |>
+#'   as_factor() |>
+#'   named_levels()
+named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99, sort.numeric=TRUE) {
   stopifnot(is.factor(data))
   if (!is.null(na.label)) {
     attrs <- attributes(data)
@@ -245,7 +245,6 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99)
     )
   }
 
-
   # Handle empty factors
   if (all_na(data)) {
     d <- data.frame(
@@ -280,7 +279,7 @@ named_levels <- function(data, label = "labels", na.label = NULL, na.value = 99)
   out <- stats::setNames(d$value, d$name)
   ## Sort if levels are numeric
   ## Else, they appear in order of appearance
-  if (possibly_numeric(levels(data))) {
+  if (possibly_numeric(levels(data)) && sort.numeric) {
     out <- out |> sort()
   }
   out
@@ -334,19 +333,14 @@ possibly_roman <- function(data) {
 #'   as_factor() |>
 #'   fct2num()
 #'
-#' # Outlier with labels, but no class of origin, handled like numeric vector
+#' structure(c(1, 2, 3, 2, 10, 9),
-#' # structure(c(1, 2, 3, 2, 10, 9),
+#'   labels = c(Unknown = 9, Refused = 10)
-#' #   labels = c(Unknown = 9, Refused = 10)
+#' ) |>
-#' # ) |>
+#'   as_factor() |>
-#' #   as_factor() |>
+#'   fct2num()
-#' #   fct2num()
-#'
-#' 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))) {
     values <- as.numeric(named_levels(data))
   } else {
@@ -357,15 +351,28 @@ fct2num <- function(data) {
 
   ## If no NA on numeric coercion, of original names, then return
   ## original numeric names, else values
-  if (possibly_numeric(out)) {
+  if (possibly_numeric(names(out))) {
     out <- as.numeric(names(out))
   }
   unname(out)
 }
 
+#' Tests if vector can be interpreted as numeric without introducing NAs by
+#' coercion
+#'
+#' @param data vector
+#'
+#' @return logical
+#' @export
+#'
+#' @examples
+#' c("1","5") |> possibly_numeric()
+#' c("1","5","e") |> possibly_numeric()
 possibly_numeric <- function(data) {
-  length(stats::na.omit(suppressWarnings(as.numeric(names(data))))) ==
+  suppressWarnings(
+  length(stats::na.omit(as.numeric(data))) ==
     length(data)
+  )
 }
 
 #' Extract attribute. Returns NA if none

R/easy_redcap.R

@@ -1,15 +1,22 @@
 #' Retrieve project API key if stored, if not, set and retrieve
 #'
+#' @description
+#' Attempting to make secure API key storage so simple, that no other way makes
+#' sense. Wrapping \link[keyring]{key_get} and \link[keyring]{key_set} using the
+#' \link[keyring]{key_list} to check if key is in storage already.
+#'
+#'
 #' @param key.name character vector of key name
+#' @param ... passed to \link[keyring]{key_set}
 #'
 #' @return character vector
 #' @importFrom keyring key_list key_get key_set
 #' @export
-get_api_key <- function(key.name) {
+get_api_key <- function(key.name, ...) {
   if (key.name %in% keyring::key_list()$service) {
     keyring::key_get(service = key.name)
   } else {
-    keyring::key_set(service = key.name, prompt = "Provide REDCap API key:")
+    keyring::key_set(service = key.name, ...)
     keyring::key_get(service = key.name)
   }
 }
@@ -18,15 +25,21 @@ get_api_key <- function(key.name) {
 #' Secure API key storage and data acquisition in one
 #'
 #' @param project.name The name of the current project (for key storage with
-#' `keyring::key_set()`, using the default keyring)
+#' \link[keyring]{key_set}, using the default keyring)
 #' @param widen.data argument to widen the exported data
 #' @param uri REDCap database API uri
-#' @param ... arguments passed on to `REDCapCAST::read_redcap_tables()`
+#' @param ... arguments passed on to \link[REDCapCAST]{read_redcap_tables}.
 #'
 #' @return data.frame or list depending on widen.data
 #' @export
+#'
+#' @examples
+#' \dontrun{
+#' easy_redcap("My_new_project",fields=c("record_id","age","hypertension"))
+#' }
 easy_redcap <- function(project.name, widen.data = TRUE, uri, ...) {
-  key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API"))
+  key <- get_api_key(key.name = paste0(project.name, "_REDCAP_API"),
+                     prompt = "Provide REDCap API key:")
 
   out <- read_redcap_tables(
     uri = uri,

R/read_redcap_tables.R

@@ -1,27 +1,33 @@
 #' Download REDCap data
 #'
-#' Implementation of REDCap_split with a focused data acquisition approach using
+#' @description
-#' REDCapR::redcap_read and only downloading specified fields, forms and/or
+#' Implementation of passed on to \link[REDCapCAST]{REDCap_split} with a focused
-#' events using the built-in focused_metadata including some clean-up.
+#' data acquisition approach using passed on to \link[REDCapR]{redcap_read} and
+#' only downloading specified fields, forms and/or events using the built-in
+#' focused_metadata including some clean-up.
 #' Works with classical and longitudinal projects with or without repeating
 #' instruments.
+#' Will preserve metadata in the data.frames as labels.
+#'
 #' @param uri REDCap database API uri
 #' @param token API token
 #' @param records records to download
 #' @param fields fields to download
 #' @param events events to download
 #' @param forms forms to download
-#' @param raw_or_label raw or label tags. Can be
+#' @param raw_or_label raw or label tags. Can be "raw", "label" or "both".
 #'
-#'   * "raw": Standard [REDCapR] method to get raw values.
+#'   * "raw": Standard \link[REDCapR]{redcap_read} method to get raw values.
-#'   * "label": Standard [REDCapR] method to get label values.
+#'   * "label": Standard \link[REDCapR]{redcap_read} method to get label values.
 #'   * "both": Get raw values with REDCap labels applied as labels. Use
-#'   [as_factor()] to format factors with original labels and use the
+#'   \link[REDCapCAST]{as_factor} to format factors with original labels and use
-#'   [gtsummary] package to easily get beautiful tables with original labels
+#'   the  `gtsummary` package functions like \link[gtsummary]{tbl_summary} to
-#'   from REDCap. Use [fct_drop()] to drop empty levels.
+#'   easily get beautiful tables with original labels from REDCap. Use
+#'   \link[REDCapCAST]{fct_drop} to drop empty levels.
 #'
 #' @param split_forms Whether to split "repeating" or "all" forms, default is
 #' all.
+#' @param ... passed on to \link[REDCapR]{redcap_read}
 #'
 #' @return list of instruments
 #' @importFrom REDCapR redcap_metadata_read redcap_read redcap_event_instruments
@@ -36,8 +42,12 @@ read_redcap_tables <- function(uri,
                                fields = NULL,
                                events = NULL,
                                forms = NULL,
-                               raw_or_label = "label",
+                               raw_or_label = c("raw","label","both"),
-                               split_forms = "all") {
+                               split_forms = "all",
+                               ...) {
+
+  raw_or_label <- match.arg(raw_or_label, c("raw","label","both"))
+
   # Getting metadata
   m <-
     REDCapR::redcap_metadata_read(redcap_uri = uri, token = token)[["data"]]
@@ -92,7 +102,8 @@ read_redcap_tables <- function(uri,
     events = events,
     forms = forms,
     records = records,
-    raw_or_label = rorl
+    raw_or_label = rorl,
+    ...
   )[["data"]]
 
   if (raw_or_label=="both"){
@@ -147,6 +158,20 @@ clean_field_label <- function(data) {
 }
 
 
+#' Converts REDCap choices to factor levels and stores in labels attribute
+#'
+#' @description
+#' Applying \link[REDCapCAST]{as_factor} to the data.frame or variable, will
+#' coerce to a factor.
+#'
+#' @param data vector
+#' @param meta vector of REDCap choices
+#'
+#' @return vector of class "labelled" with a "labels" attribute
+#' @export
+#'
+#' @examples
+#' format_redcap_factor(sample(1:3,20,TRUE),"1, First. | 2, second | 3, THIRD")
 format_redcap_factor <- function(data, meta) {
   lvls <- strsplit(meta, " | ", fixed = TRUE) |>
     unlist() |>
@@ -158,7 +183,7 @@ format_redcap_factor <- function(data, meta) {
       Reduce(c, .x)
     })()
   set_attr(data, label = lvls, attr = "labels") |>
-    set_attr(data, label = "redcapcast_labelled", attr = "class")
+    set_attr(data, label = "labelled", attr = "class")
 }
 
 

R/redcap_wider.R

@@ -4,14 +4,20 @@ utils::globalVariables(c(
   "inst.glue"
 ))
 
-#' @title Redcap Wider
+#' Transforms list of REDCap data.frames to a single wide data.frame
-#' @description Converts a list of REDCap data frames from long to wide format.
+#'
-#' Handles longitudinal projects, but not yet repeated instruments.
+#' @description Converts a list of REDCap data.frames from long to wide format.
-#' @param data A list of data frames.
+#' In essence it is a wrapper for the \link[tidyr]{pivot_wider} function applied
-#' @param event.glue A dplyr::glue string for repeated events naming
+#' on a REDCap output (from \link[REDCapCAST]{read_redcap_tables}) or manually
-#' @param inst.glue A dplyr::glue string for repeated instruments naming
+#' split by \link[REDCapCAST]{REDCap_split}.
-#' @return The list of data frames in wide format.
+#'
+#' @param data A list of data frames
+#' @param event.glue A \link[glue]{glue} string for repeated events naming
+#' @param inst.glue A \link[glue]{glue} string for repeated instruments naming
+#'
+#' @return data.frame in wide format
 #' @export
+#'
 #' @importFrom tidyr pivot_wider
 #' @importFrom tidyselect all_of
 #' @importFrom purrr reduce
@@ -77,6 +83,7 @@ redcap_wider <-
   function(data,
            event.glue = "{.value}_{redcap_event_name}",
            inst.glue = "{.value}_{redcap_repeat_instance}") {
+    # browser()
     if (!is_repeated_longitudinal(data)) {
       if (is.list(data)) {
         if (length(data) == 1) {
@@ -91,6 +98,7 @@ redcap_wider <-
       id.name <- do.call(c, lapply(data, names))[[1]]
 
       l <- lapply(data, function(i) {
+        # browser()
         rep_inst <- "redcap_repeat_instrument" %in% names(i)
 
         if (rep_inst) {
@@ -111,7 +119,15 @@ redcap_wider <-
             )
             s[!colnames(s) %in% c("redcap_repeat_instrument")]
           })
-          i <- Reduce(dplyr::bind_rows, k)
+
+          # Labels are removed and restored after bind_rows as class "labelled"
+          # is not supported
+          i <- remove_labelled(k) |>
+            dplyr::bind_rows()
+
+          all_labels <- save_labels(data)
+
+          i <- restore_labels(i, all_labels)
         }
 
         event <- "redcap_event_name" %in% names(i)
@@ -141,8 +157,51 @@ redcap_wider <-
         }
       })
 
-      out <- data.frame(Reduce(f = dplyr::full_join, x = l))
+      # out <- Reduce(f = dplyr::full_join, x = l)
+      out <- purrr::reduce(.x = l, .f = dplyr::full_join)
     }
 
     out
   }
+
+# Applies list of attributes to data.frame
+restore_labels <- function(data, labels) {
+  stopifnot(is.list(labels))
+  stopifnot(is.data.frame(data))
+  for (ndx in names(labels)) {
+    data <- purrr::imap(data, \(.y, .j){
+      if (startsWith(.j, ndx)) {
+        set_attr(.y, labels[[ndx]])
+      } else {
+        .y
+      }
+    }) |> dplyr::bind_cols()
+  }
+  return(data)
+}
+
+# Extract unique variable attributes from list of data.frames
+save_labels <- function(data) {
+  stopifnot(is.list(data))
+  out <- list()
+  for (j in seq_along(data)) {
+    out <- c(out, lapply(data[[j]], get_attr))
+  }
+
+  out[!duplicated(names(out))]
+}
+
+# Removes class attributes of class "labelled" or "haven_labelled"
+remove_labelled <- function(data){
+  stopifnot(is.list(data))
+  lapply(data, \(.x) {
+    lapply(.x, \(.y) {
+      if (REDCapCAST::is.labelled(.y)) {
+        set_attr(.y, label = NULL, attr = "class")
+      } else {
+        .y
+      }
+    }) |>
+      dplyr::bind_cols()
+  })
+}

R/utils.r

@@ -114,8 +114,12 @@ clean_redcap_name <- function(x) {
 #' Sanitize list of data frames
 #'
 #' Removing empty rows
+#'
 #' @param l A list of data frames.
 #' @param generic.names A vector of generic names to be excluded.
+#' @param drop.complete logical to remove generic REDCap variables indicating
+#' instrument completion. Default is TRUE.
+#' @param drop.empty logical to remove variables with only NAs Default is TRUE.
 #'
 #' @return A list of data frames with generic names excluded.
 #'
@@ -127,21 +131,34 @@ sanitize_split <- function(l,
                              "redcap_event_name",
                              "redcap_repeat_instrument",
                              "redcap_repeat_instance"
-                           )) {
+                           ),
+                           drop.complete=TRUE,
+                           drop.empty=TRUE) {
   generic.names <- c(
     get_id_name(l),
-    generic.names,
+    generic.names
-    paste0(names(l), "_complete")
   )
 
-  lapply(l, function(i) {
+  if (drop.complete){
+    generic.names <- c(
+      generic.names,
+      paste0(names(l), "_complete")
+    )
+  }
+
+  out <- lapply(l, function(i) {
     if (ncol(i) > 2) {
-      s <- data.frame(i[, !colnames(i) %in% generic.names])
+      s <- i[!colnames(i) %in% generic.names]
+      if (drop.empty){
       i[!apply(is.na(s), MARGIN = 1, FUN = all), ]
+        }
     } else {
       i
     }
   })
+
+  # On removing empty variables, a list may end up empty
+  out[sapply(out,nrow)>0]
 }
 
 
@@ -496,5 +513,8 @@ is_repeated_longitudinal <- function(data, generics = c(
 }
 
 
-
+dummy_fun <- function(...){
-
+  list(
+    gtsummary::add_difference()
+  )
+}

inst/WORDLIST

@@ -5,7 +5,6 @@ Codecov
 DEPRICATED
 DOI
 DataDictionary
-GStat
 Gammelgaard
 Github
 GithubActions
@@ -15,8 +14,6 @@ METACRAN
 Nav
 ORCID
 POSIXct
-Pivotting
-README
 REDCap
 REDCapR
 REDCapRITS
@@ -41,6 +38,7 @@ dmy
 docx
 doi
 dplyr
+dropdown
 droplevels
 ds
 dta
@@ -61,7 +59,6 @@ labelled
 labelling
 mRS
 matadata
-md
 mdy
 mis
 mrs

man/REDCap_split.Rd

@@ -21,8 +21,7 @@ call.}
 JSON from an API call.}
 
 \item{primary_table_name}{Name given to the list element for the primary
-output table (as described in \emph{README.md}). Ignored if
+output table. Ignored if \code{forms = 'all'}.}
-\code{forms = 'all'}.}
 
 \item{forms}{Indicate whether to create separate tables for repeating
 instruments only or for all forms.}
@@ -66,7 +65,7 @@ metadata <- postForm(
 )
 
 # Convert exported JSON strings into a list of data.frames
-REDCapRITS::REDCap_split(records, metadata)
+REDCapCAST::REDCap_split(records, metadata)
 
 # Using a raw data export -------------------------------------------------
 
@@ -79,7 +78,7 @@ metadata <- read.csv(
 )
 
 # Split the tables
-REDCapRITS::REDCap_split(records, metadata)
+REDCapCAST::REDCap_split(records, metadata)
 
 # In conjunction with the R export script ---------------------------------
 
@@ -96,10 +95,10 @@ source("ExampleProject_R_2018-06-03_1700.r")
 metadata <- read.csv("ExampleProject_DataDictionary_2018-06-03.csv")
 
 # Split the tables
-REDCapRITS::REDCap_split(data, metadata)
+REDCapCAST::REDCap_split(data, metadata)
 setwd(old)
 }
 }
 \author{
-Paul W. Egeler, M.S., GStat
+Paul W. Egeler
 }

man/as_factor.Rd

@@ -8,7 +8,6 @@
 \alias{as_factor.character}
 \alias{as_factor.haven_labelled}
 \alias{as_factor.labelled}
-\alias{as_factor.redcapcast_labelled}
 \alias{as_factor.data.frame}
 \title{Convert labelled vectors to factors while preserving attributes}
 \usage{
@@ -36,13 +35,6 @@ as_factor(x, ...)
   ...
 )
 
-\method{as_factor}{redcapcast_labelled}(
-  x,
-  levels = c("default", "labels", "values", "both"),
-  ordered = FALSE,
-  ...
-)
-
 \method{as_factor}{data.frame}(x, ..., only_labelled = TRUE)
 }
 \arguments{
@@ -64,7 +56,7 @@ as_factor(x, ...)
 \item{only_labelled}{Only apply to labelled columns?}
 }
 \description{
-This extends [forcats::as_factor()] as well as [haven::as_factor()], by appending
+This extends \link[forcats]{as_factor} as well as \link[haven]{as_factor}, by appending
 original attributes except for "class" after converting to factor to avoid
 ta loss in case of rich formatted and labelled data.
 }

man/easy_redcap.Rd

@@ -8,13 +8,13 @@ easy_redcap(project.name, widen.data = TRUE, uri, ...)
 }
 \arguments{
 \item{project.name}{The name of the current project (for key storage with
-`keyring::key_set()`, using the default keyring)}
+\link[keyring]{key_set}, using the default keyring)}
 
 \item{widen.data}{argument to widen the exported data}
 
 \item{uri}{REDCap database API uri}
 
-\item{...}{arguments passed on to `REDCapCAST::read_redcap_tables()`}
+\item{...}{arguments passed on to \link[REDCapCAST]{read_redcap_tables}.}
 }
 \value{
 data.frame or list depending on widen.data
@@ -22,3 +22,8 @@ data.frame or list depending on widen.data
 \description{
 Secure API key storage and data acquisition in one
 }
+\examples{
+\dontrun{
+easy_redcap("My_new_project",fields=c("record_id","age","hypertension"))
+}
+}

man/fct2num.Rd

@@ -34,15 +34,9 @@ structure(c(1, 2, 3, 2, 10, 9),
   as_factor() |>
   fct2num()
 
-# Outlier with labels, but no class of origin, handled like numeric vector
+structure(c(1, 2, 3, 2, 10, 9),
-# structure(c(1, 2, 3, 2, 10, 9),
+  labels = c(Unknown = 9, Refused = 10)
-#   labels = c(Unknown = 9, Refused = 10)
+) |>
-# ) |>
+  as_factor() |>
-#   as_factor() |>
+  fct2num()
-#   fct2num()
-
-v <- sample(6:19, 20, TRUE) |> factor()
-dput(v)
-named_levels(v)
-fct2num(v)
 }

man/format_redcap_factor.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/read_redcap_tables.R
+\name{format_redcap_factor}
+\alias{format_redcap_factor}
+\title{Converts REDCap choices to factor levels and stores in labels attribute}
+\usage{
+format_redcap_factor(data, meta)
+}
+\arguments{
+\item{data}{vector}
+
+\item{meta}{vector of REDCap choices}
+}
+\value{
+vector of class "labelled" with a "labels" attribute
+}
+\description{
+Applying \link[REDCapCAST]{as_factor} to the data.frame or variable, will
+coerce to a factor.
+}
+\examples{
+format_redcap_factor(sample(1:3,20,TRUE),"1, First. | 2, second | 3, THIRD")
+}

man/get_api_key.Rd

@@ -4,14 +4,18 @@
 \alias{get_api_key}
 \title{Retrieve project API key if stored, if not, set and retrieve}
 \usage{
-get_api_key(key.name)
+get_api_key(key.name, ...)
 }
 \arguments{
 \item{key.name}{character vector of key name}
+
+\item{...}{passed to \link[keyring]{key_set}}
 }
 \value{
 character vector
 }
 \description{
-Retrieve project API key if stored, if not, set and retrieve
+Attempting to make secure API key storage so simple, that no other way makes
+sense. Wrapping \link[keyring]{key_get} and \link[keyring]{key_set} using the
+\link[keyring]{key_list} to check if key is in storage already.
 }

man/is.labelled.Rd

@@ -4,10 +4,7 @@
 \alias{is.labelled}
 \title{Tests for multiple label classes}
 \usage{
-is.labelled(
+is.labelled(x, classes = c("haven_labelled", "labelled"))
-  x,
-  classes = c("redcapcast_labelled", "haven_labelled", "labelled")
-)
 }
 \arguments{
 \item{x}{data}

man/named_levels.Rd

@@ -4,7 +4,13 @@
 \alias{named_levels}
 \title{Get named vector of factor levels and values}
 \usage{
-named_levels(data, label = "labels", na.label = NULL, na.value = 99)
+named_levels(
+  data,
+  label = "labels",
+  na.label = NULL,
+  na.value = 99,
+  sort.numeric = TRUE
+)
 }
 \arguments{
 \item{data}{factor}
@@ -15,6 +21,8 @@ named_levels(data, label = "labels", na.label = NULL, na.value = 99)
 
 \item{na.value}{new value for NA strings. Ignored if na.label is NULL.
 Default is 99.}
+
+\item{sort.numeric}{sort factor levels if levels are numeric. Default is TRUE}
 }
 \value{
 named vector
@@ -23,12 +31,16 @@ named vector
 Get named vector of factor levels and values
 }
 \examples{
-\dontrun{
 structure(c(1, 2, 3, 2, 10, 9),
   labels = c(Unknown = 9, Refused = 10),
   class = "haven_labelled"
 ) |>
   as_factor() |>
   named_levels()
-}
+structure(c(1, 2, 3, 2, 10, 9),
+  labels = c(Unknown = 9, Refused = 10),
+  class = "labelled"
+) |>
+  as_factor() |>
+  named_levels()
 }

man/possibly_numeric.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/as_factor.R
+\name{possibly_numeric}
+\alias{possibly_numeric}
+\title{Tests if vector can be interpreted as numeric without introducing NAs by
+coercion}
+\usage{
+possibly_numeric(data)
+}
+\arguments{
+\item{data}{vector}
+}
+\value{
+logical
+}
+\description{
+Tests if vector can be interpreted as numeric without introducing NAs by
+coercion
+}
+\examples{
+c("1","5") |> possibly_numeric()
+c("1","5","e") |> possibly_numeric()
+}

man/read_redcap_tables.Rd

@@ -11,8 +11,9 @@ read_redcap_tables(
   fields = NULL,
   events = NULL,
   forms = NULL,
-  raw_or_label = "label",
+  raw_or_label = c("raw", "label", "both"),
-  split_forms = "all"
+  split_forms = "all",
+  ...
 )
 }
 \arguments{
@@ -28,27 +29,32 @@ read_redcap_tables(
 
 \item{forms}{forms to download}
 
-\item{raw_or_label}{raw or label tags. Can be
+\item{raw_or_label}{raw or label tags. Can be "raw", "label" or "both".
 
-  * "raw": Standard [REDCapR] method to get raw values.
+  * "raw": Standard \link[REDCapR]{redcap_read} method to get raw values.
-  * "label": Standard [REDCapR] method to get label values.
+  * "label": Standard \link[REDCapR]{redcap_read} method to get label values.
   * "both": Get raw values with REDCap labels applied as labels. Use
-  [as_factor()] to format factors with original labels and use the
+  \link[REDCapCAST]{as_factor} to format factors with original labels and use
-  [gtsummary] package to easily get beautiful tables with original labels
+  the  `gtsummary` package functions like \link[gtsummary]{tbl_summary} to
-  from REDCap. Use [fct_drop()] to drop empty levels.}
+  easily get beautiful tables with original labels from REDCap. Use
+  \link[REDCapCAST]{fct_drop} to drop empty levels.}
 
 \item{split_forms}{Whether to split "repeating" or "all" forms, default is
 all.}
+
+\item{...}{passed on to \link[REDCapR]{redcap_read}}
 }
 \value{
 list of instruments
 }
 \description{
-Implementation of REDCap_split with a focused data acquisition approach using
+Implementation of passed on to \link[REDCapCAST]{REDCap_split} with a focused
-REDCapR::redcap_read and only downloading specified fields, forms and/or
+data acquisition approach using passed on to \link[REDCapR]{redcap_read} and
-events using the built-in focused_metadata including some clean-up.
+only downloading specified fields, forms and/or events using the built-in
+focused_metadata including some clean-up.
 Works with classical and longitudinal projects with or without repeating
 instruments.
+Will preserve metadata in the data.frames as labels.
 }
 \examples{
 # Examples will be provided later

man/redcap_wider.Rd

@@ -2,7 +2,7 @@
 % Please edit documentation in R/redcap_wider.R
 \name{redcap_wider}
 \alias{redcap_wider}
-\title{Redcap Wider}
+\title{Transforms list of REDCap data.frames to a single wide data.frame}
 \usage{
 redcap_wider(
   data,
@@ -11,18 +11,20 @@ redcap_wider(
 )
 }
 \arguments{
-\item{data}{A list of data frames.}
+\item{data}{A list of data frames}
 
-\item{event.glue}{A dplyr::glue string for repeated events naming}
+\item{event.glue}{A \link[glue]{glue} string for repeated events naming}
 
-\item{inst.glue}{A dplyr::glue string for repeated instruments naming}
+\item{inst.glue}{A \link[glue]{glue} string for repeated instruments naming}
 }
 \value{
-The list of data frames in wide format.
+data.frame in wide format
 }
 \description{
-Converts a list of REDCap data frames from long to wide format.
+Converts a list of REDCap data.frames from long to wide format.
-Handles longitudinal projects, but not yet repeated instruments.
+In essence it is a wrapper for the \link[tidyr]{pivot_wider} function applied
+on a REDCap output (from \link[REDCapCAST]{read_redcap_tables}) or manually
+split by \link[REDCapCAST]{REDCap_split}.
 }
 \examples{
 # Longitudinal

man/sanitize_split.Rd

@@ -7,13 +7,20 @@
 sanitize_split(
   l,
   generic.names = c("redcap_event_name", "redcap_repeat_instrument",
-    "redcap_repeat_instance")
+    "redcap_repeat_instance"),
+  drop.complete = TRUE,
+  drop.empty = TRUE
 )
 }
 \arguments{
 \item{l}{A list of data frames.}
 
 \item{generic.names}{A vector of generic names to be excluded.}
+
+\item{drop.complete}{logical to remove generic REDCap variables indicating
+instrument completion. Default is TRUE.}
+
+\item{drop.empty}{logical to remove variables with only NAs Default is TRUE.}
 }
 \value{
 A list of data frames with generic names excluded.

tests/testthat/test-as_factor.R

@@ -0,0 +1,56 @@
+# library(testthat)
+test_that("fct2num works", {
+  expect_equal(2 * 2, 4)
+
+  expect_equal(
+    c(1, 4, 3, "A", 7, 8, 1) |>
+      as_factor() |> # named_levels()
+      fct2num(),
+    c(1, 2, 3, 4, 5, 6, 1)
+  )
+
+  expect_equal(
+    structure(c(1, 2, 3, 2, 10, 9),
+      labels = c(Unknown = 9, Refused = 10),
+      class = "haven_labelled"
+    ) |>
+      as_factor() |>
+      fct2num(),
+    c(1, 2, 3, 2, 10, 9)
+  )
+
+  expect_equal(
+    structure(c(1, 2, 3, 2, 10, 9),
+      labels = c(Unknown = 9, Refused = 10),
+      class = "labelled"
+    ) |>
+      as_factor() |>
+      fct2num(),
+    c(1, 2, 3, 2, 10, 9)
+  )
+
+
+  expect_equal(
+    structure(c(1, 2, 3, 2, 10, 9),
+      labels = c(Unknown = 9, Refused = 10)
+    ) |>
+      as_factor.labelled() |>
+      fct2num(),
+    c(1, 2, 3, 2, 10, 9)
+  )
+
+  expect_equal(
+    structure(c(1, 2, 3, 2, 10, 9),
+      labels = c(Unknown = 9, Refused = 10),
+      class = "labelled"
+    ) |>
+      as_factor() |> dput(),
+    structure(c(1L, 2L, 3L, 2L, 5L, 4L), levels = c(
+      "1", "2", "3",
+      "Unknown", "Refused"
+    ), class = "factor", labels = c(
+      Unknown = 9,
+      Refused = 10
+    ))
+  )
+})

tests/testthat/test-redcap_wider.R

@@ -1,3 +1,4 @@
+library(testthat)
 test_that("redcap_wider() returns expected output", {
   list <-
     list(
@@ -15,7 +16,7 @@ test_that("redcap_wider() returns expected output", {
 
   expect_equal(
     redcap_wider(list),
-    data.frame(
+    dplyr::tibble(
       record_id = c(1, 2),
       age_baseline = c(25, 26),
       age_followup = c(27, 28),

vignettes/REDCapCAST.Rmd

@@ -18,12 +18,44 @@ knitr::opts_chunk$set(
 library(REDCapCAST)
 ```
 
-This vignette covers the included functions and basic functionality.
+This vignette covers the basics to get you started with the two basic features of REDCapCAST:
 
-A dataset and a meta data file are provided with the package for demonstration of the functions.
+-   Casting REDCap metadata to create a new REDCap database or extend an existing with a new instrument
+
+-   Reading REDCap data in a convenient and focused way, by only getting the data you need, while preserving as much metadata as possible.
+
+## Casting meta data
+
+The easiest way is to use the `shiny_cast()`. You can access a [hosted version here](https://agdamsbo.shinyapps.io/redcapcast/) or launch it locally like this:
+
+```{r eval=FALSE}
+shiny_cast()
+```
+
+
+## Reading data from REDCap
+
+To get you started, the easiest way possible, you can use the `easy_redcap()` function (example below).
+
+You will need an API-key for your REDCap server, the uri/URL/address for the API connection (usually "<https://redcap.YOUR-institution.site/api/>").
+
+This function includes a few convenience features to ease your further work.
+
+If your project uses repeating instruments possible as a longitudinal project, you can choose to widen the data. If not, the result will be a list of each instrument you have chosen to extract data from. Make sure to specify only the fields or instruments you need, and avoid to save any of the data locally, but always source from REDCap to avoid possibly insecure local storage of sensitive data.
+
+```{r eval=FALSE}
+easy_redcap(uri = "YOUR URI", 
+            project.name = "MY_PROJECT", 
+            widen.data = TRUE,
+            fields = c("record_id", "OTHER FIELDS"))
+```
 
 ## Splitting the dataset
 
+The `easy_redcap()` function does a few things under the hood. Below are a few examples to show how the nicely formatted output is achieved.
+
+A sample dataset and Data Dictionary/metadata is provided for this demonstration:
+
 ```{r}
 redcapcast_data |> gt::gt()
 ```
@@ -32,29 +64,41 @@ redcapcast_data |> gt::gt()
 redcapcast_meta |> gt::gt()
 ```
 
+To save the metadata as labels in the dataset, we can save field labels and the choices from radio buttons and dropdown features:
+
+```{r}
+labelled_data <- 
+  apply_field_label(data=redcapcast_data,
+                       meta=redcapcast_meta) |> 
+  apply_factor_labels(meta=redcapcast_meta)
+```
+
+The `REDCap_split` function splits the data set into a list of data.frames.
+
 ```{r}
 list <-
   REDCap_split(
-    records = redcapcast_data,
+    records = labelled_data,
     metadata = redcapcast_meta,
     forms = "all"
   ) |> 
+  # Next steps cleans up and removes generic columns
   sanitize_split()
 str(list)
 ```
 
-## Reading data from REDCap
+The `easy_redcap()` will then (optionally) continue to widen the data, by transforming the list of data.frames to a single data.frame with one row for each subject/record_id (wide data format):
-
-This function wraps all the above demonstrated function to get the dataset, the metadata, apply the `REDCap_split`function and then a bit of cleaning. It just cuts outs all the steps for an easier approach.
-
-The function works very similar to the `REDCapR::redcap_read()` in allowing to specify fields, events and forms for export instead of exporting the whole database and filtering afterwards. I believe this is a better and safer, focused approach. 
-
-```{r eval=FALSE}
-# read_redcap_tables(uri = "YOUR URI", token = "YOUR TOKEN")
-```
-
-## Pivotting to wider format
 
 ```{r}
-redcap_wider(list) |> str()
+wide_data <- redcap_wider(list) 
+wide_data |> str()
 ```
+
+## Creating a nice table
+
+```{r}
+wide_data |> 
+  dplyr::select(sex,hypertension, diabetes) |> 
+  gtsummary::tbl_summary()
+```
+