mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-22 13:30:23 +01:00
Increment to v 0.2.0 and closes #10
Form timestamp fields also captured now.
This commit is contained in:
parent
e7be5c1808
commit
d15c2d35ad
@ -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"))
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
30
R/R/utils.r
30
R/R/utils.r
@ -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)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
63
R/tests/testthat/test-forms-arg.R
Normal file
63
R/tests/testthat/test-forms-arg.R
Normal 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))))
|
||||||
|
|
||||||
|
})
|
@ -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")
|
||||||
})
|
})
|
||||||
|
Loading…
Reference in New Issue
Block a user