Mathematica 9 is now available
Services & Resources / Wolfram Forums
MathGroup Archive
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

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

Search the Archive

RE: Re: corrected RE: Re: Computing sets of equivalences

  • To: mathgroup at
  • Subject: [mg46590] RE: [mg46574] Re: corrected RE: Re: Computing sets of equivalences
  • From: "Wolf, Hartmut" <Hartmut.Wolf at>
  • Date: Tue, 24 Feb 2004 21:04:48 -0500 (EST)
  • Sender: owner-wri-mathgroup at


it took me a while to discern what you added to Carl's algorithm. It's the
line where you map addequiv over the rest of the argument sequence.

But it is not at all obvious to do so, since in effect you do not built on
the work done, but, in a way restore equivalences, which would give rise to
the same result.

But this can be done more effectively just by 

 Join @@ (Partition[#, 2, 1] & /@ <the-connected-components>)

and then using Carl's original program.

I thought about a way to further use the already built connected components
and came up with this (I use my own terminology):

addc[c_] := (newext = {c, (ext /@ (oldcls = Union[nex /@ c]))};
    Scan[Unset[ext[#]] &, oldcls];
    Scan[Set[nex[#], class[First[newext]]] &, c]; 
    ext[class[First[newext]]] = newext)

classesFrom12[classes_] := Block[{nex, class, ext, newext, oldcls},
    nex[i_] = Sequence[];
    ext[_] := {};
    addc /@ classes;
    ext[_] =.;
    Union[Flatten[#]] & /@ DownValues[ext][[All, 2]]

This basic idea is the same as of Carl's (of course), we just don't work on
pairs, but on classes of arbitrary length. (Don't be afraid the Unions are
not striktly needed, but that one in addc effectively accelerates it (at
Unset), and the Union for the result could be substituted by an O[n] purge
function (as ordering is not necessary -- or not specified as required,
say). (And BTW it appears as clean:
- the first line combines the current component (which for its own is an
equivalence class) with all classes its elements are already linked to.
- these linked classes are then all Unset.
- all elements are linked to the new class.
- finally the extension of the new class is set to the combined collection.
As repeated elements now might occur in the extensions, these have to be
purged from the result.)

This function should also work on pairs, but there it cannot compete with
the original. However on very large classes it gives a bit of advantage:

This is a fast method to acquire test data:

<< DiscreteMath`Combinatorica`

makeTest[ncyc_, nmax_] := 
 With[{elements = RandomPermutation[nmax]}, 
  Join @@ DeleteCases[(Partition[#, 2, 1] &) /@
   (Take[elements, #] &) /@ ({1, 0} + # &) /@ 
       Join[{0}, Sort[Table[Random[Integer, nmax], {ncyc - 1}]], {nmax}],
       2, 1],

ttt = makeTest[5, 5000];

(cCW3 = getequiv[ttt]); // Timing        
  {1.101 Second, Null}

(c12 = classesFrom12[ttt]); // Timing
  {2.905 Second, Null}

Sort[Sort /@ cCW3] == Sort[Sort /@ c12]

So for pairs, that does not pay. But let's add a few single equivalences
which connect the large clusters:

Partition[First /@ cCW3, 2, 2]
  {{885, 1053}, {1248, 2672}}

cx = getequiv[Join[cCW3, %]]; // Timing
  {1.172 Second, Null}

-- your proposal, it's not faster than breaking the classes down to pairs
and doing everything from scratch:

ccCW3 = getequiv[Join[Join @@ (Partition[#, 2, 1] & /@ cCW3), %%]]; //
  {1.142 Second, Null}

-- but reusing the clusters now pays:

cc12 = classesFrom12[Join[cCW3, %%%]]; // Timing
  {0.611 Second, Null}

Sort[Sort /@ cx] == Sort[Sort /@ cc12] == Sort[Sort /@ ccCW3]

A final note: I tried quite a lot of variations (and it took me some time),
only to arrive (except for the names) exactly at Carl's function. Respect!
It showed that collecting the classes on the fly indeed is the decisive
advantage (to my surprise). Pattern matching for If then gives another

As, like Carl said, this is a nice challenge for Mathematica programming
performance; yet all this might be missleading if we use Mathematica as a
prototyping language for a low level implementation (in C, or Assembler).  I
tried a split/sort approach, but as it showed, it did not scale as O[n log
n]. It appeared as if for large data sets something exponential would creap
in (or a sliding transition to O[n^?]. I do not understand this. Can someone
give me a hint, or an explanation?


>-----Original Message-----
>From: drbob at [mailto:drbob at]
To: mathgroup at
>Sent: Tuesday, February 24, 2004 4:34 AM
>To: mathgroup at
>Subject: [mg46590] [mg46574] Re: corrected RE: Re: Computing sets of equivalences
>Brilliant, Carl!
>Here's a trivial modification that allows the original equivalence
>list to be more than just pairs. It could be very handy if we've
>solved the problem (and perhaps forgotten the original pairings) and
>now want to add more equivalences.
>addequiv[a_, a_] := 1
>addequiv[ptr[a_], ptr[b_]] := (ptr[a] = ptr[b] = class[a];
>    equivset[class[a]] = {a, b})
>addequiv[ptr[a_], b_class] := (ptr[a] = b; equivset[b] = {equivset[b], a})
>addequiv[a_class, ptr[b_]] := (ptr[b] = a; equivset[a] = {equivset[a], b})
>addequiv[a_class, b_class] := (equivset[a] = {equivset[a], equivset[b]};
>    equivset[b] =.; b = a)
>addequiv[a_, b__] := addequiv[a, #] & /@ {b}
>getequivs[eq_] := Block[{ptr, class, equivset}, addequiv @@@ Map[ptr, 
>    eq, {2}];
>    Flatten /@ DownValues[equivset][[All, 2]]]
>"Carl K. Woll" <carl at> wrote in message 
>news:<c146vb$4bc$1 at>...
>> At any rate, inspired by your challenge, I've come up with a 
>> much quicker algorithm.
>> addequiv[a_, a_] := 1
>> addequiv[ptr[a_], ptr[b_]] := (ptr[a] = ptr[b] = class[a];
>> equivset[class[a]] = {a, b})
>> addequiv[ptr[a_], b_class] := (ptr[a] = b; equivset[b] = 
>>    {equivset[b], a})
>> addequiv[a_class, ptr[b_]] := (ptr[b] = a; equivset[a] = 
>>    {equivset[a], b})
>> addequiv[a_class, b_class] := (equivset[a] = {equivset[a], 
>>     equivset[b]}; equivset[b] =.; b = a)
>> getequivs[eq_] := Block[{ptr, class, equivset},
>>     Apply[addequiv, Map[ptr, eq, {2}], {1}];
>>     Flatten /@
>>       DownValues[equivset][[All, 2]]]
>> It's been a while since there's been an interesting (at least to me)
>> algorithmic challenge like this for us to wrestle with.
>> Carl

  • Prev by Date: Re: Bloomberg and Mathematica
  • Next by Date: Calling and run a notebook within another notebook
  • Previous by thread: Re: corrected RE: Re: Computing sets of equivalences
  • Next by thread: RE: RE: Re: corrected RE: Re: Computing sets of equivalences