Modify a vector based on a vector of regular expressions (regex) using (if possible) a functional approach

user_5540366 0
Viewed 94

I have a dataframe with some columns that I want to modify depending on whether they match some patterns included in a vector with regular expressions

library(fuzzyjoin)
library(tidyverse)

 (df <- tribble(~a,
               "GUA-ABC",
               "REF-CDE",
               "ACC.S93",
               "ACC.ATN"))

#> # A tibble: 4 x 1
#>   a      
#>   <chr>  
#> 1 GUA-ABC
#> 2 REF-CDE
#> 3 ACC.S93
#> 4 ACC.ATN

Depending on the pattern I want to paste a text, for example, for those that contain GUA- paste "GUA001" at the end of the chain joined by a point and for those that contain REF- paste "GUA002" in the same way, to be able to obtain the following:

# This is the resulting data.frame I need

#> # A tibble: 4 x 1
#>   a             
#>   <chr>         
#> 1 GUA-ABC.GUA001
#> 2 REF-CDE.GUA002
#> 3 ACC.S93       
#> 4 ACC.ATN

I have thought of some approaches.

Approach # 1

 # list of patterns to search
 patterns <- c("\\b^GUA\\b", "\\b^REF\\b")

 # Create a named list for recoding
 model_key <- list("\\b^GUA\\b" = "GUA001",
                   "\\b^REF\\b" = "GUA002")
 
 # Create a data.frame of regexs
 (k <- tibble(regex = patterns))

#> # A tibble: 2 x 1
#>   regex       
#>   <chr>       
#> 1 "\\b^GUA\\b"
#> 2 "\\b^REF\\b"

 # perform a regex_left_join to identify the pattern
 df %>% 
  regex_left_join(k, by = c(a = "regex")) %>% 
  mutate(
   
   across(regex, recode, !!!model_key),
   a = case_when(
    
    !is.na(regex) ~ str_c(a, regex, sep = "."),
    TRUE ~ a)
   
  ) %>% select(-regex)

#> # A tibble: 4 x 1
#>   a             
#>   <chr>         
#> 1 GUA-ABC.GUA001
#> 2 REF-CDE.GUA002
#> 3 ACC.S93       
#> 4 ACC.ATN

Why is this approach not optimal? The original data frame has millions of rows and fuzzyjoin::regex_left_join takes too long to do this.

Approach # 2

 patron <- c("GUA001" = "\\b^GUA\\b", "GUA002" = "\\b^REF\\b")
 newtex <- c("GUA001", "GUA002")
 
 pegar <- function(string, pattern, text_to_paste) {
  
  if_else(condition = str_detect(string, pattern), 
          true = str_c(string, text_to_paste, sep = "."), 
          false = string)
  
 }
 
 map2_dfr(.x = patron, .y = newtex, ~ pegar(string = df$a, 
                                            pattern = .x, 
                                            text_to_paste = .y))
#> # A tibble: 4 x 2
#>   GUA001         GUA002        
#>   <chr>          <chr>         
#> 1 GUA-ABC.GUA001 GUA-ABC       
#> 2 REF-CDE        REF-CDE.GUA002
#> 3 ACC.S93        ACC.S93       
#> 4 ACC.ATN        ACC.ATN

Created on 2021-05-20 by the reprex package (v2.0.0)

With approach # 2 I can't get a single column.

As a side note, using str_replace_all and using a named vector to replace some of the values within the string has not seemed like a good alternative at the moment.

Is there a way to do this more optimally?

stringr vectorization r algorithm regex
2 Answers

One option utilizing stringr and purrr could be:

imap_dfr(model_key,
         ~ df %>%
          filter(str_detect(a, .y)) %>%
          mutate(a = str_c(a, .x, sep = "."))) %>%
 bind_rows(df %>%
            filter(str_detect(a, str_c(names(model_key), collapse = "|"), negate = TRUE)))

  a             
  <chr>         
1 GUA-ABC.GUA001
2 REF-CDE.GUA002
3 ACC.S93       
4 ACC.ATN
user_59645570

What about a boring old loop?

## make df millions of rows
df <- df[rep(1:4,1e6),]

system.time({

  val <- c("GUA\\-", "REF\\-", "ACC\\.", "QQQ\\.")
  rpl <- c("GUA001", "GUA002", "ACC001", "QQQ001")
    
  for(i in seq_along(val)) {
    sel <- grepl(val[i], df$a)
    df$a[sel] <- paste(df$a[sel], rpl[i], sep=".")
  }

})
##   user  system elapsed 
##   2.14    0.03    2.17

2 seconds to complete

df

## A tibble: 4,000,000 x 1
#   a             
#   <chr>         
# 1 GUA-ABC.GUA001
# 2 REF-CDE.GUA002
# 3 ACC.S93.ACC001
# 4 ACC.ATN.ACC001
# ...

If the functional approach is absolutely necessary, you can squish it into a Reduce function:

Reduce(
  function(str, args) {
    sel <- grepl(args[1], str)
    str[sel] <- paste(str[sel], args[2], sep=".")
    str
  },
  Map(c, val, rpl), init = df$a
)
user_4968030
Related