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 | >> \*------------------------------*/ >> >> >