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


  • Prev by Date: Re: bug in integration with version 5.0 ?
  • Next by Date: Re: Computing sets of equivalences
  • Previous by thread: Re: Computing sets of equivalences
  • Next by thread: Re: Computing sets of equivalences