Mathematica 9 is now available
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: [mg46450] Re: Computing sets of equivalences
  • From: "Carl K. Woll" <carlw at u.washington.edu>
  • Date: Thu, 19 Feb 2004 03:01:58 -0500 (EST)
  • Organization: University of Washington
  • References: <c0uu8a$e84$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Maruisz,

Here is my attempt.

addequiv[{a_, b_}] :=
 If[ !ValueQ[set[a]],
  If[ !ValueQ[set[b]],
   set[a] = set[b] = p[index++];
   equivset[set[a]] = {a, b};,

   set[a] = set[b];
   equivset[set[a]] = Union[{a}, equivset[set[a]]];
  ],

  If[ !ValueQ[set[b]],
   set[b] = set[a];
   equivset[set[a]] = Union[{b}, equivset[set[a]]];,

   equivset[set[a]] = Union[equivset[set[a]], equivset[set[b]]];
   equivset[set[b]] =. ;
   set[b] = set[a];
  ]
 ]

getequivs[eq_] := Block[{index = 1, set, equivset, p},
 addequiv /@ eq;
 DownValues[equivset][[All,2]]
]

If you can have redundant equivalences, than you will need to modify the
above code a bit. Change

   equivset[set[a]] = Union[equivset[set[a]], equivset[set[b]]];
   equivset[set[b]] =. ;
   set[b] = set[a];

to

  If[set[a]!=set[b],
   equivset[set[a]] = Union[equivset[set[a]], equivset[set[b]]];
   equivset[set[b]] =. ;
   set[b] = set[a];]

Good luck!

Carl Woll

"Mariusz Jankowski" <mjankowski at usm.maine.edu> wrote in message
news:c0uu8a$e84$1 at smc.vnet.net...
> 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: Computing sets of equivalences
  • Next by Date: Re: labeling problem
  • Previous by thread: RE: Computing sets of equivalences
  • Next by thread: Re: Computing sets of equivalences