Алгоритм/код в R, чтобы найти шаблон из любой позиции в строке

Ответ 1

find.string находит подстроку максимальной длины, подчиненную (1) подстроке, должна повторяться последовательно не менее th раз и (2) длина подстроки должна быть не больше len.

reps <- function(s, n) paste(rep(s, n), collapse = "") # repeat s n times

find.string <- function(string, th = 3, len = floor(nchar(string)/th)) {
    for(k in len:1) {
        pat <- paste0("(.{", k, "})", reps("\\1", th-1))
        r <- regexpr(pat, string, perl = TRUE)
        if (attr(r, "capture.length") > 0) break
    }
    if (r > 0) substring(string, r, r + attr(r, "capture.length")-1) else ""
}

и вот несколько тестов. Последний тест обрабатывает весь текст Джеймса Джойса Улисса за 1,4 секунды на моем ноутбуке:

> find.string("a0cc0vaaaabaaaabaaaabaa00bvw")
[1] "aaaab"
> find.string("ff00f0f0f0f0f0f0f0f0000")
[1] "0f0f"
> 
> joyce <- readLines("http://www.gutenberg.org/files/4300/4300-8.txt") 
> joycec <- paste(joyce, collapse = " ") 
> system.time(result <- find.string2(joycec, len = 25))

   user  system elapsed 
   1.36    0.00    1.39 
> result
[1] " Hoopsa boyaboy hoopsa!"

ДОБАВ

Хотя я разработал свой ответ, прежде чем увидеть BrodieG, поскольку он указывает, что они очень похожи друг на друга. Я добавил некоторые особенности его выше, чтобы получить решение ниже, и снова попробовал тесты. К сожалению, когда я добавил вариацию своего кода, пример Джеймса Джойса больше не работает, хотя он работает и с двумя другими показанными примерами. Кажется, что проблема заключается в добавлении ограничения len к коду и может представлять фундаментальное преимущество вышеприведенного кода (т.е. Он может обрабатывать такое ограничение, и такие ограничения могут быть существенными для очень длинных строк).

find.string2 <- function(string, th = 3, len = floor(nchar(string)/th)) {
    pat <- paste0(c("(.", "{1,", len, "})", rep("\\1", th-1)), collapse = "")
    r <- regexpr(pat, string, perl = TRUE)
    ifelse(r > 0, substring(string, r, r + attr(r, "capture.length")-1), "")
}

> find.string2("a0cc0vaaaabaaaabaaaabaa00bvw")
[1] "aaaab"
> find.string2("ff00f0f0f0f0f0f0f0f0000")
[1] "0f0f"

> system.time(result <- find.string2(joycec, len = 25))
   user  system elapsed 
      0       0       0 
> result
[1] "w"

ПЕРЕСМОТРЕННЫЙ Тест Джеймса Джойса, который должен был тестировать find.string2, фактически использовал find.string. Теперь это исправлено.

Ответ 2

Используйте регулярные выражения, которые создаются для этого типа вещей. Могут быть более оптимизированные способы сделать это, но с точки зрения простого написания кода это сложно превзойти. Данные:

vec <- c("a0cc0vaaaabaaaabaaaabaa00bvw","ff00f0f0f0f0f0f0f0f0000")    

Функция, которая выполняет сопоставление:

find_rep_path <- function(vec, reps) {
  regexp <- paste0(c("(.+)", rep("\\1", reps - 1L)), collapse="")
  match <- regmatches(vec, regexpr(regexp, vec, perl=T))
  substr(match, 1, nchar(match) / reps)  
}

И некоторые тесты:

sapply(vec, find_rep_path, reps=3L)
# a0cc0vaaaabaaaabaaaabaa00bvw      ff00f0f0f0f0f0f0f0f0000 
#                      "aaaab"                       "0f0f" 
sapply(vec, find_rep_path, reps=5L)
# $a0cc0vaaaabaaaabaaaabaa00bvw
# character(0)
# 
# $ff00f0f0f0f0f0f0f0f0000
# [1] "0f"

Обратите внимание, что с порогом как 3 фактический самый длинный шаблон для второй строки равен 0f0f, а не 0f (возвращается к 0f при пороге 5). Для этого я использую обратные ссылки (\\1) и повторяю их столько раз, сколько необходимо для достижения порога. Мне нужно тогда substr результат, потому что досадно, что база R не имеет простого способа получить только захваченные подвыражения при использовании совместимых с perl регулярных выражений. Вероятно, это не слишком сложный способ, но подход substr хорошо работает в этом примере.

Также, согласно обсуждению в @G. Ответ Grothendieck: вот версия с шапкой по длине шаблона, которая просто добавляет предельный аргумент и небольшую модификацию регулярного выражения.

find_rep_path <- function(vec, reps, limit) {
  regexp <- paste0(c("(.{1,", limit,"})", rep("\\1", reps - 1L)), collapse="")
  match <- regmatches(vec, regexpr(regexp, vec, perl=T))
  substr(match, 1, nchar(match) / reps)  
}
sapply(vec, find_rep_path, reps=3L, limit=3L)
# a0cc0vaaaabaaaabaaaabaa00bvw      ff00f0f0f0f0f0f0f0f0000 
#                          "a"                         "0f" 

Ответ 3

Не оптимизирована (даже быстрая) функция, но я думаю, что это скорее R-способ сделать это.

• Получить все шаблоны длины сертификатов > порог: векторизовать с помощью mapply и substr
• Получите появление этих шаблонов и извлеките файл с максимальным значением: векторизован с помощью str_locate_all.
• Повторите 1-2 для всех длин и выберите один с максимальным вхождением.

Вот мой код. Я создаю 2 функции (шаги 1-2) и шаг 3:

library(stringr)
ss = "ff00f0f0f0f0f0f0f0f0000" 
ss <- "a0cc0vaaaabaaaabaaaabaa00bvw"
find_pattern_length <- 
function(length=1,ss){
  patt = mapply(function(x,y) substr(ss,x,y),
                1:(nchar(ss)-length),
                (length+1):nchar(ss))
  res = str_locate_all(ss,unique(patt))
  ll = unlist(lapply(res,length))
  list(patt = patt[which.max(ll)],
       rep = max(ll))
}

get_pattern_threshold <- 
function(ss,threshold =3 ){
  res <- 
  sapply(seq(threshold,nchar(ss)),find_pattern_length,ss=ss)
  res[,which.max(res['rep',])]
}

несколько тестов:

get_pattern_threshold('ff00f0f0f0f0f0f0f0f0000',5)
$patt
[1] "0f0f0"

$rep
[1] 6

> get_pattern_threshold('ff00f0f0f0f0f0f0f0f0000',2)
$patt
[1] "f0"

$rep
[1] 18

Ответ 4

Поскольку вы хотите как минимум три повторения, есть хороший подход O (n ^ 2).

Для каждой возможной длины шаблона d вырезать строку на части длины d. В случае d=5 это будет:

a0cc0
vaaaa
baaaa
baaaa
baa00
bvw

Теперь посмотрим на каждую пару последующих строк A[k] и A[k+1]. Если они равны, то существует образец по крайней мере двух повторений. Затем идите дальше (k+2, k+3) и так далее. Наконец, вы также проверяете, существует ли суффикс A[k-1] и префикс A[k+n] fit (где k+n - первая строка, которая не соответствует).

Повторите его для каждого d, начиная с некоторой верхней границы (не более n/3).

У вас есть n/3 возможные длины, затем n/d строки длины d для проверки для каждого d. Это должно дать сложность O (n (n/d) d) = O (n ^ 2).

Возможно, это не оптимально, но я нашел эту режущую идею довольно опрятной;)

Ответ 5

Для ограниченного шаблона (т.е. не огромного) лучше всего сначала создать все возможные подстроки, а затем подсчитать их. Это, если суб-шаблоны могут перекрываться. Если не изменить шаг fun в цикле.

pat="a0cc0vaaaabaaaabaaaabaa00bvw"
len=nchar(pat)
thr=3
reps=floor(len/2)

# all poss strings up to half length of pattern
library(stringr)
pat=str_split(pat, "")[[1]][-1]
str.vec=vector()
for(win in 2:reps)
 {
     str.vec= c(str.vec, rollapply(data=pat,width=win,FUN=paste0, collapse=""))
 }

# the max length string repeated more than 3 times
tbl=table(str.vec)
tbl=tbl[tbl>=3]
tbl[which.max(nchar(names(tbl)))]

aaaabaa 
      3 

NB Пока я ленив и добавляю/выражаю str.vec здесь в цикле, для большей проблемы я уверен, что фактическая длина str.vec предопределена длиной шаблона, если вы хотите выработайте его.

Ответ 6

Вот мое решение, оно не оптимизировано (постройте вектор с помощью patterns <- c() ; pattern <- c(patterns, x) например) и может быть улучшено, но проще, чем ваше, я думаю.

Я не могу понять, какой шаблон точно должен (я верну его максимум), но вы можете точно настроить код так, как хотите.

str <- "a0cc0vaaaabaaaabaaaabaa00bvw"

findPatternMax <- function(str){

  nb <- nchar(str):1
  length.patt <- rev(nb)
  patterns <- c()

  for (i in 1:length(nb)){
    for (j in 1:nb[i]){
      patterns <- c(patterns, substr(str, j, j+(length.patt[i]-1)))
    }
  }
  patt.max <- names(which(table(patterns) == max(table(patterns))))
  return(patt.max)
}


  findPatternMax(str)

  > findPatternMax(str)
  [1] "a"

ИЗМЕНИТЬ: Может быть, вы хотите, чтобы возвращаемый шаблон имел минимальную длину?

то вы можете добавить параметр nchar.patt, например:

nchar.patt <- 2 #For a pattern of 2 char min

nb <- nb[length.patt >= nchar.patt]

length.patt <- length.patt[length.patt >= nchar.patt]