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