diff --git a/DESCRIPTION b/DESCRIPTION index c251e7e8..e111e20c 100644 --- a/DESCRIPTION +++ b/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", , "richardshanna91@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0009-0005-6496-8154")), diff --git a/R/checks.R b/R/checks.R index 46e96d48..8b693db0 100644 --- a/R/checks.R +++ b/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}}.", diff --git a/R/clean_redcap_long.R b/R/clean_redcap_long.R index 1dc7b549..02043505 100644 --- a/R/clean_redcap_long.R +++ b/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 diff --git a/R/combine_checkboxes.R b/R/combine_checkboxes.R index 3de2ab34..7fa91bd2 100644 --- a/R/combine_checkboxes.R +++ b/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 diff --git a/R/read_redcap.R b/R/read_redcap.R index db560149..16a1ac47 100644 --- a/R/read_redcap.R +++ b/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") } diff --git a/tests/testthat/test-read_redcap.R b/tests/testthat/test-read_redcap.R index 59f1d762..8b6c984c 100644 --- a/tests/testthat/test-read_redcap.R +++ b/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"))