Add factor levels and order to redcap_events col

DESCRIPTION

@@ -36,7 +36,8 @@ Imports:
     pillar,
     vctrs,
     readr,
-    stats
+    stats,
+    forcats
 Suggests: 
     covr,
     knitr,

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)

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

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")
     ) %>%

R/utils.R

@@ -138,31 +138,35 @@ 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
       )
     },
     call = caller_env()
   )
 
   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

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", {