corrected RE: Re: Computing sets of equivalences

• To: mathgroup at smc.vnet.net
• Subject: [mg46479] corrected RE: [mg46459] Re: Computing sets of equivalences
• From: "Wolf, Hartmut" <Hartmut.Wolf at t-systems.com>
• Date: Fri, 20 Feb 2004 00:29:23 -0500 (EST)
• Sender: owner-wri-mathgroup at wolfram.com

```Carl,

I managed to repair my proposal. The problem was to unify classes if they
are linked later. I do that now "repeating the trick":

classesFrom3[equis_] := Module[{nex, ext, class},
nex[_] := True;
ext[_] := {};
If[nex[#1],
If[nex[#2], nex[#1] = nex[#2] = class[Min[#1, #2]], ,
nex[#1] = nex[#2]], ,
If[nex[#2], nex[#2] = nex[#1], ,
Evaluate[nex[Max[#1, #2]]] = nex[Min[#1, #2]]]] & @@@ equis;
nex[_] =.;
class[i_] = i;
Scan[(ext[nex[#]] = {ext[nex[#]], #}) &,
DownValues[nex][[All, 1, 1, 1]]];
ext[_] =.;
Flatten /@ DownValues[ext][[All, 2]]
]

Of course that costs me something, the advantage compared to yours now has
now diminshed to the cubic root of 2.

Here is also a method to produce test data:

In[337]:=
cycs = Union[Prepend[Table[Random[Integer, {1, 30}], {5}], 0]]

Out[337]= {0, 13, 20, 24, 25, 30}

In[341]:=
rngs = DeleteCases[{1, 0} + # & /@ Partition[cycs, 2, 1], {x_, x_}]
Out[341]= {{1, 13}, {14, 20}, {21, 24}, {26, 30}}

In[342]:=
prob = Join @@ (Join[Partition[Range[#1, #2], 2, 1],
Block[{rnd},
rnd := Random[Integer, {#1, #2}]; {Take[
NestWhileList[rnd &, rnd, (#1 === #2 &), 2], -2]}]] &
@@@
rngs);

In[343]:= eqs = prob[[RandomPermutation[Length[prob]]]];

In[344]:= classesFrom3[eqs]
Out[344]=
{{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13},
{14, 15, 16, 17, 18, 19, 20},
{21, 22, 23, 24}, {26, 27, 28, 29, 30}}

In[345]:= Range @@@ rngs
Out[345]=
{{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13},
{14, 15, 16, 17, 18, 19, 20},
{21, 22, 23, 24}, {26, 27, 28, 29, 30}}

Your program gets recursion problems with that data, perhaps you may arrage
this with some preordering (but you'll loose O[n] then).

Both programs from Mariusz give wrong answers. Also that from Jens-Peer. The
program from Ingolf Dahl gives the same answer as mine, in a different
ordering. But of course it is not competitive with the performance. It is
however a nice example, to produce a (possible slow but) provable correct
solution first!

Hartmut

>-----Original Message-----
>From: Wolf, Hartmut
To: mathgroup at smc.vnet.net
>Sent: Thursday, February 19, 2004 4:24 PM
>To: 'Carl K. Woll'
>Cc: 'Mariusz Jankowski'
>Subject: [mg46479] Re: RE: [mg46459] Re: Computing sets of equivalences
>
>
>Yes, Carl,
>
>just saw it, re-reading my explanations, it's wrong! As are
>both solution from Marisz, not yours.
>
>Sorry, Hartmut
>
>
>>-----Original Message-----
>>From: Wolf, Hartmut
To: mathgroup at smc.vnet.net
>>Sent: Thursday, February 19, 2004 4:07 PM
>>To: 'Carl K. Woll'; mathgroup at smc.vnet.net
>>Cc: 'Mariusz Jankowski'
>>Subject: [mg46479] RE: [mg46459] Re: Computing sets of equivalences
>>
>>
>>Dear Carl,
>>
>>miserably I missed the challenge yesterday. I tried today
>>without looking at the solutions, and came up with something
>>which appears to be similiar to yours (no wonder I learnt that
>>from you!).
>>
>>It is robust against ordering and repetitions (and is faster
>>than yours by a square root of 2).  In fact it is 2 solutions,
>>the first one is this
>>
>>
>>classesFrom[equis_] :=
>>  Module[{objs = Union[Flatten[equis]], nex, ext, classes},
>>nex[_] := True;
>>    ext[_] := {};
>>    classes =
>>      Union[If[nex[#1],
>>              If[nex[#2], nex[#1] = nex[#2] = #1, , nex[#1] =
>>nex[#2]], ,
>>              If[nex[#2], nex[#2] = nex[#1], , nex[#1]]] & @@@ equis];
>>    Scan[(ext[nex[#]] = {ext[nex[#]], #}) &, objs];
>>    Flatten[ext[#]] & /@ classes
>>    ]
>>
>>and derived from that, as obj and classes can be replaced by
>>DownValues, this one:
>>
>>classesFrom2[equis_] := Module[{nex, ext},
>>    nex[_] := True;
>>    ext[_] := {};
>>    If[nex[#1], If[nex[#2], nex[#1] = nex[#2] = #1, , nex[#1]
>>= nex[#2]], ,
>>          If[nex[#2], nex[#2] = nex[#1], ,]] & @@@ equis;
>>    nex[_] =.;
>>    Scan[(ext[nex[#]] = {ext[nex[#]], #}) &,
>>      DownValues[nex][[All, 1, 1, 1]]];
>>    ext[_] =.;
>>    Flatten /@ DownValues[ext][[All, 2]]
>>    ]
>>
>>This avoids Union, but is only marginally faster, such O[n] vs
>>O[n log n] seems not to be a practical issue here.
>>
>>The algorithmic idea is quite simple: if for an associated
>>pair both entries have not been encountered, a new equivalence
>>class is created (which gets its name from the first object)
>>and both objects are linked to that class by definitions for
>>nex[obj].  If only one object has not been encountered, then
>>it is linked to the class the other obj refers to.  If both
>>have been encountered we simply pass on.
>>
>>Done that, we collect the classes passing through all objects
>>(represented by the DownValues of nex) and finally display the
>>classes (represented by the DownValues of ext) forgetting their names.
>>
>>yours,
>>Hartmut
>>
>>---
>>P.S. I didn't look into the books, but this seems to be a
>>classical problem; perhaps it's somewhere in the AddOns.
>>
>>
>>
>[...]
>

```

• Prev by Date: Re: Computing sets of equivalences
• Next by Date: Re: Re: Help Browser issue in 5.0.1 on Mac OS X
• Previous by thread: Re: Help!!!!
• Next by thread: Re: corrected RE: Re: Computing sets of equivalences