Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

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

Search the Archive

Re: Re: Faster ways to unionize intersecting sets?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg70319] Re: [mg70183] Re: Faster ways to unionize intersecting sets?
  • From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
  • Date: Thu, 12 Oct 2006 05:38:33 -0400 (EDT)

I wrote the post below in a hurry and as a result a mathematical non-sequitur
"the transitive closure of a set of equivalence classes" managed to  
sneak in. In fact, there are two related mathematical problems that  
got confused here: that of finding the equivalence classes of an  
equivalence relation specified by a list of pairs, each consisting of  
equivalent elements and that of finding the transitive closure of a  
relation (not necessarily an equivalence relation), given in a  
similar way. In the latter case one obtains a list of pairs which  
defines a relation that is transitive rather than a list of  
equivalence classes.

In this case, of course, the original problem was to find the  
equivalence classes (as sets) of an equivalence relation generated by  
a set of pairs. This is equivalent to the problem of "Unionizing  
interesecting pairs", rather than sets, where each pair represents  
equivalent elements. To make the method work on lists containing sets  
with more than two elements we need to modify the method:


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

unionizeInteresectingSets[l_]:=getequivs[Flatten[Partition[#,2,1]&/@l, 
1]]

Now, for example,


s={{1,2,3},{3,4},{5,6,7},{7,8},{9,10}};


unionizeInteresectingSets[s]


{{1,2,3,4},{5,6,7,8},{9,10}}

I would expect this to be still a very fast method, but I have not  
made any tests.

Andrzej Kozlowski


On 11 Oct 2006, at 19:56, Andrzej Kozlowski wrote:

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


  • Prev by Date: Update on Weinberg-Sallam model in supr symmetry as E8xE8
  • Next by Date: RE: sample programs
  • Previous by thread: Re: Faster ways to unionize intersecting sets?
  • Next by thread: Re: Faster ways to unionize intersecting sets?