Re: Set of strings reducing problem (Again!)
- To: mathgroup at smc.vnet.net
- Subject: [mg60348] Re: Set of strings reducing problem (Again!)
- From: "Valeri Astanoff" <astanoff at yahoo.fr>
- Date: Wed, 14 Sep 2005 03:27:15 -0400 (EDT)
- References: <dg69pb$a96$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Edson,
This is what I modified :
-1- Make Dispatch table order independant
-2- Insert z___List between p and q for not neighbor cases
In[1]:=
Unprotect[D];
U={"2","X"};
M={"1","2"};
D={"1","X"};
T={"1","2","X"};
L=Flatten[Outer[StringJoin,T,T,T,D]];
L = Select[L, Count[Characters[#], "1"] > 1 &];
cl = Characters /@ L;
r = Dispatch[{"1" + "X" -> "D",
"1" + "2" -> "M",
"1" + "U" -> "T",
"X" + "2" -> "U",
"X" + "M" -> "T",
"2" + "D" -> "T",
"X" + "1" -> "D",
"2" + "1" -> "M",
"U" + "1" -> "T",
"2" + "X" -> "U",
"M" + "X" -> "T",
"D" + "2" -> "T"}];
ncl = StringJoin @@@ (
cl //. {x___List,
{a___, p_String, c___},
z___List,
{a___, q_String, c___},
y___List} :>
{x, {a, p + q /. r, c}, z,
y} /; StringQ[p + q /.
r])
Out[10]=
{11TD,1U1D,1UU1,U11D,U1U1,UU11}
Seems to work...
v.a.