8
$\begingroup$

I am doing a research on networks which consists of polygons with different number of sides. I am trying to find all simple cycles in a network which are chordless. As an example, consider the following graph:

graph = Graph[
  {
    1 <-> 2,   2 <-> 3,   3 <-> 4,  4 <-> 5,   5 <-> 6,   1 <-> 6,  
    3 <-> 7,   7 <-> 8,   8 <-> 9,  9 <-> 10, 10 <-> 11, 11 <-> 3,
    4 <-> 12, 12 <-> 13, 13 <-> 11
  }, 
    VertexLabels -> "Name"
]

enter image description here

{1,2,3,4,5,6}, {3,4,11,12,13},{3,7,8,9,10,11} are rings and we can extract them:

cycles = FindFundamentalCycles[graph];
rings = Sort @* VertexList @* Graph /@ cycles  

enter image description here

But the above solution doesn't always work as it might give non-chordless cycles. Consider the following example:

grapht = Graph[
{
  1 <-> 2, 1 <-> 3, 2 <-> 4, 4 <-> 5, 5 <-> 6, 4 <-> 6, 
  6 <-> 7, 3 <-> 5, 3 <-> 9, 5 <-> 8, 8 <-> 9
},
VertexLabels -> "Name"];

enter image description here

Rings (cycles) are:

cyclest = FindFundamentalCycles[grapht]; 
HighlightGraph[grapht, #] & /@ cyclest

enter image description here

But I need to get {4,5,6} as a ring not {1,2,3,4,5,6} since there is an edge in the latter. Is there any way to filter out only chordless cycles?


W Community crosspost

$\endgroup$
4
$\begingroup$

First, let us find all cycles in the graph. Then, we will filter out the ones that contain chords; this we can detect by checking if the $n$-vertex induced subgraph is isomorphic to a cycle of length $n$ or not.

Let us use your graph as an example:

g = Graph[{1 <-> 2, 1 <-> 3, 2 <-> 4, 4 <-> 5, 5 <-> 6, 4 <-> 6, 
   6 <-> 7, 3 <-> 5, 3 <-> 9, 5 <-> 8, 8 <-> 9}, 
  VertexLabels -> "Name"];

cy = VertexList[Graph[#]] & /@ FindCycle[g, Infinity, All];
Select[cy, IsomorphicGraphQ[CycleGraph[Length[#]], Subgraph[g, #]] &]
(* {{4, 5, 6}, {5, 8, 9, 3}, {1, 2, 4, 5, 3}} *)

HighlightGraph[g, %]

Of course, if you have additional constraints, you can simply modify the call to FindCycle with different parameters to only find cycles of length e.g. of size 5, 6, 7, or 8. To achieve this, just do FindCycle[g, {5, 8}, All] instead.

$\endgroup$
  • $\begingroup$ This seems to work like a charm! A huge thank! $\endgroup$ – Mahdi Mar 22 '15 at 19:42
  • $\begingroup$ Although, I found that this doesn't work in Mathematica 9 mostly because of FindCycle. $\endgroup$ – Mahdi Apr 3 '15 at 5:59
0
$\begingroup$

You can use FindCycle in Mathematica 10.

$\endgroup$
  • 3
    $\begingroup$ Can you perhaps elaborate a bit on that? By default FindCycle only returns one cycle of a graph, and the returned cycle is not necessarily fundamental. So you'll need to do a bit more than just FindCycle[graph]. $\endgroup$ – Teake Nutma Oct 4 '14 at 17:46
  • 3
    $\begingroup$ I think this would be better as a comment, since it's far from a complete answer. $\endgroup$ – Juho Apr 8 '15 at 20:41
  • $\begingroup$ @mrm Frankly this one seems like a grey area. As a rule moderators should not be deciding which answers are good or bad but rather deleting spam, converting comments to comments, etc. If you had more "reputation" points you could also vote to delete this, and that would probably be best. (Deletion via multiple votes.) $\endgroup$ – Mr.Wizard Apr 9 '15 at 14:51
  • $\begingroup$ @Mr.Wizard. I don't see a delete button, so it seems I don't have the privilege you mentioned in another comment 78764/3066 $\endgroup$ – m_goldberg Apr 9 '15 at 15:48
  • $\begingroup$ @m_goldberg That's very odd; you are a 20K+ "Trusted User" ( janitor ) and you should have a delete link to the right of edit as far as I can recall. I'll try to find an explanation. $\endgroup$ – Mr.Wizard Apr 9 '15 at 15:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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