这将创建一个包含所有子字符串的所有出现的向量；它天真地这样做了，迭代输入字符串 max(nchar(x)) 的最大长度并查找长度为 1、2、... max(nchar(x)) 的所有子序列，因此在多项式时间内进行缩放——对于超大问题，它不会有效。
此修订包含以下更改：
.accumulate在先前版本的内部和外部循环中实现了可怕的“复制和附加”模式；现在我们将结果累积到一个预先分配的列表中answer0，然后在内循环之后累积这些结果。
allSubstrings()有参数min_occur, min_nchar(and max_nchar) 来限制搜索空间。特别是，min_occur（保留子字符串必须出现的最小次数）有助于减少在其中搜索较长子字符串的字符向量的长度。
该函数.filter()可用于更积极地删除不包含长度为 i 的子字符串的字符串；这可能代价高昂，因此useFilter可以设置启发式和参数。过滤器的使用使整个解决方案看起来更像是一种 hack，而不是一种算法——关于子字符串的信息已经被提取出来，所以我们不必再回去寻找它们的出现。
这是修改后的主要功能
allSubstrings <-
function(x, min_occur=1L, min_nchar=1L, max_nchar=max(nchar(x)),
..., useFilter=max(nchar(x)) > 100L)
{
len <- nchar(x)
x <- x[len >= min_nchar]; len <- len[len >= min_nchar]
answer <- vector("list", max_nchar - min_nchar + 1L)
for (i in seq(min_nchar, max_nchar)) {
## suffix of length i, starting at character j
x0 <- x; len0 <- len; n <- max(len0) - i + 1L
answer0 <- vector("list", n)
for (j in seq_len(n)) {
end <- j + i - 1L
f <- factor(substr(x0, j, end))
answer0[[j]] <- setNames(tabulate(f), levels(f))
x0 <- x0[len0 != end]; len0 <- len0[len0 != end]
}
answer0 <- unlist(answer0) # accumulate across start positions
answer0 <- vapply(split(answer0, names(answer0)), sum, integer(1))
answer0 <- answer0[answer0 >= min_occur]
if (length(answer0) == 0L)
break
answer[[i - min_nchar + 1L]] <- answer0
idx <- len != i # no need to process some strings
if (useFilter)
idx[idx] <- .filter(x[idx], names(answer0))
x <- x[idx]; len <- len[idx]
if (length(x) == 0L)
break
}
unlist(answer[seq_len(i)])
}
和.filter功能
.filter <-
function(s, q)
{
## which 's' contain at least one 'q'
answer <- rep(FALSE, length(s))
idx <- !answer # use this to minimize the number of greps
for (elt in q) {
answer[idx] <- answer[idx] | grepl(elt, s[idx], fixed=TRUE)
idx[idx] <- !answer[idx]
}
answer
}
和以前一样，结果是一个命名向量，其中名称是字符串，值是它们出现的次数。
> column <- c("bla1okay", "okay1243bla", "blaokay", "bla12okay", "okaybla")
> xx <- allSubstrings(column)
> head(sort(xx, decreasing=TRUE))
a b o k l y
10 5 5 5 5 5
> xtabs(~nchar(names(xx)) + xx)
xx
nchar(names(xx)) 1 2 3 5 10
1 2 1 1 5 1
2 8 2 0 5 0
3 15 1 0 3 0
4 20 1 0 1 0
5 22 0 0 0 0
....
像原始问题中的查询很容易执行，例如，所有 >= 3 个字符的子字符串出现超过 4 次：
> (ok <- xx[nchar(names(xx)) >= 3 & xx > 4])
bla oka kay okay
5 5 5 5
该代码没有完全回答问题，例如存在嵌套子字符串，但可能会替换lapply@user1609452 答案的嵌套部分。对这个结果进行后处理以消除嵌套子序列有点不雅，但由于后处理的结果不大，可能会足够快，例如，消除嵌套子串
> fun <- function(p, q) length(grep(p, q, fixed=TRUE))
> ok[ sapply(names(ok), fun, names(ok)) == 1L ]
bla okay
5 5
在这里，我们使用笔记本电脑上的 99k 单词词典进行输入，并为修改后的算法提供了一些基本时序
> timer <- function(n, x, ...)
system.time(allSubstrings(head(x, n), ...))[[3]]
> n <- c(100, 1000, 10000, 20000)
> data.frame(n=n, elapsed=sapply(n, timer, words))
n elapsed
1 100 0.050
2 1000 0.074
3 10000 0.490
4 20000 1.031
这比原始算法快了大约 10 倍，在这种情况下完全归功于修订版 1（使用预分配和填充，然后是累积）。
这是一个较长句子的语料库
shakes <- readLines("http://www.gutenberg.org/cache/epub/100/pg100.txt")
shakes <- paste(shakes[nchar(shakes) != 0], collapse=" ")
shakes <- gsub(" +", " ", shakes)
shakes <- strsplit(shakes, "\\. +",)[[1]]
和一些时间。min_occur这从指定参数和使用过滤器中受益匪浅。
> n <- c(100, 1000, 2000, 5000)
> data.frame(n=n, elapsed=sapply(n, timer, shakes, min_occur=10))
n elapsed
1 100 1.725
2 1000 7.724
3 2000 12.415
4 5000 60.914
使用过滤器的需要和较长字符串的较差性能导致人们想要获得更好的算法，例如suffix array；“Rlibstree”包也可能有用，尽管我不确定从哪里获得当前版本或者接口的暴露部分是否足以回答原始问题。