Эффективное распознавание образов в векторе строк - PullRequest
Новая
       9

Эффективное распознавание образов в векторе строк

0 голосов
/ 16 февраля 2019

Я ищу наиболее эффективное решение проблемы, поставленной в этом вопросе : скажем, у вас есть вектор v строк: 

set.seed(314159)
library(stringi)
library(stringr)

v <- stringi::stri_rand_strings(10000, 4, pattern = "[A-Z]")

head(v)
#> [1] "FQGK" "YNQH" "IMNJ" "WUFU" "BBAR" "BZUH"

Я хочу эффективно возвращает один логический элемент, представляющий, соответствует ли данный шаблон, скажем "FOO", какой-либо из строк в v.Предполагаемая функция будет работать следующим образом: 

detect("FOO")
#> FALSE
detect("BAR")
#> TRUE

Есть несколько способов сделать это с базовыми grep функциями или с использованием stringr::str_detect, но каждый из них включает в себя сначала сопоставление регулярного выражения для каждого элемента v В моем примере выполняется до 9999 ненужных тестов.Эффективное решение остановит оценку после того, как будет найдено одно совпадение.

Для каждого решения detect.# я тестирую его, применяя его ко всем трем буквенным комбинациям c: 


c <- combn(LETTERS,3, FUN = function(x){paste(x, collapse = '')})
head(c)
#> [1] "ABC" "ABD" "ABE" "ABF" "ABG" "ABH"

Возможные решения

Существует несколько возможныхрешения, которые я придумал.Для начала зацикливание на v, чтобы ненужное сопоставление с образцом не было выполнено после того, как совпадение найдено.Как вы увидите, это ужасная идея с большим количеством накладных расходов: 

detect.1 <- function(pattern){
  for (i in 1:length(v)){
    if (length(grep(pattern, v[i]))){return(TRUE)}
  }
  return(FALSE)
}

Далее, мы можем использовать комбинации any() и grepl() или stringr::str_detect(), но тогда мы сделаем ненужное совпадениетесты: 

#str_detect() from stringr
detect.2 <- function(pattern){
  any(str_detect(v, pattern) )
}

# any() and grepl()
detect.3 <- function(pattern){
  any(grepl(pattern, v))
}

Наконец, если мы знаем, что символ никогда не появляется в pattern, мы можем свернуть v в одну строку с компонентами, разделенными этим символом.Тогда достаточно одного grep: 

#collapse to long string
v_pasted <- paste(v, collapse = '_')
detect.4 <- function(pattern){
  isTRUE(as.logical(grep(pattern, v_pasted)))
}

Тесты

(обновлено для использования bench::mark()) 

det1 <- expression(data.frame(c, "inV" = I(lapply(c, FUN = detect.1))))
det2 <- expression(data.frame(c, "inV" = I(lapply(c, FUN = detect.2))))
det3 <- expression(data.frame(c, "inV" = I(lapply(c, FUN = detect.3))))
det4 <- expression({
  v_pasted <- paste(v, collapse = '_')
  data.frame(c, "inV" = I(lapply(c, FUN = detect.4)))
})

bench::mark(
  eval(det1),
  eval(det2),
  eval(det3),
  eval(det4),
  iterations = 5,
  relative = TRUE
)
#> Warning: Some expressions had a GC in every iteration; so filtering is
#> disabled.
#> # A tibble: 4 x 10
#>   expression   min  mean median   max `itr/sec` mem_alloc  n_gc n_itr
#>   <chr>      <dbl> <dbl>  <dbl> <dbl>     <dbl>     <dbl> <dbl> <dbl>
#> 1 eval(det1) 76.9  77.0   76.8  77.2        1        1      Inf     1
#> 2 eval(det2)  4.02  4.03   4.04  4.05      19.1    735.     Inf     1
#> 3 eval(det3)  2.77  2.79   2.79  2.80      27.6    735.     Inf     1
#> 4 eval(det4)  1     1      1     1         77.0      1.22   NaN     1

grepl заметно быстрее, чем str_detect.Метод вставки является самым быстрым, но требует наличия символа разделения, который не отображается в возможных шаблонах поиска.Есть ли какая-то более быстрая альтернатива, которую мне не хватает?

1 Ответ

0 голосов
/ 18 февраля 2019

Эта функция из пакета stringi должна быть быстрее: 

any(stri_detect_fixed(v, pattern, max_count = 1))

скамейка: 

require(stringi)
detect.m <- function(pattern){
  any(stri_detect_fixed(v, pattern, max_count = 1))
}

detm <- expression(data.frame(c, "inV" = I(lapply(c, FUN = detect.m))))
r <- bench::mark(
  # eval(det1),
  eval(det2),
  eval(det3),
  eval(det4),
  eval(detm),
  iterations = 5,
  relative = TRUE
)
r[, 1:10]
#   expression   min  mean median   max `itr/sec` mem_alloc  n_gc n_itr total_time
#    <chr>      <dbl> <dbl>  <dbl> <dbl>     <dbl>     <dbl> <dbl> <dbl>      <dbl>
# 1 eval(det2)  4.83  5.39   5.02  5.94      1         600.     9     1       5.39
# 2 eval(det3)  3.85  3.69   3.80  3.31      1.46      600.    10     1       3.69
# 3 eval(det4)  1.35  1.32   1.36  1.20      4.08        1      1     1       1.32
# 4 eval(detm)  1     1      1     1         5.39      600.     9     1       1

Увеличенный тест 

# lets create larger test case for better comparison:

a <- expand.grid(lapply(1:5, function(x) LETTERS))
a <- do.call(paste0, a)
f10 <- a[10] # lets search for 10th element
last <- a[length(a)] # and last
length(a)
length(unique(a))

v <- a

detm <- function(pattern){
  any(stri_detect_fixed(v, pattern, max_count = 1))
}

det4 <- function(pattern){
  # should include paste
  v_pasted <- paste(v, collapse = '_')
  # isTRUE(as.logical(grep(pattern, v_pasted)))
  isTRUE(grepl(pattern, v_pasted, fixed = T)) # faster
}

system.time(detm(last)) # 0.74
system.time(detm(f10)) #  0.33

system.time(det4(last)) # 3.38
system.time(det4(f10)) #  3.08
...