15

I have the edge list of an undirected graph which consists of disjoint "cycles" only. Example:

{{1, 2}, {2, 3}, {3, 4}, {4, 1}, {5, 6}, {6, 7}, {7, 5}}

Mathematica graphics

Each vertex has exactly two edges connecting to it. Each cycle has at least three vertices. The vertices are denoted by integers $1..n$. The edge list is given in some random order. The edges appear in random orientations (i.e. {1,2} might be given as {2,1})

I need to break the graph into cycles and sort the vertices in the order they're connected. For example, if the input is:

{{7, 6}, {5, 6}, {4, 3}, {3, 2}, {4, 1}, {2, 1}, {7, 5}}

then I want the output

{ {1, 2, 3, 4},
  {5, 6, 7} }

The first sublist corresponds to the tetragon, the second one corresponds to the triangle. The vertices must appear in the order they're connected.

Performance requirements: the maximum vertex count is a few thousand---it should run near-instantaneously for an input of this size. An $n \log n$ solution is possible. However, I'm more interested in a concise and elegant solution than a performant one using e.g. Compile.

Note: while it was easiest to state the problem in terms of graphs, it's not really a graph theoretical problem, so don't feel compelled to use Graph unless it's really advantageous.

Clarification: This question is not (only) about finding connected components. It is about ordering vertices along the cycles. Actually my practical problem is that I have the edges of a polygon in random order and orientation, and I need to sort them so I can use them in Polygon and related primitives.

A sample dataset can be downloaded using Import["http://w504215.open.ge.tt/1/files/3XgvcEF/0/blob?download", "WDX"].

Szabolcs
  • 234,956
  • 30
  • 623
  • 1,263

2 Answers2

7

Edited to account for @Szabolcs comment

A index-disordered edge list (a bit different from yours):

el = {{3, 2}, {1, 3}, {2, 5}, {5, 8}, {4, 7}, {7, 6}, {6, 4}, {8, 1}}

Let's visualize with labels 

gr = Graph[el, VertexLabels -> "Name", PlotRangePadding -> .2]

enter image description here

This will pick up the cycles but reorder them (as @Szabolcs reflects in the comment)

In[1]:= ConnectedComponents[gr]

Out[1]= {{1, 2, 3, 5, 8}, {4, 6, 7}}

We see this ordering is wrong because there is no edge between vertices 1 and 2. This more elaborate line will work:

In[2]:= Map[First, (FindHamiltonianCycle /@ (Subgraph[gr, #] & /@ 
         ConnectedComponents[gr])), {3}]

Out[2]= {{{1, 3, 2, 5, 8}}, {{4, 6, 7}}}

FindEulerianCycle would work too.

I wonder how it scales if you check this on your ~1000 vertex case.

Szabolcs
  • 234,956
  • 30
  • 623
  • 1,263
Vitaliy Kaurov
  • 73,078
  • 9
  • 204
  • 355
  • I am well aware of this function, but the main task is ordering vertices according to the connections, not merely finding connected components. {1,2,3,4} is a good output because the connections are 1-2, 2-3, 3-4, 4-1, but {2,1,4,3} is not. There's no guarantee ConnectedComponents won't return the latter. – Szabolcs Mar 20 '12 at 08:50
  • @Szabolcs I understand the problem now - edited. I'm curious how will this compare against non-graphs methods. – Vitaliy Kaurov Mar 20 '12 at 09:16
  • Unfortunately this does not work. Again, you are assuming that the edges/vertices will be correctly ordered. I uploaded a sample dataset (see update to the question). The method you describe gives a list starting with {1024, 1028, ...}, yet vertices 1024 and 1028 are not connected. In the returned sublist any two consecutive vertices must be connected, as well as the last and first vertex of the sublist. – Szabolcs Mar 20 '12 at 09:41
  • @Szabolcs I realized that - replacing EdgeList with FindHamiltonianCycle fixes it. I will take a look at your data set too. – Vitaliy Kaurov Mar 20 '12 at 09:43
  • Alright, now it's time for a +1. :-) Thank you! – Szabolcs Mar 20 '12 at 09:48
  • This is what I needed it for, in case you are curious :-) – Szabolcs Mar 21 '12 at 15:08
  • @Szabolcs did you find another way to solve this? – Vitaliy Kaurov Apr 08 '12 at 07:57
  • No, your way works fine, I just forgot to accept the answer ... FindEulerianCycle seems to be a bit faster. I had a way, but it turned out to give incorrect results in some cases. – Szabolcs Apr 08 '12 at 08:04
7

Perhaps ExtractCycles (in the Combinatorica package) does what you require?

Needs["Combinatorica`"]
ExtractCycles@FromUnorderedPairs@el

gives

(* {{7, 4, 6, 7}, {8, 1, 3, 2, 5, 8}} *)

Your sample dataset produces 4 cycles:

ExtractCycles@FromUnorderedPairs@data

the first of which is the following:

(* {522, 518, 521, 527, 532, 535, 541, 550, 558, 563, 567, 578, 589, 593, 603, 608, 611, 615, 627, 638, 649, 659, 668, 674, 681, 689, 700, 712, 715, 720, 725, 734, 743, 750, 755, 771, 786, 793, 801, 812, 823, 829, 834, 837, 850, 861, 869, 877, 881, 890, 899, 906, 917, 929, 932, 935, 941, 949, 955, 966, 977, 981, 985, 995, 1005, 1009, 1013, 1018, 1021, 1025, 1029, 1032, 1030, 1026, 1022, 1016, 1014, 1010, 1006, 1002, 986, 982, 978, 974, 956, 952, 942, 937, 934, 930, 926, 903, 900, 896, 882, 878, 874, 862, 858, 839, 835, 832, 824, 820, 802, 798, 785, 782, 758, 744, 740, 726, 716, 711, 708, 690, 686, 671, 669, 666, 650, 640, 636, 616, 612, 607, 604, 594, 590, 586, 568, 564, 560, 542, 538, 536, 530, 528, 524, 522} *)

user1066
  • 17,923
  • 3
  • 31
  • 49