Merge pull request #213 from CHOP-CGTInformatics/fix-record-id-bug

Fix failure when `forms` is used for projects with a stand-alone record id instrument

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: REDCapTidieR
 Type: Package
 Title: Extract 'REDCap' Databases into Tidy 'Tibble's
-Version: 1.2.1
+Version: 1.2.1.9000
 Authors@R: c(
     person("Richard", "Hanna", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0009-0005-6496-8154")),

R/checks.R

@@ -757,8 +757,8 @@ check_fields_are_checkboxes <- function(metadata_tbl, call = caller_env()) {
 check_equal_col_summaries <- function(data, col1, col2, call = caller_env()) {
   summary <- data %>%
     summarise(
-      .by = col1,
-      n = n_distinct(col2)
+      .by = {{ col1 }},
+      n = n_distinct({{ col2 }})
     )
 
   total_n <- summary %>%
@@ -767,11 +767,11 @@ check_equal_col_summaries <- function(data, col1, col2, call = caller_env()) {
   if (!all(total_n == 1)) {
     col1_n_vals <- summary %>%
       filter(.data$n > 1) %>%
-      pull(col1)
+      pull({{ col1 }})
 
     col2_n_vals <- data %>% # nolint: object_usage_linter
-      filter(col1 %in% col1_n_vals) %>%
-      pull(col2)
+      filter({{ col1 }} %in% col1_n_vals) %>%
+      pull({{ col2 }})
 
     msg <- c(
       x = "{.code {col1_n_vals}} checkbox field{?s} resulted in multiple output columns: {.code {col2_n_vals}}.",

R/clean_redcap_long.R

@@ -463,7 +463,7 @@ convert_mixed_instrument <- function(db_data_long, mixed_structure_ref) {
           TRUE ~ .data$redcap_repeat_instrument
         )
       ) %>%
-      select(-.data$update_mask)
+      select(-"update_mask")
   }
 
   db_data_long

R/combine_checkboxes.R

@@ -134,18 +134,18 @@ combine_checkboxes <- function(supertbl,
   data_tbl_mod <- data_tbl_mod %>%
     mutate(
       across(
-        selected_cols,
+        all_of(selected_cols),
         ~ replace_true(.x,
           cur_column(),
           metadata = metadata_spec,
           raw_or_label = raw_or_label
         )
       ),
-      across(selected_cols, as.character) # enforce to character strings
+      across(all_of(selected_cols), as.character) # enforce to character strings
     )
 
   new_cols <- metadata_spec %>%
-    nest(.by = .data$.new_value, .key = "metadata") %>%
+    nest(.by = ".new_value", .key = "metadata") %>%
     pmap(convert_checkbox_vals,
       data_tbl = data_tbl_mod,
       raw_or_label = raw_or_label, multi_value_label = multi_value_label, values_fill = values_fill
@@ -156,7 +156,7 @@ combine_checkboxes <- function(supertbl,
   # Keep or remove original multi columns
   if (!keep) {
     final_tbl <- final_tbl %>%
-      select(-selected_cols)
+      select(!all_of(selected_cols))
   }
 
   # Update the supertbl data tibble
@@ -191,12 +191,12 @@ get_metadata_spec <- function(metadata_tbl,
   if (!is.null(names_glue)) {
     # Similar to pivot_*, use of `names_glue` overrides use of names_prefix/sep
     glue_env <- out %>%
-      select(.data$.value)
+      select(".value")
 
     glue_env$.new_value <- as.character(glue::glue_data(glue_env, names_glue))
 
     glue_env <- glue_env %>%
-      select(.data$.new_value)
+      select(".new_value")
 
     out <- cbind(out, glue_env)
   } else {
@@ -210,7 +210,7 @@ get_metadata_spec <- function(metadata_tbl,
 
   # Check that for each unique value of .value there is one unique value of .new_value
   # May be removed in the future
-  check_equal_col_summaries(out, ".value", ".new_value") # nolint: object_usage_linter
+  check_equal_col_summaries(out, ".value", ".new_value")
 
   # Make sure selection is checkbox metadata field type
   check_fields_are_checkboxes(out)
@@ -226,8 +226,8 @@ get_metadata_spec <- function(metadata_tbl,
   }
 
   bind_cols(out, parsed_vals) %>%
-    select(.data$field_name, .data$raw, .data$label, .data$.value, .data$.new_value) %>%
-    relocate(c(.data$.value, .data$.new_value), .after = .data$field_name)
+    select("field_name", "raw", "label", ".value", ".new_value") %>%
+    relocate(".value", ".new_value", .after = "field_name")
 }
 
 #' @title Replace checkbox TRUEs with raw_or_label values

R/read_redcap.R

@@ -336,25 +336,26 @@ read_redcap <- function(redcap_uri,
 #'
 #' @keywords internal
 get_fields_to_drop <- function(db_metadata, form) {
-  # Assume the first instrument in the metadata contains IDs
-  # REDCap enforces this constraints
-  record_id_field <- db_metadata$field_name[[1]]
 
-  res <- db_metadata %>%
-    filter(.data$form_name == form) %>%
-    # Add checkbox field names to metadata
-    update_field_names() %>%
-    pull(.data$field_name_updated)
+  # Always drop form complete field which is not in metadata but should be removed from
 
-  # Remove identifier since we want to keep it
-  res <- setdiff(res, record_id_field)
+  res <- paste0(form, "_complete")
 
-  # Add form complete field which is not in metadata but should be removed from
-  # read_redcap output
+  db_metadata <- db_metadata %>%
+    filter(.data$form_name == form)
 
-  res <- c(res, paste0(form, "_complete"))
+  # If there are no fields in the metadata we're done
+  if (nrow(db_metadata) == 0) {
+    return(res)
+  }
+
+  # Otherwise get the additional fields
+  additional_fields <- db_metadata %>%
+    # Add checkbox field names to metadata
+    update_field_names() %>%
+    pull(.data$field_name_updated)
 
-  res
+  c(additional_fields, res)
 }
 
 #' @title
@@ -570,5 +571,5 @@ get_repeat_event_types <- function(data) {
       is_duplicated = (duplicated(.data$redcap_event_name) | duplicated(.data$redcap_event_name, fromLast = TRUE))
     ) %>%
     filter(!.data$is_duplicated | (.data$is_duplicated & .data$repeat_type == "repeat_separate")) %>%
-    select(-.data$is_duplicated)
+    select(-"is_duplicated")
 }

tests/testthat/test-read_redcap.R

@@ -242,7 +242,7 @@ test_that("get_fields_to_drop handles checkboxes", {
   # Example metadata
   test_meta <- tibble::tribble(
     ~field_name, ~form_name, ~field_type, ~select_choices_or_calculations, ~field_label,
-    "record_id", "my_form", "text", NA_character_, NA_character_,
+    "record_id", NA_character_, "text", NA_character_, NA_character_,
     "my_checkbox", "my_form", "checkbox", "1, 1 | -99, Unknown", NA_character_
   )
 
@@ -254,6 +254,18 @@ test_that("get_fields_to_drop handles checkboxes", {
   )
 })
 
+test_that("get_fields_to_drop handles record_id form with single field", {
+  # Example metadata
+  test_meta <- tibble::tribble(
+    ~field_name, ~form_name, ~field_type, ~select_choices_or_calculations, ~field_label,
+    "record_id", NA_character_, "text", NA_character_, NA_character_
+  )
+
+  res <- get_fields_to_drop(test_meta, "my_form")
+
+  expect_equal(res, "my_form_complete")
+})
+
 test_that("read_redcap returns metadata", {
   out <- read_redcap(Sys.getenv("REDCAP_URI"), Sys.getenv("REDCAPTIDIER_LONGITUDINAL_API"))