6
$\begingroup$

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
$\endgroup$
4
  • 1
    $\begingroup$ Do you mean to use the word "wildcard" instead of "gap"? $\endgroup$
    – Syed
    Mar 30, 2022 at 3:17
  • 2
    $\begingroup$ With a gap of 2, what would be the desired result for inputs "AABBB" and "BBBBB"? $\endgroup$
    – kglr
    Mar 30, 2022 at 6:23
  • $\begingroup$ I believe so @Syed $\endgroup$
    – Teabelly
    Mar 31, 2022 at 20:21
  • $\begingroup$ @kglr With a gap of 2, "AABBB" would be a common subset of "BBBBB" . I do hope to progress it to differentiating gap size.... can't stop saying gap... Maybe un-matched element would be a better description? or wildcards as Syed mentioned. $\endgroup$
    – Teabelly
    Mar 31, 2022 at 20:24

2 Answers 2

5
$\begingroup$

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.

$\endgroup$
1
$\begingroup$

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"}}}
$\endgroup$

This site is temporarily in read-only mode and not accepting new answers.

Not the answer you're looking for? Browse other questions tagged .