Question

我有一个关于在R中查找最长公共子字符串的问题。在StackOverflow上搜索几个帖子时，我了解了qualV包。但是，我看到这个包中的LCS函数实际上找到了string1中存在于string2中的所有字符，即使它们不是连续的。

解释一下，如果字符串是 string1：＆＃34; hel lo＆＃34; string2：＆＃34; hel 12345lo＆＃34; 我希望输出为 hel ，但是我输出为hello。我一定做错了什么。请参阅下面的代码。

library(qualV)
a= "hello"
b="hel123l5678o" 
sapply(seq_along(a), function(i)
    paste(LCS(substring(a[i], seq(1, nchar(a[i])), seq(1, nchar(a[i]))),
              substring(b[i], seq(1, nchar(b[i])), seq(1, nchar(b[i]))))$LCS,
          collapse = ""))

我也尝试过Rlibstree方法，但我仍然得到不连续的子串。此外，子串的长度也与我的预期不同。请参阅下文。

> a = "hello"
> b = "h1e2l3l4o5"

> ll <- list(a,b)
> lapply(data.frame(do.call(rbind, ll), stringsAsFactors=FALSE), function(x) getLongestCommonSubstring(x))
$do.call.rbind..ll.
[1] "h" "e" "l" "o"

> nchar(lapply(data.frame(do.call(rbind, ll), stringsAsFactors=FALSE), function(x) getLongestCommonSubstring(x)))
do.call.rbind..ll.
                21

Answer 1

以下是三种可能的解决方案。

library(stringi)
library(stringdist)

a <- "hello"
b <- "hel123l5678o"

## get all forward substrings of 'b'
sb <- stri_sub(b, 1, 1:nchar(b))
## extract them from 'a' if they exist
sstr <- na.omit(stri_extract_all_coll(a, sb, simplify=TRUE))
## match the longest one
sstr[which.max(nchar(sstr))]
# [1] "hel"

基础R中还有adist()和agrep()，stringdist包有一些运行LCS方法的函数。这是stringsidt的看法。它返回不成对字符的数量。

stringdist(a, b, method="lcs")
# [1] 7

Filter("!", mapply(
    stringdist, 
    stri_sub(b, 1, 1:nchar(b)),
    stri_sub(a, 1, 1:nchar(b)),
    MoreArgs = list(method = "lcs")
))
#  h  he hel 
#  0   0   0

现在我已经对此进行了更多探讨，我认为adist()可能是最佳选择。如果我们设置counts=TRUE，我们会得到一系列匹配，插入等等。因此，如果您将其赋予stri_locate()，我们可以使用该矩阵从a到b获取匹配。

ta <- drop(attr(adist(a, b, counts=TRUE), "trafos")))
# [1] "MMMIIIMIIIIM"

因此M值表示匹配。我们可以使用stri_sub()

来获取子字符串

stri_sub(b, stri_locate_all_regex(ta, "M+")[[1]])
# [1] "hel" "l"   "o"

抱歉，由于我不熟悉字符串距离算法，所以我没有解释得那么好。

Answer 2

我不知道你做了什么来得到你的输出＆＃34;你好＆＃34;。根据下面的反复试验，似乎LCS函数将（a）不将字符串视为LCS，如果字符遵循LCS的原则; （b）找到多个同样长的LCS（不像找到第一个的sub（））; （c）字符串中元素的顺序并不重要 - 下面没有说明; （b）LCS呼叫中字符串的顺序并不重要 - 也未显示。

所以，你的＆＃34;你好＆＃34;因为＆＃34; hel＆＃34; b之后是一个角色。嗯，这是我目前的假设。

以上A点：

a= c("hello", "hel", "abcd")
b= c("hello123l5678o", "abcd") 
print(LCS(a, b)[4]) # "abcd" - perhaps because it has nothing afterwards, unlike hello123...

a= c("hello", "hel", "abcd1") # added 1 to abcd
b= c("hello123l5678o", "abcd") 
print(LCS(a, b)[4]) # no LCS!, as if anything beyond an otherwise LCS invalidates it

a= c("hello", "hel", "abcd") 
b= c("hello1", "abcd") # added 1 to hello
print(LCS(a, b)[4]) # abcd only, since the b hello1 has a character

以上B点：

a= c("hello", "hel", "abcd") 
b= c("hello", "abcd") 
print(LCS(a, b)[4]) # found both, so not like sub vs gsub of finding first or all

Answer 3

利用@ RichardScriven的洞察力adist可以使用，但这个功能结合了所有，

编辑这很棘手，因为我们需要在两个上下文中获取longest_string，所以我做了这个功能：

longest_string <- function(s){return(s[which.max(nchar(s))])}

这结合了@ RichardSriven使用图书馆的工作......

library(stringi)
library(stringdist)
lcsbstr <- function(a,b) { 
  sbstr_locations<- stri_locate_all_regex(drop(attr(adist(a, b, counts=TRUE), "trafos")), "M+")[[1]]
  cmn_sbstr<-stri_sub(longest_string(c(a,b)), sbstr_locations)
  longest_cmn_sbstr <- longest_string(cmn_sbstr)
   return(longest_cmn_sbstr) 
}

我们可以重写它以避免使用任何外部库（但仍使用adist）...

lcsbstr_no_lib <- function(a,b) { 
    matches <- gregexpr("M+", drop(attr(adist(a, b, counts=TRUE), "trafos")))[[1]];
    lengths<- attr(matches, 'match.length')
    which_longest <- which.max(lengths)
    index_longest <- matches[which_longest]
    length_longest <- lengths[which_longest]
    longest_cmn_sbstr  <- substring(longest_string(c(a,b)), index_longest , index_longest + length_longest - 1)
    return(longest_cmn_sbstr ) 
}

所有仅识别'hello '作为最长公共子字符串，而不是'hello r'：

identical('hello ', 
    lcsbstr_no_lib('hello world', 'hello there'), 
    lcsbstr(       'hello world', 'hello there'))

编辑自编辑以来，无论哪个参数都是两者中的较长者，都可以正常工作：

identical('hello',
    lcsbstr_no_lib('hello', 'hello there'), 
    lcsbstr(       'hello', 'hello there'),
    lcsbstr_no_lib('hello there', 'hello'), 
    lcsbstr(       'hello there', 'hello'))

最后编辑 但是如果你接受这种行为，这只会很好。注意这个结果：

lcsbstr('hello world', 'hello')
#[1] 'hell'

我期待'hello'，但由于转换实际上移动（通过删除）w o rld成为地狱 o ，所以只有<根据{{1}}：

，em> hell 部分被视为匹配

使用[此Levenstein工具]观察到这种行为 - 它提供了两种可能的解决方案，相当于这两种转换;我们可以告诉adist我们更喜欢哪一个吗？（具有更多连续drop(attr(adist('hello world', 'hello', counts=TRUE), "trafos")) #[1] "MMMMDDDMDDD" #[1] vvvv v #[1] "hello world"）

的那个

最后，不要忘记adist允许您传入#[1] "MMMMDDDMDDD" #[1] "MMMMMDDDDDD"（ignore.case = TRUE是默认值）

Answer 4

df <- data.frame(A. = c("Australia", "Network"),
                 B. = c("Austria", "Netconnect"), stringsAsFactors = FALSE)

 auxFun <- function(x) {

   a <- strsplit(x[[1]], "")[[1]]
   b  <- strsplit(x[[2]], "")[[1]]
   lastchar <- suppressWarnings(which(!(a == b)))[1] - 1

   if(lastchar > 0){
     out <- paste0(a[1:lastchar], collapse = "")
   } else {
     out <- ""
   }

   return(out)
 }

 df$C. <- apply(df, 1, auxFun)

 df
 A.         B.    C.
 1 Australia    Austria Austr
 2   Network Netconnect   Net

Answer 5

使用生物串：

library(Biostrings)
a= "hello"
b="hel123l5678o"
astr= BString(a)
bstr=BString(b)

pmatchPattern(astr, bstr)

返回：

  Views on a 12-letter BString subject
Subject: hel123l5678o
views:
      start end width
  [1]     1   3     3 [hel]
  Views on a 5-letter BString pattern
Pattern: hello
views:
      start end width
  [1]     1   3     3 [hel]

所以我做了一个基准测试，虽然我的回答确实做到了这一点，实际上给了你更多的信息，但它比@Rich Scriven 慢 500 倍，哈哈。

system.time({
a= "hello"
b="123hell5678o"
rounds=100
for (i in 1:rounds) {
astr= BString(a)
bstr=BString(b)
pmatchPattern(astr, bstr)
}
})

system.time({
  c= "hello"
  d="123hell5678o"
  rounds=100
  for (i in 1:rounds) {
ta <- drop(attr(adist(c, d, counts=TRUE), "trafos"))
stri_sub(d, stri_locate_all_regex(ta, "M+")[[1]])
}
})

   user  system elapsed 
  2.476   0.027   2.510 

   user  system elapsed 
  0.006   0.000   0.005

R中最长的公共子串查找两个字符串之间的非连续匹配

5 个答案: