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