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
>