Fw: Re: Set of strings reducing problem
- To: mathgroup at smc.vnet.net
- Subject: [mg58658] Fw: [mg58591] Re: [mg58560] Set of strings reducing problem
- From: "Edson Ferreira" <edsferr at uol.com.br>
- Date: Tue, 12 Jul 2005 05:21:41 -0400 (EDT)
- Sender: owner-wri-mathgroup at wolfram.com
----- Original Message -----
From: "Edson Ferreira" <edsferr at uol.com.br>
To: mathgroup at smc.vnet.net
Subject: [mg58658] Re: [mg58591] Re: [mg58560] Set of strings reducing problem
> Hello!
>
> I've tried this:
>
> In[27]:=
> l=Characters[{"111","112","11X"}]
> Out[27]=
> {{1,1,1},{1,1,2},{1,1,X}}
> In[28]:=
> FixedPoint[listReduce,l]//ColumnForm
> Out[28]=
> \!\(\*
> InterpretationBox[GridBox[{
> {\({"1", "1", "1"}\)},
> {\({"1", "1", "M"}\)},
> {\({"1", "1", "T"}\)},
> {\({"1", "1", "D"}\)},
> {\({"1", "1", "2"}\)},
> {\({"1", "1", "U"}\)},
> {\({"1", "1", "X"}\)}
> },
> GridBaseline->{Baseline, {1, 1}},
> ColumnAlignments->{Left}],
> ColumnForm[ {{"1", "1", "1"}, {"1", "1", "M"}, {"1", "1", "T"}, {"1",
> "1",
> "D"}, {"1", "1", "2"}, {"1", "1", "U"}, {"1", "1", "X"}}],
> Editable->False]\)
>
>
> As you can see the result is not what I expected! I had a 3 elements list
> and got a 7 elements list.
>
> The curiosity is that the result I wanted is in the list : "11T"
>
> Any clue to solve this?
>
> Thanks for your attention!!!!!
>
> Edson
>
>
> ----- Original Message -----
> From: "stephen layland" <layland at wolfram.com>
To: mathgroup at smc.vnet.net
> Sent: Saturday, July 09, 2005 5:07 AM
> Subject: [mg58658] [mg58591] Re: [mg58560] Set of strings reducing problem
>
>
>> and thus spake Edson Ferreira [2005.07.07 @ 05:21]:
>>>
>>> Dear Mathematica Users,
>>>
>>> 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:
>>
>> [ ... ]
>>
>> here's an implementation of your approach. it's quite wordy, but i
>> think it should work.
>>
>> first set up your string transformation rules, i'm using a throwaway
>> symbol s[] to attach the rules to:
>>
>> s /: Plus[s["1"], s["X"]] = "D";
>> s /: Plus[s["1"], s["2"]] = "M";
>> s /: Plus[s["1"], s["U"]] = "T";
>> s /: Plus[s["X"], s["2"]] = "U";
>> s /: Plus[s["X"], s["M"]] = "T";
>> s /: Plus[s["2"], s["D"]] = "T";
>> s /: Plus[s[s1_String], s[s2_String]] := s1
>>
>> the last rule is something i threw in to handle string combinations you
>> didn't supply. you'll probably want to handle these differently.
>>
>> next, i wrote some helper functions:
>>
>> (* this is just UnsortedUnion from the help browser, see Union[] *)
>> uniq[x_]:= Module[{f}, f[y_] := (f[y] = Sequence[]; y); f /@ x]
>>
>> (* this applies the string transformations iff the two lists differ
>> in exactly one position *)
>> stringReduce[l1_List, l2_List] := Module[
>> {t = Equal @@@ Transpose[{l1, l2}], p},
>> If[Count[t, False] == 1,
>> p = Position[t, False][[1, 1]];
>> ReplacePart[l1, Plus @@ (s /@ {l1[[p]], l2[[p]]}), p],
>> Sequence @@ {l1, l2}
>> ]
>> ]
>>
>>
>> now, the trivial function that will actually do an iteration
>> of the list:
>>
>> listReduce[l_List] := uniq[stringReduce@@@Tuples[l,2]]
>> (* tuples is new in 5.1. if you don't have 5.1, you can use this:
>> Flatten[Outer[List, l, l, 1],1]
>> to achieve the same thing (those are two ell's and a one) *)
>>
>>
>> finally, we can use FixedPoint to reduce the list until it can be
>> reduced no more. I created a simple list of sample strings to test:
>>
>> alphabet = {"1", "X", "2", "U", "M", "D", "T"};
>> l = Flatten[{
>> {"1", "1", "1", "1", #, "1", "1", "1"},
>> {"2", "1", "1", "1", #, "1", "1", "2"}} & /@ alphabet, 1];
>>
>>
>> FixedPoint[listReduce,l]//ColumnForm
>>
>>
>> {"1", "1", "1", "1", "1", "1", "1", "1"}
>> {"2", "1", "1", "1", "1", "1", "1", "2"}
>> {"2", "1", "1", "1", "X", "1", "1", "2"}
>> {"2", "1", "1", "1", "2", "1", "1", "2"}
>> {"2", "1", "1", "1", "U", "1", "1", "2"}
>> {"2", "1", "1", "1", "M", "1", "1", "2"}
>> {"2", "1", "1", "1", "D", "1", "1", "2"}
>> {"2", "1", "1", "1", "T", "1", "1", "2"}
>> {"1", "1", "1", "1", "D", "1", "1", "1"}
>> {"1", "1", "1", "1", "M", "1", "1", "1"}
>> {"1", "1", "1", "1", "T", "1", "1", "1"}
>> {"1", "1", "1", "1", "X", "1", "1", "1"}
>> {"1", "1", "1", "1", "2", "1", "1", "1"}
>> {"1", "1", "1", "1", "U", "1", "1", "1"}
>>
>> In this simple case, only one pass is necessary.
>> If you want to process the strings as they are in "221111X11"
>> form, you can simply slap in a call to Characters[] and StringJoin[].
>>
>> --
>> /*------------------------------*\
>> | stephen layland |
>> | Documentation Programmer |
>> | http://members.wri.com/layland |
>> \*------------------------------*/
>>
>>
>