mkearney / chr Goto Github PK

# Test for anagrams that are the same length as the input string.
chr_anagram("stac", c("cats are great", "tacs", "frogs", "cats", "ts"))
#> [1] FALSE  TRUE FALSE  TRUE FALSE

# Use arg "value" to return the values that are anagrams.
chr_anagram("stac", c("cats are great", "tacs", "frogs", "cats", "ts"), value = TRUE)
#> [1] "tacs" "cats"

# Use arg "any_len" to test for anagrams that are any length (either same length or sub-string).
chr_anagram("stac", c("cats are great", "tacs", "frogs", "cats", "ts"), any_len = TRUE)
#> [1]  TRUE  TRUE FALSE  TRUE FALSE

# Use arg "ignore_space" to make anagram searching insensitive to spaces.
chr_anagram("s t a c", c("cats are great", "t acs", "frogs", "ca   ts", "ts"), ignore_space = TRUE)
#> [1] FALSE  TRUE FALSE  TRUE FALSE

# Use arg "ignore_case" to make anagram searching insensitive to lower/upper case.
chr_anagram("STAc", c("catS are great", "tacs", "frogs", "CaTS", "ts"), ignore_case = TRUE)
#> [1] FALSE  TRUE FALSE  TRUE FALSE

x <- c("Acme Pizza, Inc.", "Tom's Sports Equipment, LLC")

ngram_func(x, ngram_len = 2L)
#> [[1]]
#>  [1] "Ac" "cm" "me" "e " " P" "Pi" "iz" "zz" "za" "a," ", " " I" "In" "nc" "c."

#> [[2]]
#>  [1] "To" "om" "m'" "'s" "s " " S" "Sp" "po" "or" "rt" "ts" "s " " E" "Eq" "qu" "ui" "ip" "pm" "me" "en" "nt" "t," ", " " L" "LL" "LC"

ngram_func(x, ngram_len = 3L, lower = TRUE, strip_punc = TRUE, strip_ws = TRUE)
#> [[1]]
#>  [1] "acm" "cme" "mep" "epi" "piz" "izz" "zza" "zai" "ain" "inc"

#> [[2]]
#>  [1] "tom" "oms" "mss" "ssp" "spo" "por" "ort" "rts" "tse" "seq" "equ" "qui" "uip" "ipm" "pme" "men" "ent" "ntl" "tll" "llc"

ngram_func <- function(x, ngram_len = 2L, lower = FALSE, strip_punc = FALSE, 
                       strip_ws = FALSE) {
  # Input validation
  stopifnot(is.character(x))
  stopifnot(is.integer(ngram_len))
  stopifnot(is.logical(lower))
  stopifnot(is.logical(strip_punc))
  stopifnot(is.logical(strip_ws))
  
  # If arg "lower" is TRUE, make all chars in x lowercase.
  if (isTRUE(lower)) x <- tolower(x)
  
  # If arg "strip_punc" is TRUE, remove all punctuation from x.
  if (isTRUE(strip_punc)) x <- gsub("[[:punct:]]", "", x)
  
  # If arg "strip_ws" is TRUE, remove all white space from x.
  if (isTRUE(strip_ws)) x <- gsub("\\s", "", x)
  
  # Split each element of x into individual chars.
  x <- strsplit(x, "", fixed = TRUE)
  
  # If ngram_len is 1L, return x, as strsplit handles tokenization into single 
  # chars.
  if (identical(ngram_len, 1L)) return(x)
  
  # Generate ngram tokens.
  ngram_len <- ngram_len - 1
  lapply(x, function(strings) {
    vapply(seq_len(length(strings) - ngram_len), function(char) {
      paste(strings[char:(char + ngram_len)], collapse = "")
    }, character(1))
  })
}