R中的算法/代码,用于从字符串中的任何位置查找模式

Question

我想从任何给定字符串中的任何位置找到模式,使得模式至少重复阈值次数.例如,对于字符串"a0cc0vaaaabaaaabaaaabaa00bvw",模式应该是"aaaab".另一个例子:对于字符串"ff00f0f0f0f0f0f0f0f0000",模式应为"0f".在两种情况下,阈值都被视为3,即模式应重复至少3次.

如果有人可以在R中建议一个优化的方法来寻找这个问题的解决方案,请与我分享.目前我通过使用3个嵌套循环来实现这一点,并且需要花费很多时间.

谢谢!

Answer 1

使用正则表达式,这是为这种类型的东西.可能有更优化的方法,但在易于编写代码方面,它很难被击败.数据:

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(在阈值5处恢复为0f).为了做到这一点,我使用了返回引用(\\1),并根据需要重复这些时间以达到阈值.我需要接下来substr的结果,因为在使用perl兼容的正则表达式时,烦人的基础R没有简单的方法来获取捕获的子表达式.可能有一种不太难的方法,但是在这个例子中,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" 

Answer 2

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秒的速度处理了James Joyce的Ulysses的整个文本:

> 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"

修订本应该测试的James Joyce测试find.string2实际上是在使用find.string.这已经修复了.