       Re: Set of strings reducing problem

• To: mathgroup at smc.vnet.net
• Subject: [mg58583] Re: Set of strings reducing problem
• Date: Fri, 8 Jul 2005 00:46:15 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

```On 7/7/05 at 5:35 AM, edsferr at uol.com.br (Edson Ferreira) wrote:

>I have a problem that I haven't got any clue to solve with
>Mathematica.

>Let's say a have a list of "n" equal length strings:

>L={"11111111",
>   "11112111",
>   "1111X111",
>       ...
>       ...
>       ...
>   "21122211"}

>The characters used in strings are only "1", "X", "2", "U", "M",
>"D" and "T".

>What I want is a reduced set of strings (with all the resulting
>strings with the same length as all the original ones).

>The rule to "join" two strings is the following:

>If one string is different from the other by just one character
>then take the characters that are different and apply the rule
>bellow:

>"1" + "X" = "D"
>"1" + "2" = "M"
>"1" + "U" = "T"
>"X" + "2" = "U"
>"X" + "M" = "T"
>"2" + "D" = "T"

>For example, suppose I have these two elements in the list :
>"11112111" and "1111X111"

>The rule will transform these two strings into one : "1111U111"

Block[{X, M, T, D, U},
StringJoin @@ ToString /@
((ToExpression /@Characters[x] + ToExpression /@ Characters[y] /.
{D + 2 -> 2*T, M + X -> 2*T, X + 2 -> 2*U, U + 1 -> 2*T,
3 -> 2*M, X + 1 -> 2*D})/2)]

What I've done is use ToExpression to convert each string to a list of symbols and integers then use Mathematica's pattern matching to implement your rules. The final result is then converted back to a string. I've used Block to ensure the results are not affected by usage of X, M etc as variables elsewhere in the notebook.

>After all the possible transformations (always using two strings
>with only one different character and resulting another string) I
>will obtain a reduced set of strings.

>How can I do that with mathematica??

>I guess the first step is a function to identify is two strings are
>different by just one ccharacter. A loop then search in the set for
>any ocurrences of that and apply all possible transformations until
>we can't get any redution.

The following function will count the number of differences in two strings of equal length

noDifferent[x_, y_] :=
Count[

I can generate a list of all pairs that differ by a single character as follows:

Union[Pick[Flatten[Outer[Sort@{#1, #2}& , L, L], 1],
(#1 == 1 & ) /@ Flatten[Outer[noDifferent, L, L]]]]

and finally doing