4
$\begingroup$

Here are the nodes (vertices) of my graph:

a = 
  {{1, 2}, {1, 3}, {1, 4}, {1, 6}, {2, 6}, {3, 8}, {3, 11}, {4, 8}, {5, 2}, 
   {5, 6}, {5, 8}, {6, 8}, {6, 10}, {6, 11}, {7, 2}, {7, 6}, {8, 9}, {8, 11}, 
   {9, 6}, {10, 2}, {10, 9}, {11, 3}, {11, 4}, {11, 9}, {11, 10}};

First, I need to find the all feedback loops of a graph which has directed edges. For this I have tried the following code:

cycles[a_] := 
  Module[{f, edges = Rule @@@ a // Dispatch}, 
    f[x_, b___, x_] := {{x, b, x}};
    f[___, x_, ___, x_] = {};
    f[c___, v_] := Join @@ (f[c, v, #] & /@ ReplaceList[v, edges]);
    Join @@ f /@ Union @@ a]
cycles[a];

which gives me probably individual feedback loops:

{{2, 6, 8, 11, 10, 2}, {2, 6, 10, 2}, {2, 6, 11, 10, 2}, {3, 8, 9, 6, 11, 3}, 
 {3, 8, 11, 3}, {3, 11, 3}, {4, 8, 9, 6, 11, 4}, {4, 8, 11, 4}, {6, 8, 9, 6}, 
 {6, 8, 11, 9, 6}, {6, 8, 11, 10, 2, 6}, {6, 8, 11,10, 9, 6}, {6, 10, 2, 6}, 
 {6, 10, 9, 6}, {6, 11, 3, 8, 9, 6}, {6, 11, 4, 8, 9, 6}, {6, 11, 9, 6}, 
 {6, 11, 10, 2, 6}, {6, 11, 10, 9, 6}, {8, 9, 6, 8}, {8, 9, 6, 11, 3, 8}, 
 {8, 9, 6, 11, 4, 8}, {8, 11, 3, 8}, {8, 11, 4, 8}, {8, 11, 9, 6, 8}, 
 {8, 11, 10, 2, 6, 8}, {8, 11, 10, 9, 6, 8}, {9, 6, 8, 9}, {9, 6, 8, 11, 9}, 
 {9, 6, 8, 11, 10, 9}, {9, 6, 10, 9}, {9, 6, 11, 3, 8, 9}, {9, 6, 11, 4, 8, 9}, 
 {9, 6, 11, 9}, {9, 6, 11, 10, 9}, {10, 2, 6, 8, 11, 10}, {10, 2, 6, 10}, 
 {10, 2, 6, 11, 10}, {10, 9, 6, 8, 11, 10}, {10, 9, 6, 10}, {10,9, 6, 11, 10}, 
 {11, 3, 8, 9, 6, 11}, {11, 3, 8, 11}, {11, 3, 11}, {11, 4, 8, 9, 6, 11}, 
 {11, 4, 8, 11}, {11, 9, 6, 8, 11}, {11, 9, 6, 11}, {11, 10, 2, 6, 8, 11}, 
 {11, 10, 2, 6, 11}, {11, 10, 9, 6, 8, 11}, {11, 10, 9, 6, 11}}

My main question is: How can I visualise all individual feedback loops of a graph? For example like this:

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ The IGraph/M package has the IGFeedbackArcSet function, which may be of use for problems like this. $\endgroup$
    – Szabolcs
    Dec 16 '15 at 15:18
5
$\begingroup$

You don't need to write code to find cycles. There is a built-in function for that (FindCycle) Besides, using pattern matching for this goal as you did is bound to be rather slow.

For visualization of the cycles you can use HighlightGraph.

g = Graph[Rule @@@ a, VertexLabels -> "Name"]

Mathematica graphics

cycles = FindCycle[g, Infinity, 99999]
Manipulate[
   HighlightGraph[g, cycles[[i]]],
   {{i, 1, "Cycle"}, 1, Length@cycles, 1}
];

Mathematica graphics

$\endgroup$

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.