R/chi_check.R

In graemegowans/chilir: CHI Functions

#' Check CHI
#'
#' Check that the CHI number is valid
#'
#' @param to_check character vector of CHI numbers
#' @return character
#' @export
#' @examples
#' x <- c("0101011237", "0101201234","3201201234", "0113201234",
#'  "3213201234", "123", "12345678900", "010120123?")
#' chi_check(x)
chi_check <- function(to_check) {

  #stop if input is not character
  if(inherits(to_check, "character") != TRUE) {
    stop("input should be character class - try adding col_types = 'c' to read_csv")
  }

  #define checksum function
  checksum <- function(x) {

    #define sub_num helper function
    sub_num <- function(z, num) {
      #weight factor for checksum calculation
      wg <- c(10, 9, 8, 7, 6, 5, 4, 3, 2)
      z_ex <- substr(z, num, num)
      as.numeric(z_ex) * wg[num]
    }

    #multiply by weights and add together
    y <- sub_num(x, 1) + sub_num(x, 2) +
      sub_num(x, 3) + sub_num(x, 4)+
      sub_num(x, 5) + sub_num(x, 6)+
      sub_num(x, 7) + sub_num(x, 8)+
      sub_num(x, 9)

    y2 <- floor(y/11) #discard remainder
    y3 <- 11 * (y2 + 1) - y #check sum calc
    y3 <- ifelse(y3 == 11, 0, y3) #if 11, make 0
    ifelse(y3 != substr(x, 10, 10), "fail", NA_character_)
  }

  #make vec of numerics, replacing invalid characters with NA
  to_check_num <- ifelse(grepl(x = to_check, pattern = "[[:punct:][:alpha:]]"),
                         NA_character_,
                         to_check)
  #perform checks
  ifelse(is.na(to_check_num), "invalid character", #check character
         ifelse(nchar(to_check_num) > 10, "too long", #is it 10 digits?
                ifelse(nchar(to_check_num) < 10, "too short", #is it 10 digits?
                       ifelse(is.na(lubridate::dmy(substr(to_check_num, 1, 6), quiet = TRUE)), "invalid date", #date check
                              ifelse(checksum(to_check_num) == "fail", "invalid checksum", NA_character_)))))#checksum calculation
}