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