Is this rule-based solution efficient?

*To*: mathgroup at smc.vnet.net*Subject*: [mg2096] Is this rule-based solution efficient?*From*: drc at gate.net (David Cabana)*Date*: Fri, 29 Sep 1995 01:15:14 -0400

I want to describe a problem, and my attempt at a rule based solution using Mathematica. I am interested in your comments regarding the proposed solution. In particular, how could I make it more efficient? Say we have some domain D and and variables {a,b,c,...} over D. We don't know the values of any of the variables, but we have a number of equality relations among them. This sequence of equalities will be the input for our problem. For instance, we might have something like {a==b, a==c, d==f, g==a, e==i, f==i}. The goal is to compute a partition of the variables into maximal nonintersecting sets such that all the variables in each set are equal to one another. In the example above, the output would be (unique up to order) {{a,b,c,g},{d,e,f,i}}. Below is my solution. As a matter of convenience, I assume the input to be in a slightly different format than described above. In particular, I denote the equality x==y by {x,y}. The sample input given above becomes instead {{a,b}, {a,c}, {d,f}, {g,a}, {e,i}, {f,i}}. My idea is the simple: merge lists with a common variable until the remaining lists are mutually nonintersecting. Here is the implementation. Meets[A_,B_]:= Intersection[A,B] != {} Merge[{A_,B_,C__}]:= If[Meets[A,B], {Union[A,B], C}, Union[{B} ~Join~ Merge[{A,C}] ]] Merge[{A_,B_}]:= If[Meets[A,B], {Union[A,B]}, {A,B}] Merge[{A_}]:= {A} theSolution[M_]:=FixedPoint[Merge, M] theSolution[M_, k_]:=FixedPoint[Merge, M, k] (* used for debugging *) Some comments: I have no real feeling for whether this is very efficient use of Mma. I don't like the final Union in the definition of Merge[{A_,B_,C__}], but it is there to insure termination. Otherwise what can happen is that theSolution runs endlessly because there is no fixed point. For example, let testinput ={{a,b},{b,c},{c,d},{d,e},{f,g},{m,p},{g,h},{f,i}}; Test[M_, k_]:=Table[theSolution[M,z],{z,1,k}] With Merge[{A_,B_,C__}] as above, things work properly: Test[testinput, 10] Out[28]= { {{a, b, c}, {c, d}, {d, e}, {f, g}, {m, p}, {g, h}, {f, i}}, {{a, b, c, d}, {d, e}, {f, g}, {m, p}, {g, h}, {f, i}}, {{a, b, c, d, e}, {f, g}, {m, p}, {g, h}, {f, i}}, {{f, g}, {f, i}, {g, h}, {m, p}, {a, b, c, d, e}}, {{f, g, i}, {g, h}, {m, p}, {a, b, c, d, e}}, {{f, g, h, i}, {m, p}, {a, b, c, d, e}}, {{m, p}, {f, g, h, i}, {a, b, c, d, e}}, {{m, p}, {f, g, h, i}, {a, b, c, d, e}}, {{m, p}, {f, g, h, i}, {a, b, c, d, e}}, {{m, p}, {f, g, h, i}, {a, b, c, d, e}} } The fixed point occurs at z=7. If one instead defines Merge[{A_,B_,C__}]:= If[Meets[A,B], {Union[A,B], C}, {B} ~Join~ Merge[{A,C}]] then the following happens: Test[testinput, 10] Out[37]= { {{a, b, c}, {c, d}, {d, e}, {f, g}, {m, p}, {g, h}, {f, i}}, {{a, b, c, d}, {d, e}, {f, g}, {m, p}, {g, h}, {f, i}}, {{a, b, c, d, e}, {f, g}, {m, p}, {g, h}, {f, i}}, {{f, g}, {m, p}, {g, h}, {a, b, c, d, e}, {f, i}}, {{m, p}, {f, g, h}, {a, b, c, d, e}, {f, i}}, {{f, g, h}, {a, b, c, d, e}, {m, p}, {f, i}}, {{a, b, c, d, e}, {m, p}, {f, g, h, i}}, {{m, p}, {a, b, c, d, e}, {f, g, h, i}}, {{a, b, c, d, e}, {m, p}, {f, g, h, i}}, {{m, p}, {a, b, c, d, e}, {f, g, h, i}} } Notice the cycle in steps z=7,8,9,10. I put the Union statement in as an ad hoc device to avoid this phenomemon. I want to use this little routine quite a few times, so I would like to make it fast. I am not married to this solution, and would love to see a much better one. Thank you, -- David Cabana drc at gate.net