Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

If I have an undirected graph represented with an adjacency matrix, how can I find all the subgraphs which are a cycle of length N?

I don't really know the math nor the programming language well, so I find myself resorting to making a bunch of for loops to try traversing the graph. This is very slow, and I might as well just write it in C at that point. So I'm hoping to learn how to work better with mathematica here.

So far, I think I've found a way to tell me the number of such subgraphs. For example, I might be able to get the number of cycles of length 3 in the graph given by the matrix m by doing something like...

Digitize[matrix_] := Map[Sign[#]&,matrix,{2}] 
m=Digitize[m]; (* ensure it is normalized *)
ident = Table[KroneckerDelta[i,j],{i,1,Length[m]},{j,1,Length[m]}];
m1 = m*(1-ident); (* remove self-loops, giving steps away of length 1 *)
m2 = (m1.m1)*(1-ident); (* matrix of steps of length 2, with no repeats *)
m3 = (m2.m1); (* matrix of steps of length 3 *)
(* reading diagonal of m3 will tell how many paths lead back to the start? *) 

This already looks a bit messy, and I'm not sure how much I can generalize it to larger N. And even then, it doesn't help me get the actual paths.

Help?

Clarification: Ideally I'd like to eventually write a module that given a length N and an adjacency matrix for an undirected graph, outputs a list of all the unique (up to cyclic reordering) lists of vertices which form a cyclic path of length N.

share|improve this question
    
Welcome to the Mathematica SE site WideEyed! –  magma Mar 8 '12 at 2:18
    
Do you allow repeated vertices in the cycles? What about repeated edges? –  Szabolcs Mar 8 '12 at 13:54

2 Answers 2

up vote 14 down vote accepted

With the following obvious replacements for the two graphs: PetersenGraph[5, 2] --> yourgraph, and CycleGraph[5] --->CycleGraph[n] for general n where

  yourgraph=AdjacencyGraph[yourAdjacencyMatrix]

You can use the first example from the docs on SubGraph section Applications:

  {g, h} = {PetersenGraph[5, 2], CycleGraph[5]};
  Grid[{{g, h}}]

pict 1

Select the subgraphs isomorphic to CycleGraph[5]:

  s = Subsets[Range[VertexCount[g]], {VertexCount[h]}];
  Select[Subgraph[g, #] & /@ s, IsomorphicGraphQ[#, h] &];

and view

  Grid[Partition[
  HighlightGraph[g, #] & /@ 
  Select[Subgraph[g, #] & /@ s, IsomorphicGraphQ[#, h] &], {5}]]

highlighted subgraphs

EDIT: A function to select cyclic subgraphs with k vertices

 ClearAll[cyclicSubgraphs];
 cyclicSubgraphs[grph_Graph, k_Integer] := 
 Select[Subgraph[grph, #] & /@ Subsets[Range[VertexCount[grph]], {k}], 
 IsomorphicGraphQ[#, CycleGraph[k]] &]

Example:

Row[HighlightGraph[SetProperty[GraphData[{"Antiprism", 6}], {VertexLabels -> "Name", 
 VertexSize -> Medium, ImagePadding -> 20, ImageSize -> 300}], #] & /@ 
 cyclicSubgraphs[GraphData[{"Antiprism", 6}], 8])]

enter image description here

share|improve this answer
4  
I find it interesting that you answer is taken almost verbatim from the docs. :) –  rcollyer Mar 8 '12 at 19:59
    
@rcollyer, yes it is and it is the very first example in its section as noted -- I wish i could have added that SubGraph was among my first few search keywords too;) –  kguler Mar 9 '12 at 3:49
    
IMO, it would be appropriate to give another example than what can be found in the Documentation, since this stack is supposed to be an alternative source of such information. (It turns out that I'm interested in such a problem, too :P) –  CHM Mar 9 '12 at 19:53
    
Wonderful! Except that I get "Subsets::toomany: "The number of subsets (316399053474504) indicated by Subsets[{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27‌​,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,<<734>>},{6‌​}] is too large; it must be a machine integer." –  Ralph Dratman Jul 11 '12 at 17:37
1  
@Ralph, for "large" graphs, even if you don't hit the @MaxMachineInteger wall, this method will be painfully slow. –  kguler Jul 11 '12 at 22:00

Here is some code for computing k-cycles. The efficiency is no better than O(c*k*n) where c = #cycles and n = #vertices. In general it is probably worse, since it tries to build cycles from shorter paths and there might be many of those that eventually fail to become full cycles.

extendCycle[cyc_List, edges_List] := 
 Map[If[# > First[cyc] && ! MemberQ[cyc, #], Append[cyc, #], 
    Null /. Null :> Sequence[]] &, edges[[Last[cyc]]]]

cycles[mat_, k_] := 
 Module[{n = Length[mat], m2, cyc, cyclist}, 
  m2 = MapIndexed[#1*#2[[2]] &, mat, {2}] /. 0 :> Sequence[];
  cyclist = Flatten[Drop[MapIndexed[{#2[[1]], #1} &, m2, {2}], -k+1], 1];
  Do[cyclist = 
    Flatten[Map[extendCycle[#, m2] &, cyclist], 1], {k - 2}];
  Map[If[MemberQ[m2[[Last[#]]], First[#]], Append[#, First[#]], 
     Null /. Null :> Sequence[]] &, cyclist]
  ]

Here is an example. For a reasonably sparse graph it seems to work well. In this construction, "mat2" is the adjacency matrix we will use.

len = 20;
mat = RandomChoice[{.6, .4} -> {0, 1}, {len, len}];
Do[mat[[j, j]] = 0, {j, len}];
mat2 = Floor[(mat + Transpose[mat])/2];

First I show what this looks like, though in a sparse format. The first entry, {18,19}, means that vertex 1 is connected (only) to vertices 18 and 19.

mat3 = MapIndexed[#1*#2[[2]] &, mat2, {2}] /. 0 :> Sequence[]

Out[114]= {{18, 19}, {6, 7}, {9, 14, 15, 20}, {13, 20}, {6, 10, 11, 
  12, 14, 15, 20}, {2, 5, 8, 20}, {2, 14, 19}, {6}, {3, 12, 17},
  {5, 14}, {5, 13, 14, 15}, {5, 9}, {4, 11}, {3, 5, 7, 10, 11, 18},
  {3, 5, 11, 18}, {}, {9, 18, 19}, {1, 14, 15, 17}, {1, 7, 17}, {3, 4, 5, 6}}

Here is the result for finding all 6-cycles.

In[116]:= Timing[cycles[mat2, 6]]

Out[116]= {0.02, {{2, 6, 5, 10, 14, 7, 2}, {2, 6, 5, 11, 14, 7, 
   2}, {2, 6, 20, 3, 14, 7, 2}, {2, 6, 20, 5, 14, 7, 2}, {2, 7, 14, 3,
    20, 6, 2}, {2, 7, 14, 5, 20, 6, 2}, {2, 7, 14, 10, 5, 6, 2}, {2, 
   7, 14, 11, 5, 6, 2}, {3, 9, 12, 5, 6, 20, 3}, {3, 9, 12, 5, 10, 14,
    3}, {3, 9, 12, 5, 11, 14, 3}, {3, 9, 12, 5, 11, 15, 3}, {3, 9, 17,
    19, 7, 14, 3}, {3, 14, 7, 19, 17, 9, 3}, {3, 14, 10, 5, 6, 20, 
   3}, {3, 14, 10, 5, 11, 15, 3}, {3, 14, 10, 5, 12, 9, 3}, {3, 14, 
   11, 5, 6, 20, 3}, {3, 14, 11, 5, 12, 9, 3}, {3, 14, 11, 13, 4, 20, 
   3}, {3, 14, 11, 15, 5, 20, 3}, {3, 14, 18, 15, 5, 20, 3}, {3, 15, 
   11, 5, 6, 20, 3}, {3, 15, 11, 5, 10, 14, 3}, {3, 15, 11, 5, 12, 9, 
   3}, {3, 15, 11, 13, 4, 20, 3}, {3, 15, 11, 14, 5, 20, 3}, {3, 15, 
   18, 14, 5, 20, 3}, {3, 20, 4, 13, 11, 14, 3}, {3, 20, 4, 13, 11, 
   15, 3}, {3, 20, 5, 14, 11, 15, 3}, {3, 20, 5, 14, 18, 15, 3}, {3, 
   20, 5, 15, 11, 14, 3}, {3, 20, 5, 15, 18, 14, 3}, {3, 20, 6, 5, 10,
    14, 3}, {3, 20, 6, 5, 11, 14, 3}, {3, 20, 6, 5, 11, 15, 3}, {3, 
   20, 6, 5, 12, 9, 3}, {4, 13, 11, 5, 6, 20, 4}, {4, 13, 11, 14, 5, 
   20, 4}, {4, 13, 11, 15, 5, 20, 4}, {4, 20, 5, 14, 11, 13, 4}, {4, 
   20, 5, 15, 11, 13, 4}, {4, 20, 6, 5, 11, 13, 4}, {5, 10, 14, 18, 
   15, 11, 5}, {5, 11, 15, 18, 14, 10, 5}, {5, 12, 9, 17, 18, 14, 
   5}, {5, 12, 9, 17, 18, 15, 5}, {5, 14, 18, 17, 9, 12, 5}, {5, 15, 
   18, 17, 9, 12, 5}, {10, 5, 11, 15, 18, 14, 10}}}

Here is a denser example. In this instance, the sparse form of the adjacency matrhx is as below.

{{5, 6, 7, 10, 12, 13, 17, 19}, {3, 6, 9, 13, 14, 16, 17, 20}, {2, 4, 
  5, 6, 7, 8, 11}, {3, 9, 12, 13, 14, 15, 17, 19}, {1, 3, 7, 11, 12, 
  13, 15, 20}, {1, 2, 3, 8, 14, 16, 17, 18, 19, 20}, {1, 3, 5, 8, 9, 
  12, 16, 18}, {3, 6, 7, 9, 12, 13, 14, 16, 17, 18, 19}, {2, 4, 7, 8, 
  17}, {1, 11, 13}, {3, 5, 10, 14, 18}, {1, 4, 5, 7, 8}, {1, 2, 4, 5, 
  8, 10, 14, 15, 18, 20}, {2, 4, 6, 8, 11, 13, 16, 19}, {4, 5, 13, 17,
   18}, {2, 6, 7, 8, 14, 17, 18, 19}, {1, 2, 4, 6, 8, 9, 15, 16, 
  19}, {6, 7, 8, 11, 13, 15, 16, 20}, {1, 4, 6, 8, 14, 16, 17, 
  20}, {2, 5, 6, 13, 18, 19}}

In[124]:= Timing[Length[cycles[mat2, 6]]]

Out[124]= {0.55, 17105}
share|improve this answer
    
That worked very well for me. Thank you! –  Ralph Dratman Jul 11 '12 at 17:58

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.