Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

[Date Index] [Thread Index] [Author Index]

Search the Archive

RE: Computing sets of equivalences

  • To: mathgroup at smc.vnet.net
  • Subject: [mg46465] RE: [mg46437] Computing sets of equivalences
  • From: "Ingolf Dahl" <ingolf.dahl at telia.com>
  • Date: Thu, 19 Feb 2004 03:02:27 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

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


  • Prev by Date: Re: output in NMinimize on each step?
  • Next by Date: Re: Computing sets of equivalences
  • Previous by thread: Re: Computing sets of equivalences
  • Next by thread: Re: Computing sets of equivalences