3
$\begingroup$

I want to compare two strings by counting how many common characters they have at the same position - but overall in all possible alignments of the two strings.

SeedRandom[1]
str1 = RandomInteger[{1, 26}, 90] /. 
   Thread[Range[26] -> CharacterRange["A", "Z"]] // StringJoin
str2 = RandomInteger[{1, 26}, 850] /. 
   Thread[Range[26] -> CharacterRange["A", "Z"]] // StringJoin
fu[x_, y_] := 
 Module[{par = Partition[Characters[y], StringLength[x], 1, {1, 1}]},
  Count[Flatten[(Transpose[{#, Characters[x]}] & /@ par), 1], {z_, z_}]
  ]

fu[str1, str2] // Timing
(*{0.046875, 3013}*)

This means that strings str1 and str2 have 3013 common characters in total in all possible alignments.

Can it be done more efficiently, perhaps without converting strings into lists?

$\endgroup$
5
  • 2
    $\begingroup$ Is this the same as doing {c1, c2} = Characters /@ {str1, str2}; Sum[Boole[c1[[i]] == c2[[j]]], {i, Length[c1]}, {j, Length[c2]}] which also gives 3013? Or more compactly you could do Total[Outer[Boole@*Equal, c1, c2], 2] $\endgroup$
    – flinty
    Oct 3 '20 at 17:53
  • $\begingroup$ ^ note with the above, if you use ToCharacterCode instead of Characters, you get slightly better performance. $\endgroup$
    – flinty
    Oct 3 '20 at 18:02
  • 3
    $\begingroup$ I got an order of a magnitude's speed-up using fu[x_, y_] := Module[{ par = Partition[Characters[y], StringLength[x], 1, {1, 1}], len = StringLength[x] }, Total[len - HammingDistance[x, StringJoin[#]] & /@ par] ] $\endgroup$
    – C. E.
    Oct 3 '20 at 18:06
  • $\begingroup$ @flinty: Your code is more elegant but no speed gain. C. E.@: Nice speed gain. $\endgroup$ Oct 3 '20 at 19:00
  • $\begingroup$ You could try to use ListCorrelate: ListCorrelate[str1, str2, {1, -1}, {}, (Equal[##]) &,(Count[{##}, True]) &] $\endgroup$ Oct 4 '20 at 16:00
0
$\begingroup$

There is

fu3 = Dot @@ Lookup[#, Union @@ Keys[#], 0] &[Counts@*ToCharacterCode /@ {#, #2}] &;

Last@Table[fu[str1, str2], {100}] // RepeatedTiming
Last@Table[fu3[str1, str2], {100}] // RepeatedTiming
(* {2.3, 3013} *)
(* {0.0029, 3013} *)
$\endgroup$
1
  • 1
    $\begingroup$ Or bit faster fu4 = Dot @@ Lookup[#, Union @@ Keys[#], 0] &[ Counts /@ ToCharacterCode[{#, #2}]] &;. $\endgroup$ Oct 3 '20 at 22:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.