R：从开头找到最大的公共子串
Posted
技术标签:
【中文标题】R：从开头找到最大的公共子串【英文标题】：R: find largest common substring starting at the beginning 【发布时间】：2014-12-04 18:32:39 【问题描述】：我有 2 个向量：
word1 <- "bestelling"
word2 <- "bestelbon"
现在我想找到从开头开始的最大公共子字符串，所以这里就是“bestel”。
但是以“bestelling”和“stel”等另外两个词为例，那么我想返回""。
【问题讨论】：
对所有这些答案进行基准测试的人+1。 @MatthewPlourde 我无法抗拒挑战 :-) ... @MatthewPlourde 查看初步结果。 这些看起来不太像向量...您的意思是字符串还是可以澄清这一点？ 【参考方案1】：fun <- function(words)
#extract substrings from length 1 to length of shortest word
subs <- sapply(seq_len(min(nchar(words))),
function(x, words) substring(words, 1, x),
words=words)
#max length for which substrings are equal
neqal <- max(cumsum(apply(subs, 2, function(x) length(unique(x)) == 1L)))
#return substring
substring(words[1], 1, neqal)
words1 <- c("bestelling", "bestelbon")
fun(words1)
#[1] "bestel"
words2 <- c("bestelling", "stel")
fun(words2)
#[1] ""
【讨论】：
这很好——我一直在寻找一个适用于单词列表的函数，而不仅仅是一对。【参考方案2】：这似乎有效
longestprefix<-function(a,b)
n <- pmin(nchar(a), nchar(b))
mapply(function(x, y, n)
rr<-rle(x[1:n]==y[1:n])
if(rr$values[1])
paste(x[1:rr$lengths[1]], collapse="")
else
""
, strsplit(a, ""), strsplit(b,""), n)
longestprefix("bestelling", "bestelbon")
# [1] "bestel"
longestprefix("bestelling", "stel")
# [1] ""
【讨论】：
【参考方案3】：这适用于任意的单词向量
words <- c('bestelling', 'bestelbon')
words.split <- strsplit(words, '')
words.split <- lapply(words.split, `length<-`, max(nchar(words)))
words.mat <- do.call(rbind, words.split)
common.substr.length <- which.max(apply(words.mat, 2, function(col) !length(unique(col)) == 1)) - 1
substr(words[1], 1, common.substr.length)
# [1] "bestel"
【讨论】：
【参考方案4】：有点乱，但这是我想出的：
largest_subset <- Vectorize(function(word1,word2)
substr(word1, 1, sum(substring(word1, 1, 1:nchar(word1))==substring(word2, 1, 1:nchar(word2))))
)
如果单词长度不同，它会产生警告消息，但不要害怕。它检查从每个单词的第一个字符到每个位置的每个子字符串是否在两个单词之间产生匹配。然后，您可以计算有多少值是真实的，并捕获到该字符的子字符串。我对它进行了矢量化，以便您可以将其应用于词向量。
> word1 <- c("tester","doesitwork","yupyppp","blanks")
> word2 <- c("testover","doesit","yupsuredoes","")
> largest_subset(word1,word2)
tester doesitwork yupyppp blanks
"test" "doesit" "yup" ""
【讨论】：
【参考方案5】：这是另一个似乎有效的功能。
foo <- function(word1, word2)
s1 <- substring(word1, 1, 1:nchar(word1))
s2 <- substring(word2, 1, 1:nchar(word2))
if(length(w <- which(s1 %in% s2))) s2[max(w)] else character(1)
foo("bestelling", "bestelbon")
# [1] "bestel"
foo("bestelling", "stel")
# [1] ""
foo("bestelbon", "bestieboop")
# [1] "best"
foo("stel", "steal")
# [1] "ste"
【讨论】：
Richard 感谢优雅的解决方案。如何扩展它，以便我可以在两个字符串长度内的任何位置找到公共子字符串（而不仅仅是开头）【参考方案6】：为什么不添加另一个！并破解它，所以答案与其他人不同！
largestStartSubstr<-function(word1, word2)
word1vec<-unlist(strsplit(word1, "", fixed=TRUE))
word2vec<-unlist(strsplit(word2, "", fixed=TRUE))
indexes<-intersect(1:nchar(word1), 1:nchar(word2))
bools<-word1vec[indexes]==word2vec[indexes]
if(bools[1]==FALSE)
""
else
lastChar<-match(1,c(0,diff(cumsum(!bools))))-1
if(is.na(lastChar))
lastChar<-indexes[length(indexes)]
substr(word1, 1,lastChar)
word1 <- "bestselling"
word2<- "bestsel"
largestStartSubstr(word1, word2)
#[1] "bestsel"
word1 <- "bestselling"
word2<- "sel"
largestStartSubstr(word1, word2)
#[1] ""
【讨论】：
【参考方案7】：尽管我通常避免在 R 中使用 for 循环 - 鉴于您从头开始并继续直到找到解决方案，这似乎是一种简单的方法。
它比我认为的其他一些示例更直观
lcsB <- function(string1, string2)
x <- ''
for (i in 1:nchar(string1))
if (substr(string1[1],1,i) == substr(string2[1],1,i))
x <- substr(string1[1],1,i)
else
return(x)
return(x)
lcsB("bestelling", "bestelbon")
lcsB("bestelling", "stel")
【讨论】：
【参考方案8】：我意识到我来晚了，但确定成对对齐是生物学研究中的一个基本问题，并且已经有一个包（或包系列）可以解决这个问题。可以使用名为 Biostrings 的 Bioconductor 包（如果您安装了所有默认依赖项，它至少很大，因此在安装过程中需要耐心等待）。它返回 S4 对象，因此需要不同的提取函数。这可能是一个大锤来提取坚果，但这里是给出所需结果的代码：
install.packages("Biostrings", repo="http://www.bioconductor.org/packages/2.14/bioc/", dependencies=TRUE)
library(Biostrings)
psa1 <- pairwiseAlignment(pattern = c(word1) ,word2,type="local")
psa1@pattern
#[1] bestel
但是，它没有设置为默认限制匹配以在两个字符串的第一个字符处对齐。我们可以希望@MartinMorgan 能够解决我的错误。
【讨论】：
【参考方案9】：Matthew Plourde 打来电话，Benchmarker 先生回应！ 抱歉，BondedDust，但我无法从工作场所的墙壁后面接触到生物导体。
library(microbenchmark)
wfoo1 <-'bestelling'
wfoo2<-'bestelbon'
microbenchmark(stu(wfoo1,wfoo2),nathan(wfoo1,wfoo2),plourde(),scriven(wfoo1,wfoo2),dmt(wfoo1,wfoo2),mrflick(wfoo1,wfoo2),roland(c(wfoo1,wfoo2)))
Unit: microseconds
expr min lq median uq
stu(wfoo1, wfoo2) 171.905 183.0230 187.5135 191.1490
nathan(wfoo1, wfoo2) 35.921 42.3360 43.6180 46.1840
plourde() 551.208 581.3545 591.6175 602.5220
scriven(wfoo1, wfoo2) 16.678 21.1680 22.6645 23.7335
dmt(wfoo1, wfoo2) 79.966 86.1665 88.7325 91.5125
mrflick(wfoo1, wfoo2) 100.492 108.4030 111.1830 113.9625
roland(c(wfoo1, wfoo2)) 215.950 226.8545 231.7725 237.5455
max neval
435.321 100
59.012 100
730.809 100
85.525 100
286.081 100
466.537 100
291.213 100
我认为我有责任修改这些函数，以便它们根据一个包含 1000 个参考词（而不仅仅是一对）的向量来测量输入词，以了解速度测试的结果。也许以后。
稍后... :-)。我没有做循环，但我用长词试了一下：
编辑：正如弗洛德尔指出的那样，这是一个错字，导致测试了一个相当长的向量 非常短的单词！
wfoo1 <-rep(letters,100)
wfoo2<-c(rep(letters,99),'foo')
Unit: microseconds
expr min lq median
stu(wfoo1, wfoo2) 31215.243 32718.5535 35270.6110
nathan(wfoo1, wfoo2) 202.266 216.3780 227.2825
plourde() 569.168 617.0615 661.5340
scriven(wfoo1, wfoo2) 794.953 828.3070 847.5505
dmt(wfoo1, wfoo2) 1081.033 1156.9365 1205.8990
mrflick(wfoo1, wfoo2) 126058.316 131283.4485 241018.5150
roland(c(wfoo1, wfoo2)) 946.759 1004.4885 1045.3260
uq max neval
146451.2595 167000.713 100
236.0485 356.211 100
694.6750 795.381 100
868.9310 1021.594 100
1307.6740 116075.442 100
246739.6910 991550.586 100
1082.1020 1243.103 100
抱歉，理查德，但看起来你需要把鸡肉晚餐送给内森。
EDIT2：确保输入是单个单词，并将弗洛德尔的代码添加到堆中。
编辑了“plourde”函数以接受输入并重新运行长字案例
wfoo1 <-paste(rep(letters,100),collapse='')
wfoo2<-paste(c(rep(letters,99),'foo'),collapse='')
看起来 3 个人的代码执行相似，所以就像在环法自行车赛中一样，我将第一名授予 mrflick、dmt 和 flodel。
microbenchmark(stu(wfoo1,wfoo2),nathan(wfoo1,wfoo2),plourde(c(wfoo1,wfoo2)),scriven(wfoo1,wfoo2),dmt(wfoo1,wfoo2),mrflick(wfoo1,wfoo2),roland(c(wfoo1,wfoo2)),flodel(wfoo1,wfoo2) )
Unit: microseconds
expr min lq median
stu(wfoo1, wfoo2) 17786.578 18243.2795 18420.317
nathan(wfoo1, wfoo2) 36651.195 37703.3625 38095.493
plourde(c(wfoo1, wfoo2)) 183616.029 187673.5350 190706.457
scriven(wfoo1, wfoo2) 17546.253 17994.1890 18244.990
dmt(wfoo1, wfoo2) 737.651 781.0550 821.466
mrflick(wfoo1, wfoo2) 870.643 951.4630 976.479
roland(c(wfoo1, wfoo2)) 99540.947 102644.2115 103654.258
flodel(wfoo1, wfoo2) 666.239 705.5795 717.553
uq max neval
18602.270 20835.107 100
38450.848 155422.375 100
303856.952 1079715.032 100
18404.281 18992.905 100
853.751 1719.047 100
1012.186 116669.839 100
105423.123 226522.073 100
732.947 822.748 100
【讨论】：
然而，这些函数是否适用于长度 > 1 的向量还不是很清楚。如果是这样，两个参数之一的长度应该 > 1，还是两者兼而有之？如果不是，我们应该用两个很长的词进行测试吗？在 OP 没有提供任何细节的情况下，我认为 Carl 的测试是我们能做的最好的。 @DavidArenburg 两个 loooooong 词怎么样？查看我的编辑:-) @flodel，我将plourde 重写为带参数的函数，但愚蠢地没有输入它们！重大过失。现已修复，我当然希望【参考方案10】：
flodel <- function(word1, word2)
# the length of the shorter word
n <- min(nchar(word1), nchar(word2))
# two vectors of characters of the same length n
c1 <- strsplit(word1, "", fixed = TRUE)[[1]][1:n]
c2 <- strsplit(word2, "", fixed = TRUE)[[1]][1:n]
# a vector that is TRUE as long as the characters match
m <- as.logical(cumprod(c1 == c2))
# the answer
paste(c1[m], collapse = "")
【讨论】：
几乎所有这些都可以通过使用charToRaw/rawToChar 而不是strsplit/paste 显着加快。特别是这个，已经是最快的了，在我的测试中得到了近 5 倍的加速。【参考方案11】：
一点正则表达式可以做到这一点：
sub('^([^|]*)[^|]*(?:\\|\\1[^|]*)$', '\\1', paste0(word1, '|', word2))
#[1] "bestel"
我使用| 作为分隔符 - 选择一个对您的字符串有意义的分隔符。
【讨论】：
以上是关于R：从开头找到最大的公共子串的主要内容，如果未能解决你的问题，请参考以下文章