gp with CRAN in sight

This commit is contained in:
AG Damsbo 2023-04-13 10:57:04 +02:00
parent 20f08c271b
commit 349ff695e1
24 changed files with 337 additions and 156 deletions

1
.gitignore vendored
View File

@ -3,3 +3,4 @@
.Rproj.user .Rproj.user
test-data/ test-data/
inst/doc

View File

@ -1,10 +1,10 @@
Package: REDCapCAST Package: REDCapCAST
Title: REDCap Castellated data handling Title: REDCap Castellated data handling
Version: 23.3.2 Version: 23.4.1
Authors@R: c( Authors@R: c(
person("Paul", "Egeler", email = "paul.egeler@spectrumhealth.org", role = c("aut")), person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk", role = c("aut", "cre"),
person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk", role = c("cre", "ctb","cph"), comment = c(ORCID = "0000-0002-7559-1154")),
comment = c(ORCID = "0000-0002-7559-1154"))) person("Paul", "Egeler", email = "paul.egeler@spectrumhealth.org", role = "aut"))
Description: This package is based on REDCapRITS by Paul Egeler and Spectrum Health. Description: This package is based on REDCapRITS by Paul Egeler and Spectrum Health.
See [https://github.com/SpectrumHealthResearch/REDCapRITS](https://github.com/SpectrumHealthResearch/REDCapRITS). See [https://github.com/SpectrumHealthResearch/REDCapRITS](https://github.com/SpectrumHealthResearch/REDCapRITS).
Handle the castellated dataset from REDCap projects with repeating Handle the castellated dataset from REDCap projects with repeating
@ -27,7 +27,11 @@ Suggests:
testthat, testthat,
Hmisc, Hmisc,
readr, readr,
covr covr,
knitr,
rmarkdown,
gt,
keyring
License: GPL (>= 3) License: GPL (>= 3)
Encoding: UTF-8 Encoding: UTF-8
LazyData: true LazyData: true
@ -46,3 +50,4 @@ Collate:
'read_redcap_tables.R' 'read_redcap_tables.R'
'redcap_wider.R' 'redcap_wider.R'
Language: en-US Language: en-US
VignetteBuilder: knitr

View File

@ -1,3 +1,9 @@
# REDCapCAST 23.4.1
### Documentation:
* Aiming for CRAN
# REDCapCAST 23.3.2 # REDCapCAST 23.3.2
### Documentation: ### Documentation:

View File

@ -48,15 +48,16 @@
#' records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv") #' records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv")
#' #'
#' # Get the metadata #' # Get the metadata
#' metadata <- read.csv("/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv") #' metadata <- read.csv(
#' "/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv")
#' #'
#' # Split the tables #' # Split the tables
#' REDCapRITS::REDCap_split(records, metadata) #' REDCapRITS::REDCap_split(records, metadata)
#' #'
#' # In conjunction with the R export script --------------------------------- #' # In conjunction with the R export script ---------------------------------
#' #'
#' # You must set the working directory first since the REDCap data export script #' # You must set the working directory first since the REDCap data export
#' # contains relative file references. #' # script contains relative file references.
#' setwd("/path/to/data/") #' setwd("/path/to/data/")
#' #'
#' # Run the data export script supplied by REDCap. #' # Run the data export script supplied by REDCap.
@ -148,7 +149,8 @@ REDCap_split <- function(records,
if (forms == "repeating" && primary_table_name %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. The primary table label will be left blank."
) )
primary_table_name <- "" primary_table_name <- ""
} else if (primary_table_name > "") { } else if (primary_table_name > "") {
@ -159,7 +161,8 @@ REDCap_split <- function(records,
for (i in names(out)) { for (i in names(out)) {
if (i == primary_table_name) { if (i == primary_table_name) {
out_fields <- which(vars_in_data %in% c(universal_fields, out_fields <- which(vars_in_data %in% c(universal_fields,
fields[!fields[, 2] %in% subtables, 1])) fields[!fields[, 2] %in%
subtables, 1]))
out[[primary_table_index]] <- out[[primary_table_index]] <-
out[[primary_table_index]][out_fields] out[[primary_table_index]][out_fields]

View File

@ -1,10 +1,9 @@
#' Download REDCap data #' Download REDCap data
#' #'
#' Implementation of REDCap_split with a focused data acquisition approach using #' Implementation of REDCap_split with a focused data acquisition approach using
#' REDCapR::redcap_read nad only downloading specified fields, forms and/or events #' REDCapR::redcap_read nad only downloading specified fields, forms and/or
#' using the built-in focused_metadata #' events using the built-in focused_metadata including some clean-up.
#' including some clean-up. Works with longitudinal projects with repeating #' Works with longitudinal projects with repeating instruments.
#' instruments.
#' @param uri REDCap database uri #' @param uri REDCap database uri
#' @param token API token #' @param token API token
#' @param records records to download #' @param records records to download
@ -12,7 +11,8 @@
#' @param events events to download #' @param events events to download
#' @param forms forms to download #' @param forms forms to download
#' @param raw_or_label raw or label tags #' @param raw_or_label raw or label tags
#' @param split_forms Whether to split "repeating" or "all" forms, default is all. #' @param split_forms Whether to split "repeating" or "all" forms, default is
#' all.
#' @param generics vector of auto-generated generic variable names to #' @param generics vector of auto-generated generic variable names to
#' ignore when discarding empty rows #' ignore when discarding empty rows
#' #'
@ -73,7 +73,8 @@ read_redcap_tables <- function(uri,
)[["data"]] )[["data"]]
# Process repeat instrument naming # Process repeat instrument naming
# Removes any extra characters other than a-z, 0-9 and "_", to mimic raw instrument names. # Removes any extra characters other than a-z, 0-9 and "_", to mimic raw
# instrument names.
if ("redcap_repeat_instrument" %in% names(d)) { if ("redcap_repeat_instrument" %in% names(d)) {
d$redcap_repeat_instrument <- d$redcap_repeat_instrument <-
gsub("[^a-z0-9_]", "", gsub(" ", "_", tolower(d$redcap_repeat_instrument))) gsub("[^a-z0-9_]", "", gsub(" ", "_", tolower(d$redcap_repeat_instrument)))

View File

@ -27,7 +27,8 @@ redcap_wider <-
inst.glue = "{.value}_{redcap_repeat_instance}") { inst.glue = "{.value}_{redcap_repeat_instance}") {
all_names <- unique(do.call(c, lapply(list, names))) all_names <- unique(do.call(c, lapply(list, names)))
if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in% all_names)) { if (!any(c("redcap_event_name", "redcap_repeat_instrument") %in%
all_names)) {
stop( stop(
"The dataset does not include a 'redcap_event_name' variable. "The dataset does not include a 'redcap_event_name' variable.
redcap_wider only handles projects with repeating instruments or redcap_wider only handles projects with repeating instruments or
@ -35,11 +36,6 @@ redcap_wider <-
) )
} }
# if (any(grepl("_timestamp",all_names))){
# stop("The dataset includes a '_timestamp' variable, which is not supported
# by this function yet. Sorry! Feel free to contribute :)")
# }
id.name <- all_names[1] id.name <- all_names[1]
l <- lapply(list, function(i) { l <- lapply(list, function(i) {

View File

@ -138,7 +138,8 @@ match_fields_to_form <- function(metadata, vars_in_data) {
names(fields) <- c("field_name", "form_name") names(fields) <- c("field_name", "form_name")
# Process instrument status fields # Process instrument status fields
form_names <- unique(metadata[,grepl(".*[Ff]orm[._][Nn]ame$",names(metadata))]) form_names <- unique(metadata[,grepl(".*[Ff]orm[._][Nn]ame$",
names(metadata))])
form_complete_fields <- data.frame( form_complete_fields <- data.frame(
field_name = paste0(form_names, "_complete"), field_name = paste0(form_names, "_complete"),
form_name = form_names, form_name = form_names,

View File

@ -9,7 +9,27 @@ experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](h
# REDCapCAST # REDCapCAST
REDCap Castellated data handling when using repeated instruments. REDCap Castellated data handling when using repeated instruments.
Modified fork of SpectrumHealthResearch/REDCapRITS. This fork is purely minded on R usage and includes a few implementations of the main `REDCap_split` function. This package is a fork of [SpectrumHealthResearch/REDCapRITS](https://github.com/SpectrumHealthResearch/REDCapRITS). The REDCapRITS represents great and extensive work to handle castellated REDCap data in different programming languages. This fork is purely minded on R usage and includes a few implementations of the main `REDCap_split` function.
Fork of [REDCapRITS: REDCap Repeating Instrument Table Splitter](https://github.com/SpectrumHealthResearch/REDCapRITS) The main goal for this project was to allow for a "minimal data" approach by allowing to filter records, instruments and variables in the export to only download data needed. I think this approach is desireable for handling sensitive, clinical data. No similar functionality is available from similar tools (like `REDCapR` or `REDCapTidieR`). Please refer to [REDCap-Tools](https://redcap-tools.github.io/) for other great tools.
## Use and immprovements
This package is primarily relevant for working with longitudinal projects and/or projects using repeated instruments. Here is just a short descirption of the main functions:
* `REDcap_split()`: Works largely as the original `REDCapRITS::REDCap_split()`. It takes a REDCap dataset and metadata (data dictionary) to split the data set into a list of dataframes of instruments.
* `read_redcap_tables()`: wraps the use of [`REDCapR::redcap_read()`](https://github.com/OuhscBbmc/REDCapR) with `REDCap_split()` to ease the export of REDCap data.
* `redcap_wider()`: pivots each data frame with repeated instruments to a wide format utilizing the [`tidyr::pivot_wider()`](https://tidyr.tidyverse.org/reference/pivot_wider.html) from the [tidyverse](https://www.tidyverse.org/).
Compared to the original `REDCapRITS`, all matching functions are improved to accept column naming of REDCap data from manual download or API export.
## Installation
Install the latest version directly from GitHub:
```
remotes::install_github("agdamsbo/REDCapCAST")
```

View File

@ -1,6 +1,7 @@
pandoc: 2.19.2 pandoc: 2.19.2
pkgdown: 2.0.7 pkgdown: 2.0.7
pkgdown_sha: ~ pkgdown_sha: ~
articles: {} articles:
last_built: 2023-03-08T19:18Z Introduction: Introduction.html
last_built: 2023-04-13T08:56Z

File diff suppressed because one or more lines are too long

View File

@ -6,6 +6,12 @@
<url> <url>
<loc>/LICENSE.html</loc> <loc>/LICENSE.html</loc>
</url> </url>
<url>
<loc>/articles/Introduction.html</loc>
</url>
<url>
<loc>/articles/index.html</loc>
</url>
<url> <url>
<loc>/authors.html</loc> <loc>/authors.html</loc>
</url> </url>

View File

@ -1,21 +1,29 @@
CMD
Codecov
DataDictionary DataDictionary
GStat GStat
GithubActions
JSON JSON
Lifecycle
Pivotting
README README
REDCap REDCap
REDCapR REDCapR
REDCapRITS REDCapRITS
SpectrumHealthResearch SpectrumHealthResearch
Splitter
api api
descirption
desireable
doi doi
dplyr dplyr
github github
https https
immprovements
jbi jbi
matadata matadata
md md
nad nad
og og
thorugh thorugh
tidyverse
uri uri

View File

@ -74,15 +74,16 @@ REDCapRITS::REDCap_split(records, metadata)
records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv") records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv")
# Get the metadata # Get the metadata
metadata <- read.csv("/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv") metadata <- read.csv(
"/path/to/data/ExampleProject_DataDictionary_2018-06-03.csv")
# Split the tables # Split the tables
REDCapRITS::REDCap_split(records, metadata) REDCapRITS::REDCap_split(records, metadata)
# In conjunction with the R export script --------------------------------- # In conjunction with the R export script ---------------------------------
# You must set the working directory first since the REDCap data export script # You must set the working directory first since the REDCap data export
# contains relative file references. # script contains relative file references.
setwd("/path/to/data/") setwd("/path/to/data/")
# Run the data export script supplied by REDCap. # Run the data export script supplied by REDCap.

View File

@ -32,7 +32,8 @@ read_redcap_tables(
\item{raw_or_label}{raw or label tags} \item{raw_or_label}{raw or label tags}
\item{split_forms}{Whether to split "repeating" or "all" forms, default is all.} \item{split_forms}{Whether to split "repeating" or "all" forms, default is
all.}
\item{generics}{vector of auto-generated generic variable names to \item{generics}{vector of auto-generated generic variable names to
ignore when discarding empty rows} ignore when discarding empty rows}
@ -42,10 +43,9 @@ list of instruments
} }
\description{ \description{
Implementation of REDCap_split with a focused data acquisition approach using Implementation of REDCap_split with a focused data acquisition approach using
REDCapR::redcap_read nad only downloading specified fields, forms and/or events REDCapR::redcap_read nad only downloading specified fields, forms and/or
using the built-in focused_metadata events using the built-in focused_metadata including some clean-up.
including some clean-up. Works with longitudinal projects with repeating Works with longitudinal projects with repeating instruments.
instruments.
} }
\examples{ \examples{
# Examples will be provided later # Examples will be provided later

View File

@ -37,11 +37,11 @@ REDCap_split(
# Longitudinal data from @pbchase; Issue #7 ------------------------------- # Longitudinal data from @pbchase; Issue #7 -------------------------------
file_paths <- sapply( file_paths <- vapply(
c( c(
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv", records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv" metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"
), ref_data_location ), FUN.VALUE = "character", ref_data_location
) )
redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE) redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)

View File

@ -4,85 +4,113 @@ REDCap_process_csv <- function(data) {
stop("This test requires the 'Hmisc' package") stop("This test requires the 'Hmisc' package")
} }
Hmisc::label(data$row) = "Name" Hmisc::label(data$row) <- "Name"
Hmisc::label(data$redcap_repeat_instrument) = "Repeat Instrument" Hmisc::label(data$redcap_repeat_instrument) <- "Repeat Instrument"
Hmisc::label(data$redcap_repeat_instance) = "Repeat Instance" Hmisc::label(data$redcap_repeat_instance) <- "Repeat Instance"
Hmisc::label(data$mpg) = "Miles/(US) gallon" Hmisc::label(data$mpg) <- "Miles/(US) gallon"
Hmisc::label(data$cyl) = "Number of cylinders" Hmisc::label(data$cyl) <- "Number of cylinders"
Hmisc::label(data$disp) = "Displacement" Hmisc::label(data$disp) <- "Displacement"
Hmisc::label(data$hp) = "Gross horsepower" Hmisc::label(data$hp) <- "Gross horsepower"
Hmisc::label(data$drat) = "Rear axle ratio" Hmisc::label(data$drat) <- "Rear axle ratio"
Hmisc::label(data$wt) = "Weight" Hmisc::label(data$wt) <- "Weight"
Hmisc::label(data$qsec) = "1/4 mile time" Hmisc::label(data$qsec) <- "1/4 mile time"
Hmisc::label(data$vs) = "V engine?" Hmisc::label(data$vs) <- "V engine?"
Hmisc::label(data$am) = "Transmission" Hmisc::label(data$am) <- "Transmission"
Hmisc::label(data$gear) = "Number of forward gears" Hmisc::label(data$gear) <- "Number of forward gears"
Hmisc::label(data$carb) = "Number of carburetors" Hmisc::label(data$carb) <- "Number of carburetors"
Hmisc::label(data$color_available___red) = "Colors Available (choice=Red)" Hmisc::label(data$color_available___red) <-
Hmisc::label(data$color_available___green) = "Colors Available (choice=Green)" "Colors Available (choice<-Red)"
Hmisc::label(data$color_available___blue) = "Colors Available (choice=Blue)" Hmisc::label(data$color_available___green) <-
Hmisc::label(data$color_available___black) = "Colors Available (choice=Black)" "Colors Available (choice<-Green)"
Hmisc::label(data$motor_trend_cars_complete) = "Complete?" Hmisc::label(data$color_available___blue) <-
Hmisc::label(data$letter_group___a) = "Which group? (choice=A)" "Colors Available (choice<-Blue)"
Hmisc::label(data$letter_group___b) = "Which group? (choice=B)" Hmisc::label(data$color_available___black) <-
Hmisc::label(data$letter_group___c) = "Which group? (choice=C)" "Colors Available (choice<-Black)"
Hmisc::label(data$choice) = "Choose one" Hmisc::label(data$motor_trend_cars_complete) <- "Complete?"
Hmisc::label(data$grouping_complete) = "Complete?" Hmisc::label(data$letter_group___a) <- "Which group? (choice<-A)"
Hmisc::label(data$price) = "Sale price" Hmisc::label(data$letter_group___b) <- "Which group? (choice<-B)"
Hmisc::label(data$color) = "Color" Hmisc::label(data$letter_group___c) <- "Which group? (choice<-C)"
Hmisc::label(data$customer) = "Customer Name" Hmisc::label(data$choice) <- "Choose one"
Hmisc::label(data$sale_complete) = "Complete?" Hmisc::label(data$grouping_complete) <- "Complete?"
Hmisc::label(data$price) <- "Sale price"
Hmisc::label(data$color) <- "Color"
Hmisc::label(data$customer) <- "Customer Name"
Hmisc::label(data$sale_complete) <- "Complete?"
#Setting Units #Setting Units
#Setting Factors(will create new variable for factors) #Setting Factors(will create new variable for factors)
data$redcap_repeat_instrument.factor = factor(data$redcap_repeat_instrument, levels = data$redcap_repeat_instrument.factor <-
factor(data$redcap_repeat_instrument, levels <-
c("sale")) c("sale"))
data$cyl.factor = factor(data$cyl, levels = c("3", "4", "5", "6", "7", "8")) data$cyl.factor <-
data$vs.factor = factor(data$vs, levels = c("1", "0")) factor(data$cyl, levels <- c("3", "4", "5", "6", "7", "8"))
data$am.factor = factor(data$am, levels = c("0", "1")) data$vs.factor <- factor(data$vs, levels <- c("1", "0"))
data$gear.factor = factor(data$gear, levels = c("3", "4", "5")) data$am.factor <- factor(data$am, levels <- c("0", "1"))
data$carb.factor = factor(data$carb, levels = c("1", "2", "3", "4", "5", "6", "7", "8")) data$gear.factor <- factor(data$gear, levels <- c("3", "4", "5"))
data$color_available___red.factor = factor(data$color_available___red, levels = data$carb.factor <-
factor(data$carb, levels <-
c("1", "2", "3", "4", "5", "6", "7", "8"))
data$color_available___red.factor <-
factor(data$color_available___red, levels <-
c("0", "1")) c("0", "1"))
data$color_available___green.factor = factor(data$color_available___green, levels = data$color_available___green.factor <-
factor(data$color_available___green, levels <-
c("0", "1")) c("0", "1"))
data$color_available___blue.factor = factor(data$color_available___blue, levels = data$color_available___blue.factor <-
factor(data$color_available___blue, levels <-
c("0", "1")) c("0", "1"))
data$color_available___black.factor = factor(data$color_available___black, levels = data$color_available___black.factor <-
factor(data$color_available___black, levels <-
c("0", "1")) c("0", "1"))
data$motor_trend_cars_complete.factor = factor(data$motor_trend_cars_complete, levels = data$motor_trend_cars_complete.factor <-
factor(data$motor_trend_cars_complete, levels <-
c("0", "1", "2")) c("0", "1", "2"))
data$letter_group___a.factor = factor(data$letter_group___a, levels = data$letter_group___a.factor <-
factor(data$letter_group___a, levels <-
c("0", "1")) c("0", "1"))
data$letter_group___b.factor = factor(data$letter_group___b, levels = data$letter_group___b.factor <-
factor(data$letter_group___b, levels <-
c("0", "1")) c("0", "1"))
data$letter_group___c.factor = factor(data$letter_group___c, levels = data$letter_group___c.factor <-
factor(data$letter_group___c, levels <-
c("0", "1")) c("0", "1"))
data$choice.factor = factor(data$choice, levels = c("choice1", "choice2")) data$choice.factor <-
data$grouping_complete.factor = factor(data$grouping_complete, levels = factor(data$choice, levels <- c("choice1", "choice2"))
data$grouping_complete.factor <-
factor(data$grouping_complete, levels <-
c("0", "1", "2")) c("0", "1", "2"))
data$color.factor = factor(data$color, levels = c("1", "2", "3", "4")) data$color.factor <-
data$sale_complete.factor = factor(data$sale_complete, levels = c("0", "1", "2")) factor(data$color, levels <- c("1", "2", "3", "4"))
data$sale_complete.factor <-
factor(data$sale_complete, levels <- c("0", "1", "2"))
levels(data$redcap_repeat_instrument.factor) = c("Sale") levels(data$redcap_repeat_instrument.factor) <- c("Sale")
levels(data$cyl.factor) = c("3", "4", "5", "6", "7", "8") levels(data$cyl.factor) <- c("3", "4", "5", "6", "7", "8")
levels(data$vs.factor) = c("Yes", "No") levels(data$vs.factor) <- c("Yes", "No")
levels(data$am.factor) = c("Automatic", "Manual") levels(data$am.factor) <- c("Automatic", "Manual")
levels(data$gear.factor) = c("3", "4", "5") levels(data$gear.factor) <- c("3", "4", "5")
levels(data$carb.factor) = c("1", "2", "3", "4", "5", "6", "7", "8") levels(data$carb.factor) <-
levels(data$color_available___red.factor) = c("Unchecked", "Checked") c("1", "2", "3", "4", "5", "6", "7", "8")
levels(data$color_available___green.factor) = c("Unchecked", "Checked") levels(data$color_available___red.factor) <-
levels(data$color_available___blue.factor) = c("Unchecked", "Checked") c("Unchecked", "Checked")
levels(data$color_available___black.factor) = c("Unchecked", "Checked") levels(data$color_available___green.factor) <-
levels(data$motor_trend_cars_complete.factor) = c("Incomplete", "Unverified", "Complete") c("Unchecked", "Checked")
levels(data$letter_group___a.factor) = c("Unchecked", "Checked") levels(data$color_available___blue.factor) <-
levels(data$letter_group___b.factor) = c("Unchecked", "Checked") c("Unchecked", "Checked")
levels(data$letter_group___c.factor) = c("Unchecked", "Checked") levels(data$color_available___black.factor) <-
levels(data$choice.factor) = c("Choice 1", "Choice 2") c("Unchecked", "Checked")
levels(data$grouping_complete.factor) = c("Incomplete", "Unverified", "Complete") levels(data$motor_trend_cars_complete.factor) <-
levels(data$color.factor) = c("red", "green", "blue", "black") c("Incomplete", "Unverified", "Complete")
levels(data$sale_complete.factor) = c("Incomplete", "Unverified", "Complete") levels(data$letter_group___a.factor) <- c("Unchecked", "Checked")
levels(data$letter_group___b.factor) <- c("Unchecked", "Checked")
levels(data$letter_group___c.factor) <- c("Unchecked", "Checked")
levels(data$choice.factor) <- c("Choice 1", "Choice 2")
levels(data$grouping_complete.factor) <-
c("Incomplete", "Unverified", "Complete")
levels(data$color.factor) <- c("red", "green", "blue", "black")
levels(data$sale_complete.factor) <-
c("Incomplete", "Unverified", "Complete")
data data
} }

View File

@ -1,9 +1,12 @@
# Check the RCurl export --------------------------------------------------- # Check the RCurl export ---------------------------------------------------
test_that("JSON character vector from RCurl matches reference", { test_that("JSON character vector from RCurl matches reference", {
metadata <- jsonlite::fromJSON(get_data_location("ExampleProject_metadata.json")) metadata <-
jsonlite::fromJSON(get_data_location("ExampleProject_metadata.json"))
records <- jsonlite::fromJSON(get_data_location("ExampleProject_records.json")) records <-
jsonlite::fromJSON(get_data_location("ExampleProject_records.json"))
redcap_output_json1 <- REDCap_split(records, metadata) redcap_output_json1 <- REDCap_split(records, metadata)

View File

@ -1,11 +1,13 @@
# Set up the path and data ------------------------------------------------- # Set up the path and data -------------------------------------------------
metadata <- read.csv( metadata <- read.csv(
get_data_location("ExampleProject_DataDictionary_2018-06-07.csv"), get_data_location("ExampleProject_DataDictionary_2018-06-07.csv"),
stringsAsFactors = TRUE stringsAsFactors = TRUE
) )
records <- read.csv(get_data_location("ExampleProject_DATA_2018-06-07_1129.csv"), records <-
read.csv(get_data_location("ExampleProject_DATA_2018-06-07_1129.csv"),
stringsAsFactors = TRUE) stringsAsFactors = TRUE)
redcap_output_csv1 <- REDCap_split(records, metadata) redcap_output_csv1 <- REDCap_split(records, metadata)
@ -18,16 +20,18 @@ test_that("CSV export matches reference", {
# Test that REDCap_split can handle a focused dataset # Test that REDCap_split can handle a focused dataset
records_red <- records[!records$redcap_repeat_instrument == "sale", records_red <- records[!records$redcap_repeat_instrument == "sale",
!names(records) %in% metadata$field_name[metadata$form_name == "sale"] & !names(records) %in%
metadata$field_name[metadata$form_name == "sale"] &
!names(records) == "sale_complete"] !names(records) == "sale_complete"]
records_red$redcap_repeat_instrument <- as.character(records_red$redcap_repeat_instrument) records_red$redcap_repeat_instrument <-
as.character(records_red$redcap_repeat_instrument)
redcap_output_red <- REDCap_split(records_red, metadata) redcap_output_red <- REDCap_split(records_red, metadata)
test_that("REDCap_split handles subset dataset", test_that("REDCap_split handles subset dataset",
{ {
testthat::expect_length(redcap_output_red,1) testthat::expect_length(redcap_output_red, 1)
}) })
@ -37,17 +41,20 @@ if (requireNamespace("Hmisc", quietly = TRUE)) {
redcap_output_csv2 <- redcap_output_csv2 <-
REDCap_split(REDCap_process_csv(records), metadata) REDCap_split(REDCap_process_csv(records), metadata)
expect_known_hash(redcap_output_csv2, "34f82cab35bf8aae47d08cd96f743e6b") expect_known_hash(redcap_output_csv2, "6d8d0462ab2343b848a086ab06b50fe3")
}) })
} }
if (requireNamespace("readr", quietly = TRUE)) { if (requireNamespace("readr", quietly = TRUE)) {
context("Compatibility with readr")
metadata <- readr::read_csv(get_data_location("ExampleProject_DataDictionary_2018-06-07.csv")) metadata <-
readr::read_csv(get_data_location(
"ExampleProject_DataDictionary_2018-06-07.csv"))
records <- readr::read_csv(get_data_location("ExampleProject_DATA_2018-06-07_1129.csv")) records <-
readr::read_csv(get_data_location(
"ExampleProject_DATA_2018-06-07_1129.csv"))
redcap_output_readr <- REDCap_split(records, metadata) redcap_output_readr <- REDCap_split(records, metadata)
@ -57,11 +64,14 @@ if (requireNamespace("readr", quietly = TRUE)) {
lapply(redcap_output_csv1, FUN)) lapply(redcap_output_csv1, FUN))
} }
test_that("Result of data read in with `readr` will match result with `read.csv`", test_that("Result of data read in with `readr` will
match result with `read.csv`",
{ {
# The list itself # The list itself
expect_identical(length(redcap_output_readr), length(redcap_output_csv1)) expect_identical(length(redcap_output_readr),
expect_identical(names(redcap_output_readr), names(redcap_output_csv1)) length(redcap_output_csv1))
expect_identical(names(redcap_output_readr),
names(redcap_output_csv1))
# Each element of the list # Each element of the list
expect_matching_elements(names) expect_matching_elements(names)
@ -69,5 +79,3 @@ if (requireNamespace("readr", quietly = TRUE)) {
}) })
} }

View File

@ -1,5 +1,6 @@
# Global variables -------------------------------------------------------- # Global variables --------------------------------------------------------
# Cars # Cars
@ -12,14 +13,15 @@ records <-
redcap_output_json <- REDCap_split(records, metadata, forms = "all") redcap_output_json <- REDCap_split(records, metadata, forms = "all")
# Longitudinal # Longitudinal
file_paths <- sapply( file_paths <- vapply(
c(records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv", c(records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"), metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"),
FUN.VALUE = "character",
get_data_location get_data_location
) )
redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE) redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)
redcap[["metadata"]] <- with(redcap, metadata[metadata[, 1] > "",]) redcap[["metadata"]] <- with(redcap, metadata[metadata[, 1] > "", ])
redcap_output_long <- redcap_output_long <-
with(redcap, REDCap_split(records, metadata, forms = "all")) with(redcap, REDCap_split(records, metadata, forms = "all"))
redcap_long_names <- names(redcap[[1]]) redcap_long_names <- names(redcap[[1]])
@ -35,7 +37,7 @@ test_that("Each form is an element in the list", {
test_that("All variables land somewhere", { test_that("All variables land somewhere", {
expect_true(setequal(names(records), Reduce( expect_true(setequal(names(records), Reduce(
"union", sapply(redcap_output_json, names) "union", lapply(redcap_output_json, names)
))) )))
}) })
@ -47,11 +49,8 @@ test_that("Primary table name is ignored", {
}) })
test_that("Supports longitudinal data", { 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( expect_true(setequal(redcap_long_names, Reduce(
"union", sapply(redcap_output_long, names) "union", lapply(redcap_output_long, names)
))) )))
}) })

View File

@ -1,11 +1,11 @@
## "Longitudinal data" ## "Longitudinal data"
test_that("CSV export matches reference", { test_that("CSV export matches reference", {
file_paths <- sapply( file_paths <- vapply(
c( c(
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv", records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv" metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"
), get_data_location ), get_data_location, FUN.VALUE = "character"
) )
redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE) redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)

View File

@ -2,15 +2,18 @@
# Global variables ------------------------------------------------------- # Global variables -------------------------------------------------------
metadata <- jsonlite::fromJSON(get_data_location("ExampleProject_metadata.json")) metadata <-
jsonlite::fromJSON(get_data_location("ExampleProject_metadata.json"))
records <- jsonlite::fromJSON(get_data_location("ExampleProject_records.json")) records <-
jsonlite::fromJSON(get_data_location("ExampleProject_records.json"))
ref_hash <- "2c8b6531597182af1248f92124161e0c" ref_hash <- "2c8b6531597182af1248f92124161e0c"
# Tests ------------------------------------------------------------------- # Tests -------------------------------------------------------------------
test_that("Will not use a repeating instrument name for primary table", { test_that("Will not use a repeating instrument name for primary table", {
redcap_output_json1 <- expect_warning(REDCap_split(records, metadata, "sale"), redcap_output_json1 <-
expect_warning(REDCap_split(records, metadata, "sale"),
"primary table") "primary table")
expect_known_hash(redcap_output_json1, ref_hash) expect_known_hash(redcap_output_json1, ref_hash)

View File

@ -1,33 +1,46 @@
test_that("redcap_wider() returns expected output", { test_that("redcap_wider() returns expected output", {
list <- list(data.frame(record_id = c(1,2,1,2), redcap_event_name = c("baseline", "baseline", "followup", "followup"), age = c(25,26,27,28)), list <-
data.frame(record_id = c(1,2), redcap_event_name = c("baseline", "baseline"), gender = c("male", "female"))) list(
data.frame(
record_id = c(1, 2, 1, 2),
redcap_event_name = c("baseline", "baseline", "followup", "followup"),
age = c(25, 26, 27, 28)
),
data.frame(
record_id = c(1, 2),
redcap_event_name = c("baseline", "baseline"),
gender = c("male", "female")
)
)
expect_equal(redcap_wider(list), expect_equal(
data.frame(record_id = c(1,2), redcap_wider(list),
age_baseline = c(25,26), data.frame(
age_followup = c(27,28), record_id = c(1, 2),
gender = c("male","female"))) age_baseline = c(25, 26),
age_followup = c(27, 28),
gender = c("male", "female")
)
)
}) })
# Using test data # Using test data
# Set up the path and data ------------------------------------------------- # Set up the path and data -------------------------------------------------
file_paths <- sapply( file_paths <- lapply(
c(records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv", c(records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"), metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"),
get_data_location get_data_location
) )
redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE) redcap <- lapply(file_paths, read.csv, stringsAsFactors = FALSE)
redcap[["metadata"]] <- with(redcap, metadata[metadata[, 1] > "",]) redcap[["metadata"]] <- with(redcap, metadata[metadata[, 1] > "", ])
list <- list <-
with(redcap, REDCap_split(records, metadata, forms = "all")) with(redcap, REDCap_split(records, metadata, forms = "all"))
wide_ds <- redcap_wider(list) wide_ds <- redcap_wider(list)
test_that("redcap_wider() returns wide output from CSV",{ test_that("redcap_wider() returns wide output from CSV", {
expect_equal(ncol(wide_ds),171) expect_equal(ncol(wide_ds), 171)
}) })

2
vignettes/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*.html
*.R

View File

@ -0,0 +1,76 @@
---
title: "Introduction"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Introduction}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
```{r setup}
library(REDCapCAST)
```
This vignette covers the included functions and basic functionality.
## Splitting the dataset
```{r eval=FALSE}
keyring::key_set("handbook_api")
keyring::key_set("cast_api")
```
```{r include=FALSE}
uri <- keyring::key_get("DB_URI")
```
```{r}
dataset <- REDCapR::redcap_read_oneshot(redcap_uri = uri,
token = keyring::key_get("cast_api"))$data
dataset |> gt::gt()
```
```{r}
metadata <- REDCapR::redcap_metadata_read(redcap_uri = uri,
token = keyring::key_get("cast_api"))$data
metadata |> gt::gt()
```
```{r}
list <-
REDCapCAST::REDCap_split(records = dataset,
metadata = metadata,
forms = "repeating")
str(list)
```
```{r}
list <-
REDCapCAST::REDCap_split(records = dataset,
metadata = metadata,
forms = "all")
str(list)
```
## Reading data from REDCap
```{r}
ds <- read_redcap_tables(uri = uri, token = keyring::key_get("cast_api"))
str(ds)
```
## Pivotting to wider format
```{r}
redcap_wider(ds) |> gt::gt()
```