Increment to v 0.2.0 and closes #10

Form timestamp fields also captured now.
This commit is contained in:
Paul W. Egeler, M.S., GStat 2019-07-08 18:01:48 -04:00
parent e7be5c1808
commit d15c2d35ad
6 changed files with 121 additions and 4 deletions

View File

@ -1,6 +1,6 @@
Package: REDCapRITS Package: REDCapRITS
Title: REDCap Repeating Instrument Table Splitter Title: REDCap Repeating Instrument Table Splitter
Version: 0.1.0 Version: 0.2.0
Authors@R: c( Authors@R: c(
person("Paul", "Egeler", email = "paul.egeler@spectrumhealth.org", role = c("aut", "cre")), person("Paul", "Egeler", email = "paul.egeler@spectrumhealth.org", role = c("aut", "cre")),
person("Spectrum Health, Grand Rapids, MI", role = "cph")) person("Spectrum Health, Grand Rapids, MI", role = "cph"))

View File

@ -1,3 +1,8 @@
# REDCapRITS 0.2.0 (Release date: 2019-??-??)
* [feature] User can now separate each form into its own data.frame, regardless if it is a repeating instrument or not. (#10)
* [bug] Handles auto-generated form timestamp fields.
# REDCapRITS 0.1.0 (Release date: 2019-07-01) # REDCapRITS 0.1.0 (Release date: 2019-07-01)
* [feature] User can now specify the name of the 'primary' table, which previously was left blank. (#9) * [feature] User can now specify the name of the 'primary' table, which previously was left blank. (#9)

View File

@ -134,12 +134,13 @@ 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)
primary_table_index <- which(names(out) == "")
if (forms == "repeating" && primary_table_name %in% subtables) { if (forms == "repeating" && primary_table_name %in% subtables) {
warning("The label given to the primary table is already used by a repeating instrument. The primary table label will be left blank.") warning("The label given to the primary table is already used by a repeating instrument. The primary table label will be left blank.")
primary_table_name <- "" primary_table_name <- ""
} else if (primary_table_name > "") { } else if (primary_table_name > "") {
names(out)[[which(names(out) == "")]] <- primary_table_name names(out)[[primary_table_index]] <- primary_table_name
} }
# Delete the variables that are not relevant # Delete the variables that are not relevant
@ -153,7 +154,7 @@ REDCap_split <- function(records,
fields[!fields[,2] %in% subtables, 1] fields[!fields[,2] %in% subtables, 1]
) )
) )
out[[which(names(out) == primary_table_name)]] <- out[[which(names(out) == primary_table_name)]][out_fields] out[[primary_table_index]] <- out[[primary_table_index]][out_fields]
} else { } else {
@ -169,6 +170,24 @@ REDCap_split <- function(records,
} }
} }
if (forms == "all") {
out <- c(
split_non_repeating_forms(
out[[primary_table_index]],
universal_fields,
fields[!fields[,2] %in% subtables,]
),
out[-primary_table_index]
)
}
} else {
out <- split_non_repeating_forms(records, universal_fields, fields)
} }
out out

View File

@ -15,6 +15,20 @@ match_fields_to_form <- function(metadata, vars_in_data) {
fields <- rbind(fields, form_complete_fields) fields <- rbind(fields, form_complete_fields)
# Process survey timestamps
timestamps <- intersect(vars_in_data, paste0(form_names, "_timestamp"))
if (length(timestamps)) {
timestamp_fields <- data.frame(
field_name = timestamps,
form_name = sub("_timestamp$", "", timestamps),
stringsAsFactors = FALSE
)
fields <- rbind(fields, timestamp_fields)
}
# Process checkbox fields # Process checkbox fields
if (any(metadata$field_type == "checkbox")) { if (any(metadata$field_type == "checkbox")) {
@ -74,3 +88,19 @@ match_fields_to_form <- function(metadata, vars_in_data) {
fields fields
} }
split_non_repeating_forms <- function(table, universal_fields, fields) {
forms <- unique(fields[[2]])
x <- lapply(
forms,
function (x) {
table[names(table) %in% union(universal_fields, fields[fields[,2] == x,1])]
})
structure(x, names = forms)
}

View File

@ -0,0 +1,63 @@
context("Using the `forms = 'all'` argument")
# Global variables --------------------------------------------------------
# Cars
metadata <- jsonlite::fromJSON(
get_data_location(
"ExampleProject_metadata.json"
)
)
records <- jsonlite::fromJSON(
get_data_location(
"ExampleProject_records.json"
)
)
redcap_output_json <- REDCap_split(records, metadata, forms = "all")
# Longitudinal
file_paths <- sapply(
c(
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"
), get_data_location
)
redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)
redcap[["metadata"]] <- with(redcap, metadata[metadata[,1] > "",])
redcap_output_long <- with(redcap, REDCap_split(records, metadata, forms = "all"))
redcap_long_names <- names(redcap[[1]])
# Tests -------------------------------------------------------------------
test_that("Each form is an element in the list", {
expect_length(redcap_output_json, 3L)
expect_identical(names(redcap_output_json), c("motor_trend_cars", "grouping", "sale"))
})
test_that("All variables land somewhere", {
expect_true(setequal(names(records), Reduce("union", sapply(redcap_output_json, names))))
})
test_that("Primary table name is ignored", {
expect_identical(
REDCap_split(records, metadata, "HELLO", "all"),
redcap_output_json
)
})
test_that("Supports longitudinal data", {
# setdiff(redcap_long_names, Reduce("union", sapply(redcap_output_long, names)))
## [1] "informed_consent_and_addendum_timestamp"
expect_true(setequal(redcap_long_names, Reduce("union", sapply(redcap_output_long, names))))
})

View File

@ -13,5 +13,5 @@ test_that("CSV export matches reference", {
redcap_output <- with(redcap, REDCap_split(records, metadata)) redcap_output <- with(redcap, REDCap_split(records, metadata))
expect_known_hash(redcap_output, "dff3a52955") expect_known_hash(redcap_output, "0934bcb292")
}) })