#' @name splitForms
#' @title Split a Data Frame into its Forms
#'
#' @description Separates a data frame from REDCap into a list of data
#' frames where each form constitutes an element in the list.
#'
#' @inheritParams common-rcon-arg
#' @param Records `data.frame` such as one generated by `exportRecords` or
#' `exportRecordsTyped`
#' @param envir environment. The target environment for the resulting list
#' of `data.frame`s. Defaults to `NULL` which returns the a list.
#' Use `globalenv` to assign the global environment. Will accept a number
#' of the environment.
#' @param base `character(1)` giving the start of the naming scheme
#' for the elements of the list. By default, the names of the list will
#' be the form names. If this value is provided, it will follow the
#' format `base.form_name`.
#' @param post `function` to apply to each element of form data
#' after separating them, must be of signature `function(data, rcon)`.
#'
#' @seealso
#' ## Other post-processing functions
#'
#' [recastRecords()], \cr
#' [guessCast()], \cr
#' [guessDate()], \cr
#' [castForImport()], \cr
#' [mChoiceCast()], \cr
#' [widerRepeated()]
#'
#' @examples
#' \dontrun{
#' unlockREDCap(connections = c(rcon = "project_alias"),
#' url = "your_redcap_url",
#' keyring = "API_KEYs",
#' envir = globalenv())
#'
#' Records <- exportRecordsTyped(rcon)
#'
#' splitForms(Records, rcon)
#' }
#'
#'
#' @export
splitForms <- function(Records,
rcon,
envir = NULL,
base = NULL,
post = NULL){
###################################################################
# Argument Validation ####
if(is.numeric(envir)) envir <- as.environment(envir)
coll <- checkmate::makeAssertCollection()
checkmate::assert_data_frame(x = Records,
add = coll)
checkmate::assert_class(x = rcon,
classes = "redcapConnection",
add = coll)
checkmate::assert_environment(x = envir,
null.ok = TRUE,
add = coll)
checkmate::assert_character(x = base,
len = 1,
null.ok = TRUE,
any.missing = FALSE,
add = coll)
checkmate::assert_function(x = post,
null.ok = TRUE,
add = coll)
checkmate::reportAssertions(coll)
###################################################################
# Split Forms ####
id_vars <- c(getProjectIdFields(rcon),
REDCAP_SYSTEM_FIELDS)
id_vars <- id_vars[id_vars %in% names(Records)]
FieldNames <- rcon$fieldnames()
FieldNames <- FieldNames[FieldNames$export_field_name %in% names(Records), , drop = FALSE]
FieldNames <- FieldNames[!FieldNames$original_field_name %in% id_vars, , drop = FALSE]
MetaData <- rcon$metadata()
MetaData <- MetaData[MetaData$field_name %in% FieldNames$original_field_name, , drop = FALSE]
FormNames <- split(MetaData$field_name,
MetaData$form_name,
drop = TRUE)
form_order <- rcon$instruments()$instrument_name
form_order <- form_order[form_order %in% names(FormNames)]
FormNames <- FormNames[form_order]
FormNames <- lapply(FormNames,
function(fn){
FN <- rcon$fieldnames()
FN$export_field_name[FN$original_field_name %in% fn]
})
FormNames <- lapply(FormNames,
function(fn){
fn <- c(id_vars, fn)
fn[!duplicated(fn)]
})
FormData <- lapply(FormNames,
function(fn){
Records[fn]
})
FormData <- lapply(FormData,
filterEmptyRow,
rcon = rcon)
###################################################################
# Add the invalid attribute to each element ####
FormData <- lapply(FormData,
function(fd){
inv <- attr(Records, "invalid")
inv <- inv[inv$field_name %in% names(fd), , drop = FALSE]
if (!is.null(inv) && nrow(inv) > 0){
attr(fd, "invalid") <- inv
}
fd
})
###################################################################
# Apply the base name, if necessary ####
if (!is.null(base)){
names(FormData) <- paste0(base, ".", names(FormData))
}
###################################################################
# Apply the function to the list ####
if (!is.null(post)){
FormData <- lapply(FormData,
function(x) post(x, rcon))
}
###################################################################
# Return the Result ####
if(is.null(envir)) FormData else list2env(FormData, envir=envir)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.