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