DAG tests

R/metadata-utilities.R

@@ -65,7 +65,7 @@
 #' }
 #'
 #' path_3         <- system.file(package="REDCapR", "test-data/project-simple/simple-metadata.csv")
-#' ds_metadata_3  <- read.csv(path_3, stringsAsFactors=FALSE)
+#' ds_metadata_3  <- read.csv(path_3)
 #' choices_3      <- ds_metadata_3[ds_metadata_3$field_name=="race", "select_choices_or_calculations"]
 #' REDCapR::regex_named_captures(pattern=pattern_boxes, text=choices_3)
 

R/project-dag-write.R

@@ -13,6 +13,7 @@ populate_project_dag_write <- function(batch = FALSE) {
   }
 
   credential  <- retrieve_credential_testing(2545L)
+  # credential$token <- "123CA040BDA500E5CADB144D610FA3D0"
 
   project <- REDCapR::redcap_project$new(
     redcap_uri    = credential$redcap_uri,
@@ -35,14 +36,17 @@ populate_project_dag_write <- function(batch = FALSE) {
       path_in_dag,
       show_col_types = FALSE
     )
-  # ds_to_write <- utils::read.csv(file="./inst/test-data/project-dag/dag-data.csv", stringsAsFactors=FALSE)
+  # ds_to_write <- utils::read.csv(file="./inst/test-data/project-dag/dag-data.csv")
 
   # Remove the calculated variables.
   ds_to_write$last_name <- NULL
   # ds_to_write$bmi <- NULL
 
+  # ds_to_write$record_id <- sub("^\\d+-(\\d+)$", "\\1",  ds_to_write$record_id)
+  # ds_to_write$redcap_data_access_group <- NULL
+
   # Import the data into the REDCap project
-  testthat::expect_message(
+  # testthat::expect_message(
     returned_object <- if (batch) {
       REDCapR::redcap_write(
         ds          = ds_to_write,
@@ -52,15 +56,15 @@ populate_project_dag_write <- function(batch = FALSE) {
         convert_logical_to_integer = TRUE
       )
     } else {
-      REDCapR::redcap_write_oneshot(
-        ds          = ds_to_write,
-        redcap_uri  = project$redcap_uri,
-        token       = project$token,
-        verbose     = TRUE,
-        convert_logical_to_integer = TRUE
-      )
+        REDCapR::redcap_write_oneshot(
+          ds          = ds_to_write,
+          redcap_uri  = project$redcap_uri,
+          token       = project$token,
+          verbose     = TRUE,
+          convert_logical_to_integer = TRUE
+        )
     }
-  )
+  # )
 
   # # If uploading the data was successful, then upload the image files.
   # if (returned_object$success) {

R/project-simple.R

@@ -35,7 +35,7 @@ populate_project_simple <- function(batch = FALSE) {
       path_in_simple,
       show_col_types = FALSE
     )
-  # ds_to_write <- utils::read.csv(file="./inst/test-data/project-simple/simple-data.csv", stringsAsFactors=FALSE)
+  # ds_to_write <- utils::read.csv(file="./inst/test-data/project-simple/simple-data.csv")
 
   # Remove the calculated variables.
   ds_to_write$age <- NULL

inst/test-data/project-color-boxes/Readme.md

@@ -35,7 +35,7 @@ Here's some (slightly modified) code that Benjamin wrote for Issue #51:
 > post_result_all <- httr::POST(url=url, body=list(token=token, content='record', format='csv', rawOrLabel='label', fields='id, color'))
 > (csv_all <- as.character(post_result_all))
 [1] "id,color___r,color___g,color___b,color___p\n\"1\",\"Red\",\"\",\"\",\"\"\n\"2\",\"\",\"\",\"Blue\",\"\"\n\"3\",\"\",\"Green\",\"Blue\",\"\"\n\"4\",\"\",\"\",\"\",\"\"\n"
-> (ds_all <- read.csv(textConnection(csv_all), stringsAsFactors=FALSE))
+> (ds_all <- read.csv(textConnection(csv_all)))
   id color___r color___g color___b color___p
 1  1       Red                            NA
 2  2                          Blue        NA
@@ -45,7 +45,7 @@ Here's some (slightly modified) code that Benjamin wrote for Issue #51:
 > post_result_some <- httr::POST(url=url, body=list(token=token, content='record', format='csv', rawOrLabel='label', fields='id, color', records='2,3,4'))
 > (csv_some <- as.character(post_result_some))
 [1] "id,color___r,color___g,color___b,color___p\n\"2\",\"\",\"\",\"Blue\",\"\"\n\"3\",\"\",\"Green\",\"Blue\",\"\"\n\"4\",\"\",\"\",\"\",\"\"\n"
-> (ds_some <- read.csv(textConnection(csv_some), stringsAsFactors=FALSE))
+> (ds_some <- read.csv(textConnection(csv_some)))
   id color___r color___g color___b color___p
 1  2        NA                Blue        NA
 2  3        NA     Green      Blue        NA

inst/test-data/specific-redcapr/write-dag/after.R

@@ -0,0 +1,8 @@
+structure(list(record_id = c("331-1", "331-2", "332-3"), first_name = c("aa", 
+"bb", "cc"), last_name = c("last name 1", "last name 2", NA), 
+    address = c(NA, NA, NA), telephone = c(NA, NA, NA), email = c(NA, 
+    NA, NA), dob = c(NA, NA, NA), age = c(NA, NA, NA), ethnicity = c(NA, 
+    NA, NA), race = c(NA, NA, NA), sex = c(NA, NA, NA), height = c(NA, 
+    NA, NA), weight = c(NA, NA, NA), bmi = c(NA, NA, NA), comments = c(NA, 
+    NA, NA), demographics_complete = c(2, 2, 0)), row.names = c(NA, 
+-3L), class = "data.frame")

inst/test-data/specific-redcapr/write-dag/before.R

@@ -0,0 +1,6 @@
+structure(list(record_id = c("331-1", "331-2"), first_name = c("aa", 
+"bb"), last_name = c(NA, NA), address = c(NA, NA), telephone = c(NA, 
+NA), email = c(NA, NA), dob = c(NA, NA), age = c(NA, NA), ethnicity = c(NA, 
+NA), race = c(NA, NA), sex = c(NA, NA), height = c(NA, NA), weight = c(NA, 
+NA), bmi = c(NA, NA), comments = c(NA, NA), demographics_complete = c(0, 
+0)), row.names = c(NA, -2L), class = "data.frame")

playgrounds/HttrPlayground.R

@@ -51,7 +51,7 @@ result <- httr::POST(
 )
 httr::content(result, "text")
 
-ds <- utils::read.csv(text=raw_text, stringsAsFactors=FALSE) #Convert the raw text to a dataset.
+ds <- utils::read.csv(text=raw_text) #Convert the raw text to a dataset.
 
 #
 # raw_text2 <- RCurl::postForm(
@@ -66,7 +66,7 @@ ds <- utils::read.csv(text=raw_text, stringsAsFactors=FALSE) #Convert the raw te
 #   , fields = fields_collapsed
 #   , .opts = RCurl::curlOptions(ssl.verifypeer = FALSE)
 # )
-# ds2 <- utils::read.csv(text=raw_text2, stringsAsFactors=FALSE) #Convert the raw text to a dataset.
+# ds2 <- utils::read.csv(text=raw_text2) #Convert the raw text to a dataset.
 
 # result <- redcap_read_oneshot(redcap_uri="https://bbmc.ouhsc.edu/redcap/api/", token = "9A81268476645C4E5F03428B8AC3AA7B")
 # dput(result$data)

playgrounds/ReadWithCert.R

@@ -18,7 +18,7 @@ raw_text <- RCurl::postForm(
   , .opts = RCurl::curlOptions(ssl.verifypeer = FALSE)
 )
 try(
-  dsTry <- utils::read.csv(text=raw_text, stringsAsFactors=FALSE) #Convert the raw text to a dataset.
+  dsTry <- utils::read.csv(text=raw_text) #Convert the raw text to a dataset.
 )
 if( ! exists("dsTry") )
   dsTry <- data.frame()

playgrounds/Validation.R

@@ -39,8 +39,7 @@ data.frame(
   field_name = colnames(df)[flag],
   field_index = indices,
   concern = "The REDCap API does not automatically convert boolean values to 0/1 values.",
-  suggestion = "Convert the variable with the `as.integer()` function .",
-  stringsAsFactors = FALSE
+  suggestion = "Convert the variable with the `as.integer()` function ."
 )
 
 v <- validate_no_logical(dfGood)

playgrounds/local-token.R

@@ -8,7 +8,7 @@ check_token_pattern      <- TRUE
 # Check that the file exists and read it into a data frame.
 if( !file.exists(path_credential) ) stop("The credential file was not found.")
 # ds_credentials <- readr::read_csv(path_credential, comment = "#")
-ds_credentials <- utils::read.csv(path_credential, comment.char="#", stringsAsFactors=FALSE)
+ds_credentials <- utils::read.csv(path_credential, comment.char="#")
 
 # Select only the records with a matching project id.
 ds_credential <- ds_credentials[ds_credentials$project_id==project_id, ]

playgrounds/retired/retrieve-token.R

@@ -90,8 +90,7 @@ retrieve_token_mssql <- function(
   sql <- "EXEC [redcap].[prcToken] @RedcapProjectName = ?"
 
   d_input <- data.frame(
-    RedcapProjectName  = project_name,
-    stringsAsFactors   = FALSE
+    RedcapProjectName  = project_name
   )
 
   if( base::missing(channel) | base::is.null(channel) ) {
@@ -106,7 +105,7 @@ retrieve_token_mssql <- function(
 
   base::tryCatch(
     expr = {
-      token <- RODBCext::sqlExecute(channel, sql, d_input, fetch=TRUE, stringsAsFactors=FALSE)$Token[1]
+      token <- RODBCext::sqlExecute(channel, sql, d_input, fetch=TRUE)$Token[1]
     }, finally = {
       if( close_channel_on_exit ) RODBC::odbcClose(channel)
     }

tests/testthat/test-column-sanitize.R

@@ -1,7 +1,7 @@
 library(testthat)
 
 test_that("dry_run", {
-  dirty <- data.frame(id=seq_along(letters), names=letters, stringsAsFactors=FALSE) #These aren't really dirty.  And should have no conversion problems
+  dirty <- data.frame(id=seq_along(letters), names=letters) #These aren't really dirty.  And should have no conversion problems
 
   expected <- structure(list(id = as.character(1:26), names = letters),
                         .Names = c("id", "names"), row.names = c(NA, -26L), class = "data.frame")

tests/testthat/test-write-dag.R

@@ -0,0 +1,91 @@
+library(testthat)
+update_expectation  <- FALSE
+
+test_that("Smoke Test", {
+  testthat::skip_on_cran()
+  start_clean_result <- REDCapR:::clean_start_dag_write(batch=FALSE)
+  project <- start_clean_result$redcap_project
+})
+
+test_that("default", {
+  testthat::skip_on_cran()
+  path_expected_before <- "test-data/specific-redcapr/write-dag/before.R"
+  path_expected_after  <- "test-data/specific-redcapr/write-dag/after.R"
+  start_clean_result <- REDCapR:::clean_start_dag_write(batch=FALSE)
+  project <- start_clean_result$redcap_project
+  token_for_dag_user <- "C79DB3836373478986928303B52E74DF"
+
+  expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+  expect_message(
+    returned_object <- redcap_read_oneshot(redcap_uri=project$redcap_uri, token=token_for_dag_user),
+    regexp = expected_outcome_message
+  )
+
+  if (update_expectation) save_expected(returned_object$data, path_expected_before)
+  expected_data_frame <- retrieve_expected(path_expected_before)
+
+  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object$data$bmi<-NULL; returned_object$data$age<-NULL;dput(returned_object$data)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+  expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
+  expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+
+  ds_updated <- returned_object$data
+  ds_updated$last_name <- paste("last name", seq_len(nrow(ds_updated)))
+  ds_updated$demographics_complete <- REDCapR::constant("form_complete")
+  # ds_updated$record_id <- sub("^\\d+-(\\d+)$", "\\1",  ds_updated$record_id)
+  # ds_updated$redcap_data_access_group <- NULL
+
+  redcap_write_oneshot(ds_updated, project$redcap_uri, token_for_dag_user)
+  returned_object <- redcap_read_oneshot(redcap_uri=project$redcap_uri, token=project$token)
+
+  if (update_expectation) save_expected(returned_object$data, path_expected_after)
+  expected_data_frame <- retrieve_expected(path_expected_after)
+
+  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object$data$bmi<-NULL; returned_object$data$age<-NULL;dput(returned_object$data)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+  expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
+  expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+})
+
+test_that("reassign subject to a different dag", {
+  testthat::skip_on_cran()
+
+  # Step 1: Initialize the project
+  start_clean_result <- REDCapR:::clean_start_dag_write(batch=FALSE)
+  url                <- start_clean_result$redcap_project$redcap_uri
+  token_for_admin    <- start_clean_result$redcap_project$token
+  token_for_dag_user <- "C79DB3836373478986928303B52E74DF"
+
+  # Step 2a: Retrieve the dataset as admin.  The 3 subjects' DAGs are 'daga', 'daga', & 'dagb'
+  ds_admin_1  <- redcap_read_oneshot(url, token_for_admin, export_data_access_groups=T)$data
+  expect_equal(nrow(ds_admin_1), 3L)
+  expect_equal(ds_admin_1$record_id               , c("331-1", "331-2", "332-3"))
+  expect_equal(ds_admin_1$redcap_data_access_group, c("daga", "daga", "dagb"   ))
+
+  # Step 2b: Retrieve the dataset as user. Only the first two subjects are visible to DAG-A users initially.
+  ds_user_1   <- redcap_read_oneshot(url, token_for_dag_user)$data
+  expect_equal(nrow(ds_user_1), 2L)
+  expect_equal(ds_user_1$record_id, c("331-1", "331-2"))
+
+  #Step 3: Reassign the 2nd subject and upload to server
+  ds_admin_1$redcap_data_access_group[2] <- "dagb"
+  redcap_write_oneshot(ds_admin_1, url, token_for_admin)
+
+  # Step 4a: Retrieve the dataset as admin.  Should the 2nd row automatically change from '331-2' to '332-2'?
+  ds_admin_2  <- redcap_read_oneshot(url, token_for_admin, export_data_access_groups=T)$data
+  expect_equal(nrow(ds_admin_2), 3L)
+  expect_equal(ds_admin_2$record_id               , c("331-1", "331-2", "332-3"))
+  # expect_equal(ds_admin_2$record_id               , c("331-1", "332-2", "332-3"))
+  expect_equal(ds_admin_2$redcap_data_access_group, c("daga", "dagb", "dagb"   ))
+
+  # Step 4b: Retrieve the dataset as user. Now only one subject is visible to DAG-A users.
+  ds_user_2   <- redcap_read_oneshot(url, token_for_dag_user)$data
+  expect_equal(nrow(ds_user_2), 1L)
+  expect_equal(ds_user_2$record_id, c("331-1"))
+})

utility/refresh.R

@@ -31,7 +31,7 @@ devtools::run_examples(); #dev.off() #This overwrites the NAMESPACE file too
 # devtools::run_examples(, "redcap_read.Rd")
 test_results_checked <- devtools::test()
 test_results_checked <- devtools::test(filter = "write-error")
-test_results_checked <- devtools::test(filter = "report")
+test_results_checked <- devtools::test(filter = "column")
 test_results_checked <- devtools::test(filter = "validate.*$")
 
 # testthat::test_dir("./tests/")