Re: Computing sets of equivalences
- To: mathgroup at smc.vnet.net
- Subject: [mg46498] Re: Computing sets of equivalences
- From: "Steve Luttrell" <steve1 at _removemefirst_luttrell.org.uk>
- Date: Fri, 20 Feb 2004 06:53:45 -0500 (EST)
- References: <c0uu8a$e84$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
This does what you want: <<DiscreteMath`Combinatorica` ConnectedComponents[FromOrderedPairs[{{1, 2}, {1, 5}, {2, 3}, {3, 4}, {5, 6}, {7, 8}, {11, 12}, {12, 13}, {10, 14}}]] Steve Luttrell "Mariusz Jankowski" <mjankowski at usm.maine.edu> wrote in message news:c0uu8a$e84$1 at smc.vnet.net... > 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 >