Skip to content

Commit

Permalink
return tibble instead of data.frame
Browse files Browse the repository at this point in the history
ref #415
  • Loading branch information
wibeasley committed Aug 30, 2022
1 parent d9a5013 commit 5683b9d
Show file tree
Hide file tree
Showing 15 changed files with 135 additions and 42 deletions.
6 changes: 3 additions & 3 deletions R/redcap-read-oneshot.R
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@
#' `httr` package. See the details below. Optional.
#'
#' @return Currently, a list is returned with the following elements:
#' * `data`: An R [base::data.frame()] of the desired records and columns.
#' * `data`: A [tibble::tibble()] of the desired records and columns.
#' * `success`: A boolean value indicating if the operation was apparently
#' successful.
#' * `status_code`: The
Expand Down Expand Up @@ -336,7 +336,7 @@ redcap_read_oneshot <- function(
# Override the 'success' determination from the http status code.
# and return an empty data.frame.
kernel$success <- FALSE
ds <- data.frame()
ds <- tibble::tibble()
outcome_message <- sprintf(
"The REDCap read failed. The http status code was %i. The 'raw_text' returned was '%s'.",
kernel$status_code,
Expand All @@ -345,7 +345,7 @@ redcap_read_oneshot <- function(
# nocov end
}
} else { # kernel fails
ds <- data.frame() #Return an empty data.frame
ds <- tibble::tibble() # Return an empty data.frame
outcome_message <- if (any(grepl(kernel$regex_empty, kernel$raw_text))) {
"The REDCapR read/export operation was not successful. The returned dataset was empty." # nocov
} else {
Expand Down
10 changes: 5 additions & 5 deletions R/redcap-read.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#' @description From an external perspective, this function is similar to
#' [redcap_read_oneshot()]. The internals differ in that `redcap_read`
#' retrieves subsets of the data, and then combines them before returning
#' (among other objects) a single [base::data.frame()]. This function can
#' (among other objects) a single [tibble::tibble()]. This function can
#' be more appropriate than [redcap_read_oneshot()] when returning large
#' datasets that could tie up the server.
#'
Expand Down Expand Up @@ -100,7 +100,7 @@
#' This defaults to the first variable in the dataset.
#'
#' @return Currently, a list is returned with the following elements:
#' * `data`: An R [base::data.frame()] of the desired records and columns.
#' * `data`: A [tibble::tibble()] of the desired records and columns.
#' * `success`: A boolean value indicating if the operation was apparently
#' successful.
#' * `status_codes`: A collection of
Expand All @@ -122,7 +122,7 @@
#' through the REDCap API. The long list is then subsetted into batches,
#' whose sizes are determined by the `batch_size` parameter. REDCap is then
#' queried for all variables of the subset's subjects. This is repeated for
#' each subset, before returning a unified [base::data.frame()].
#' each subset, before returning a unified [tibble::tibble()].
#'
#' The function allows a delay between calls, which allows the server to
#' attend to other users' requests (such as the users entering data in a
Expand Down Expand Up @@ -300,7 +300,7 @@ redcap_read <- function(
outcome_messages <- paste0("The initial call failed with the code: ", initial_call$status_code, ".")
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
return(list(
data = data.frame(),
data = tibble::tibble(),
records_collapsed = "failed in initial batch call",
fields_collapsed = "failed in initial batch call",
forms_collapsed = "failed in initial batch call",
Expand Down Expand Up @@ -402,7 +402,7 @@ redcap_read <- function(
rm(read_result) #Admittedly overkill defensiveness.
}

ds_stacked <- as.data.frame(dplyr::bind_rows(lst_batch))
ds_stacked <- dplyr::bind_rows(lst_batch)

if (is.null(col_types) && guess_type) {
ds_stacked <-
Expand Down
6 changes: 3 additions & 3 deletions man/redcap_read.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/redcap_read_oneshot.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

24 changes: 16 additions & 8 deletions tests/testthat/test-read-batch-longitudinal.R
Original file line number Diff line number Diff line change
Expand Up @@ -32,12 +32,13 @@ test_that("smoke", {
test_that("so-example-data-frame-retrieval", {
path_expected <- "test-data/project-longitudinal/expected/so-example-data-frame-retrieval.R"

actual <- data.frame(a=1:5, b=6:10)
actual <- tibble::tibble(a=1:5, b=6:10)

if (update_expectation) save_expected(actual, path_expected)
expected_data_frame <- retrieve_expected(path_expected)

expect_equal(actual, expected_data_frame, label="The returned data.frame should be correct")
expect_equal(actual, expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE)
expect_s3_class(actual, "tbl")
})

test_that("default", {
Expand All @@ -55,13 +56,14 @@ test_that("default", {
if (update_expectation) save_expected(returned_object1$data, path_expected)
expected_data_frame <- retrieve_expected(path_expected)

expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object1$data)
expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object1$data)
expect_true(returned_object1$success)
expect_match(returned_object1$status_codes, regexp="200", perl=TRUE)
expect_true(returned_object1$records_collapsed=="", "A subset of records was not requested.")
expect_true(returned_object1$fields_collapsed=="", "A subset of fields was not requested.")
expect_true(nchar(returned_object1$filter_logic)==0L, "A filter was not specified.")
expect_match(returned_object1$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
expect_s3_class(returned_object1$data, "tbl")

###########################
## Tiny Batch size
Expand All @@ -70,13 +72,14 @@ test_that("default", {
returned_object2 <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, batch_size=8)
)

expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object2$data)
expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object2$data)
expect_true(returned_object2$success)
expect_match(returned_object2$status_codes, regexp="200", perl=TRUE)
expect_true(returned_object2$records_collapsed=="", "A subset of records was not requested.")
expect_true(returned_object2$fields_collapsed=="", "A subset of fields was not requested.")
expect_true(nchar(returned_object2$filter_logic)==0L, "A filter was not specified.")
expect_match(returned_object2$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
expect_s3_class(returned_object2$data, "tbl")
})

test_that("filter-numeric", {
Expand All @@ -96,28 +99,31 @@ test_that("filter-numeric", {
if (update_expectation) save_expected(returned_object1$data, path_expected)
expected_data_frame <- retrieve_expected(path_expected)

expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object1$data)
expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object1$data)
expect_true(returned_object1$success)
expect_match(returned_object1$status_codes, regexp="200", perl=TRUE)
expect_true(returned_object1$records_collapsed=="", "A subset of records was not requested.")
expect_true(returned_object1$fields_collapsed=="", "A subset of fields was not requested.")
expect_equal(returned_object1$filter_logic, filter)
expect_match(returned_object1$outcome_messages, regexp=expected_outcome_message, perl=TRUE)

expect_s3_class(returned_object1$data, "tbl")

###########################
## Tiny Batch size
expect_message(
regexp = expected_outcome_message,
returned_object2 <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, batch_size=8, filter_logic=filter)
)

expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object2$data)
expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object2$data)
expect_true(returned_object2$success)
expect_match(returned_object2$status_codes, regexp="200", perl=TRUE)
expect_true(returned_object2$records_collapsed=="", "A subset of records was not requested.")
expect_true(returned_object2$fields_collapsed=="", "A subset of fields was not requested.")
expect_equal(returned_object1$filter_logic, filter)
expect_match(returned_object2$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
expect_s3_class(returned_object2$data, "tbl")
})

test_that("filter-character", {
Expand All @@ -137,13 +143,14 @@ test_that("filter-character", {
if (update_expectation) save_expected(returned_object1$data, path_expected)
expected_data_frame <- retrieve_expected(path_expected)

expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object1$data)
expect_equal(returned_object1$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object1$data)
expect_true(returned_object1$success)
expect_match(returned_object1$status_codes, regexp="200", perl=TRUE)
expect_true(returned_object1$records_collapsed=="", "A subset of records was not requested.")
expect_true(returned_object1$fields_collapsed=="", "A subset of fields was not requested.")
expect_equal(returned_object1$filter_logic, filter)
expect_match(returned_object1$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
expect_s3_class(returned_object1$data, "tbl")

###########################
## Tiny Batch size
Expand All @@ -152,13 +159,14 @@ test_that("filter-character", {
returned_object2 <- redcap_read(redcap_uri=credential$redcap_uri, token=credential$token, batch_size=8, filter_logic=filter)
)

expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct") # dput(returned_object2$data)
expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object2$data)
expect_true(returned_object2$success)
expect_match(returned_object2$status_codes, regexp="200", perl=TRUE)
expect_true(returned_object2$records_collapsed=="", "A subset of records was not requested.")
expect_true(returned_object2$fields_collapsed=="", "A subset of fields was not requested.")
expect_equal(returned_object2$filter_logic, filter)
expect_match(returned_object2$outcome_messages, regexp=expected_outcome_message, perl=TRUE)
expect_s3_class(returned_object2$data, "tbl")
})

rm(credential, project, update_expectation)
4 changes: 4 additions & 0 deletions tests/testthat/test-read-batch-repeating-sparse.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ test_that("default", {
expect_true(returned_object$filter_logic=="", "A filter was not specified.")
expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
expect_true(returned_object$success)
expect_s3_class(returned_object$data, "tbl")
})


Expand Down Expand Up @@ -67,6 +68,7 @@ test_that("batch size 3", {
expect_true(returned_object$filter_logic=="", "A filter was not specified.")
expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
expect_true(returned_object$success)
expect_s3_class(returned_object$data, "tbl")
})


Expand Down Expand Up @@ -95,6 +97,7 @@ test_that("batch size 2", {
expect_true(returned_object$filter_logic=="", "A filter was not specified.")
expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
expect_true(returned_object$success)
expect_s3_class(returned_object$data, "tbl")
})


Expand Down Expand Up @@ -123,6 +126,7 @@ test_that("batch size 1", {
expect_true(returned_object$filter_logic=="", "A filter was not specified.")
expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
expect_true(returned_object$success)
expect_s3_class(returned_object$data, "tbl")
})

rm(credential)
Loading

0 comments on commit 5683b9d

Please sign in to comment.