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.
>>
>>
>>
>[...]
>