RE: RE: Computing sets of equivalences

*To*: mathgroup at smc.vnet.net*Subject*: [mg46481] RE: [mg46465] RE: [mg46437] Computing sets of equivalences*From*: "Ingolf Dahl" <ingolf.dahl at telia.com>*Date*: Fri, 20 Feb 2004 00:29:25 -0500 (EST)*Sender*: owner-wri-mathgroup at wolfram.com

Just for the fun of it, and gaining some speed: A recursive variant, to exclude rechecking of what already is OK in the list recursiveequivalences[mylist_List] := Block[{$RecursionLimit = 100000}, If[Length[mylist] < 2, Return[mylist]]; Return[(Append[recursiveequivalences[Most[#]], Last[#]]) &@(mylist //. List[a___, x_List, b___, y_List] /; Intersection[x, y] != {} :> List[a, b, Union[x, y]])]] Here is a method to get 500 random number pairs: expr = Table[ i = Random[Integer, {0, 999}]; {i, Mod[i + Random[Integer, {1, 999}], 1000]}, {500}]; Hartmut, could you recheck your last variant? It did not work for me. Regards Ingolf Dahl Sweden -----Original Message----- From: Ingolf Dahl [mailto:ingolf.dahl at telia.com] To: mathgroup at smc.vnet.net Subject: [mg46481] [mg46465] RE: [mg46437] Computing sets of equivalences Mariusz, Here is one slightly more compact way to express your ideas in Mathematica: expr = {{1, 2}, {1, 5}, {2, 3}, {3, 4}, {5, 6}, {7, 8}, {11, 12}, {12, 13}, {10, 14}}; equivalences[mylist_List] := mylist //. List[a___, x_List, b___, y_List, c___] /; Intersection[x, y] != {} :> List[a, Union[x, y], b, c] equivalences[expr] (Output {{1, 2, 3, 4, 5, 6}, {7, 8}, {11, 12, 13}, {10, 14}}) If you want to change the sorting order, you might apply some variant of Sort afterwards. Best regards Ingolf Dahl Sweden >-----Original Message----- >From: Mariusz Jankowski [mailto:mjankowski at usm.maine.edu] To: mathgroup at smc.vnet.net >Sent: Wednesday, February 18, 2004 06:37 >To: mathgroup at smc.vnet.net >Subject: [mg46481] [mg46465] [mg46437] Computing sets of equivalences > > >Dear Mathgroup, I think this falls into the "classic algorithms" category, >so I hope some of you will find this interesting. I checked archives and >mathsource but did not find anything useful. > >I have a list of lists, each sublist implying an equivalence. I am >trying to >split the list into lists of equivalences (this is part of a connected >components algorithm). For example, given > >{{1,2},{1,5},{2,3},{3,4},{5,6},{7,8},{11,12},{12,13},{10,14}} > >I want > >{{1,2,3,4,5,6},{7,8},{10,14},{11,12,13}}. > >Here is my currently "best" attempt. I accumulate the equivalences by >comparing pairs of list, merging them if they have common elements. At the >end of each iteration I remove all merged pairs from original list and >repeat. > > iselectEquivalences[v_]:=Module[{x,y,tmp,pos}, > x=v;y={}; > While[x=!={}, > tmp=x[[1]]; > pos={{1}}; > Do[ > If[Intersection[tmp,x[[i]]]==={}, tmp, tmp=Union[tmp,x[[i]]]; > pos=Join[pos, {{i}}]], {i, 2, Length[x]}]; > x=Delete[x, pos]; > y=Join[y, {tmp}] ]; > y] > > >Can you tell me if you have or know of a realization of this classic >operation that works better/faster? Are there alternative paradigms for >solving this kind of problem. > > >Thanks, Mariusz >