added contrast, remove_redundant

fixed bug in random_hcpcs
added several more wrappers

DESCRIPTION

@@ -16,7 +16,9 @@ Imports:
     rlang,
     stringfish,
     stringr,
-    vctrs
+    vctrs,
+    purrr,
+    stats
 Suggests: 
     fs,
     pins,

NAMESPACE

@@ -1,17 +1,26 @@
 # Generated by roxygen2: do not edit by hand
 
 export(chop)
+export(contrast)
 export(empty)
 export(get_pin)
 export(gh_raw)
+export(letters_to_numbers)
 export(list_pins)
+export(lump)
 export(max_vlength)
 export(mount_board)
 export(random_hcpcs)
+export(remove_redundant)
+export(sf_detect)
 export(sf_extract)
+export(sf_remove)
 export(sf_sub)
 export(sort_order)
 export(split_lengths)
 export(take_at)
 export(unique_narm)
 export(unique_vlength)
+importFrom(collapse,"%!in%")
+importFrom(collapse,"%=%")
+importFrom(collapse,.c)

R/generated-globals.R

@@ -1,7 +1,15 @@
 # Generated by roxyglobals: do not edit by hand
 
 utils::globalVariables(c(
-  # <sf_extract>
-  "x",
+  # <remove_redundant>
+  "x1",
+  # <remove_redundant>
+  "x2",
+  # <remove_redundant>
+  "x3",
+  # <remove_redundant>
+  "x4",
+  # <remove_redundant>
+  "x5",
   NULL
 ))

R/helpers.R

@@ -65,7 +65,25 @@ sf_sub <- \(x, i = 1, z) stringfish::sf_substr(x, start = i, stop = z, nthreads
 #' @autoglobal
 #' @keywords internal
 #' @export
-sf_extract <- \(s, p) x[stringfish::sf_grepl(s, p, nthreads = 4L)]
+sf_extract <- \(s, p) s[stringfish::sf_grepl(s, p, nthreads = 4L)]
+
+#' Detect by Regex
+#' @param s subject
+#' @param p pattern
+#' @returns vector
+#' @autoglobal
+#' @keywords internal
+#' @export
+sf_detect <- \(s, p) stringfish::sf_grepl(s, p, nthreads = 4L)
+
+#' Remove by Regex
+#' @param s subject
+#' @param p pattern
+#' @returns vector
+#' @autoglobal
+#' @keywords internal
+#' @export
+sf_remove <- \(s, p) stringfish::sf_gsub(s, p, "", nthreads = 4L)
 
 #' Sort Order
 #' @param x vector
@@ -86,3 +104,43 @@ sort_order <- \(x) {
     paste0(numb, collapse = "")
   )
 }
+
+#' Lump Like Vectors Together
+#' @param x vector
+#' @returns vector
+#' @autoglobal
+#' @keywords internal
+#' @export
+lump <- function(x, threshold = 3) {
+
+  stopifnot(is.numeric(x))
+
+  xo <- order(x)
+
+  xs <- x[xo]
+
+  dlag <- abs(c(0, xs[-1] - xs[seq_along(xs) - 1]))
+
+  bi <- ifelse(dlag >= threshold, 1, 0)
+
+  id <- cumsum(bi) + 1
+
+  id[xo]
+}
+
+#' Convert Letters to Integers
+#' @param x vector of letters
+#' @examples
+#' letters_to_numbers(LETTERS)
+#' @returns vector of integers
+#' @autoglobal
+#' @keywords internal
+#' @export
+letters_to_numbers <- \(x) {
+
+  unname(
+    setNames(
+      seq_along(LETTERS), LETTERS)[
+      sf_extract(x, "[A-Z]{1}")]
+    )
+}

R/random_hcpcs.R

@@ -11,15 +11,13 @@
 #' @autoglobal
 random_hcpcs <- function(n = 10) {
 
-  h <- stringfish::convert_to_sf(get_pin("hcpcs_vec"))
+  h <- stringfish::convert_to_sf(
+    get_pin("hcpcs_vec"))
 
-  ltrs <- LETTERS[stringfish::sf_grepl(LETTERS, "[^DINOW-Z]", nthreads = 4L)]
-
-  c(
-    sample(c(ltrs, 0:9), size = sample.int(5, 1)),
-    sfsub(sample(h, n), z = 2),
-    sfsub(sample(h, n), z = 3),
-    sfsub(sample(h, n), z = 4),
-    sfsub(sample(h, n), z = 5)
+  c(sample(c(sf_extract(LETTERS, "[^DINOW-Z]"), 0:9), size = sample.int(5, 1)),
+    sf_sub(sample(h, n), z = 2),
+    sf_sub(sample(h, n), z = 3),
+    sf_sub(sample(h, n), z = 4),
+    sf_sub(sample(h, n), z = 5)
   )
 }

R/redundant.R

@@ -0,0 +1,65 @@
+#' Contrast Redundant Characters
+#'
+#' @param long <character> vector
+#' @param short <character> vector
+#'
+#' @returns <character> vector
+#'
+#' @examples
+#' contrast(
+#'    long = c("39550", "92083", "C5274"),
+#'    short = c("3", "5", "M", "U"))
+#'
+#' @importFrom collapse %!in%
+#'
+#' @export
+#'
+#' @autoglobal
+contrast <- rr <- \(long, short) {
+
+  if (empty(long))  return(character(0))
+
+  if (empty(short)) return(long)
+
+  long[
+    sf_sub(
+      x = long,
+      i = 1,
+      z = unique_vlength(short)) %!in% short]
+}
+
+#' Remove Redundant Characters
+#'
+#' @param x <list> of vectors
+#' @param verbose <logical> print output
+#'
+#' @returns <list> of vectors
+#'
+#' @examples
+#' random_hcpcs(15) |>
+#'    split_lengths() |>
+#'    remove_redundant()
+#'
+#' @importFrom collapse %=% .c
+#'
+#' @export
+#'
+#' @autoglobal
+remove_redundant <- function(x, verbose = FALSE) {
+
+  .c(x1, x2, x3, x4, x5) %=% x
+
+  out <- list(
+    x1 = x1,
+    x2 = rr(x2, x1),
+    x3 = rr(x3, x1) |> rr(x2),
+    x4 = rr(x4, x1) |> rr(x2) |> rr(x3),
+    x5 = rr(x5, x1) |> rr(x2) |> rr(x3) |> rr(x4)
+  )
+
+  if (verbose) {
+    return(invisible(out))
+  } else {
+    return(out)
+  }
+}

R/split_lengths.R

@@ -17,7 +17,7 @@ split_lengths <- function(x, verbose = FALSE) {
 
   stopifnot(is.character(x))
 
-  x <- stringfish::sf_gsub(x, "\\*|\\s", "", nthreads = 4L) |>
+  x <- sf_remove(x, "\\*|\\s") |>
     unique_narm() |>
     stringr::str_sort()
 
@@ -31,15 +31,8 @@ split_lengths <- function(x, verbose = FALSE) {
     x5 = x[l == 5])
 
   if (verbose) {
-
-    # cat("Split by Length:", sep = "\n")
-
-    # cat("\n")
-
-    # cat(view(out), sep = "\n")
-    #
-    # return(invisible(out))
-
+    return(invisible(out))
+  } else {
+    return(out)
   }
-  return(out)
 }