RE: Re: corrected RE: Re: Computing sets of equivalences
- To: mathgroup at smc.vnet.net
- Subject: [mg46590] RE: [mg46574] Re: corrected RE: Re: Computing sets of equivalences
- From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
- Date: Tue, 24 Feb 2004 21:04:48 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
Bobby,
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} + # &) /@
Partition[
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]
True
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), %%]]; //
Timing
{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]
True
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
tweak.
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?
Hartmut
>-----Original Message-----
>From: drbob at bigfoot.com [mailto:drbob at bigfoot.com]
To: mathgroup at smc.vnet.net
>Sent: Tuesday, February 24, 2004 4:34 AM
>To: mathgroup at smc.vnet.net
>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.
>
>Clear[addequiv]
>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]]]
>
>Bobby
>
>"Carl K. Woll" <carl at woll2woll.com> wrote in message
>news:<c146vb$4bc$1 at smc.vnet.net>...
[...]
>>
>> 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
>>