From 036d6d4d3620e5a180fd4e045e60c4e3f3c1b8f4 Mon Sep 17 00:00:00 2001 From: Giles Graham Date: Fri, 21 Aug 2026 13:35:51 +1200 Subject: [PATCH 1/4] convert format checking function to vectorised form. Removed internal single argument version --- R/check_format.R | 63 +++++++++++++++--------------------------------- 1 file changed, 20 insertions(+), 43 deletions(-) diff --git a/R/check_format.R b/R/check_format.R index ef71085..351978f 100644 --- a/R/check_format.R +++ b/R/check_format.R @@ -1,38 +1,3 @@ -# Check an NHI for being in a correct format. -# -# This hidden function checks only one scalar value. See the exported, -# vector-safe nhi_format() function for documentation. -# -.nhi_format <- function(nhi, allow_test_cases = FALSE) { - - if (is.na(nhi)) { - return(NA) - } - - nhi = toupper(nhi) - - if (allow_test_cases == TRUE) { - # allow NHIs that start with Z (reserved for test cases). - # Original format is 3 letters excluding O and I, followed by 4 digits. - original_pattern = '^[A-HJ-NP-Z]{3}[0-9]{4}$' - # Revised format is 3 letters followed by 2 digits followed 2 letters: - revised_pattern = '^[A-HJ-NP-Z]{3}[0-9]{2}[A-HJ-NP-Z]{2}$' - } else { # don't allow Z in the first position (most common use case): - original_pattern = '^[A-HJ-NP-Y][A-HJ-NP-Z]{2}[0-9]{4}$' - revised_pattern = '^[A-HJ-NP-Y][A-HJ-NP-Z]{2}[0-9]{2}[A-HJ-NP-Z]{2}$' - } - - if (grepl(pattern = original_pattern, x = nhi)) { - return('original format') - } - - if (grepl(pattern = revised_pattern, x = nhi)) { - return('revised format') - } else { - return('invalid format') - } -} - #' Check NHIs for correct format. #' #' \code{nhi_format} Check whether NHIs have the basic @@ -61,15 +26,27 @@ #' nhi_format('ZZZ00AX', allow_test_cases = TRUE) #' #' @export -nhi_format <- function(nhi, allow_test_cases = FALSE) { +nhi_format <- function(nhis, allow_test_cases = FALSE) { - # allow for more than one value to be processed: - n = length(nhi) - result = rep(NA, n) # create a same-length vector to return + nhis = toupper(nhis) - for (i in 1:n) { - result[i] = .nhi_format(nhi[i], allow_test_cases = allow_test_cases) + if (allow_test_cases == TRUE) { + # allow NHIs that start with Z (reserved for test cases). + # Original format is 3 letters excluding O and I, followed by 4 digits. + original_pattern = '^[A-HJ-NP-Z]{3}[0-9]{4}$' + # Revised format is 3 letters followed by 2 digits followed 2 letters: + revised_pattern = '^[A-HJ-NP-Z]{3}[0-9]{2}[A-HJ-NP-Z]{2}$' + } else { # don't allow Z in the first position (most common use case): + original_pattern = '^[A-HJ-NP-Y][A-HJ-NP-Z]{2}[0-9]{4}$' + revised_pattern = '^[A-HJ-NP-Y][A-HJ-NP-Z]{2}[0-9]{2}[A-HJ-NP-Z]{2}$' } - - return(result) + + + nhiformat <- rep(NA_character_,length(nhis)) + nhiformat[grepl(pattern = original_pattern, x = nhis)] <- 'original format' + nhiformat[grepl(pattern = revised_pattern, x = nhis)] <- 'revised format' + nhiformat[is.na(nhiformat)] <- 'invalid format' + + return(nhiformat) } + From 60b4cd83cefbf2626ffc0586fba3fe334ff25df3 Mon Sep 17 00:00:00 2001 From: Giles Graham Date: Fri, 21 Aug 2026 13:36:57 +1200 Subject: [PATCH 2/4] changed environment setup to indicate structure of lookup table --- R/nhiValidator.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/nhiValidator.R b/R/nhiValidator.R index b4190df..9abec4d 100644 --- a/R/nhiValidator.R +++ b/R/nhiValidator.R @@ -10,7 +10,8 @@ nhi_env <- new.env(emptyenv()) # define values for 24 letters (excluding I and O) and 10 digits: nhi_env$lookup = c(1:24, 0:9) +nhi_env$letters <- LETTERS |> setdiff(c('I','O')) +nhi_env$numbers <- 0:9 |> as.character() # to look up values by name: -names(nhi_env$lookup) = - strsplit('ABCDEFGHJKLMNPQRSTUVWXYZ0123456789', split = '')[[1]] +names(nhi_env$lookup) = c(nhi_env$letters,nhi_env$numbers) From 8defdbb4870e54566a16dabe7add27760f7ed594 Mon Sep 17 00:00:00 2001 From: Giles Graham Date: Fri, 21 Aug 2026 13:38:10 +1200 Subject: [PATCH 3/4] convert to single vectorised function, and add option to throw error if invalid NHIs found --- R/check_validity.R | 130 ++++++++++++++++++++++----------------------- 1 file changed, 64 insertions(+), 66 deletions(-) diff --git a/R/check_validity.R b/R/check_validity.R index a57a732..2d7442f 100644 --- a/R/check_validity.R +++ b/R/check_validity.R @@ -1,48 +1,3 @@ -# Conduct internal validity check of an NHI. -# -# This hidden function checks only one scalar value. See the exported, -# vector-safe nhi_valid() function for documentation. -# -.is_valid_nhi <- function(nhi, nhi_type = 'original format') { - - checksum = 0 - nhi = toupper(nhi) - characters = strsplit(nhi, split = '')[[1]][1:7] - - if (nhi_type == 'original format') { - modulus = 11 - } else { - modulus = 24 # for revised format - } - - # multiply each character's looked-up numeric value by its reversed - # position in the string (ie multiply the 1st by 7, the 2nd by 6, etc): - for (j in 7:2) { - checksum = (nhi_env$lookup[characters[8 - j]] * j) + checksum - } - - checksum = checksum %% modulus - if (checksum == 0) { # defined to be incorrect - return(FALSE) - } else { - checksum = (modulus - checksum) - - if (nhi_type == 'original format') { - # change 10 to 0, otherwise left unchanged: - checksum = as.character(checksum %% 10) - } else { - # in the new format, convert it to a letter: - checksum = names(nhi_env$lookup)[checksum] - } - - # compare to the final check digit: - if (checksum == characters[7]) { - return(TRUE) - } else { - return(FALSE) - } - } -} #' Conduct internal validity check of an NHI. #' @@ -57,6 +12,9 @@ #' them as invalid (almost certainly the right choice in real-world #' situations). #' +#' @param error_if_invalid If any value is an invalid NHI, option to throw +#' an error and list the problem indexes +#' #' @return \code{TRUE} if the format is correct and the final check digit #' matches the calculated value, \code{FALSE} otherwise. #' @@ -70,29 +28,69 @@ #' nhi_valid('ZZZ00AX') # FALSE in real-world situations #' #' @export -nhi_valid <- function(nhi, allow_test_cases = FALSE) { - - # allow for more than one value to be processed: - n = length(nhi) - result = rep(NA, n) # create a same-length vector to return - - for (i in 1:n) { - - # check if empty: - if (is.na(nhi[i])) { - result[i] = NA - } else { - # check for the basic sequential structure of valid letters and digits: - nhi_type = nhi_format(nhi[i], allow_test_cases = allow_test_cases) +nhi_valid <- function( + nhis, + nhi_type = 'original format', + allow_test_cases = FALSE, + error_if_invalid = FALSE) { + + checksum = 0 + + sum_first_six_nhi_characters <- function(x){ + sum( + nhi_env$lookup[x[-length(x)]]*(7:2) + ) + } + + nhis = toupper(nhis) + nhi_df <- data.frame(nhis = nhis) + # nhi_format takes care of steps 1-3 + nhi_df$type <- nhi_format(nhi_df$nhis,allow_test_cases = allow_test_cases) + nhi_df$characters <- strsplit(nhi_df$nhis, split = '') + nhi_df$characters[is.na(nhi_df$characters)] <- list(rep(NA_character_,7)) + + + nhi_df$modulo <- c( + 'original format' = 11, + 'revised format' = 23 + )[nhi_df$type] + + nhi_df$last_character <- + lapply(nhi_df$characters,\(x)tail(x,n=1)) |> + unlist() + + nhi_df$checksum <- nhi_env$lookup[nhi_df$last_character] - if (nhi_type == 'original format' | nhi_type == 'revised format') { - result[i] = .is_valid_nhi(nhi[i], nhi_type) # TRUE or FALSE - } else { # was invalid format: - result[i] = FALSE - } - } + nhi_df$sumtocheck <- + lapply( + nhi_df$characters, + sum_first_six_nhi_characters + ) |> unlist() + + nhi_df$is_valid <- + nhi_df$checksum == + (nhi_df$modulo - (nhi_df$sumtocheck %% nhi_df$modulo)) + + if(error_if_invalid){ + if(any(!nhi_df$is_valid)){ + + invalid_indices <- which(!nhi_df$is_valid) + truncated <- ifelse( + length(invalid_indices)>10, + paste(paste(invalid_indices[1:10],collapse = ', '),'...'), + paste(invalid_indices,collapse = ", ") + ) + + stop(paste0( + 'Invalid NHI(s) in ',length(invalid_indices),' row(s): ', + truncated + ) + ) + } } - return(result) + return(nhi_df$is_valid) } + + From 79a7adbf4a6bfd57268928a41af9cebacbb24387 Mon Sep 17 00:00:00 2001 From: Giles Graham Date: Fri, 21 Aug 2026 14:15:40 +1200 Subject: [PATCH 4/4] updated the description slightly and the package version. --- DESCRIPTION | 2 +- README.Rmd | 10 +++------- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ccd4280..9d9fbc1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: nhiValidator Type: Package Title: Check the Internal Validity of New Zealand NHI Numbers -Version: 0.5.1 +Version: 0.6.1 Authors@R: c( person('Michael', 'MacAskill', email = 'michael.macaskill@nzbri.org', role = c('aut', 'cre'))) diff --git a/README.Rmd b/README.Rmd index d6471bb..dcd50fb 100644 --- a/README.Rmd +++ b/README.Rmd @@ -112,13 +112,7 @@ you can override that behaviour by setting the No further feature development is envisaged but issue reports and pull requests are certainly welcome. -The package functions are vectorised only to the extent that they can be passed -a vector of values and return a corresponding vector of results. Under the hood, -however, the functions iterate over each entry in the vector and process them -sequentially. This can lead to slow performance when processing a lot of values. -If for some reason you need to validate a million NHIs, for example, expect to -wait for half an hour. Performance optimisation is not a priority for the -original developer but pull requests in that regard will be gratefully received. +As of version 0.6.1 the primary functions are vectorised, but there is still optimisation potential. Pull requests in that regard will be gratefully received. ## Licence @@ -127,5 +121,7 @@ at the New Zealand Brain Research Institute. It is released as open-source software under an [MIT licence](https://opensource.org/licenses/MIT). Note the provisions under that licence about warranties and liability. +Vectorisation was added by [Giles Graham](emailto:giles.graham@phfscience.nz) + Please report any issues or suggestions using the [Github issues page for this project](https://github.com/nzbri/nhiValidator/issues).