2018-01-19 17:50:08 +01:00
|
|
|
#' Split REDCap repeating instruments table into multiple tables
|
|
|
|
#'
|
2018-05-25 18:02:21 +02:00
|
|
|
#' This will take a raw \code{data.frame} from REDCap and split it into a base table
|
2018-01-19 17:50:08 +01:00
|
|
|
#' and give individual tables for each repeating instrument. Metadata
|
|
|
|
#' is used to determine which fields should be included in each resultant table.
|
|
|
|
#'
|
2018-05-29 05:47:16 +02:00
|
|
|
#' @param records \code{data.frame} containing project records
|
|
|
|
#' @param metadata \code{data.frame} containing project metadata (the data dictionary)
|
2018-01-19 17:50:08 +01:00
|
|
|
#' @author Paul W. Egeler, M.S., GStat
|
|
|
|
#' @examples
|
|
|
|
#' \dontrun{
|
|
|
|
#' library(jsonlite)
|
|
|
|
#' library(RCurl)
|
2018-05-25 18:02:21 +02:00
|
|
|
#'
|
2018-01-19 17:50:08 +01:00
|
|
|
#' # Get the metadata
|
|
|
|
#' result.meta <- postForm(
|
|
|
|
#' api_url,
|
|
|
|
#' token = api_token,
|
|
|
|
#' content = 'metadata',
|
|
|
|
#' format = 'json'
|
|
|
|
#' )
|
2018-05-25 18:02:21 +02:00
|
|
|
#'
|
2018-01-19 17:50:08 +01:00
|
|
|
#' # Get the records
|
|
|
|
#' result.record <- postForm(
|
|
|
|
#' uri = api_url,
|
|
|
|
#' token = api_token,
|
|
|
|
#' content = 'record',
|
|
|
|
#' format = 'json',
|
|
|
|
#' type = 'flat',
|
|
|
|
#' rawOrLabel = 'raw',
|
|
|
|
#' rawOrLabelHeaders = 'raw',
|
|
|
|
#' exportCheckboxLabel = 'false',
|
|
|
|
#' exportSurveyFields = 'false',
|
|
|
|
#' exportDataAccessGroups = 'false',
|
|
|
|
#' returnFormat = 'json'
|
|
|
|
#' )
|
2018-05-25 18:02:21 +02:00
|
|
|
#'
|
2018-05-29 05:47:16 +02:00
|
|
|
#' # Convert JSON to data.frames
|
2018-01-19 17:50:08 +01:00
|
|
|
#' records <- fromJSON(result.record)
|
|
|
|
#' metadata <- fromJSON(result.meta)
|
|
|
|
#'
|
2018-05-29 05:47:16 +02:00
|
|
|
#' # Split the data.frame into a list of data.frames
|
2018-01-19 17:50:08 +01:00
|
|
|
#' REDCap_split(records, metadata)
|
|
|
|
#' }
|
|
|
|
#' @return a list of data.frames
|
|
|
|
#' @export
|
|
|
|
REDCap_split <- function(records, metadata) {
|
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
stopifnot(all(sapply(list(records,metadata), inherits, "data.frame")))
|
|
|
|
|
|
|
|
# Check to see if there were any repeating instruments
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
if (!any(names(records) == "redcap_repeat_instrument")) {
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
message("There are no repeating instruments in this data.")
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
return(list(records))
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
}
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
# Clean the metadata
|
|
|
|
metadata <-
|
|
|
|
metadata[metadata$field_type != "descriptive", c("field_name", "form_name")]
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
# Identify the subtables in the data
|
|
|
|
subtables <- unique(records$redcap_repeat_instrument)
|
|
|
|
subtables <- subtables[subtables != ""]
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
# Split the table based on instrument
|
|
|
|
out <- split.data.frame(records, records$redcap_repeat_instrument)
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
# Delete the variables that are not relevant
|
|
|
|
for (i in names(out)) {
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
if (i == "") {
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
out[[which(names(out) == "")]] <-
|
|
|
|
out[[which(names(out) == "")]][metadata[!metadata[,2] %in% subtables, 1]]
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
} else {
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
out[[i]] <-
|
|
|
|
out[[i]][c(names(records[1:3]),metadata[metadata[,2] == i, 1])]
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
}
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
}
|
2018-01-19 17:50:08 +01:00
|
|
|
|
2018-05-25 18:02:21 +02:00
|
|
|
return(out)
|
2018-01-19 17:50:08 +01:00
|
|
|
|
|
|
|
}
|