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: [mg46468] Re: Computing sets of equivalences
  • From: Paul Abbott <paul at physics.uwa.edu.au>
  • Date: Fri, 20 Feb 2004 00:29:13 -0500 (EST)
  • Organization: The University of Western Australia
  • References: <c0uu8a$e84$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

In article <c0uu8a$e84$1 at smc.vnet.net>,
 Mariusz Jankowski<mjankowski at usm.maine.edu> wrote:

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

Not my area, but I assume that DiscreteMath`Combinatorica` has code for 
this?

Working backwards from your output,

 r = {{1, 2, 3, 4, 5, 6}, {7, 8}, {10, 14}, {11, 12, 13}}

defining a test to check if a pair {a,b} appears in the connected 
components list,

 f[r_][a_, b_] := Or @@ (Intersection[#, {a, b}] == Sort[{a, b}] & ) /@ r

we can make a graph (here including the extra vertex "9" which does not 
appear in your list -- this could be avoided by renumbering),

 <<DiscreteMath`Combinatorica`

 g = MakeGraph[Range[Min[r],Max[r]], f[r]]

compute the connected components (which we already know),

 ConnectedComponents[g]

and show the graph

  ShowGraph[g, VertexNumber -> True]; 

Cheers,
Paul

-- 
Paul Abbott                                   Phone: +61 8 9380 2734
School of Physics, M013                         Fax: +61 8 9380 1014
The University of Western Australia      (CRICOS Provider No 00126G)         
35 Stirling Highway
Crawley WA 6009                      mailto:paul at physics.uwa.edu.au 
AUSTRALIA                            http://physics.uwa.edu.au/~paul


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