Tests for getstudydatapoints

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: castoRedc
 Title: Wraps Castor API for easy data access
-Version: 2.0.1
+Version: 2.1.0
 Authors@R: c(
     person("Thomas", "Johnson", role = "aut"),
     person("Reinier", "van Linschoten",
@@ -26,10 +26,11 @@ Imports:
     glue
 Suggests:
     knitr,
-    testthat
+    testthat (>= 3.0.0)
 RoxygenNote: 7.3.0
 Collate:
     'imports.R'
     'utils.R'
     'CastorData.R'
     'CastorAPIWrapper.R'
+Config/testthat/edition: 3

R/CastorData.R

@@ -498,15 +498,19 @@ CastorData <- R6::R6Class("CastorData",
                 "returning data frame with just participant metadata.")
 
         empty.df <- data.frame(
-          "Site Abbreviation" =
-            participant_metadata[["_embedded"]][["site"]][["abbreviation"]],
-          "Randomization Group" =
-            ifelse(is.null(participant_metadata[["randomization_group"]]), NA,
-                   participant_metadata[["randomization_group"]]),
-          "Participant Creation" = participant_metadata[["created_on"]][["date"]],
-          "Participant_ID" = participant_id
+          "institute" =
+            participant_metadata[["_embedded"]][["site"]][["name"]],
+          "randomisation_group" =
+            ifelse(is.null(participant_metadata[["randomization_group_name"]]),
+                   NA,
+                   participant_metadata[["randomization_group_name"]]),
+          "participant_id" = participant_id,
+          "archived" = participant_metadata[["archived"]],
+          "randomisation_datetime" =
+            ifelse(is.null(participant_metadata[["randomizated_on"]]),
+                   NA,
+                   participant_metadata[["randomizated_on"]])
         )
-
         return(empty.df)
       }
       # Filter out any field types that are specified in the filter_types
@@ -524,55 +528,81 @@ CastorData <- R6::R6Class("CastorData",
         stringsAsFactors = FALSE)
 
       # Add the participant id as a column to the data.
-      study_data_points.df[["Participant_ID"]] <- participant_id
+      study_data_points.df[["participant_id"]] <- participant_id
 
       # Randomization ID should be in participant data.
-      study_data_points.df[["Site_Abbreviation"]] <-
-        participant_metadata[["_embedded"]][["site"]][["abbreviation"]]
-      study_data_points.df[["Randomization_Group"]] <-
-        ifelse(is.null(participant_metadata[["randomization_group"]]),
+      study_data_points.df[["institute"]] <-
+        participant_metadata[["_embedded"]][["site"]][["name"]]
+      study_data_points.df[["archived"]] <-
+        participant_metadata[["archived"]]
+      study_data_points.df[["randomisation_group"]] <-
+        ifelse(is.null(participant_metadata[["randomization_group_name"]]),
+               NA,
+               participant_metadata[["randomization_group_name"]])
+      study_data_points.df[["randomisation_datetime"]] <-
+        ifelse(is.null(participant_metadata[["randomizated_on"]]),
                NA,
-               participant_metadata[["randomization_group"]])
-      study_data_points.df[["Participant_Creation"]] <-
-        participant_metadata[["created_on"]][["date"]]
+               participant_metadata[["randomizated_on"]])
 
       return(study_data_points.df)
     },
-    getStudyDataBulk = function(study_id., field_info., participant_metadata) {
-      study_data <- self$getStudyDataPointsBulk(study_id.)
-      if (isTRUE(nrow(study_data) > 0)) {
-        study_data_field_info <- distinct(left_join(study_data, field_info., by = "field_id"))
-        study_data_long <- select(study_data_field_info,
-                                  field_variable_name, participant_id, field_value)
-        study_data_wide <- spread(study_data_long,
-                                  field_variable_name, field_value)
-        study_data_complete_cases <- filter_all(study_data_wide,
-                                                 any_vars(!is.na(.)))
-
-        # Add randomized on date for studies without randomization
-        # Is not retrieved from API, but needs to exist for further steps
-        if (!("randomized_on.date" %in% names(participant_metadata))) {
-          participant_metadata <- participant_metadata %>%
-            mutate(randomized_on.date = NA_character_)
-        }
-
-        rename(
-          left_join(
-            select(
-              participant_metadata,
-              participant_id,
-              Randomization_Group = randomization_group,
-              Randomization_Group_Name = randomization_group_name,
-              Randomized_On = randomized_on.date,
-              Site_Abbreviation = `_embedded.site.abbreviation`,
-              Participant_Creation = created_on.date),
-            study_data_complete_cases,
-            by="participant_id"
+    getStudyDataBulk = function(study_id, field_info=NULL, participant_metadata=NULL) {
+      # Extract the necessary info that wasnt given to the function
+      if (is.null(field_info)) {self$getFields(study_id)}
+      if (is.null(participant_metadata)) {self$getParticipants(study_id)}
+
+      # Extract all study data points in long format
+      # One row per datapoint
+      study_data <- self$getStudyDataPointsBulk(study_id)
+
+      # If there is study data
+      if (nrow(study_data) > 0) {
+        # Add the field names to the field ids and values in long format
+        study_data <- left_join(select(study_data, -updated_on),
+                                select(field_info, c(field_variable_name, field_id)),
+                                by = "field_id")
+
+        # Move from long (each data point has a row) to wide format per participant
+        study_data <- pivot_wider(select(study_data, -field_id),
+                                  names_from = field_variable_name,
+                                  values_from = field_value)
+
+        # Add participant metadata to the dataframe
+        study_data <- left_join(
+          select(
+            participant_metadata,
+            participant_id,
+            `_embedded.site.name`,
+            archived,
+            randomization_group_name,
+            randomized_on,
           ),
-          Participant_ID = participant_id
+          study_data,
+          by = "participant_id"
         )
-      } else
-        NULL
+
+        study_data <- rename(study_data,
+          randomisation_group = randomization_group_name,
+          randomisation_datetime = randomized_on,
+          institute = `_embedded.site.name`
+        )
+      } else {
+        # If no study data, only return participant information
+        study_data <-
+          rename(select(
+            participant_metadata,
+            participant_id,
+            `_embedded.site.name`,
+            archived,
+            randomization_group_name,
+            randomized_on,
+          ),
+          randomisation_group = randomization_group_name,
+          randomisation_datetime = randomized_on,
+          institute = `_embedded.site.name`
+          )
+      }
+      study_data
     },
     generateFieldMetadata = function(study_id, field_info) {
       forms <- self$getForms(study_id)
@@ -683,8 +713,8 @@ CastorData <- R6::R6Class("CastorData",
           all_data_points.df <- self$getStudyDataBulk(study_id, field_info,
                                                       participant_metadata)
         } else {
-          # Get study data from getStudyDataPoints and collect them by participant in a
-          # list.
+          # Get study data from getStudyDataPoints
+          # Collect them by participant in a list
           study_data <- lapply(participant_metadata$participant_id, function(participant) {
             if (self$verbose) message("getting participant ", participant)
             return(self$getStudyDataPoints(study_id, participant, filter_types))
@@ -693,10 +723,6 @@ CastorData <- R6::R6Class("CastorData",
           all_data_points.df <- bind_rows(study_data)
         }
       } else {
-        all_data_points.df <- NULL
-      }
-
-      if (is.null(all_data_points.df)) {
         all_data_points.df <- rename(
           select(
             participant_metadata,

create_testing_credentials.R

@@ -1,7 +1,7 @@
 creds = list(
   client_id = "",
   client_secret = "",
-  example_study = "",
+  output_study = "",
   base_url = "https://data.castoredc.com",
   example_field = "",
   example_visit = "",
@@ -14,7 +14,7 @@ creds = list(
 )
 
 castor_api <- CastorData$new(key=creds$client_id, secret=creds$client_secret, base_url=creds$base_url)
-entire_study <- castor_api$getStudyData(creds$example_study)
+entire_study <- castor_api$getStudyData(creds$output_study)
 study_hash <- digest::digest(entire_study)
 
 creds$study_hash <- study_hash

tests/test_files/files_output/CastorAdverseEvent (noLabel).csv

@@ -0,0 +1,3 @@
+participant_id,institute,created_on,custom_name,parent,archived,AE_type,AE_startdate,AE_stopdate,AE_severity,AE_relation,AE_action,AE_outcome,AE_expected,AE_SAE
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:58:13,Adverse event - 22-06-2021 09:58:12,No parent,FALSE,,,,,,,,,
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:55:13,Adverse event - 22-06-2021 09:55:12,Follow-up Visit,FALSE,A bug in the API,23-06-2021,24-06-2021,4,4,2,1,1,1

tests/test_files/files_output/CastorAdverseEvent.csv

@@ -0,0 +1,3 @@
+participant_id,institute,created_on,custom_name,parent,archived,AE_type,AE_startdate,AE_stopdate,AE_severity,AE_relation,AE_action,AE_outcome,AE_expected,AE_SAE
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:58:13,Adverse event - 22-06-2021 09:58:12,No parent,FALSE,,,,,,,,,
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:55:13,Adverse event - 22-06-2021 09:55:12,Follow-up Visit,FALSE,A bug in the API,23-06-2021,24-06-2021,Life-threatening,Definitely related,Medical intervention,Resolved,Yes,Yes

tests/test_files/files_output/CastorComorbidities (noLabel).csv

@@ -0,0 +1,2 @@
+participant_id,institute,created_on,custom_name,parent,archived,comorbidities
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:56:07,Comorbidities - 22-06-2021 09:56:06,No parent,FALSE,-- Uploaded File: comorbidities.txt --

tests/test_files/files_output/CastorComorbidities.csv

@@ -0,0 +1,2 @@
+participant_id,institute,created_on,custom_name,parent,archived,comorbidities
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:56:07,Comorbidities - 22-06-2021 09:56:06,No parent,FALSE,-- Uploaded File: comorbidities.txt --

tests/test_files/files_output/CastorMedication (noLabel).csv

@@ -0,0 +1,3 @@
+participant_id,institute,created_on,custom_name,parent,archived,med_name,med_start,med_stop,med_dose,med_units,med_other_unit
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:54:28,Medication - 22-06-2021 09:54:28,Unscheduled visits and Medication,FALSE,Diclofenac,25-06-2021,28-06-2021,150,2,
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:58:27,Medication - 22-06-2021 09:58:26,No parent,FALSE,,,,,,

tests/test_files/files_output/CastorMedication.csv

@@ -0,0 +1,3 @@
+participant_id,institute,created_on,custom_name,parent,archived,med_name,med_start,med_stop,med_dose,med_units,med_other_unit
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:54:28,Medication - 22-06-2021 09:54:28,Unscheduled visits and Medication,FALSE,Diclofenac,25-06-2021,28-06-2021,150,mg/day,
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:58:27,Medication - 22-06-2021 09:58:26,No parent,FALSE,,,,,,

tests/test_files/files_output/CastorQOLSurvey (noLabel).csv

@@ -0,0 +1,3 @@
+participant_id,institute,survey_name,survey_instance_id,created_on,sent_on,progress,completed_on,package_id,package_name,archived,SF12_1,SF12_2,SF12_3,SF12_12,VAS
+110001,Franciscus Gasthuis & Vlietland,QOL Survey,4FF130AD-274C-4C8F-A4A0-A7816A5A88E9,22-06-2021 10:12:19,22-06-2021 10:12:19,100,22-06-2021 10:12:44,0761A9BA-9802-483D-8EB3-D07233A56F2B,My first survey package,FALSE,5,2,2,5,85
+110001,Franciscus Gasthuis & Vlietland,QOL Survey,B99F0082-1B20-456B-8D4D-47D16867B211,22-06-2021 10:13:01,22-06-2021 10:13:01,0,,5B3FE56F-89FA-4C6D-A638-E8FA46113EB0,My first survey package,FALSE,,,,,

tests/test_files/files_output/CastorQOLSurvey.csv

@@ -0,0 +1,3 @@
+participant_id,institute,survey_name,survey_instance_id,created_on,sent_on,progress,completed_on,package_id,package_name,archived,SF12_1,SF12_2,SF12_3,SF12_12,VAS
+110001,Franciscus Gasthuis & Vlietland,QOL Survey,4FF130AD-274C-4C8F-A4A0-A7816A5A88E9,22-06-2021 10:12:19,22-06-2021 10:12:19,100,22-06-2021 10:12:44,0761A9BA-9802-483D-8EB3-D07233A56F2B,My first survey package,FALSE,Excellent,Mostly,Mostly,Rarely,85
+110001,Franciscus Gasthuis & Vlietland,QOL Survey,B99F0082-1B20-456B-8D4D-47D16867B211,22-06-2021 10:13:01,22-06-2021 10:13:01,0,,5B3FE56F-89FA-4C6D-A638-E8FA46113EB0,My first survey package,FALSE,,,,,

tests/test_files/files_output/CastorStudy (noLabel).csv

@@ -0,0 +1,3 @@
+participant_id,archived,institute,randomisation_group,randomisation_datetime,ic_date,ic_versions#Main study CF,ic_versions#Other,ic_main_version,ic_other_version,ic_language#English,ic_language#Dutch,ic_language#French,ic_language#Other,inc_ic,inc_trials,inc_age,inc_dx,inc_criteria,pat_birth_year,pat_sex,pat_race,pat_height,his_cvd,his_diabetes,his_smoke,his_smoke_start,his_smoke_dose,his_family#None,his_family#Unknown,his_family#Deafness,his_family#(Cardio)myopathy,his_family#Encephalopathy,his_family#Diabetes Mellitus,his_family#Hypertension/Cardiovascular disease,his_family#Thrombosis,his_family#Malignancy,randalloc,randdisp,disp_datetime,base_date,onset_stroke,onset_trombectomy,base_weight,base_bmi,base_sbp,base_dbp,base_hr,base_bl_date,base_hb,base_ht,base_leucoc,base_tromboc,base_urea,base_creat,base_CRP,fac_V_leiden_number,fac_V_leiden_date,base_gluc,fu_date,fu_weight,fu_bmi,fu_sbp,fu_dbp,fu_hr,fu_bl_date,fu_hb,fu_ht,fu_leucoc,fu_tromboc,fu_urea,fu_creat,fu_CRP,fu_gluc,unscheduled,conc_med
+110001,FALSE,Franciscus Gasthuis & Vlietland,,,22-06-2021,TRUE,FALSE,2.5,,FALSE,FALSE,TRUE,FALSE,1,0,1,0,Yes,1996,0,2,1.75,1,0,0,,,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE,FALSE,FALSE,FALSE,,,,22-06-2021,21-06-2021 01:15,01:30,88,28.7,120,65,66,22-06-2021,7.4,0.23,4.1,252,4.6,88,2.1,55,22-06-2021,5.4,29-06-2021,66,21.6,132,72,69,29-06-2021,8.1,0.36,9.5,366,8.2,99,4.4,3.1,1,1
+110002,FALSE,Franciscus Gasthuis & Vlietland,,,,FALSE,FALSE,,,-99,-99,-99,-99,,,,,,,,,-95,,,,,,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,,,,31-12-2999,,,,,,,,,,,,,,,,-96,01-01-2996,,,,,,,,,,,,,,,,,,

tests/test_files/files_output/CastorStudy.csv

@@ -0,0 +1,3 @@
+participant_id,archived,institute,randomisation_group,randomisation_datetime,ic_date,ic_versions#Main study CF,ic_versions#Other,ic_main_version,ic_other_version,ic_language#English,ic_language#Dutch,ic_language#French,ic_language#Other,inc_ic,inc_trials,inc_age,inc_dx,inc_criteria,pat_birth_year,pat_sex,pat_race,pat_height,his_cvd,his_diabetes,his_smoke,his_smoke_start,his_smoke_dose,his_family#None,his_family#Unknown,his_family#Deafness,his_family#(Cardio)myopathy,his_family#Encephalopathy,his_family#Diabetes Mellitus,his_family#Hypertension/Cardiovascular disease,his_family#Thrombosis,his_family#Malignancy,randalloc,randdisp,disp_datetime,base_date,onset_stroke,onset_trombectomy,base_weight,base_bmi,base_sbp,base_dbp,base_hr,base_bl_date,base_hb,base_ht,base_leucoc,base_tromboc,base_urea,base_creat,base_CRP,fac_V_leiden_number,fac_V_leiden_date,base_gluc,fu_date,fu_weight,fu_bmi,fu_sbp,fu_dbp,fu_hr,fu_bl_date,fu_hb,fu_ht,fu_leucoc,fu_tromboc,fu_urea,fu_creat,fu_CRP,fu_gluc,unscheduled,conc_med
+110001,FALSE,Franciscus Gasthuis & Vlietland,,,22-06-2021,TRUE,FALSE,2.5,,FALSE,FALSE,TRUE,FALSE,Yes,No,Yes,No,Yes,1996,Female,African/black,1.75,Yes,No,No,,,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE,FALSE,FALSE,FALSE,,,,22-06-2021,21-06-2021 01:15,01:30,88,28.7,120,65,66,22-06-2021,7.4,0.23,4.1,252,4.6,88,2.1,55,22-06-2021,5.4,29-06-2021,66,21.6,132,72,69,29-06-2021,8.1,0.36,9.5,366,8.2,99,4.4,3.1,Yes,Yes
+110002,FALSE,Franciscus Gasthuis & Vlietland,,,,FALSE,FALSE,,,-99,-99,-99,-99,,,,,,,,,-95,,,,,,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,,,,31-12-2999,,,,,,,,,,,,,,,,-96,01-01-2996,,,,,,,,,,,,,,,,,,

tests/test_files/files_output/CastorUnscheduledVisit (noLabel).csv

@@ -0,0 +1,2 @@
+participant_id,institute,created_on,custom_name,parent,archived,unsvis_type,unsvis_date,unsvis_weight,unsvis_sbp,unsvis_dbp,unsvis_hr,unslab_date,unslab_s_hb,unslab_ht,unslab_leucoc,unslab_tromboc,unslab_urea,unslab_creat,unslab_CRP,unslab_gluc
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:57:38,Unscheduled visit - 22-06-2021 09:57:36,Unscheduled visits and Medication,FALSE,3,24-06-2021,98.3,233,156,112,,,,,,,,,

tests/test_files/files_output/CastorUnscheduledVisit.csv

@@ -0,0 +1,2 @@
+participant_id,institute,created_on,custom_name,parent,archived,unsvis_type,unsvis_date,unsvis_weight,unsvis_sbp,unsvis_dbp,unsvis_hr,unslab_date,unslab_s_hb,unslab_ht,unslab_leucoc,unslab_tromboc,unslab_urea,unslab_creat,unslab_CRP,unslab_gluc
+110001,Franciscus Gasthuis & Vlietland,22-06-2021 09:57:38,Unscheduled visit - 22-06-2021 09:57:36,Unscheduled visits and Medication,FALSE,admission to day-care,24-06-2021,98.3,233,156,112,,,,,,,,,

tests/testthat/test_fields.R

@@ -1,33 +1,54 @@
-context("Test Field related methods.")
-
 creds <- readRDS("testing_credentials.Rds")
 castor_api <- CastorData$new(key=creds$client_id, secret=creds$client_secret, base_url=creds$base_url)
 
 test_that("getField returns an appropriate object.", {
-  field <- castor_api$getField(creds$example_study, creds$example_field)
+  field <- castor_api$getField(creds$output_study, creds$example_field)
 
-  expect_is(field, "list")
+  expect_type(field, "list")
   expect_equal(field$field_id, creds$example_field)
   expect_gt(length(field), 0)
 })
 
+test_that("getField fails appropriately", {
+  error <- expect_error(castor_api$getField(creds$output_study, creds$fail_field))
+  expect_match(error$message, "Error code: 404")
+})
+
+
 test_that("getFieldsPages returns an appropriate object.", {
-  fields <- castor_api$getFieldsPages(creds$example_study)
-  one_field <- castor_api$getFieldsPages(creds$example_study, page = 1)
-
-  expect_is(fields, "list")
-  expect_is(one_field, "list")
-  expect_true(length(one_field) == 1)
-  expect_error(castor_api$getFieldsPages(creds$example_study, page = -1))
-  expect_error(castor_api$getFieldsPages(creds$example_study, page = 100000000))
-  expect_error(castor_api$getFieldsPages(creds$example_study, page = pi))
+  fields <- castor_api$getFieldsPages(creds$output_study)
+  expect_type(fields, "list")
 })
 
+test_that("getFieldPages returns an appropriate object when retrieving a single page.", {
+  one_page <- castor_api$getFieldsPages(creds$output_study, page = 1)
+  expect_type(one_page, "list")
+  expect_true(length(one_page) == 1)
+})
+
+test_that("getFieldPages fails appropriately", {
+  error1 <- expect_error(castor_api$getFieldsPages(creds$output_study, page = -1))
+  expect_match(error1$message, "Error code: 400")
+
+  error2 <- expect_error(castor_api$getFieldsPages(creds$output_study, page = 100000000))
+  expect_match(error2$message, "Error code: 409")
+
+  error3 <- expect_error(castor_api$getFieldsPages(creds$output_study, page = pi))
+  expect_match(error3$message, "page must be an integer")
+})
+
+
+
 test_that("getFields returns an appropriate object.", {
-  field_data <- castor_api$getFields(creds$example_study)
+  field_data <- castor_api$getFields(creds$output_study)
 
-  expect_is(field_data, "data.frame")
-  expect_gt(nrow(field_data), 0)
-  expect_gt(ncol(field_data), 0)
-  expect_error(castor_api$getFields("this is not a study id"))
+  expect_s3_class(field_data, "data.frame")
+  expect_equal(nrow(field_data), 115)
+  expect_equal(ncol(field_data), 37)
 })
+
+test_that("getFields fails appropriately", {
+  error <- expect_error(castor_api$getFields("THISISNOTASTUDYID"))
+  expect_match(error$message, "Error code: 404")
+})
+