From af34dc399c5c781fcd540771888377c9b3e20391 Mon Sep 17 00:00:00 2001 From: Will Beasley Date: Sun, 2 Oct 2022 13:08:30 -0500 Subject: [PATCH] crossing plumbing variables ref #420 --- playgrounds/eav-playground-2.R | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/playgrounds/eav-playground-2.R b/playgrounds/eav-playground-2.R index 4b205bdd..4d5ca84a 100644 --- a/playgrounds/eav-playground-2.R +++ b/playgrounds/eav-playground-2.R @@ -20,10 +20,11 @@ token <- "56F43A10D01D6578A46393394D76D88F" # PHI-free demo: Repeating Instrume # forms <- "health" fields <- NULL forms <- NULL +records <- NULL #c("1") # ---- load-data --------------------------------------------------------------- system.time( - ds_expected <- REDCapR::redcap_read_oneshot(redcap_uri, token)$data + ds_expected <- REDCapR::redcap_read_oneshot(redcap_uri, token, records=records)$data ) system.time({ @@ -39,7 +40,7 @@ system.time({ desired_fields <- ds_metadata$field_name - ds_eav <- REDCapR:::redcap_read_eav_oneshot(redcap_uri, token, fields = desired_fields)$data + ds_eav <- REDCapR:::redcap_read_eav_oneshot(redcap_uri, token, fields = desired_fields, records=records)$data }) testit::assert(ds_metadata$field_name == colnames(ds_expected)) @@ -48,13 +49,19 @@ testthat::expect_setequal( ds_metadata$field_name, colnames(ds_expected)) # ---- tweak-data -------------------------------------------------------------- if (!"event_id" %in% colnames(ds_eav)) { ds_eav$event_id <- "dummy_1" + .dummy_event <- TRUE +} else { + .dummy_event <- FALSE } +.fields_to_cross <- setdiff(ds_metadata$field_name, c("redcap_repeat_instrument", "redcap_repeat_instance")) +.fields_to_return <- c("record", "event_id", ds_metadata$field_name) + ds_eav_possible <- ds_eav %>% tidyr::expand( tidyr::nesting(record, event_id), - tidyr::crossing(field_name = ds_metadata$field_name) + tidyr::crossing(field_name = .fields_to_cross) ) ds_eav_2 <- @@ -71,10 +78,10 @@ ds_eav_2 <- ) %>% dplyr::right_join(ds_eav_possible, by = c("record", "event_id", "field_name")) -# . <- NULL # For the sake of avoiding an R CMD check note. ds <- ds_eav_2 %>% dplyr::select(-.data$field_type, -.data$field_name_base) %>% + # dplyr::slice(1:46) %>% # dplyr::group_by(record, redcap_repeat_instrument, redcap_repeat_instance, event_id, field_name) %>% # dplyr::summarise(n = dplyr::n(), .groups = "drop") %>% # dplyr::filter(n > 1L) %>% @@ -82,12 +89,20 @@ ds <- # dplyr::select(-.data$redcap_repeat_instance) %>% # TODO: need a good fix for repeats # tidyr::drop_na(event_id) %>% # TODO: need a good fix for repeats tidyr::pivot_wider( # Everything else is considered an ID column + id_cols= c(.data$record, .data$event_id, .data$redcap_repeat_instrument, .data$redcap_repeat_instance), names_from = .data$field_name, values_from = .data$value ) %>% - dplyr::select(!!ds_metadata$field_name) %>% - readr::type_convert(col_types) + dplyr::select(!!.fields_to_return) # dplyr::select(.data = ., !!intersect(variables_to_keep, colnames(.))) +if (.dummy_event) { + ds$event_id <- NULL +} + +ds <- + ds %>% + readr::type_convert(col_types) + testit::assert(colnames(ds) == colnames(ds_expected)) testthat::expect_setequal(colnames(ds), colnames(ds_expected))