gp with CRAN in sight

This commit is contained in:
AG Damsbo 2023-04-13 10:57:04 +02:00
commit 349ff695e1
24 changed files with 338 additions and 157 deletions

View file

@ -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)

View file

@ -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 =
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 =
c("0", "1"))
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 =
c("0", "1"))
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 =
c("0", "1", "2"))
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 =
c("0", "1"))
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 =
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$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 <-
c("0", "1"))
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 <-
c("0", "1"))
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 <-
c("0", "1", "2"))
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 <-
c("0", "1"))
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 <-
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
}

View file

@ -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)

View file

@ -1,12 +1,14 @@
# 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"),
stringsAsFactors = TRUE)
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) == "sale_complete"]
records_red$redcap_repeat_instrument <- as.character(records_red$redcap_repeat_instrument)
!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)
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)) {
})
}

View file

@ -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)
)))
})

View file

@ -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)

View file

@ -2,16 +2,19 @@
# 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"),
"primary table")
redcap_output_json1 <-
expect_warning(REDCap_split(records, metadata, "sale"),
"primary table")
expect_known_hash(redcap_output_json1, ref_hash)

View file

@ -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)
})