Re: Computing sets of equivalences

*To*: mathgroup at smc.vnet.net*Subject*: [mg46486] Re: Computing sets of equivalences*From*: drbob at bigfoot.com (Bobby R. Treat)*Date*: Fri, 20 Feb 2004 00:29:32 -0500 (EST)*References*: <c11sa4$mef$1@smc.vnet.net>*Sender*: owner-wri-mathgroup at wolfram.com

Ingolf, I love that solution. This may make it a trifle faster (or not). I took a hint from UnsortedUnion (under Help for Union). unsortedUnion[a_List, b_List] := Module[{f}, f[y_] := (f[y] = Sequence[]; y); f /@ Join[a, b]] intersectingQ[x_List, y_List] := Module[ {f, g}, g[a_] := False; f[a_] := g[a] = Hold@Throw@True; f /@ x; Catch[Scan[ReleaseHold@g@# &, y, {1}]; False] ] equivalence = List[a___, x_List, b___, y_List, c___] /; intersectingQ[ x, y] :> List[a, unsortedUnion[x, y], b, c]; test = {{8, 7}, {12, 11}, {13, 12, 13}, {1, 5}, {2, 3}, {1, 2}, {3, 4}, {5, 6}, {14, 10}}; test //. equivalence {{8, 7}, {12, 11, 13}, {1, 5, 2, 3, 4, 6}, {14, 10}} This avoids sorting, and stops as soon as a duplicate is found rather than building the full Intersection. Bobby "Ingolf Dahl" <ingolf.dahl at telia.com> wrote in message news:<c11sa4$mef$1 at smc.vnet.net>... > 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: [mg46486] 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 > >