4
$\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?

Improve this question
$\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
    Commented Oct 3, 2020 at 17:53
  • $\begingroup$ ^ note with the above, if you use ToCharacterCode instead of Characters, you get slightly better performance. $\endgroup$
    – flinty
    Commented Oct 3, 2020 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.
    Commented Oct 3, 2020 at 18:06
  • $\begingroup$ @flinty: Your code is more elegant but no speed gain. C. E.@: Nice speed gain. $\endgroup$
    – azerbajdzan
    Commented Oct 3, 2020 at 19:00
  • $\begingroup$ You could try to use ListCorrelate: ListCorrelate[str1, str2, {1, -1}, {}, (Equal[##]) &,(Count[{##}, True]) &] $\endgroup$
    – Daniel Huber
    Commented Oct 4, 2020 at 16:00

1 Answer 1

Reset to default
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} *)
Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ Or bit faster fu4 = Dot @@ Lookup[#, Union @@ Keys[#], 0] &[ Counts /@ ToCharacterCode[{#, #2}]] &;. $\endgroup$
    – azerbajdzan
    Commented Oct 3, 2020 at 22:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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