more regex

DESCRIPTION

@@ -25,6 +25,7 @@ Imports:
     stringr,
     tidyr,
     triebeard,
+    vctrs,
     withr (>= 3.0.0)
 Suggests:
     clock,

NAMESPACE

@@ -6,11 +6,13 @@ export(calculate_amounts)
 export(carc_add_dash)
 export(chr)
 export(construct_regex)
+export(construct_regex2)
 export(data_dict)
 export(get_example)
 export(get_pin)
 export(gt_theme_northstar)
 export(is_carc_code)
+export(is_carc_full)
 export(is_carc_group)
 export(is_category_I)
 export(is_category_II)

R/adjustments.R

@@ -251,6 +251,32 @@ carc_add_dash <- \(x, placeholder = "||") {
   )
 }
 
+#' Validate CARC Codes
+#'
+#' @param x `<chr>` vector of CARC adjustment codes; should be of the form
+#'   `GROUP-CARC`, where `GROUP` is two letters, followed by a dash (`-`) and
+#'   `CARC` is a two-to-three character alphanumeric string.
+#'
+#' @template returns
+#'
+#' @examples
+#' x <- c("- 253", "OA-23", "PI-", "-45 ", "OA23")
+#'
+#' is_carc_code(x)
+#'
+#' x[which(is_carc_code(x))]
+#'
+#' @autoglobal
+#'
+#' @export
+is_carc_full <- function(x) {
+
+  stringr::str_detect(
+    gsub(" ", "", x),
+    stringr::regex(
+      "^[COP]{1}[AIOR]{1}-?[ABDPWY123456789]{1,3}$"))
+
+}
 
 #' Validate CARC Codes
 #'
@@ -293,7 +319,11 @@ is_carc_code <- function(x) {
 #' @export
 is_carc_group <- function(x) {
 
-  stringr::str_detect(gsub(" ", "", x),
-    stringr::regex("^[ACIOPR]{2}-?$"))
-
+  stringr::str_detect(
+    gsub(" ", "", x),
+    stringr::regex(
+      # "^[ACIOPR]{2}-?$"
+      "^[COP][AIOR]-?[ABDPWY123456789]$"
+      )
+    )
 }

R/regex.R

@@ -0,0 +1,159 @@
+#' Construct regex patterns
+#'
+#' @param x `<chr>` vector
+#'
+#' @examples
+#' construct_regex(search_descriptions()$hcpcs_code)
+#'
+#' @returns `<chr>` vector
+#'
+#' @autoglobal
+#'
+#' @keywords internal
+#'
+#' @export
+construct_regex <- function(x) {
+
+  # TODO: check for equal lengths
+
+  x <- collapse::funique(
+    collapse::na_rm(
+      gsub(" ", "", x)))
+
+  x <- stringr::str_split(x, "") |>
+    purrr::list_transpose() |>
+    purrr::map(collapse::funique) |>
+    purrr::map(pos_re) |>
+    purrr::list_c() |>
+    paste0(collapse = "")
+
+  paste0("^", x, "$")
+
+}
+
+#' Internal function for `construct_regex()`
+#'
+#' @param x `<chr>` vector
+#'
+#' @returns `<chr>` vector
+#'
+#' @autoglobal
+#'
+#' @noRd
+pos_re <- function(x) {
+
+  sorted   <- stringr::str_sort(x, numeric = TRUE)
+  alphabet <- purrr::list_c(strex::str_extract_non_numerics(sorted))
+  numbers  <- purrr::list_c(strex::str_extract_numbers(sorted))
+
+  paste0("[",
+         fuimus::collapser(alphabet),
+         fuimus::collapser(numbers),
+         "]")
+
+}
+
+#' Construct regex patterns
+#'
+#' @param x `<chr>` vector
+#'
+#' @examples
+#' construct_regex2(search_descriptions()$hcpcs_code)
+#'
+#' @returns `<chr>` vector
+#'
+#' @autoglobal
+#'
+#' @keywords internal
+#'
+#' @export
+construct_regex2 <- function(x) {
+
+  x <- collapse::funique(
+    collapse::na_rm(
+      gsub(" ", "", x)
+    )
+  )
+
+  vecs <- stringr::str_split_fixed(
+    x,
+    "",
+    n = max(
+      collapse::vlengths(x)
+    )
+  ) |>
+    as.data.frame() |>
+    purrr::map(
+      dplyr::na_if,
+      y = ""
+      )
+
+  to_brackets <- vecs |>
+    purrr::map(collapse::na_rm) |>
+    purrr::map(collapse::funique) |>
+    purrr::map(pos_re2)
+
+  qmark <- names(
+    which(
+      purrr::map_lgl(vecs, anyNA)
+      )
+    )
+
+  if (!vctrs::vec_is_empty(qmark)) {
+    to_brackets[qmark] <- purrr::map(
+      to_brackets[qmark],
+      \(x) paste0(x, "?")
+      )
+  }
+
+  to_vec <- to_brackets |>
+    purrr::list_c() |>
+    paste0(collapse = "")
+
+  paste0("^", to_vec, "$")
+}
+
+#' Internal function for `construct_regex2()`
+#'
+#' @param x `<chr>` vector
+#'
+#' @returns `<chr>` vector
+#'
+#' @autoglobal
+#'
+#' @noRd
+pos_re2 <- function(x) {
+
+  sorted   <- stringr::str_sort(x, numeric = TRUE)
+  alphabet <- purrr::list_c(strex::str_extract_non_numerics(sorted))
+  numbers  <- purrr::list_c(strex::str_extract_numbers(sorted))
+
+  paste0("[",
+         fuimus::collapser(alphabet),
+         fuimus::collapser(numbers),
+         "]",
+         "{1}"
+         )
+
+}
+
+#' Internal function for `construct_regex2()`
+#'
+#' @param x `<chr>` vector
+#'
+#' @returns `<chr>` vector
+#'
+#' @autoglobal
+#'
+#' @noRd
+pos_nchar <- function(x) {
+
+  ch <- range(collapse::vlengths(x))
+
+  ifelse(
+    ch[1] == ch[2],
+    paste0("{", ch[1], "}"),
+    paste0("{", ch[1], ",", ch[2], "}")
+  )
+
+}

R/utils.R

@@ -87,61 +87,6 @@ chr <- function(...) {
   as.character(...)
 }
 
-#' Construct regex pattern for HCPCS codes
-#'
-#' @param x `<chr>` vector
-#'
-#' @examples
-#' construct_regex(search_descriptions()$hcpcs_code)
-#'
-#' @returns `<chr>` vector
-#'
-#' @autoglobal
-#'
-#' @keywords internal
-#'
-#' @export
-construct_regex <- function(x) {
-
-  # TODO: check for equal lengths
-
-  x <- collapse::funique(
-    collapse::na_rm(
-      gsub(" ", "", x)))
-
-  x <- stringr::str_split(x, "") |>
-    purrr::list_transpose() |>
-    purrr::map(collapse::funique) |>
-    purrr::map(pos_re) |>
-    purrr::list_c() |>
-    paste0(collapse = "")
-
-  paste0("^", x, "$")
-
-}
-
-#' Internal function for `construct_regex()`
-#'
-#' @param x `<chr>` vector
-#'
-#' @returns `<chr>` vector
-#'
-#' @autoglobal
-#'
-#' @noRd
-pos_re <- function(x) {
-
-  sorted   <- stringr::str_sort(x, numeric = TRUE)
-  alphabet <- purrr::list_c(strex::str_extract_non_numerics(sorted))
-  numbers  <- purrr::list_c(strex::str_extract_numbers(sorted))
-
-  paste0("[",
-         fuimus::collapser(alphabet),
-         fuimus::collapser(numbers),
-         "]")
-
-}
-
 #' Apply {gt} Theme
 #'
 #' @param gt_object `<gt_tbl>` A [gt][gt::gt-package] table object