Re: Set of strings reducing problem
- To: mathgroup at smc.vnet.net
- Subject: [mg58583] Re: Set of strings reducing problem
- From: Bill Rowe <readnewsciv at earthlink.net>
- 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"
The function below will add two strings per your rules above
addString[x_, y_] :=
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[
MapThread[SameQ, {Characters[x], Characters[y]}], False]
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
addString@@@list
where list is the list of pairs that differ by one character will generate the reduced list you want.
--
To reply via email subtract one hundred and four