Longest common subset sequence with gaps

Question

I would like to find the longest common subset (including a gap of x) within two lists.

Example:

A = AAABBBBCCCCC
B = CCCBBBAAABABA

We can use

LongestCommonSubsequence[ "AAABBBBCCCCC", "CCCBBBAAABABA"]
Out[]= AAAB

I understand LongestCommonSequence allows for non-contiguous, however as far as I can tell there is no option to limit the allowed gap.

Gap example x=1:

AAABBBBCCCCC
CCCBBBAAABABA

Longest common sequence with a gap of 1:

AAABBB
AAABAB

Answer 1

This brute force approach uses HammingDistance to compare the substrings of the two search strings. To reduce the search time, the longest substrings are compared first. If no match occurs, shorter substrings are used. All matching substrings of the same length are returned.

A helper function, subStrings uses Subsequences to generate all of the substrings of a specified length of the given string.

The main function, longestHammingMatch takes four arguments. the first two are the search strings. The third is minimum length of the substrings to consider. Set the minimum length to 2 or greater to avoid single letter matches. The fourth argument is the number of mismatches that are allowed. Set the 4th argument to 0 for exact match, 1 for 1 letter different, etc.

Clear[subStrings]
subStrings[len_][str_String] := StringJoin @@@ Subsequences[
    Characters@str, {len}] // DeleteDuplicates

Clear[longestHammingMatch]
longestHammingMatch[s1_, s2_, minLength_, maxDiff_] := Reap[
  Block[{tuples, subseq, maxLength, found, 
    start = Min[StringLength /@ {s1, s2}]},
    Do[
      tuples = Select[Tuples[subStrings[len] /@ {s1, s2}],
      StringLength@First[#] == StringLength@Last[#] &];
 
      subseq = 
      Table[{If[maxDiff >= HammingDistance @@ t, len, 0], t}, {t, 
        tuples}];
 
      found = Select[subseq, First[#] == len &];
      If[Length@found > 0, Sow[Last /@ found]; Break[]],
 
      {len, start, minLength, -1}]]][[2]]

Example usage

Define the search strings --

{s1, s2} = {"AAABBBBCCCCC", "CCCBBBAAABABA"}

Search for the longest exact match using substrings with at least 3 letters:

longestHammingMatch[s1, s2, 3, 0]   (*  {{{{"AAAB", "AAAB"}}}}   *)

Search for the longest match using substrings with at least 3 letters and allowing at most 1 mismatch. This is the example in the OP:

longestHammingMatch[s1, s2, 3, 1]   (*  {{{{"AAABBB", "AAABAB"}}}}  *)

Search for the longest match using substrings with at least 3 letters and allowing at most 2 mismatches:

longestHammingMatch[s1, s2, 3, 2]   (*  {{{{"AAABBBB", "AAABABA"}}}}  *)

Try to find a match with at least 8 letters and up to 3 mismatched characters:

longestHammingMatch[s1, s2, 8, 3]   (*  {}  *)

The last example search failed to find a match that met criteria, so an empty list of matches was returned.

Answer 2

My attempt with a simplified example:

A = "SGRCHVAGCYCPYPGIGLVSSPDDNDCEAPSAWKQSTDVEHAHFPVPKSRLSRGASDPSQDRSPRGAVPPTIYRTKRASPPGAIPRSVFYPDPKGDERELPESLREAGESKTAKPSCSQNKPRPYVPRFMEAEAPSLALHHFAMRVADAGATLRALDAREAAFAGTPPGPRRPETMNGCGADIEGPTGWEPGLLEDVYPAGKILHAGAHSTGAGGGMQKDGRNDPTEKHPGPVCKEYLRLLANPTHPSAWSPVPPWPQSRSLGMRTLCSRAVYAPLVVQLAPVVWTTGFAIPANRGIVHGALSLLSAWRGLMVTGMMAQPGEPARVDLLNAFYTSRDPEVSGGNSAVHVSLEFVFAWGPLGPLFCSGQYVVFRFIREGNALMGFGEQLRFYSEMVGNGEPVPVLSRSWRKPGHLLPLGPKSNVIARFLEGDVSMVLRLAPAAPYTYYQPEHGLLARSSWLFLSDRRVAGRAMRKISLRGRGARLPFALIFAASILPCRNNPSCGASLDTAVTASDPQDVGAVGLRGVVKETFASVFKPVVAGQLGSSFTQGRPWLNVIIGPVLSFAPLTPWALRGFKDDALTLLPCLDIAARRDTRRYRWQPGDPNDAPRIDRGELLVDAPSGYHTIRFAVPIPVLRRKAEVPGQCAARSIDAGERDGPAMPSPMFYGYRHCYIPPPPGYETEKLVPLAISGFGVALVSAPLKLGLASGVYAVIIAGELARYGSALLDLAVAEGGSPGSVPVSEPGLDNWVGRPMALTASKLLDGLFLYIGTSRGSRETGMQVAVPGMSILPELGDPTFAAVMGAYLPSFGLAGVWFLPCQWCARGLTSCVDSQRKRPPALDPLHFSLRFSSVTQVQGTCDAACLILGSRRHEWDEPHALRLWGRAIAPEPAAAAHKVGADIHDWPAFRLVAADHHLTPKNRLGPANMSGGQGWSYFRGLESLAGGEARLGFVHSTRAERILVGAAQPVPATPFGHLDGPDPHEAPFSGLYCPSGALPPYIPPTGQSPGPHATIRYPRPNARHMEFWETVSAGFDLAAGAPLGYLGQPPQFLFKGICNPGHARPWEKHGLLVAAGSPTKPAAPWRLLGLAHRELLEALAEERQLDGTLVGGVLRYLRAENLCALRAGYKRRRWFDEEVRGPKLDPEPVSGGCPGPFDTGWSPPWREEGHSYPRSVVASGSPVELPLIRSIAPGALLDFPAAPAVPCRVPQFLVSENREVMLAEGHFSLTLPDALGLMYSVEEPPVLVIWAARQEFAAWTEGTTSHLDPWYDPGWWSPGGFARTRQSNYCRRTATSKGGPGAHDAFAEPPRYLAIPRFLFSRSPNHPDDPPGAAAPP"

Searching for common subsets of length 4 and with an allowed error / gap of 1 letter.

p = Partition[ToCharacterCode[A], 4, 1];
common = Table[
   Position[
    Total /@ 
     Unitize[ArrayComponents[(# - p[[i]] & /@ 
         p[[i + 1 ;;]])]], _?(# <= 1 &)], {i, 1, Length[p] - 1}];

{FromCharacterCode[p[[#]]], 
   FromCharacterCode /@ Extract[p[[# + 1 ;;]], %[[#]]]} & /@ Range[10]

Out[]= {{"SGRC", {"SGGC"}}, {"GRCH", {}}, {"RCHV", {}}, {"CHVA", {}}, \
{"HVAG", {"RVAG", "VVAG"}}, {"VAGC", {"VAGR", 
   "VAGQ"}}, {"AGCY", {}}, {"GCYC", {"GLYC"}}, {"CYCP", {"CYIP", 
   "LYCP"}}, {"YCPY", {"YCPS"}}}