Re: Set of strings reducing problem

*To*: mathgroup at smc.vnet.net*Subject*: [mg58591] Re: [mg58560] Set of strings reducing problem*From*: stephen layland <layland at wolfram.com>*Date*: Sat, 9 Jul 2005 04:07:51 -0400 (EDT)*References*: <200507070935.FAA29410@smc.vnet.net>*Sender*: owner-wri-mathgroup at wolfram.com

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

**References**:**Set of strings reducing problem***From:*"Edson Ferreira" <edsferr@uol.com.br>