diff --git a/DESCRIPTION b/DESCRIPTION index e491b4c1..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")), @@ -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/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 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..db560149 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,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 index 302aab5b..5d5555a2 100644 --- 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 index 7eb23520..df577ec9 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, "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", {