Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Re: Faster ways to unionize intersecting sets?

• To: mathgroup at smc.vnet.net
• Subject: [mg70314] Re: [mg70183] Re: Faster ways to unionize intersecting sets?
• From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
• Date: Thu, 12 Oct 2006 05:38:07 -0400 (EDT)
• References: <eg02a3$81m$1@smc.vnet.net> <eg2e4o$70u$1@smc.vnet.net> <200610071106.HAA23299@smc.vnet.net>

Actually this question has already been considered on this list more  
than once but with a different interpretation. It is actually  
equivalent to finding the transitive closure of a set of equivalence  
classes. You can find many interesting and very fast solutions in the  
thread entitled: "Computing sets of equivalences" that run in 2004  
(and there have been other  essentially equivalent ones). Here I will  
just quote the solution provided by Carl Woll, which may well have  
been the fastest:


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

In your case:

s = {{1, 2}, {2, 3}, {4, 5}, {6, 7}, {7, 5}, {9, 10}, {11, 12}, {13,  
14}};


getequivs[s]

{{1,2,3},{6,7,4,5},{9,10},{11,12},{13,14}}

test it on large examples and you will see how fast it is.

Andrzej Kozlowski




On 7 Oct 2006, at 20:06, lsha wrote:

> Hi,
>
> I tried mergeSets2[] and the answer is different from mergeSets[].
> An example:
> In[34]:=
> s = {{1, 2}, {2, 3}, {4, 5}, {6, 7}, {7, 5}, {9, 10}, {11, 12},  
> {13, 14}};
>
>
> In[35]:=
> mergeSets[s]
> Out[35]=
> {{1, 2, 3}, {4, 5, 6, 7}, {9, 10}, {11, 12}, {13, 14}}
>
>
> In[36]:=
> mergeSets2[s]
> Out[36]=
> {{{9, 10}, {11, 12}, {13, 14}}, {1, 2, 3, 4, 5, 6, 7}}
>
> The non-intersecting singles are correct but the intersecting sets  
> are all
> merged together with mergeSets2[].
>
> Regards,
> Ling Sha
>
> "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com> wrote in message
> news:eg2e4o$70u$1 at smc.vnet.net...
>> lsha wrote:
>>> Hi,
>>>
>>> I need to search a list of sets and unionize any sets that  
>>> intersect. The
>>> following functions seems to work but may be there are faster ways?
>>>
>>> Thanks in advance.
>>>
>>>
>>>
>>> intersectQ[s1_, s2_] := If[Intersection[s1, s2] != {}, True, False]
>>>
>>> mergeSets[s_List] := Module[
>>> {h, r, singles, club, cnt},
>>> cnt = Length[s];
>>> If[cnt < 2, Return[s]];
>>> singles = {};
>>> club = s;
>>>
>>> While[cnt >= 2,
>>> h = club[[1]];
>>> r = Rest[club];
>>> hit = 0;
>>> club = If[intersectQ[h, #], hit = 1; Union[h, #], #] & /@ r;
>>> If[hit == 0, singles = Append[singles, h]];
>>> --cnt;
>>> ];
>>> Join[singles, club]
>>> ]
>>>
>>>
>> Using functional programming, mergeSets2 (see In[5]) is 15 to 20  
>> times
>> faster than the original procedural code.
>>
>> In[1]:=
>> intersectQ[s1_, s2_] := If[Intersection[s1, s2] != {},
>>    True, False]
>> mergeSets[s_List] := Module[{h, r, singles, club,
>>     cnt}, cnt = Length[s]; If[cnt < 2, Return[s]];
>>     singles = {}; club = s; While[cnt >= 2,
>>      h = club[[1]]; r = Rest[club]; hit = 0;
>>       club = (If[intersectQ[h, #1], hit = 1;
>>            Union[h, #1], #1] & ) /@ r;
>>       If[hit == 0, singles = Append[singles, h]];
>>       --cnt; ]; Join[singles, club]]
>>
>> In[3]:=
>> s = Table[Table[Random[Integer, {1, 1000}],
>>      {Random[Integer, {1, 20}]}], {100}];
>>
>> In[4]:=
>> t1 = Timing[res1 = mergeSets[s]; ][[1]]
>>
>> Out[4]=
>> 1.234 Second
>>
>> In[5]:=
>> mergeSets2[s_List] := Module[{list, pos, singles,
>>     club}, list = MapIndexed[Intersection[#1,
>>         Flatten[Drop[s, #2]]] & , s];
>>     pos = Position[list, {}]; singles =
>>      Extract[s, pos]; club =
>>      Union[Flatten[Complement[s, singles]]];
>>     {singles, club}]
>>
>> In[6]:=
>> t2 = Timing[res2 = mergeSets2[s]; ][[1]]
>>
>> Out[6]=
>> 0.063 Second
>>
>> In[7]:=
>> t1/t2
>>
>> Out[7]=
>> 19.5873
>>
>> Regards,
>> Jean-Marc
>>
>

• References:
  • Re: Faster ways to unionize intersecting sets?
    • From: "lsha" <lsha@earthlink.net>