Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1995
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1995

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Weirdness in Encapsulated Postscript (Windows version)?
  • Next by Date: Mathematica World Update
  • Previous by thread: Problems with DO and TABLE...
  • Next by thread: Mathematica World Update