From c16a96a8cf22efeef56c8b563a92aa1a36fafbd2 Mon Sep 17 00:00:00 2001
From: Richard Hanna <richardshanna91@gmail.com>
Date: Fri, 1 Nov 2024 10:11:43 -0400
Subject: [PATCH] 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", {