Fixed bug introduced in previous commit, added test to check for bug

Also started working on issue #10
This commit is contained in:
Paul W. Egeler, M.S., GStat 2019-07-08 12:19:33 -04:00
parent 76420b527c
commit e7be5c1808
3 changed files with 116 additions and 55 deletions

View File

@ -10,8 +10,11 @@
#' @param metadata Project metadata (the data dictionary). May be a #' @param metadata Project metadata (the data dictionary). May be a
#' \code{data.frame}, \code{response}, or \code{character} vector containing #' \code{data.frame}, \code{response}, or \code{character} vector containing
#' JSON from an API call. #' JSON from an API call.
#' @param primary_table_label Name of the label given to the list element for #' @param primary_table_name Name given to the list element for the primary
#' the primary output table (as described in *README.md*). #' output table (as described in \emph{README.md}). Ignored if
#' \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, M.S., GStat
#' @examples #' @examples
#' \dontrun{ #' \dontrun{
@ -66,13 +69,20 @@
#' # Split the tables #' # Split the tables
#' REDCapRITS::REDCap_split(data, metadata) #' REDCapRITS::REDCap_split(data, metadata)
#' } #' }
#' @return A list of \code{"data.frame"}s: one base table and zero or more #' @return A list of \code{"data.frame"}s. The number of tables will differ
#' depending on the \code{forms} option selected.
#' \itemize{
#' \item \code{'repeating'}: one base table and one or more
#' tables for each repeating instrument. #' tables for each repeating instrument.
#' \item \code{'all'}: a data.frame for each instrument, regardless of
#' whether it is a repeating instrument or not.
#' }
#' @include process_user_input.r utils.r #' @include process_user_input.r utils.r
#' @export #' @export
REDCap_split <- function(records, REDCap_split <- function(records,
metadata, metadata,
primary_table_label = "" primary_table_name = "",
forms = c("repeating", "all")
) { ) {
# Process user input # Process user input
@ -82,8 +92,11 @@ REDCap_split <- function(records,
# Get the variable names in the dataset # Get the variable names in the dataset
vars_in_data <- names(records) vars_in_data <- names(records)
# Match arg for forms
forms <- match.arg(forms)
# Check to see if there were any repeating instruments # Check to see if there were any repeating instruments
if (!"redcap_repeat_instrument" %in% vars_in_data) { if (forms == "repeating" && !"redcap_repeat_instrument" %in% vars_in_data) {
stop("There are no repeating instruments in this dataset.") stop("There are no repeating instruments in this dataset.")
} }
@ -107,6 +120,7 @@ REDCap_split <- function(records,
) )
) )
if ("redcap_repeat_instrument" %in% vars_in_data) {
# Variables to be at the beginning of each repeating instrument # Variables to be at the beginning of each repeating instrument
repeat_instrument_fields <- grep( repeat_instrument_fields <- grep(
"^redcap_repeat.*", "^redcap_repeat.*",
@ -114,7 +128,6 @@ REDCap_split <- function(records,
value = TRUE value = TRUE
) )
# Identify the subtables in the data # Identify the subtables in the data
subtables <- unique(records$redcap_repeat_instrument) subtables <- unique(records$redcap_repeat_instrument)
subtables <- subtables[subtables != ""] subtables <- subtables[subtables != ""]
@ -122,19 +135,17 @@ REDCap_split <- function(records,
# Split the table based on instrument # Split the table based on instrument
out <- split.data.frame(records, records$redcap_repeat_instrument) out <- split.data.frame(records, records$redcap_repeat_instrument)
if (primary_table_label %in% subtables) { if (forms == "repeating" && primary_table_name %in% subtables) {
warning( warning("The label given to the primary table is already used by a repeating instrument. The primary table label will be left blank.")
"The label given to the primary table is already used by a repeating instrument.\n", primary_table_name <- ""
"The primary table label will be left blank." } else if (primary_table_name > "") {
) names(out)[[which(names(out) == "")]] <- primary_table_name
} else if (primary_table_label > "") {
names(out)[[which(names(out) == "")]] <- primary_table_label
} }
# Delete the variables that are not relevant # Delete the variables that are not relevant
for (i in names(out)) { for (i in names(out)) {
if (i == primary_table_label) { if (i == primary_table_name) {
out_fields <- which( out_fields <- which(
vars_in_data %in% c( vars_in_data %in% c(
@ -142,7 +153,7 @@ REDCap_split <- function(records,
fields[!fields[,2] %in% subtables, 1] fields[!fields[,2] %in% subtables, 1]
) )
) )
out[[which(names(out) == primary_table_label)]] <- out[[which(names(out) == primary_table_label)]][out_fields] out[[which(names(out) == primary_table_name)]] <- out[[which(names(out) == primary_table_name)]][out_fields]
} else { } else {
@ -158,6 +169,7 @@ REDCap_split <- function(records,
} }
} }
}
out out

View File

@ -4,7 +4,8 @@
\alias{REDCap_split} \alias{REDCap_split}
\title{Split REDCap repeating instruments table into multiple tables} \title{Split REDCap repeating instruments table into multiple tables}
\usage{ \usage{
REDCap_split(records, metadata, primary_table_label = "") REDCap_split(records, metadata, primary_table_name = "",
forms = c("repeating", "all"))
} }
\arguments{ \arguments{
\item{records}{Exported project records. May be a \code{data.frame}, \item{records}{Exported project records. May be a \code{data.frame},
@ -15,12 +16,22 @@ call.}
\code{data.frame}, \code{response}, or \code{character} vector containing \code{data.frame}, \code{response}, or \code{character} vector containing
JSON from an API call.} JSON from an API call.}
\item{primary_table_label}{Name of the label given to the list element for \item{primary_table_name}{Name given to the list element for the primary
the primary output table (as described in *README.md*).} output table (as described in \emph{README.md}). Ignored if
\code{forms = 'all'}.}
\item{forms}{Indicate whether to create separate tables for repeating
instruments only or for all forms.}
} }
\value{ \value{
A list of \code{"data.frame"}s: one base table and zero or more A list of \code{"data.frame"}s. The number of tables will differ
depending on the \code{forms} option selected.
\itemize{
\item \code{'repeating'}: one base table and one or more
tables for each repeating instrument. tables for each repeating instrument.
\item \code{'all'}: a data.frame for each instrument, regardless of
whether it is a repeating instrument or not.
}
} }
\description{ \description{
This will take output from a REDCap export and split it into a base table This will take output from a REDCap export and split it into a base table

View File

@ -0,0 +1,38 @@
context("Primary table name processing")
# Global variables -------------------------------------------------------
metadata <- jsonlite::fromJSON(
get_data_location(
"ExampleProject_metadata.json"
)
)
records <- jsonlite::fromJSON(
get_data_location(
"ExampleProject_records.json"
)
)
ref_hash <- "2c8b6531597182af1248f92124161e0c"
# Tests -------------------------------------------------------------------
test_that("Will not use a repeating instrument name for primary table", {
redcap_output_json1 <- expect_warning(
REDCap_split(records, metadata, "sale"),
"primary table"
)
expect_known_hash(redcap_output_json1, ref_hash)
})
test_that("Names are set correctly and output is identical", {
redcap_output_json2 <- REDCap_split(records, metadata, "main")
expect_identical(names(redcap_output_json2), c("main", "sale"))
expect_known_hash(setNames(redcap_output_json2, c("", "sale")), ref_hash)
})