mirror of
https://github.com/agdamsbo/REDCapCAST.git
synced 2024-11-22 05:20:23 +01:00
gp with CRAN in sight
This commit is contained in:
AG Damsbo
parent
20f08c271b
commit
349ff695e1
1
.gitignore
vendored
1
.gitignore
vendored
@ -3,3 +3,4 @@
|
||||
.Rproj.user
|
||||
test-data/
|
||||
|
||||
inst/doc
|
||||
|
||||
15
DESCRIPTION
15
DESCRIPTION
@ -1,10 +1,10 @@
|
||||
Package: REDCapCAST
|
||||
Title: REDCap Castellated data handling
|
||||
Version: 23.3.2
|
||||
Version: 23.4.1
|
||||
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("cre", "ctb","cph"),
|
||||
comment = c(ORCID = "0000-0002-7559-1154")))
|
||||
person("Andreas Gammelgaard", "Damsbo", email = "agdamsbo@clin.au.dk", role = c("aut", "cre"),
|
||||
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.
|
||||
See [https://github.com/SpectrumHealthResearch/REDCapRITS](https://github.com/SpectrumHealthResearch/REDCapRITS).
|
||||
Handle the castellated dataset from REDCap projects with repeating
|
||||
@ -27,7 +27,11 @@ Suggests:
|
||||
testthat,
|
||||
Hmisc,
|
||||
readr,
|
||||
covr
|
||||
covr,
|
||||
knitr,
|
||||
rmarkdown,
|
||||
gt,
|
||||
keyring
|
||||
License: GPL (>= 3)
|
||||
Encoding: UTF-8
|
||||
LazyData: true
|
||||
@ -46,3 +50,4 @@ Collate:
|
||||
'read_redcap_tables.R'
|
||||
'redcap_wider.R'
|
||||
Language: en-US
|
||||
VignetteBuilder: knitr
|
||||
|
||||
6
NEWS.md
6
NEWS.md
@ -1,3 +1,9 @@
|
||||
# REDCapCAST 23.4.1
|
||||
|
||||
### Documentation:
|
||||
|
||||
* Aiming for CRAN
|
||||
|
||||
# REDCapCAST 23.3.2
|
||||
|
||||
### Documentation:
|
||||
|
||||
@ -48,15 +48,16 @@
|
||||
#' records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv")
|
||||
#'
|
||||
#' # 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
|
||||
#' REDCapRITS::REDCap_split(records, metadata)
|
||||
#'
|
||||
#' # In conjunction with the R export script ---------------------------------
|
||||
#'
|
||||
#' # You must set the working directory first since the REDCap data export script
|
||||
#' # contains relative file references.
|
||||
#' # You must set the working directory first since the REDCap data export
|
||||
#' # script contains relative file references.
|
||||
#' setwd("/path/to/data/")
|
||||
#'
|
||||
#' # Run the data export script supplied by REDCap.
|
||||
@ -148,7 +149,8 @@ REDCap_split <- function(records,
|
||||
|
||||
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."
|
||||
"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 <- ""
|
||||
} else if (primary_table_name > "") {
|
||||
@ -159,7 +161,8 @@ REDCap_split <- function(records,
|
||||
for (i in names(out)) {
|
||||
if (i == primary_table_name) {
|
||||
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_fields]
|
||||
|
||||
|
||||
@ -1,10 +1,9 @@
|
||||
#' Download REDCap data
|
||||
#'
|
||||
#' Implementation of REDCap_split with a focused data acquisition approach using
|
||||
#' REDCapR::redcap_read nad only downloading specified fields, forms and/or events
|
||||
#' using the built-in focused_metadata
|
||||
#' including some clean-up. Works with longitudinal projects with repeating
|
||||
#' instruments.
|
||||
#' REDCapR::redcap_read nad only downloading specified fields, forms and/or
|
||||
#' events using the built-in focused_metadata including some clean-up.
|
||||
#' Works with longitudinal projects with repeating instruments.
|
||||
#' @param uri REDCap database uri
|
||||
#' @param token API token
|
||||
#' @param records records to download
|
||||
@ -12,7 +11,8 @@
|
||||
#' @param events events to download
|
||||
#' @param forms forms to download
|
||||
#' @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
|
||||
#' ignore when discarding empty rows
|
||||
#'
|
||||
@ -73,7 +73,8 @@ read_redcap_tables <- function(uri,
|
||||
)[["data"]]
|
||||
|
||||
# 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)) {
|
||||
d$redcap_repeat_instrument <-
|
||||
gsub("[^a-z0-9_]", "", gsub(" ", "_", tolower(d$redcap_repeat_instrument)))
|
||||
|
||||
@ -27,7 +27,8 @@ redcap_wider <-
|
||||
inst.glue = "{.value}_{redcap_repeat_instance}") {
|
||||
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(
|
||||
"The dataset does not include a 'redcap_event_name' variable.
|
||||
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]
|
||||
|
||||
l <- lapply(list, function(i) {
|
||||
|
||||
@ -138,7 +138,8 @@ match_fields_to_form <- function(metadata, vars_in_data) {
|
||||
names(fields) <- c("field_name", "form_name")
|
||||
|
||||
# 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(
|
||||
field_name = paste0(form_names, "_complete"),
|
||||
form_name = form_names,
|
||||
|
||||
24
README.md
24
README.md
@ -9,7 +9,27 @@ experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](h
|
||||
# REDCapCAST
|
||||
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")
|
||||
```
|
||||
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
pandoc: 2.19.2
|
||||
pkgdown: 2.0.7
|
||||
pkgdown_sha: ~
|
||||
articles: {}
|
||||
last_built: 2023-03-08T19:18Z
|
||||
articles:
|
||||
Introduction: Introduction.html
|
||||
last_built: 2023-04-13T08:56Z
|
||||
|
||||
|
||||
File diff suppressed because one or more lines are too long
@ -6,6 +6,12 @@
|
||||
<url>
|
||||
<loc>/LICENSE.html</loc>
|
||||
</url>
|
||||
<url>
|
||||
<loc>/articles/Introduction.html</loc>
|
||||
</url>
|
||||
<url>
|
||||
<loc>/articles/index.html</loc>
|
||||
</url>
|
||||
<url>
|
||||
<loc>/authors.html</loc>
|
||||
</url>
|
||||
|
||||
@ -1,21 +1,29 @@
|
||||
CMD
|
||||
Codecov
|
||||
DataDictionary
|
||||
GStat
|
||||
GithubActions
|
||||
JSON
|
||||
Lifecycle
|
||||
Pivotting
|
||||
README
|
||||
REDCap
|
||||
REDCapR
|
||||
REDCapRITS
|
||||
SpectrumHealthResearch
|
||||
Splitter
|
||||
api
|
||||
descirption
|
||||
desireable
|
||||
doi
|
||||
dplyr
|
||||
github
|
||||
https
|
||||
immprovements
|
||||
jbi
|
||||
matadata
|
||||
md
|
||||
nad
|
||||
og
|
||||
thorugh
|
||||
tidyverse
|
||||
uri
|
||||
|
||||
@ -74,15 +74,16 @@ REDCapRITS::REDCap_split(records, metadata)
|
||||
records <- read.csv("/path/to/data/ExampleProject_DATA_2018-06-03_1700.csv")
|
||||
|
||||
# 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
|
||||
REDCapRITS::REDCap_split(records, metadata)
|
||||
|
||||
# In conjunction with the R export script ---------------------------------
|
||||
|
||||
# You must set the working directory first since the REDCap data export script
|
||||
# contains relative file references.
|
||||
# You must set the working directory first since the REDCap data export
|
||||
# script contains relative file references.
|
||||
setwd("/path/to/data/")
|
||||
|
||||
# Run the data export script supplied by REDCap.
|
||||
|
||||
@ -32,7 +32,8 @@ read_redcap_tables(
|
||||
|
||||
\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
|
||||
ignore when discarding empty rows}
|
||||
@ -42,10 +43,9 @@ list of instruments
|
||||
}
|
||||
\description{
|
||||
Implementation of REDCap_split with a focused data acquisition approach using
|
||||
REDCapR::redcap_read nad only downloading specified fields, forms and/or events
|
||||
using the built-in focused_metadata
|
||||
including some clean-up. Works with longitudinal projects with repeating
|
||||
instruments.
|
||||
REDCapR::redcap_read nad only downloading specified fields, forms and/or
|
||||
events using the built-in focused_metadata including some clean-up.
|
||||
Works with longitudinal projects with repeating instruments.
|
||||
}
|
||||
\examples{
|
||||
# Examples will be provided later
|
||||
|
||||
@ -37,11 +37,11 @@ REDCap_split(
|
||||
|
||||
# Longitudinal data from @pbchase; Issue #7 -------------------------------
|
||||
|
||||
file_paths <- sapply(
|
||||
file_paths <- vapply(
|
||||
c(
|
||||
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.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)
|
||||
|
||||
@ -4,85 +4,113 @@ REDCap_process_csv <- function(data) {
|
||||
stop("This test requires the 'Hmisc' package")
|
||||
}
|
||||
|
||||
Hmisc::label(data$row) = "Name"
|
||||
Hmisc::label(data$redcap_repeat_instrument) = "Repeat Instrument"
|
||||
Hmisc::label(data$redcap_repeat_instance) = "Repeat Instance"
|
||||
Hmisc::label(data$mpg) = "Miles/(US) gallon"
|
||||
Hmisc::label(data$cyl) = "Number of cylinders"
|
||||
Hmisc::label(data$disp) = "Displacement"
|
||||
Hmisc::label(data$hp) = "Gross horsepower"
|
||||
Hmisc::label(data$drat) = "Rear axle ratio"
|
||||
Hmisc::label(data$wt) = "Weight"
|
||||
Hmisc::label(data$qsec) = "1/4 mile time"
|
||||
Hmisc::label(data$vs) = "V engine?"
|
||||
Hmisc::label(data$am) = "Transmission"
|
||||
Hmisc::label(data$gear) = "Number of forward gears"
|
||||
Hmisc::label(data$carb) = "Number of carburetors"
|
||||
Hmisc::label(data$color_available___red) = "Colors Available (choice=Red)"
|
||||
Hmisc::label(data$color_available___green) = "Colors Available (choice=Green)"
|
||||
Hmisc::label(data$color_available___blue) = "Colors Available (choice=Blue)"
|
||||
Hmisc::label(data$color_available___black) = "Colors Available (choice=Black)"
|
||||
Hmisc::label(data$motor_trend_cars_complete) = "Complete?"
|
||||
Hmisc::label(data$letter_group___a) = "Which group? (choice=A)"
|
||||
Hmisc::label(data$letter_group___b) = "Which group? (choice=B)"
|
||||
Hmisc::label(data$letter_group___c) = "Which group? (choice=C)"
|
||||
Hmisc::label(data$choice) = "Choose one"
|
||||
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?"
|
||||
Hmisc::label(data$row) <- "Name"
|
||||
Hmisc::label(data$redcap_repeat_instrument) <- "Repeat Instrument"
|
||||
Hmisc::label(data$redcap_repeat_instance) <- "Repeat Instance"
|
||||
Hmisc::label(data$mpg) <- "Miles/(US) gallon"
|
||||
Hmisc::label(data$cyl) <- "Number of cylinders"
|
||||
Hmisc::label(data$disp) <- "Displacement"
|
||||
Hmisc::label(data$hp) <- "Gross horsepower"
|
||||
Hmisc::label(data$drat) <- "Rear axle ratio"
|
||||
Hmisc::label(data$wt) <- "Weight"
|
||||
Hmisc::label(data$qsec) <- "1/4 mile time"
|
||||
Hmisc::label(data$vs) <- "V engine?"
|
||||
Hmisc::label(data$am) <- "Transmission"
|
||||
Hmisc::label(data$gear) <- "Number of forward gears"
|
||||
Hmisc::label(data$carb) <- "Number of carburetors"
|
||||
Hmisc::label(data$color_available___red) <-
|
||||
"Colors Available (choice<-Red)"
|
||||
Hmisc::label(data$color_available___green) <-
|
||||
"Colors Available (choice<-Green)"
|
||||
Hmisc::label(data$color_available___blue) <-
|
||||
"Colors Available (choice<-Blue)"
|
||||
Hmisc::label(data$color_available___black) <-
|
||||
"Colors Available (choice<-Black)"
|
||||
Hmisc::label(data$motor_trend_cars_complete) <- "Complete?"
|
||||
Hmisc::label(data$letter_group___a) <- "Which group? (choice<-A)"
|
||||
Hmisc::label(data$letter_group___b) <- "Which group? (choice<-B)"
|
||||
Hmisc::label(data$letter_group___c) <- "Which group? (choice<-C)"
|
||||
Hmisc::label(data$choice) <- "Choose one"
|
||||
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 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"))
|
||||
data$cyl.factor = factor(data$cyl, levels = c("3", "4", "5", "6", "7", "8"))
|
||||
data$vs.factor = factor(data$vs, levels = c("1", "0"))
|
||||
data$am.factor = factor(data$am, levels = c("0", "1"))
|
||||
data$gear.factor = factor(data$gear, levels = c("3", "4", "5"))
|
||||
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 =
|
||||
data$cyl.factor <-
|
||||
factor(data$cyl, levels <- c("3", "4", "5", "6", "7", "8"))
|
||||
data$vs.factor <- factor(data$vs, levels <- c("1", "0"))
|
||||
data$am.factor <- factor(data$am, levels <- c("0", "1"))
|
||||
data$gear.factor <- factor(data$gear, levels <- c("3", "4", "5"))
|
||||
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"))
|
||||
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"))
|
||||
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"))
|
||||
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"))
|
||||
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"))
|
||||
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"))
|
||||
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"))
|
||||
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"))
|
||||
data$choice.factor = factor(data$choice, levels = c("choice1", "choice2"))
|
||||
data$grouping_complete.factor = factor(data$grouping_complete, levels =
|
||||
data$choice.factor <-
|
||||
factor(data$choice, levels <- c("choice1", "choice2"))
|
||||
data$grouping_complete.factor <-
|
||||
factor(data$grouping_complete, levels <-
|
||||
c("0", "1", "2"))
|
||||
data$color.factor = factor(data$color, levels = c("1", "2", "3", "4"))
|
||||
data$sale_complete.factor = factor(data$sale_complete, levels = c("0", "1", "2"))
|
||||
data$color.factor <-
|
||||
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$cyl.factor) = c("3", "4", "5", "6", "7", "8")
|
||||
levels(data$vs.factor) = c("Yes", "No")
|
||||
levels(data$am.factor) = c("Automatic", "Manual")
|
||||
levels(data$gear.factor) = c("3", "4", "5")
|
||||
levels(data$carb.factor) = c("1", "2", "3", "4", "5", "6", "7", "8")
|
||||
levels(data$color_available___red.factor) = c("Unchecked", "Checked")
|
||||
levels(data$color_available___green.factor) = c("Unchecked", "Checked")
|
||||
levels(data$color_available___blue.factor) = c("Unchecked", "Checked")
|
||||
levels(data$color_available___black.factor) = c("Unchecked", "Checked")
|
||||
levels(data$motor_trend_cars_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")
|
||||
levels(data$redcap_repeat_instrument.factor) <- c("Sale")
|
||||
levels(data$cyl.factor) <- c("3", "4", "5", "6", "7", "8")
|
||||
levels(data$vs.factor) <- c("Yes", "No")
|
||||
levels(data$am.factor) <- c("Automatic", "Manual")
|
||||
levels(data$gear.factor) <- c("3", "4", "5")
|
||||
levels(data$carb.factor) <-
|
||||
c("1", "2", "3", "4", "5", "6", "7", "8")
|
||||
levels(data$color_available___red.factor) <-
|
||||
c("Unchecked", "Checked")
|
||||
levels(data$color_available___green.factor) <-
|
||||
c("Unchecked", "Checked")
|
||||
levels(data$color_available___blue.factor) <-
|
||||
c("Unchecked", "Checked")
|
||||
levels(data$color_available___black.factor) <-
|
||||
c("Unchecked", "Checked")
|
||||
levels(data$motor_trend_cars_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
|
||||
}
|
||||
|
||||
@ -1,9 +1,12 @@
|
||||
|
||||
|
||||
# Check the RCurl export ---------------------------------------------------
|
||||
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)
|
||||
|
||||
|
||||
@ -1,11 +1,13 @@
|
||||
|
||||
|
||||
# Set up the path and data -------------------------------------------------
|
||||
metadata <- read.csv(
|
||||
get_data_location("ExampleProject_DataDictionary_2018-06-07.csv"),
|
||||
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)
|
||||
|
||||
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
|
||||
|
||||
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"]
|
||||
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)
|
||||
|
||||
|
||||
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_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)) {
|
||||
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)
|
||||
|
||||
@ -57,11 +64,14 @@ if (requireNamespace("readr", quietly = TRUE)) {
|
||||
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
|
||||
expect_identical(length(redcap_output_readr), length(redcap_output_csv1))
|
||||
expect_identical(names(redcap_output_readr), names(redcap_output_csv1))
|
||||
expect_identical(length(redcap_output_readr),
|
||||
length(redcap_output_csv1))
|
||||
expect_identical(names(redcap_output_readr),
|
||||
names(redcap_output_csv1))
|
||||
|
||||
# Each element of the list
|
||||
expect_matching_elements(names)
|
||||
@ -69,5 +79,3 @@ if (requireNamespace("readr", quietly = TRUE)) {
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -1,5 +1,6 @@
|
||||
|
||||
|
||||
|
||||
# Global variables --------------------------------------------------------
|
||||
|
||||
# Cars
|
||||
@ -12,14 +13,15 @@ records <-
|
||||
redcap_output_json <- REDCap_split(records, metadata, forms = "all")
|
||||
|
||||
# Longitudinal
|
||||
file_paths <- sapply(
|
||||
file_paths <- vapply(
|
||||
c(records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.csv",
|
||||
metadata = "WARRIORtestForSoftwareUpgrades_DataDictionary_2018-06-21.csv"),
|
||||
FUN.VALUE = "character",
|
||||
get_data_location
|
||||
)
|
||||
|
||||
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 <-
|
||||
with(redcap, REDCap_split(records, metadata, forms = "all"))
|
||||
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", {
|
||||
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", {
|
||||
# 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)
|
||||
"union", lapply(redcap_output_long, names)
|
||||
)))
|
||||
|
||||
})
|
||||
|
||||
@ -1,11 +1,11 @@
|
||||
## "Longitudinal data"
|
||||
|
||||
test_that("CSV export matches reference", {
|
||||
file_paths <- sapply(
|
||||
file_paths <- vapply(
|
||||
c(
|
||||
records = "WARRIORtestForSoftwa_DATA_2018-06-21_1431.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)
|
||||
|
||||
@ -2,15 +2,18 @@
|
||||
|
||||
|
||||
# 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"
|
||||
|
||||
# Tests -------------------------------------------------------------------
|
||||
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")
|
||||
|
||||
expect_known_hash(redcap_output_json1, ref_hash)
|
||||
|
||||
@ -1,33 +1,46 @@
|
||||
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)),
|
||||
data.frame(record_id = c(1,2), redcap_event_name = c("baseline", "baseline"), gender = c("male", "female")))
|
||||
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)
|
||||
),
|
||||
data.frame(
|
||||
record_id = c(1, 2),
|
||||
redcap_event_name = c("baseline", "baseline"),
|
||||
gender = c("male", "female")
|
||||
)
|
||||
)
|
||||
|
||||
expect_equal(redcap_wider(list),
|
||||
data.frame(record_id = c(1,2),
|
||||
age_baseline = c(25,26),
|
||||
age_followup = c(27,28),
|
||||
gender = c("male","female")))
|
||||
expect_equal(
|
||||
redcap_wider(list),
|
||||
data.frame(
|
||||
record_id = c(1, 2),
|
||||
age_baseline = c(25, 26),
|
||||
age_followup = c(27, 28),
|
||||
gender = c("male", "female")
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
|
||||
# Using test data
|
||||
|
||||
# Set up the path and data -------------------------------------------------
|
||||
file_paths <- sapply(
|
||||
file_paths <- lapply(
|
||||
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[["metadata"]] <- with(redcap, metadata[metadata[, 1] > "", ])
|
||||
list <-
|
||||
with(redcap, REDCap_split(records, metadata, forms = "all"))
|
||||
|
||||
wide_ds <- redcap_wider(list)
|
||||
|
||||
test_that("redcap_wider() returns wide output from CSV",{
|
||||
expect_equal(ncol(wide_ds),171)
|
||||
test_that("redcap_wider() returns wide output from CSV", {
|
||||
expect_equal(ncol(wide_ds), 171)
|
||||
})
|
||||
|
||||
|
||||
|
||||
2
vignettes/.gitignore
vendored
Normal file
2
vignettes/.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
*.html
|
||||
*.R
|
||||
76
vignettes/Introduction.Rmd
Normal file
76
vignettes/Introduction.Rmd
Normal 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()
|
||||
```
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user