самая длинная общая подстрока в R, находящая несмежные совпадения между двумя строками

Вот три возможных решения.

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" 

Извините, я не очень хорошо это объяснил, так как я плохо разбираюсь в алгоритмах расстояния между строками.

Использование информации @RichardScriven о том, что adist можно использовать ( он вычисляет приблизительное расстояние между строками. Я сделал функцию более полной. Обратите внимание, что "trafos" означает преобразования, используемые для определения расстояния между двумя строками (пример внизу)

ИЗМЕНИТЬ Этот ответ может привести к неправильным/неожиданным результатам; как указано @wdkrnls:

Я запустил вашу функцию против яблока и больших яблочных рогаликов, и она вернула appl. Я бы ожидал яблоко.

Смотрите объяснение неправильного результата ниже. Начнем с функции для получения longest_string в списке:

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

Затем мы можем использовать работу @RichardSriven и библиотеку stringi:

library(stringi)
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) 
}

Или мы можем переписать наш код, чтобы избежать использования каких-либо внешних библиотек (по-прежнему используя родную функцию R 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', 'hello there'), 
    lcsbstr(       'hello', 'hello there'),
    lcsbstr_no_lib('hello there', 'hello'), 
    lcsbstr(       'hello there', 'hello'))

ПОСЛЕДНИЕ ИЗМЕНЕНИЯ Обратите внимание на странное поведение с этим результатом:

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

Я ожидал 'hello', но поскольку преобразование фактически перемещает (через удаление) o в миреorld, чтобы стать o в адуo -- только ад часть считается совпадением в соответствии с M:

drop(attr(adist('hello world', 'hello', counts=TRUE), "trafos"))
#[1] "MMMMDDDMDDD"
#[1]  vvvv   v
#[1] "hello world"

Такое поведение наблюдается с помощью инструмента Левенштейна — он дает два возможных решения: эквивалентно этим двум преобразованиям

#[1] "MMMMDDDMDDD"
#[1] "MMMMMDDDDDD"

Я не знаю, можем ли мы настроить adist так, чтобы одно решение предпочиталось другому? (преобразования имеют одинаковый вес - одинаковое количество M и D - не знаю, как предпочесть преобразования с большим числом последовательных M)

Наконец, не забывайте, что adist позволяет передавать ignore.case = TRUE (по умолчанию FALSE).

• Ключ к свойству "trafos" объекта adist; преобразования для перехода от одной строки к другой:

последовательности преобразования возвращаются как атрибут trafos возвращаемого значения, как строки символов с элементами M, I, D и S, указывающими совпадение, вставку, удаление и замену

Я не уверен, что вы сделали, чтобы получить "привет". Основываясь на приведенных ниже экспериментах методом проб и ошибок, кажется, что функция LCS (а) не будет рассматривать строку как LCS, если символ следует за тем, что в противном случае было бы LCS; (b) найти несколько LCS одинаковой длины (в отличие от функции sub(), которая находит только первую); (c) порядок элементов в строках не имеет значения, что не имеет иллюстраций ниже; и (b) порядок строки в вызове LCS не имеет значения — также не показано.

Итак, ваше «привет» a не имело LCS в b, так как за «hel» b следовал символ. Ну, это моя текущая гипотеза.

Пункт А выше:

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

Пункт Б выше:

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

Использование биострок:

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]

Итак, я провел тест, и хотя мой ответ действительно помогает и дает вам гораздо больше информации, он примерно в 500 раз медленнее, чем @Rich Scriven, лол.

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