From fdf9ae0194f6452cfce6a44f495eb84c39856096 Mon Sep 17 00:00:00 2001 From: Richard Hanna Date: Thu, 16 Jul 2026 12:43:19 -0400 Subject: [PATCH] Add text validation and choice consistency checks Implements metadata-driven validation for REDCap text fields and choice values. Adds new validation.R module with parsers for supported text validation types: integers, decimals, dates, datetimes, times, emails, and phone numbers. Consistency checks now detect invalid choice codes in radio, dropdown, Yes/No, and True/False fields, and invalid formats in validated text fields. Enhances data import to request raw codes with type guessing disabled, ensuring choice values like '0' and '1' remain character rather than being coerced to logical. Adds caching for validation parsing and form applicability to improve performance. Removes orphaned_branching_reference check in favor of stricter validation and choice enforcement. Updates quality report documentation and test coverage. --- NAMESPACE | 1 + R/REDCapExploreR-package.R | 2 +- R/choices.R | 97 ++++- R/quality_report.R | 285 +++++++++----- R/validation.R | 342 +++++++++++++++++ man/build_quality_report.Rd | 19 +- man/pull_redcap_project.Rd | 4 +- tests/testthat/test-quality-report.R | 522 +++++++++++++++++++++++++- vignettes/articles/quality-report.Rmd | 102 ++++- 9 files changed, 1244 insertions(+), 130 deletions(-) create mode 100644 R/validation.R diff --git a/NAMESPACE b/NAMESPACE index bf738b1..35fc995 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -64,6 +64,7 @@ importFrom(htmltools,tags) importFrom(purrr,flatten_chr) importFrom(purrr,map) importFrom(purrr,map_chr) +importFrom(purrr,map_dbl) importFrom(purrr,map_lgl) importFrom(rlang,"!!!") importFrom(rlang,":=") diff --git a/R/REDCapExploreR-package.R b/R/REDCapExploreR-package.R index c538f86..c309f7e 100644 --- a/R/REDCapExploreR-package.R +++ b/R/REDCapExploreR-package.R @@ -9,7 +9,7 @@ #' @importFrom ggplot2 aes element_blank element_text geom_tile ggplot labs #' scale_fill_gradientn scale_x_discrete scale_y_discrete theme theme_minimal #' @importFrom htmltools browsable htmlDependency tagList tags -#' @importFrom purrr flatten_chr map map_chr map_lgl +#' @importFrom purrr flatten_chr map map_chr map_dbl map_lgl #' @importFrom REDCapR redcap_arm_export redcap_event_instruments #' redcap_instruments redcap_event_read redcap_instrument_repeating #' redcap_metadata_read redcap_project_info_read redcap_read_oneshot diff --git a/R/choices.R b/R/choices.R index ad00dfe..3cf94d7 100644 --- a/R/choices.R +++ b/R/choices.R @@ -47,18 +47,91 @@ get_choice_rows <- function(metadata) { metadata$choice_definition[[index]], "\\|" )[[1]] + parts <- strsplit(choices, ",", fixed = TRUE) + tibble( + field_order = metadata$field_order[[index]], + field_name = metadata$field_name[[index]], + form_name = metadata$form_name[[index]], + choice_type = tolower(metadata$field_type[[index]]), + choice_order = seq_along(choices), + choice_value = map_chr(parts, \(part) str_trim(part[[1]])), + choice_label = map_chr(parts, \(part) { + str_trim(paste(part[-1], collapse = ",")) + }) + ) + })) +} - bind_rows(map(seq_along(choices), \(choice_index) { - parts <- strsplit(choices[[choice_index]], ",", fixed = TRUE)[[1]] - tibble( - field_order = metadata$field_order[[index]], - field_name = metadata$field_name[[index]], - form_name = metadata$form_name[[index]], - choice_type = tolower(metadata$field_type[[index]]), - choice_order = choice_index, - choice_value = str_trim(parts[[1]]), - choice_label = str_trim(paste(parts[-1], collapse = ",")) - ) - })) +get_project_choice_rows <- function(project) { + if ("choices" %in% names(project)) { + return(project$choices) + } + + get_choice_rows(project$metadata) +} + +get_invalid_choice_findings <- function(project) { + choices <- get_project_choice_rows(project) + fields <- choices |> + filter(.data$choice_type != "checkbox") |> + distinct( + .data$field_name, + .data$form_name, + .data$choice_type + ) + + bind_rows(map(seq_len(nrow(fields)), \(index) { + field <- fields$field_name[[index]] + allowed <- choices |> + filter(.data$field_name == .env$field) |> + pull(.data$choice_value) + + if (!field %in% names(project$data)) { + return(get_empty_findings()) + } + + value <- as.character(project$data[[field]]) + applicable <- get_form_applicable_rows( + project, + fields$form_name[[index]] + ) + invalid <- applicable & !get_is_missing(value) & !value %in% allowed + get_invalid_choice_finding_rows( + project, + field, + fields$form_name[[index]], + invalid, + value[invalid], + allowed + ) })) } + +get_invalid_choice_finding_rows <- function( + project, + field, + form_name, + invalid, + value, + allowed +) { + if (!any(invalid)) { + return(get_empty_findings()) + } + + tibble( + check = "consistency", + issue = "invalid_choice_value", + severity = "warning", + scope = "record_field", + record_id = as.character(project$data[[project$record_id_field]][invalid]), + form_name = form_name, + event_name = get_event_values(project$data, invalid), + repeat_instrument = get_repeat_instrument_values(project$data, invalid), + repeat_instance = get_repeat_instance_values(project$data, invalid), + field_name = field, + value = value, + expected = paste("One of:", paste(allowed, collapse = ", ")), + message = paste("Field", field, "contains an invalid REDCap choice value.") + ) +} diff --git a/R/quality_report.R b/R/quality_report.R index 4fba6a0..56307e2 100644 --- a/R/quality_report.R +++ b/R/quality_report.R @@ -31,7 +31,6 @@ #' - `duplicate_field_label` #' - `missing_field_label` #' - `missing_choice_definition` -#' - `orphaned_branching_reference` #' - `high_risk_free_text` #' - `outliers` #' - `outside_validation_range` @@ -40,9 +39,27 @@ #' - `operational` #' - `incomplete_form_status` #' - `consistency` +#' - `invalid_choice_value` +#' - `invalid_validation_format` #' - `checkbox_no_values_selected` #' - `checkbox_none_with_other` #' +#' `invalid_validation_format` is evaluated only for text fields with a +#' supported validation configured in +#' `text_validation_type_or_show_slider_number`. Supported validations include +#' REDCap integer and number formats, dates and datetimes, times, email +#' addresses, and North American and Australian phone numbers. Number formats +#' accept decimal values with or without a leading zero. Date and datetime +#' values are validated in REDCap's canonical API export formats, regardless of +#' their configured data-entry display order. +#' `outside_validation_range` enforces the optional `text_validation_min` and +#' `text_validation_max` bounds using the configured validation type. +#' Unvalidated text fields and unsupported validation types are not assessed. +#' `invalid_choice_value` applies to radio, dropdown, Yes/No, and True/False +#' fields; checkbox fields retain their dedicated consistency checks. Choice +#' and text validation checks use structurally applicable form, event, and +#' repeat rows regardless of form completion status or branching logic. +#' #' @returns A list with `findings`, `summaries`, and `metadata` elements. #' `findings` includes record, form, event, repeat instrument, and repeat #' instance context when available from the REDCap export. @@ -151,6 +168,11 @@ get_quality_report <- function( "Normalized input" ) + project$represented_fields <- get_represented_fields(project) + project$form_applicability <- get_form_applicability(project) + project$validation_cache <- new.env(parent = emptyenv()) + project$field_value_cache <- new.env(parent = emptyenv()) + project$choices <- get_choice_rows(project$metadata) project$field_applicability <- get_field_applicability(project) update_report_progress( progress_bar, @@ -258,7 +280,9 @@ get_quality_report <- function( #' @returns A list containing raw records, metadata, events, event-instrument #' mapping, instruments, and repeating instrument configuration. #' Errors from any structural metadata endpoint are reported rather than -#' converted into empty project structure. +#' converted into empty project structure. Records and headers use raw REDCap +#' codes with automatic type guessing disabled, and checkbox choices are +#' returned as raw `0`/`1` values. Only empty strings are imported as missing. #' #' @export pull_redcap_project <- function(redcap_uri, token) { @@ -267,6 +291,11 @@ pull_redcap_project <- function(redcap_uri, token) { data_result <- redcap_read_oneshot( redcap_uri = redcap_uri, token = token, + raw_or_label = "raw", + raw_or_label_headers = "raw", + export_checkbox_label = FALSE, + na = "", + guess_type = FALSE, verbose = FALSE ) metadata_result <- redcap_metadata_read( @@ -701,9 +730,7 @@ get_field_summary <- function(project) { } bind_rows(map(fields, \(field) { - metadata_row <- project$metadata |> - filter(.data$field_name == field) |> - slice(1) + metadata_row <- get_metadata_row(project, field) field_rows <- get_field_applicable_rows(project, field) value <- get_field_values(project, field)[field_rows] missing <- get_is_missing(value) @@ -757,9 +784,11 @@ get_field_applicability <- function(project) { setNames( map(fields, \(field) { - metadata_row <- field_metadata |> - filter(.data$field_name == field) |> - slice(1) + metadata_row <- field_metadata[ + match(field, field_metadata$field_name), + names(field_metadata), + drop = FALSE + ] logic_key <- as.character(metadata_row$branching_logic) if (get_is_missing(logic_key)) { logic_key <- "__missing_branching_logic__" @@ -779,13 +808,17 @@ get_field_applicability <- function(project) { } get_represented_fields <- function(project) { - project$metadata$field_name[ - map_lgl(project$metadata$field_name, \(field) { - field %in% - names(project$data) || - any(startsWith(names(project$data), paste0(field, "___"))) - }) - ] + if ("represented_fields" %in% names(project)) { + return(project$represented_fields) + } + + checkbox_fields <- sub( + "___.*$", + "", + names(project$data)[str_detect(names(project$data), "___")] + ) + represented <- unique(c(names(project$data), checkbox_fields)) + project$metadata$field_name[project$metadata$field_name %in% represented] } get_field_values <- function(project, field) { @@ -793,6 +826,10 @@ get_field_values <- function(project, field) { return(project$data[[field]]) } + if ("field_value_cache" %in% names(project) && exists(field, envir = project$field_value_cache, inherits = FALSE)) { + return(project$field_value_cache[[field]]) + } + checkbox_columns <- names(project$data)[startsWith( names(project$data), paste0(field, "___") @@ -801,26 +838,57 @@ get_field_values <- function(project, field) { return(rep(NA_character_, nrow(project$data))) } - checkbox_data <- project$data[checkbox_columns] - checked <- as.data.frame(map(checkbox_data, get_is_checked)) - missing <- as.data.frame(map(checkbox_data, get_is_missing)) - checked_names <- sub(paste0("^", field, "___"), "", checkbox_columns) - map_chr(seq_len(nrow(checked)), \(row) { - row_checked <- unlist(checked[row, ], use.names = FALSE) - row_missing <- unlist(missing[row, ], use.names = FALSE) - if (all(row_missing)) { - return(NA_character_) - } + checked <- vapply( + project$data[checkbox_columns], + get_is_checked, + logical(nrow(project$data)) + ) + missing <- vapply( + project$data[checkbox_columns], + get_is_missing, + logical(nrow(project$data)) + ) + checked <- matrix( + checked, + nrow = nrow(project$data), + ncol = length(checkbox_columns) + ) + missing <- matrix( + missing, + nrow = nrow(project$data), + ncol = length(checkbox_columns) + ) - if (!any(row_checked, na.rm = TRUE)) { - return("No selections") - } + checked_names <- sub(paste0("^", field, "___"), "", checkbox_columns) + all_missing <- rowSums(missing) == ncol(missing) + selected <- !all_missing & rowSums(checked) > 0 + out <- rep("No selections", nrow(project$data)) + out[all_missing] <- NA_character_ + + if (any(selected)) { + keys <- do.call( + paste0, + unname(as.data.frame(checked[selected, , drop = FALSE] + 0L)) + ) + unique_keys <- unique(keys) + first_rows <- which(selected)[match(unique_keys, keys)] + labels <- map_chr(first_rows, \(row) { + paste(checked_names[checked[row, ]], collapse = ", ") + }) + out[selected] <- labels[match(keys, unique_keys)] + } - paste(checked_names[row_checked], collapse = ", ") - }) + if ("field_value_cache" %in% names(project)) { + project$field_value_cache[[field]] <- out + } + out } get_form_applicable_rows <- function(project, form_name) { + if ("form_applicability" %in% names(project) && form_name %in% names(project$form_applicability)) { + return(project$form_applicability[[form_name]]) + } + repeated_rows <- get_repeating_instrument_rows(project) matching_repeat_rows <- get_matching_repeat_rows(project, form_name) nonrepeat_rows <- !repeated_rows @@ -831,14 +899,16 @@ get_form_applicable_rows <- function(project, form_name) { get_form_available_rows(project, form_name)) } -get_missingness_form_applicable_rows <- function(project, form_name) { - repeated_rows <- get_repeating_instrument_rows(project) - matching_repeat_rows <- get_matching_repeat_rows(project, form_name) - nonrepeat_rows <- !repeated_rows +get_form_applicability <- function(project) { + forms <- unique(project$metadata$form_name) + setNames( + map(forms, \(form_name) get_form_applicable_rows(project, form_name)), + forms + ) +} - (matching_repeat_rows | - (nonrepeat_rows & - get_event_form_enabled_rows(project, form_name))) & +get_missingness_form_applicable_rows <- function(project, form_name) { + get_form_applicable_rows(project, form_name) & get_form_completion_assessed_rows(project$data, form_name) } @@ -1048,48 +1118,16 @@ get_metadata_findings <- function(project) { ) ) - branch_orphans <- get_branching_orphans(metadata) high_risk_text <- get_high_risk_text_findings(metadata) bind_rows( duplicate_labels, missing_labels, malformed_choices, - branch_orphans, high_risk_text ) } -get_branching_orphans <- function(metadata) { - fields <- metadata$field_name - bind_rows(map(seq_len(nrow(metadata)), \(index) { - logic <- metadata$branching_logic[[index]] - refs <- get_branching_references(logic) - missing_refs <- setdiff(refs, fields) - - if (length(missing_refs) == 0) { - return(get_empty_findings()) - } - - tibble( - check = "metadata", - issue = "orphaned_branching_reference", - severity = "warning", - scope = "field", - record_id = NA_character_, - form_name = metadata$form_name[[index]], - event_name = NA_character_, - field_name = metadata$field_name[[index]], - value = paste(missing_refs, collapse = ", "), - expected = "Branching references present in metadata", - message = paste( - "Branching logic references missing field(s):", - paste(missing_refs, collapse = ", ") - ) - ) - })) -} - get_high_risk_text_findings <- function(metadata) { pattern <- paste0( "(?:^|[^a-z])", @@ -1135,28 +1173,48 @@ get_outlier_findings <- function(project, outlier_iqr_multiplier) { get_range_findings <- function(project) { metadata <- project$metadata |> filter( + tolower(.data$field_type) == "text", .data$field_name %in% names(project$data), + tolower(.data$text_validation_type_or_show_slider_number) %in% + get_bounded_text_validations(), !get_is_missing(.data$text_validation_min) | !get_is_missing(.data$text_validation_max) ) bind_rows(map(seq_len(nrow(metadata)), \(index) { field <- metadata$field_name[[index]] - value <- suppressWarnings(as.numeric(project$data[[field]])) - min_value <- suppressWarnings(as.numeric(metadata$text_validation_min[[ - index - ]])) - max_value <- suppressWarnings(as.numeric(metadata$text_validation_max[[ - index - ]])) - low <- !is.na(value) & !is.na(min_value) & value < min_value - high <- !is.na(value) & !is.na(max_value) & value > max_value + validation <- tolower( + metadata$text_validation_type_or_show_slider_number[[index]] + ) + value <- get_cached_validation_values(project, field, validation) + min_text <- as.character(metadata$text_validation_min[[index]]) + max_text <- as.character(metadata$text_validation_max[[index]]) + min_value <- get_parsed_validation_values(min_text, validation) + max_value <- get_parsed_validation_values(max_text, validation) + applicable <- get_form_applicable_rows( + project, + metadata$form_name[[index]] + ) + low <- applicable & !is.na(value) & !is.na(min_value) & value < min_value + high <- applicable & !is.na(value) & !is.na(max_value) & value > max_value bad <- low | high if (!any(bad)) { return(get_empty_findings()) } + expected <- case_when( + !get_is_missing(min_text) && !get_is_missing(max_text) ~ + paste( + "Between", + min_text, + "and", + max_text + ), + !get_is_missing(min_text) ~ paste("At least", min_text), + TRUE ~ paste("At most", max_text) + ) + tibble( check = "outliers", issue = "outside_validation_range", @@ -1169,7 +1227,7 @@ get_range_findings <- function(project) { repeat_instance = get_repeat_instance_values(project$data, bad), field_name = field, value = as.character(project$data[[field]][bad]), - expected = paste("Between", min_value, "and", max_value), + expected = expected, message = paste("Field", field, "is outside the REDCap validation range.") ) })) @@ -1187,7 +1245,15 @@ get_iqr_outlier_findings <- function(project, outlier_iqr_multiplier) { return(get_empty_findings()) } - values <- suppressWarnings(as.numeric(project$data[[field]])) + metadata_row <- get_metadata_row(project, field) + validation <- tolower( + metadata_row$text_validation_type_or_show_slider_number + ) + values <- if (validation %in% get_supported_text_validations() && get_validation_family(validation) == "number") { + get_cached_validation_values(project, field, validation) + } else { + suppressWarnings(as.numeric(project$data[[field]])) + } observed <- values[!is.na(values)] if (length(observed) < 4 || IQR(observed) == 0) { return(get_empty_findings()) @@ -1203,7 +1269,6 @@ get_iqr_outlier_findings <- function(project, outlier_iqr_multiplier) { return(get_empty_findings()) } - metadata_row <- get_metadata_row(project, field) tibble( check = "outliers", issue = "numeric_iqr_outlier", @@ -1227,20 +1292,30 @@ get_iqr_outlier_findings <- function(project, outlier_iqr_multiplier) { get_future_date_findings <- function(project, today = Sys.Date()) { date_fields <- project$metadata |> filter( + tolower(.data$field_type) == "text", .data$field_name %in% names(project$data), - str_detect( - tolower(.data$text_validation_type_or_show_slider_number), - "date" - ) + tolower(.data$text_validation_type_or_show_slider_number) %in% + get_supported_text_validations(), + get_validation_family( + tolower(.data$text_validation_type_or_show_slider_number) + ) %in% + c("date", "datetime") ) bind_rows(map(seq_len(nrow(date_fields)), \(index) { field <- date_fields$field_name[[index]] - value <- as.Date( - as.character(project$data[[field]]), - format = "%Y-%m-%d" + validation <- tolower( + date_fields$text_validation_type_or_show_slider_number[[index]] + ) + value <- get_validation_dates_from_parsed( + get_cached_validation_values(project, field, validation), + validation ) - future <- !is.na(value) & value > today + applicable <- get_form_applicable_rows( + project, + date_fields$form_name[[index]] + ) + future <- applicable & !is.na(value) & value > today if (!any(future)) { return(get_empty_findings()) @@ -1356,7 +1431,15 @@ get_empty_completion_status <- function() { } get_consistency_findings <- function(project) { - choices <- get_choice_rows(project$metadata) + bind_rows( + get_invalid_choice_findings(project), + get_invalid_validation_findings(project), + get_checkbox_consistency_findings(project) + ) +} + +get_checkbox_consistency_findings <- function(project) { + choices <- get_project_choice_rows(project) checkbox_groups <- split( names(project$data)[str_detect(names(project$data), "___")], sub( @@ -1636,7 +1719,7 @@ get_form_metadata <- function(project) { } get_choice_metadata <- function(project) { - get_choice_rows(project$metadata) |> + get_project_choice_rows(project) |> select("field_name", "form_name", "choice_value", "choice_label") } @@ -1694,11 +1777,9 @@ get_optional_redcapr_data <- function(fun, redcap_uri, token, label) { } get_metadata_row <- function(project, field) { - row <- project$metadata |> - filter(.data$field_name == field) |> - slice(1) + index <- match(field, project$metadata$field_name) - if (nrow(row) == 0) { + if (is.na(index)) { return(tibble( field_name = field, form_name = NA_character_, @@ -1707,7 +1788,7 @@ get_metadata_row <- function(project, field) { )) } - row + project$metadata[index, , drop = FALSE] } get_is_missing <- function(x) { @@ -1870,8 +1951,18 @@ get_is_numeric_field <- function(project, field) { return(FALSE) } + observed <- as.character(value[!get_is_missing(value)]) + values_are_numeric <- length(observed) > 0 && + all( + !is.na( + suppressWarnings(as.numeric(observed)) + ) + ) + is.numeric(value) || - validation %in% c("integer", "number", "float", "number_1dp", "number_2dp") + values_are_numeric || + validation %in% "float" || + (validation %in% get_supported_text_validations() && get_validation_family(validation) == "number") } get_branching_references <- function(logic) { diff --git a/R/validation.R b/R/validation.R new file mode 100644 index 0000000..b90faf3 --- /dev/null +++ b/R/validation.R @@ -0,0 +1,342 @@ +#' Parse REDCap text validation values +#' +#' @description +#' Provides strict, metadata-driven parsing for supported REDCap text +#' validation types. +#' +#' @param value Exported REDCap field values. +#' @param validation REDCap text validation type. +#' +#' @returns Parsed numeric values, with invalid or missing values represented by +#' `NA_real_`. +#' +#' @noRd +get_parsed_validation_values <- function(value, validation) { + value <- as.character(value) + validation <- tolower(validation) + family <- get_validation_family(validation) + missing <- get_is_missing(value) + + if (family == "number") { + valid <- !missing & + grepl( + get_number_validation_pattern(validation), + value, + perl = TRUE + ) + if (str_detect(validation, "comma_decimal$")) { + value[valid] <- sub(",", ".", value[valid], fixed = TRUE) + } + + parsed <- rep(NA_real_, length(value)) + parsed[valid] <- as.numeric(value[valid]) + return(parsed) + } + + if (family %in% c("date", "datetime")) { + return(get_parsed_temporal_values(value, validation, family)) + } + + if (family == "time") { + return(map_dbl(value, \(item) get_parsed_time_value(item, validation))) + } + + rep(NA_real_, length(value)) +} + +get_parsed_validation_value <- function(value, validation) { + get_parsed_validation_values(value, validation)[[1]] +} + +get_cached_validation_values <- function(project, field, validation) { + if (!"validation_cache" %in% names(project)) { + return(get_parsed_validation_values(project$data[[field]], validation)) + } + + key <- paste(field, validation, sep = "::") + if (!exists(key, envir = project$validation_cache, inherits = FALSE)) { + project$validation_cache[[key]] <- get_parsed_validation_values( + project$data[[field]], + validation + ) + } + + project$validation_cache[[key]] +} + +get_is_valid_validation_value <- function(value, validation) { + value <- as.character(value) + validation <- tolower(validation) + family <- get_validation_family(validation) + + if (family %in% c("number", "date", "datetime", "time")) { + return( + get_is_missing(value) | + !is.na(get_parsed_validation_values(value, validation)) + ) + } + + if (family == "email") { + return( + get_is_missing(value) | + grepl( + "^[^[:space:]@]+@[^[:space:]@]+\\.[^[:space:]@]+$", + value, + perl = TRUE + ) + ) + } + + if (family == "phone") { + return( + get_is_missing(value) | + map_lgl(value, \(item) get_is_valid_phone(item, validation)) + ) + } + + rep(TRUE, length(value)) +} + +get_supported_text_validations <- function() { + c( + "integer", + "number", + "number_comma_decimal", + paste0("number_", 1:4, "dp"), + paste0("number_", 1:4, "dp_comma_decimal"), + "date_dmy", + "date_mdy", + "date_ymd", + "datetime_dmy", + "datetime_mdy", + "datetime_ymd", + "datetime_seconds_dmy", + "datetime_seconds_mdy", + "datetime_seconds_ymd", + "time", + "time_hh_mm_ss", + "time_mm_ss", + "email", + "phone", + "phone_australia" + ) +} + +get_bounded_text_validations <- function() { + validations <- get_supported_text_validations() + validations[map_lgl(validations, \(validation) { + get_validation_family(validation) %in% + c("number", "date", "datetime", "time") + })] +} + +get_validation_family <- function(validation) { + case_when( + validation == "integer" | startsWith(validation, "number") ~ "number", + startsWith(validation, "datetime") ~ "datetime", + startsWith(validation, "date") ~ "date", + startsWith(validation, "time") ~ "time", + validation == "email" ~ "email", + startsWith(validation, "phone") ~ "phone", + TRUE ~ "unsupported" + ) +} + +get_number_validation_pattern <- function(validation) { + if (validation == "integer") { + return("^-?[0-9]+$") + } + + decimal_mark <- if (str_detect(validation, "comma_decimal$")) "," else "\\." + precision <- suppressWarnings(as.integer(sub( + "^number_([1-4])dp.*$", + "\\1", + validation + ))) + decimals <- if (is.na(precision)) "+" else paste0("{1,", precision, "}") + + paste0( + "^-?(?:[0-9]+(?:", + decimal_mark, + "[0-9]", + decimals, + ")?|", + decimal_mark, + "[0-9]", + decimals, + ")$" + ) +} + +get_temporal_validation_format <- function(validation) { + if (startsWith(validation, "datetime_seconds")) { + return("%Y-%m-%d %H:%M:%S") + } + if (startsWith(validation, "datetime")) { + return("%Y-%m-%d %H:%M") + } + + "%Y-%m-%d" +} + +get_parsed_temporal_value <- function(value, validation, family) { + get_parsed_temporal_values(value, validation, family)[[1]] +} + +get_parsed_temporal_values <- function(value, validation, family) { + format <- get_temporal_validation_format(validation) + parsed <- if (family == "date") { + suppressWarnings(as.Date(value, format = format)) + } else { + suppressWarnings(as.POSIXct(strptime(value, format = format, tz = "UTC"))) + } + + valid <- !get_is_missing(value) & + !is.na(parsed) & + format(parsed, format, tz = "UTC") == value + + out <- as.numeric(parsed) + out[!valid] <- NA_real_ + out +} + +get_parsed_time_value <- function(value, validation) { + patterns <- c( + time = "^[0-9]{2}:[0-9]{2}$", + time_hh_mm_ss = "^[0-9]{2}:[0-9]{2}:[0-9]{2}$", + time_mm_ss = "^[0-9]{2}:[0-9]{2}$" + ) + pattern <- patterns[[validation]] + if (!grepl(pattern, value)) { + return(NA_real_) + } + + parts <- as.numeric(strsplit(value, ":", fixed = TRUE)[[1]]) + if (validation == "time_mm_ss") { + if (parts[[1]] > 59 || parts[[2]] > 59) { + return(NA_real_) + } + return(parts[[1]] * 60 + parts[[2]]) + } + + if (parts[[1]] > 23 || parts[[2]] > 59) { + return(NA_real_) + } + if (length(parts) == 3 && parts[[3]] > 59) { + return(NA_real_) + } + + hours <- parts[[1]] * 3600 + minutes <- parts[[2]] * 60 + seconds <- ifelse(length(parts) == 3, parts[[3]], 0) + hours + minutes + seconds +} + +get_is_valid_phone <- function(value, validation) { + if (trimws(value) != value || !grepl("^\\+?[0-9() .-]+$", value)) { + return(FALSE) + } + + digits <- gsub("[^0-9]", "", value) + has_plus <- startsWith(value, "+") + if (validation == "phone") { + international <- nchar(digits) == 11 && startsWith(digits, "1") + return((!has_plus && nchar(digits) == 10) || international) + } + + local <- !has_plus && nchar(digits) == 10 && startsWith(digits, "0") + international <- nchar(digits) == 11 && startsWith(digits, "61") + local || international +} + +get_invalid_validation_findings <- function(project) { + metadata <- project$metadata |> + filter( + tolower(.data$field_type) == "text", + .data$field_name %in% names(project$data), + tolower(.data$text_validation_type_or_show_slider_number) %in% + get_supported_text_validations() + ) + + bind_rows(map(seq_len(nrow(metadata)), \(index) { + field <- metadata$field_name[[index]] + validation <- tolower( + metadata$text_validation_type_or_show_slider_number[[index]] + ) + value <- as.character(project$data[[field]]) + applicable <- get_form_applicable_rows( + project, + metadata$form_name[[index]] + ) + family <- get_validation_family(validation) + valid <- if (family %in% c("number", "date", "datetime", "time")) { + get_is_missing(value) | + !is.na(get_cached_validation_values(project, field, validation)) + } else { + get_is_valid_validation_value(value, validation) + } + invalid <- applicable & + !get_is_missing(value) & + !valid + + if (!any(invalid)) { + return(get_empty_findings()) + } + + tibble( + check = "consistency", + issue = "invalid_validation_format", + severity = "warning", + scope = "record_field", + record_id = as.character(project$data[[project$record_id_field]][ + invalid + ]), + form_name = metadata$form_name[[index]], + event_name = get_event_values(project$data, invalid), + repeat_instrument = get_repeat_instrument_values(project$data, invalid), + repeat_instance = get_repeat_instance_values(project$data, invalid), + field_name = field, + value = value[invalid], + expected = get_validation_expected(validation), + message = paste( + "Field", + field, + "does not match its REDCap text validation." + ) + ) + })) +} + +get_validation_expected <- function(validation) { + family <- get_validation_family(validation) + if (family == "date") { + return("Valid REDCap date (YYYY-MM-DD)") + } + if (family == "datetime") { + format <- if (startsWith(validation, "datetime_seconds")) { + "YYYY-MM-DD HH:MM:SS" + } else { + "YYYY-MM-DD HH:MM" + } + return(paste("Valid REDCap datetime", paste0("(", format, ")"))) + } + + paste("Value matching REDCap", validation, "validation") +} + +get_validation_date_values <- function(value, validation) { + get_validation_dates_from_parsed( + get_parsed_validation_values(value, validation), + validation + ) +} + +get_validation_dates_from_parsed <- function(parsed, validation) { + family <- get_validation_family(validation) + + if (family == "date") { + return(as.Date(parsed, origin = "1970-01-01")) + } + + as.Date(as.POSIXct(parsed, origin = "1970-01-01", tz = "UTC")) +} diff --git a/man/build_quality_report.Rd b/man/build_quality_report.Rd index ebb2263..bc03ba0 100644 --- a/man/build_quality_report.Rd +++ b/man/build_quality_report.Rd @@ -75,7 +75,6 @@ Current \code{findings$issue} values by \code{findings$check}: \item \code{duplicate_field_label} \item \code{missing_field_label} \item \code{missing_choice_definition} -\item \code{orphaned_branching_reference} \item \code{high_risk_free_text} } \item \code{outliers} @@ -90,10 +89,28 @@ Current \code{findings$issue} values by \code{findings$check}: } \item \code{consistency} \itemize{ +\item \code{invalid_choice_value} +\item \code{invalid_validation_format} \item \code{checkbox_no_values_selected} \item \code{checkbox_none_with_other} } } + +\code{invalid_validation_format} is evaluated only for text fields with a +supported validation configured in +\code{text_validation_type_or_show_slider_number}. Supported validations include +REDCap integer and number formats, dates and datetimes, times, email +addresses, and North American and Australian phone numbers. Number formats +accept decimal values with or without a leading zero. Date and datetime +values are validated in REDCap's canonical API export formats, regardless of +their configured data-entry display order. +\code{outside_validation_range} enforces the optional \code{text_validation_min} and +\code{text_validation_max} bounds using the configured validation type. +Unvalidated text fields and unsupported validation types are not assessed. +\code{invalid_choice_value} applies to radio, dropdown, Yes/No, and True/False +fields; checkbox fields retain their dedicated consistency checks. Choice +and text validation checks use structurally applicable form, event, and +repeat rows regardless of form completion status or branching logic. } \examples{ \dontrun{ diff --git a/man/pull_redcap_project.Rd b/man/pull_redcap_project.Rd index 3b8246b..536e2ff 100644 --- a/man/pull_redcap_project.Rd +++ b/man/pull_redcap_project.Rd @@ -15,7 +15,9 @@ pull_redcap_project(redcap_uri, token) A list containing raw records, metadata, events, event-instrument mapping, instruments, and repeating instrument configuration. Errors from any structural metadata endpoint are reported rather than -converted into empty project structure. +converted into empty project structure. Records and headers use raw REDCap +codes with automatic type guessing disabled, and checkbox choices are +returned as raw \code{0}/\code{1} values. Only empty strings are imported as missing. } \description{ Retrieves records and project metadata from the REDCap API using REDCapR. diff --git a/tests/testthat/test-quality-report.R b/tests/testthat/test-quality-report.R index f7ad0d6..19c3d42 100644 --- a/tests/testthat/test-quality-report.R +++ b/tests/testthat/test-quality-report.R @@ -67,8 +67,23 @@ test_that("build_quality_report validates scalar finite thresholds", { ) }) -test_that("pull_redcap_project quiets REDCapR API messages", { - quiet_records <- function(redcap_uri, token, verbose, ...) { +test_that("pull_redcap_project requests quiet raw REDCapR records", { + quiet_records <- function( + redcap_uri, + token, + raw_or_label, + raw_or_label_headers, + export_checkbox_label, + na, + guess_type, + verbose, + ... + ) { + expect_equal(raw_or_label, "raw") + expect_equal(raw_or_label_headers, "raw") + expect_false(export_checkbox_label) + expect_equal(na, "") + expect_false(guess_type) if (verbose) { message("records should be quiet") } @@ -123,6 +138,53 @@ test_that("pull_redcap_project quiets REDCapR API messages", { ) }) +test_that("API record import preserves raw choice codes as characters", { + captured <- NULL + testthat::local_mocked_bindings( + redcap_read_oneshot = function(..., guess_type, na) { + captured <<- list(guess_type = guess_type, na = na) + choice_value <- if (guess_type) FALSE else "1" + list( + data = tibble::tibble( + record_id = "1", + choice_field = choice_value + ) + ) + }, + redcap_metadata_read = function(...) { + list( + data = tibble::tibble( + field_name = c("record_id", "choice_field"), + form_name = "main", + field_type = c("text", "dropdown"), + field_label = c("Record ID", "Choice"), + select_choices_or_calculations = c(NA, "1, One | 2, Two") + ) + ) + }, + redcap_event_read = function(...) list(data = tibble::tibble()), + redcap_event_instruments = function(...) list(data = tibble::tibble()), + redcap_instruments = function(...) list(data = tibble::tibble()), + redcap_instrument_repeating = function(...) list(data = tibble::tibble()) + ) + + project <- pull_redcap_project( + redcap_uri = "https://redcap.example/api/", + token = "test-token" + ) + report <- get_quality_report( + project = get_quality_project_data(project), + checks = "consistency", + sparse_threshold = 0.95, + outlier_iqr_multiplier = 3 + ) + + expect_false(captured$guess_type) + expect_equal(captured$na, "") + expect_equal(project$data$choice_field, "1") + expect_equal(nrow(report$findings), 0) +}) + test_that("pull_redcap_project reports optional and required API failures", { testthat::local_mocked_bindings( redcap_read_oneshot = function(redcap_uri, token, verbose, ...) { @@ -286,7 +348,7 @@ test_that("build_quality_report returns expected findings and summaries for API )) }) -test_that("API metadata checks report label, branching, and text risks", { +test_that("API metadata checks report label, choice, and text risks", { redcap_data <- tibble::tibble( record_id = "1", field_a = "1", @@ -313,10 +375,57 @@ test_that("API metadata checks report label, branching, and text risks", { expect_true("duplicate_field_label" %in% report$findings$issue) expect_true("missing_choice_definition" %in% report$findings$issue) - expect_true("orphaned_branching_reference" %in% report$findings$issue) expect_true("high_risk_free_text" %in% report$findings$issue) }) +test_that("API metadata checks do not report branching references", { + redcap_data <- tibble::tibble( + record_id = "1", + source_field = "1", + target_field = "present", + missing_reference = NA_character_, + event_reference = NA_character_, + smart_variable_reference = NA_character_, + main_complete = 2 + ) + metadata <- tibble::tibble( + field_name = c( + "record_id", + "source_field", + "target_field", + "missing_reference", + "event_reference", + "smart_variable_reference" + ), + form_name = c("main", "source_form", rep("target_form", 4)), + field_type = "text", + field_label = c( + "Record ID", + "Source Field", + "Target Field", + "Missing Reference", + "Event Reference", + "Smart Variable Reference" + ), + branching_logic = c( + NA, + NA, + "[source_field] = '1'", + "[not_in_metadata] = '1'", + "[baseline_arm_1][source_field] = '1'", + "[current-event-name] = 'baseline_arm_1'" + ) + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + checks = "metadata" + ) + + expect_false("orphaned_branching_reference" %in% report$findings$issue) +}) + test_that("API metadata aliases are standardized", { redcap_data <- tibble::tibble( record_id = "1", @@ -415,6 +524,305 @@ test_that("API outlier checks ignore invalid date strings", { expect_false("future_date" %in% report$findings$issue) }) +test_that("REDCap text validation parsers enforce supported formats", { + examples <- tibble::tribble( + ~validation, + ~valid, + ~invalid, + "integer", + "-12", + "12.0", + "number", + "12.25", + "1e3", + "number_comma_decimal", + "12,25", + "12.25", + "number_1dp", + "12.3", + "12.34", + "number_2dp", + "12.34", + "12.345", + "number_3dp", + "12.345", + "12.3456", + "number_4dp", + "12.3456", + "12.34567", + "number_1dp_comma_decimal", + "12,3", + "12,34", + "number_2dp_comma_decimal", + "12,34", + "12,345", + "number_3dp_comma_decimal", + "12,345", + "12,3456", + "number_4dp_comma_decimal", + "12,3456", + "12,34567", + "date_dmy", + "2025-12-31", + "2025-02-30", + "date_mdy", + "2025-12-31", + "12-31-2025", + "date_ymd", + "2024-02-29", + "2025-02-29", + "datetime_dmy", + "2025-12-31 23:59", + "2025-12-31 23:60", + "datetime_mdy", + "2025-12-31 23:59", + "12-31-2025 23:59", + "datetime_ymd", + "2025-12-31 23:59", + "2025-12-31 24:00", + "datetime_seconds_dmy", + "2025-12-31 23:59:59", + "2025-12-31 23:59", + "datetime_seconds_mdy", + "2025-12-31 23:59:59", + "2025-12-31 23:60:00", + "datetime_seconds_ymd", + "2025-12-31 23:59:59", + "2025-13-31 23:59:59", + "time", + "23:59", + "24:00", + "time_hh_mm_ss", + "23:59:59", + "23:60:00", + "time_mm_ss", + "59:59", + "60:00", + "email", + "person@example.org", + "person@example", + "phone", + "(215) 555-1212", + "215-555-121", + "phone_australia", + "+61 412 345 678", + "+61 12 345" + ) + + expect_true(all(purrr::map2_lgl( + examples$valid, + examples$validation, + get_is_valid_validation_value + ))) + expect_false(any(purrr::map2_lgl( + examples$invalid, + examples$validation, + get_is_valid_validation_value + ))) + expect_true(all(get_is_valid_validation_value( + c(".850", "-.850"), + "number" + ))) + expect_equal( + get_parsed_validation_values(c(".850", "-.850"), "number"), + c(0.85, -0.85) + ) + expect_true(get_is_valid_validation_value(".850", "number_3dp")) + expect_true(get_is_valid_validation_value(",850", "number_3dp_comma_decimal")) + expect_false(any(get_is_valid_validation_value(c(".", "-."), "number"))) + expect_equal( + get_validation_expected("date_mdy"), + "Valid REDCap date (YYYY-MM-DD)" + ) + expect_equal( + get_validation_expected("datetime_seconds_dmy"), + "Valid REDCap datetime (YYYY-MM-DD HH:MM:SS)" + ) +}) + +test_that("API number validation accepts decimals without a leading zero", { + redcap_data <- tibble::tibble( + record_id = c("1", "2", "3"), + score = c(".850", "-.850", "."), + main_complete = 2 + ) + metadata <- tibble::tibble( + field_name = c("record_id", "score"), + form_name = "main", + field_type = "text", + field_label = c("Record ID", "Score"), + text_validation_type_or_show_slider_number = c(NA, "number") + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + checks = "consistency" + ) + + expect_equal(report$findings$issue, "invalid_validation_format") + expect_equal(report$findings$record_id, "3") + expect_equal(report$findings$value, ".") +}) + +test_that("API consistency enforces only configured text validations", { + redcap_data <- tibble::tibble( + record_id = c("1", "2", "3"), + validated_text = c("10", "10.5", ""), + unvalidated_text = c("anything", "10.5", ""), + unsupported_text = c("abc", "123", ""), + non_text = c("10", "10.5", ""), + main_complete = c(2, 0, NA) + ) + metadata <- tibble::tibble( + field_name = c( + "record_id", + "validated_text", + "unvalidated_text", + "unsupported_text", + "non_text" + ), + form_name = "main", + field_type = c("text", "text", "text", "text", "notes"), + field_label = c( + "Record ID", + "Validated", + "Unvalidated", + "Unsupported", + "Non-text" + ), + text_validation_type_or_show_slider_number = c( + NA, + "integer", + NA, + "alpha_only", + "integer" + ) + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + checks = "consistency" + ) + + expect_equal(report$findings$issue, "invalid_validation_format") + expect_equal(report$findings$record_id, "2") + expect_equal(report$findings$field_name, "validated_text") + expect_equal(report$findings$value, "10.5") +}) + +test_that("API validation bounds use configured type-aware metadata", { + redcap_data <- tibble::tibble( + record_id = c("1", "2", "3"), + score = c("4", "11", "invalid"), + comma_score = c("1,4", "2,6", "invalid"), + visit_date = c("2024-12-31", "2025-06-01", "invalid"), + visit_datetime = c( + "2025-01-01 08:59", + "2025-01-01 09:00", + "invalid" + ), + visit_time = c("18:01", "18:00", "invalid"), + main_complete = c(2, 0, NA) + ) + metadata <- tibble::tibble( + field_name = c( + "record_id", + "score", + "comma_score", + "visit_date", + "visit_datetime", + "visit_time" + ), + form_name = "main", + field_type = "text", + field_label = c( + "Record ID", + "Score", + "Comma Score", + "Visit Date", + "Visit Datetime", + "Visit Time" + ), + text_validation_type_or_show_slider_number = c( + NA, + "integer", + "number_1dp_comma_decimal", + "date_ymd", + "datetime_ymd", + "time" + ), + text_validation_min = c( + NA, + "5", + "1,5", + "2025-01-01", + "2025-01-01 09:00", + NA + ), + text_validation_max = c(NA, "10", "2,5", NA, NA, "18:00") + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + checks = c("outliers", "consistency") + ) + range_findings <- report$findings |> + dplyr::filter(.data$issue == "outside_validation_range") + format_findings <- report$findings |> + dplyr::filter(.data$issue == "invalid_validation_format") + + expect_equal(nrow(range_findings), 7) + expect_setequal(range_findings$record_id, c("1", "2")) + expect_false(any(range_findings$record_id == "3")) + expect_setequal( + unique(range_findings$expected), + c( + "Between 5 and 10", + "Between 1,5 and 2,5", + "At least 2025-01-01", + "At least 2025-01-01 09:00", + "At most 18:00" + ) + ) + expect_equal(nrow(format_findings), 5) + expect_true(all(format_findings$record_id == "3")) +}) + +test_that("API malformed dates do not also produce future findings", { + redcap_data <- tibble::tibble( + record_id = c("1", "2"), + visit_date = c("2999-01-01", "2999-13-01"), + main_complete = c(2, 0) + ) + metadata <- tibble::tibble( + field_name = c("record_id", "visit_date"), + form_name = "main", + field_type = "text", + field_label = c("Record ID", "Visit Date"), + text_validation_type_or_show_slider_number = c(NA, "date_ymd") + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + checks = c("outliers", "consistency") + ) + + expect_equal( + report$findings$record_id[report$findings$issue == "future_date"], + "1" + ) + expect_equal( + report$findings$record_id[ + report$findings$issue == "invalid_validation_format" + ], + "2" + ) +}) + test_that("API reports drop descriptive text fields before analysis", { redcap_data <- tibble::tibble( record_id = c("1", "2"), @@ -602,6 +1010,112 @@ test_that("API checkbox consistency findings use REDCap checkbox columns", { expect_equal(report$findings$value, "symptoms___none") }) +test_that("API consistency detects invalid non-checkbox choice values", { + redcap_data <- tibble::tibble( + record_id = c("1", "2", "3"), + radio_field = c("1", "9", ""), + dropdown_field = c("a", "z", NA), + yesno_field = c("1", "2", "0"), + truefalse_field = c("0", "true", "1"), + checkbox_field___a = c(1, 2, 0), + checkbox_field___b = c(0, 0, 0), + checkbox_field___unknown = c(0, 1, 0), + undefined_field = c("1", "9", ""), + main_complete = c(2, 0, NA) + ) + metadata <- tibble::tibble( + field_name = c( + "record_id", + "radio_field", + "dropdown_field", + "yesno_field", + "truefalse_field", + "checkbox_field", + "undefined_field" + ), + form_name = "main", + field_type = c( + "text", + "radio", + "dropdown", + "yesno", + "truefalse", + "checkbox", + "radio" + ), + field_label = c( + "Record ID", + "Radio", + "Dropdown", + "Yes/No", + "True/False", + "Checkbox", + "Undefined" + ), + select_choices_or_calculations = c( + NA, + "1, One | 2, Two", + "a, A | b, B", + NA, + NA, + "A, A | B, B", + NA + ) + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + checks = "consistency" + ) + findings <- report$findings |> + dplyr::filter(.data$issue == "invalid_choice_value") + + expect_equal(nrow(findings), 4) + expect_true(all(findings$record_id == "2")) + expect_setequal( + findings$field_name, + c( + "radio_field", + "dropdown_field", + "yesno_field", + "truefalse_field" + ) + ) + expect_false("checkbox_field" %in% findings$field_name) + expect_false("undefined_field" %in% findings$field_name) +}) + +test_that("API invalid choices include applicable repeating context", { + redcap_data <- tibble::tibble( + record_id = c("1", "1", "1"), + redcap_event_name = "event_1_arm_1", + redcap_repeat_instrument = c(NA, "repeat_form", "other_form"), + redcap_repeat_instance = c(NA, 1, 1), + repeat_choice = c(NA, "9", "9"), + repeat_form_complete = c(NA, 0, NA) + ) + metadata <- tibble::tibble( + field_name = c("record_id", "repeat_choice"), + form_name = c("main", "repeat_form"), + field_type = c("text", "radio"), + field_label = c("Record ID", "Repeat Choice"), + select_choices_or_calculations = c(NA, "1, One | 2, Two") + ) + + report <- build_mock_quality_report( + redcap_data, + metadata, + repeating_instruments = tibble::tibble(form_name = "repeat_form"), + checks = "consistency" + ) + + expect_equal(report$findings$issue, "invalid_choice_value") + expect_equal(report$findings$event_name, "event_1_arm_1") + expect_equal(report$findings$repeat_instrument, "repeat_form") + expect_equal(report$findings$repeat_instance, "1") +}) + test_that("API checkbox consistency reports fields with no selected options", { redcap_data <- tibble::tibble( record_id = c("1", "2"), diff --git a/vignettes/articles/quality-report.Rmd b/vignettes/articles/quality-report.Rmd index 6b2e892..5408ae2 100644 --- a/vignettes/articles/quality-report.Rmd +++ b/vignettes/articles/quality-report.Rmd @@ -260,6 +260,78 @@ report produces one field-level `checkbox_no_values_selected` informational finding. It is a prompt to confirm that the no-selection state is intentional, not a missingness finding. +## Metadata-Defined Validation + +Choice and text validation findings compare exported raw values with rules +configured in REDCap metadata. Unlike missingness, these checks inspect +nonblank values on structurally applicable rows regardless of whether a form is +Incomplete, Unverified, or Complete. Event-to-form and repeating-instrument +mappings are respected. Branching logic does not suppress these findings: a +stored nonblank value that violates its metadata remains reviewable even when +the field is currently hidden. + +The records pull disables automatic column type guessing so raw choice codes +such as `0` and `1` remain character values rather than being converted to +logical `FALSE` and `TRUE`. Only empty CSV values are imported as missing; +literal codes such as `"NA"` are preserved for comparison with metadata. + +### Choice values + +`invalid_choice_value` identifies raw codes that are not among a field's +metadata choices for radio, dropdown, Yes/No, and True/False fields. Yes/No and +True/False use their implicit REDCap `0`/`1` definitions. + +Checkbox fields are not assessed by `invalid_choice_value`. Their metadata +codes identify the separate exported option columns, while each option column +contains a `0` or `1` selection state. Checkbox review remains available through +`checkbox_no_values_selected` and `checkbox_none_with_other`. + +Fields without an explicit radio, dropdown, or checkbox definition cannot be +compared with allowed codes. They produce `missing_choice_definition` under the +metadata check instead of an invalid-choice finding. + +### Text validation formats and bounds + +`invalid_validation_format` applies only when all of the following are true: + +1. The metadata `field_type` is `text`. +2. `text_validation_type_or_show_slider_number` contains a supported REDCap + validation type. +3. The exported value is nonblank on a structurally applicable row. + +The report does not infer validation from an R column class, field name, +question text, or observed values. Text fields without configured validation +and unsupported validation types are not assessed. + +Supported metadata validation families are: + +- `integer`; `number`; decimal-place variants from `number_1dp` through + `number_4dp`; and their `*_comma_decimal` variants. +- `date_dmy`, `date_mdy`, and `date_ymd`. +- DMY, MDY, and YMD `datetime_*` types, with or without seconds. +- `time`, `time_hh_mm_ss`, and `time_mm_ss`. +- `email`, `phone`, and `phone_australia`. + +The DMY, MDY, and YMD suffix controls REDCap's data-entry display, but REDCap +exports stored date and datetime values through the API in canonical YMD order. +The report therefore validates all date types as `YYYY-MM-DD` and datetime +types as `YYYY-MM-DD HH:MM` or `YYYY-MM-DD HH:MM:SS`, depending on whether the +validation includes seconds. + +Parsing remains strict for impossible calendar or clock values, decimal +separators, configured decimal precision, and scientific notation. REDCap +number validations accept decimal values with or without a leading zero, such +as `0.850` and `.850`. Email checks assess structure rather than deliverability. +Phone checks allow common punctuation and assess North American or Australian +digit structure; they do not verify that a number is assigned. + +When supplied, `text_validation_min` and `text_validation_max` produce +`outside_validation_range` findings for validly formatted numeric, date, +datetime, and time values outside those user-configured bounds. Either bound +can be used alone. A malformed value produces `invalid_validation_format` and +is excluded from range and future-date checks to avoid duplicate or misleading +findings. + ## Quality Report Structure ### Findings @@ -293,12 +365,13 @@ The following checks are currently performed. | Metadata | `duplicate_field_label` | The same nonblank field label is used by multiple field names. | Info, field | | Metadata | `missing_field_label` | A field has no label. | Info, field | | Metadata | `missing_choice_definition` | A radio, dropdown, or checkbox field has no explicit choice definition. | Warning, field | -| Metadata | `orphaned_branching_reference` | Branching logic references a field not present in project metadata. | Warning, field | | Metadata | `high_risk_free_text` | A text or notes field name or label contains terms associated with notes, comments, other details, or similar free text. | Info, field | -| Outliers | `outside_validation_range` | A numeric value is below or above a REDCap metadata validation bound. | Warning, `record_field` | +| Outliers | `outside_validation_range` | A validly formatted numeric, date, datetime, or time value is outside `text_validation_min` or `text_validation_max`. | Warning, `record_field` | | Outliers | `numeric_iqr_outlier` | A numeric, non-choice field falls outside the configured IQR heuristic. At least four observed values and a nonzero IQR are required. | Info, `record_field` | -| Outliers | `future_date` | A field with date validation contains a `YYYY-MM-DD` value after the report date. | Info, `record_field` | +| Outliers | `future_date` | A validly formatted date or datetime value occurs after the report date. | Info, `record_field` | | Operational | `incomplete_form_status` | An applicable form status is missing or is not Complete. | Info, `record_field` | +| Consistency | `invalid_choice_value` | A raw radio, dropdown, Yes/No, or True/False code is absent from metadata choices. | Warning, `record_field` | +| Consistency | `invalid_validation_format` | A text value does not satisfy its configured `text_validation_type_or_show_slider_number` rule. | Warning, `record_field` | | Consistency | `checkbox_no_values_selected` | No options are selected for a checkbox field across applicable Unverified or Complete forms. | Info, field | | Consistency | `checkbox_none_with_other` | A checkbox option labeled None, No, Not applicable, N/A, NA, or None of the above is selected with another option. | Warning, `record_field` | @@ -427,20 +500,21 @@ evaluates to `NA` is treated as not shown for that row. REDCap functions, smart variables, and other expressions outside the supported subset are treated as applicable rather than used to hide a potentially -required value. The metadata check separately reports references to fields that -are absent from project metadata. Complex branching findings should therefore -be reviewed against REDCap itself. +required value. The report does not produce findings for apparently missing +branching references because event-qualified fields, cross-form fields, and +smart variables cannot be classified reliably from bracketed tokens alone. -### Outlier checks depend on metadata and sample size +### Validation and outlier checks have different sources -Validation-range findings depend on numeric minimum and maximum values defined -in REDCap metadata. IQR findings are distribution-based and require at least -four observed values and a nonzero IQR. Their usefulness depends on the field's -distribution and the selected multiplier. +Format and range findings enforce user-created `text_validation_*` metadata +for text fields. The validation type determines how values and optional bounds +are parsed. Unsupported or absent validation types do not produce format +findings, and malformed values are not reported as range or future-date +findings. -Future-date checks apply only to fields whose REDCap validation type contains -`date`, and values are interpreted in `YYYY-MM-DD` form. Invalid date strings -are not reported as future dates. +IQR findings are separate distribution-based heuristics. They require at least +four observed values and a nonzero IQR, and their usefulness depends on the +field's distribution and selected multiplier. ### Counts reflect REDCap's row structure