From c16a96a8cf22efeef56c8b563a92aa1a36fafbd2 Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Fri, 1 Nov 2024 10:11:43 -0400 Subject: [PATCH 1/4] Add factor levels and order to redcap_events col --- DESCRIPTION | 3 ++- NAMESPACE | 1 + R/REDCapTidieR-package.R | 1 + R/read_redcap.R | 10 +++++++++- R/utils.R | 16 ++++++++++------ tests/testthat/test-utils.R | 6 ++++++ 6 files changed, 29 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e491b4c1..17aca6f5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,8 @@ Imports: pillar, vctrs, readr, - stats + stats, + forcats Suggests: covr, knitr, diff --git a/NAMESPACE b/NAMESPACE index 5c16f592..05bb7fdd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,6 +66,7 @@ importFrom(dplyr,select) importFrom(dplyr,slice) importFrom(dplyr,summarise) importFrom(dplyr,ungroup) +importFrom(forcats,fct_inorder) importFrom(formattable,percent) importFrom(lobstr,obj_size) importFrom(lubridate,is.Date) diff --git a/R/REDCapTidieR-package.R b/R/REDCapTidieR-package.R index 4c8d6142..09a507b1 100644 --- a/R/REDCapTidieR-package.R +++ b/R/REDCapTidieR-package.R @@ -8,6 +8,7 @@ #' left_join mutate pull recode relocate rename right_join row_number rowwise #' select slice summarise ungroup coalesce cur_column bind_cols first nth n_distinct #' first distinct +#' @importFrom forcats fct_inorder #' @importFrom formattable percent #' @importFrom lobstr obj_size #' @importFrom lubridate is.difftime is.period is.POSIXt is.Date diff --git a/R/read_redcap.R b/R/read_redcap.R index 6bcaf067..acec2234 100644 --- a/R/read_redcap.R +++ b/R/read_redcap.R @@ -177,7 +177,6 @@ read_redcap <- function(redcap_uri, export_survey_fields <- ifelse(is.null(export_survey_fields), TRUE, export_survey_fields) # Load REDCap Dataset output ---- - db_data <- try_redcapr({ redcap_read_oneshot( redcap_uri = redcap_uri, @@ -463,12 +462,21 @@ add_event_mapping <- function(supertbl, linked_arms, repeat_event_types) { event_info <- linked_arms if (!is.null(repeat_event_types)) { + # Preserve factor levels post-join by referencing level order from linked_arms + repeat_event_types$redcap_event_name <- factor(repeat_event_types$redcap_event_name, + levels = levels(event_info$unique_event_name), + ordered = TRUE + ) + event_info <- event_info %>% left_join(repeat_event_types, by = c("unique_event_name" = "redcap_event_name")) } event_info <- event_info %>% add_partial_keys(.data$unique_event_name) %>% + mutate( + across(any_of("redcap_event"), ~ fct_inorder(redcap_event, ordered = TRUE)) + ) %>% select( redcap_form_name = "form", "redcap_event", "event_name", "redcap_arm", "arm_name", any_of("repeat_type") ) %>% diff --git a/R/utils.R b/R/utils.R index 302aab5b..bd74e936 100644 --- a/R/utils.R +++ b/R/utils.R @@ -138,23 +138,23 @@ link_arms <- function(redcap_uri, # match field name of redcap_event_instruments() output rename(arm_num = "arm_number") - db_event_instruments <- try_redcapr( + db_event_labels <- try_redcapr( { - redcap_event_instruments( + redcap_event_read( redcap_uri = redcap_uri, token = token, - arms = NULL, # get all arms verbose = !suppress_redcapr_messages ) }, call = caller_env() ) - db_event_labels <- try_redcapr( + db_event_instruments <- try_redcapr( { - redcap_event_read( + redcap_event_instruments( redcap_uri = redcap_uri, token = token, + arms = NULL, # get all arms verbose = !suppress_redcapr_messages ) }, @@ -162,7 +162,11 @@ link_arms <- function(redcap_uri, ) left_join(db_event_instruments, arms, by = "arm_num") %>% - left_join(db_event_labels, by = c("arm_num", "unique_event_name")) + left_join(db_event_labels, by = c("arm_num", "unique_event_name")) %>% + mutate( + across(any_of("unique_event_name"), ~ fct_inorder(.x, ordered = TRUE)), + across(any_of("event_name"), ~ fct_inorder(.x, ordered = TRUE)) + ) } #' @title diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 7eb23520..0d7550c4 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -228,6 +228,12 @@ test_that("link_arms works", { # all arms are represented in output (test redcap has 2 arms) n_unique_arms <- length(unique(out$arm_num)) expect_equal(n_unique_arms, 2) + expect_s3_class(out$unique_event_name, "ordered") + expect_s3_class(out$event_name, "ordered") + expect_equal( + levels(out$unique_event_name), + c("event_1_arm_1", "event_2_arm_1", "event_1_arm_2", "event_3_arm_2") + ) }) test_that("update_field_names works", { From bd9c7aab7fa7b6c227f65b2ca586b99f255bbc16 Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Fri, 1 Nov 2024 10:31:47 -0400 Subject: [PATCH 2/4] Update NEWS and version --- DESCRIPTION | 2 +- NEWS.md | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 17aca6f5..c251e7e8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: REDCapTidieR Type: Package Title: Extract 'REDCap' Databases into Tidy 'Tibble's -Version: 1.2.0 +Version: 1.2.1 Authors@R: c( person("Richard", "Hanna", , "richardshanna91@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0009-0005-6496-8154")), diff --git a/NEWS.md b/NEWS.md index 0beea435..bea99c89 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,8 @@ -# REDCapTidieR 1.2.0 (development version) +# REDCapTidieR 1.2.1 (development version) + +- For longitudinal REDCap projects, the `redcap_events` column has been updated to give REDCap event factor levels and order for the `redcap_event` and `event_name` columns + +# REDCapTidieR 1.2.0 - Added `combine_checkboxes()` analytics function - Use `combine_checkboxes()` to consolidate multiple checkbox fields in a REDCap data tibble under a single column From f335bf4f1f906f3a5f7f6e8151f8fe6a55ce73c5 Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Fri, 1 Nov 2024 10:45:19 -0400 Subject: [PATCH 3/4] Undo reorder for review simplicity --- R/utils.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/utils.R b/R/utils.R index bd74e936..b2edfe22 100644 --- a/R/utils.R +++ b/R/utils.R @@ -138,23 +138,23 @@ link_arms <- function(redcap_uri, # match field name of redcap_event_instruments() output rename(arm_num = "arm_number") - db_event_labels <- try_redcapr( + db_event_instruments <- try_redcapr( { - redcap_event_read( + redcap_event_instruments( redcap_uri = redcap_uri, token = token, + arms = NULL, # get all arms verbose = !suppress_redcapr_messages ) }, call = caller_env() ) - db_event_instruments <- try_redcapr( + db_event_labels <- try_redcapr( { - redcap_event_instruments( + redcap_event_read( redcap_uri = redcap_uri, token = token, - arms = NULL, # get all arms verbose = !suppress_redcapr_messages ) }, From 573cafff7b56bee0963448ed6bba47707adb63d4 Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Tue, 12 Nov 2024 09:38:45 -0500 Subject: [PATCH 4/4] Remove ordered, fix tests --- R/read_redcap.R | 3 +-- R/utils.R | 4 ++-- tests/testthat/test-utils.R | 4 ++-- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/read_redcap.R b/R/read_redcap.R index acec2234..db560149 100644 --- a/R/read_redcap.R +++ b/R/read_redcap.R @@ -464,8 +464,7 @@ add_event_mapping <- function(supertbl, linked_arms, repeat_event_types) { if (!is.null(repeat_event_types)) { # Preserve factor levels post-join by referencing level order from linked_arms repeat_event_types$redcap_event_name <- factor(repeat_event_types$redcap_event_name, - levels = levels(event_info$unique_event_name), - ordered = TRUE + levels = levels(event_info$unique_event_name) ) event_info <- event_info %>% diff --git a/R/utils.R b/R/utils.R index b2edfe22..5d5555a2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -164,8 +164,8 @@ link_arms <- function(redcap_uri, left_join(db_event_instruments, arms, by = "arm_num") %>% left_join(db_event_labels, by = c("arm_num", "unique_event_name")) %>% mutate( - across(any_of("unique_event_name"), ~ fct_inorder(.x, ordered = TRUE)), - across(any_of("event_name"), ~ fct_inorder(.x, ordered = TRUE)) + across(any_of("unique_event_name"), ~ fct_inorder(.x)), + across(any_of("event_name"), ~ fct_inorder(.x)) ) } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 0d7550c4..df577ec9 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -228,8 +228,8 @@ test_that("link_arms works", { # all arms are represented in output (test redcap has 2 arms) n_unique_arms <- length(unique(out$arm_num)) expect_equal(n_unique_arms, 2) - expect_s3_class(out$unique_event_name, "ordered") - expect_s3_class(out$event_name, "ordered") + expect_s3_class(out$unique_event_name, "factor") + expect_s3_class(out$event_name, "factor") expect_equal( levels(out$unique_event_name), c("event_1_arm_1", "event_2_arm_1", "event_1_arm_2", "event_3_arm_2")