Merge pull request #211 from CHOP-CGTInformatics/redcap-event-factor-…

…levels Add factor levels to redcap_events col
CHOP-CGTInformatics · Nov 12, 2024 · 74f986d · 74f986d
2 parents 771a56a + 573caff
commit 74f986d
Show file tree

Hide file tree

Showing 7 changed files with 29 additions and 5 deletions.
diff --git 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")),
@@ -36,7 +36,8 @@ Imports:
     pillar,
     vctrs,
     readr,
-    stats
+    stats,
+    forcats
 Suggests: 
     covr,
     knitr,

diff --git 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/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

diff --git 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
@@ -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,20 @@ 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)
+    )
+
     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
@@ -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)),
+      across(any_of("event_name"), ~ fct_inorder(.x))
+    )
 }
 
 #' @title

diff --git 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, "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")
+  )
 })
 
 test_that("update_field_names works", {