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

let pairs = 
   [("A","B");
    ("A","C");
    ("D","F");
    ("B","C");
    ("D","G");
    ("G","A");
    ("C","G");
    ("D","A");
   ]

let adjacency = Seq.group_by fst pairs |> Seq.map (fun (a,pairs) -> a,Seq.map snd pairs |> Seq.to_array)
let graph = dict adjacency

// Path (x0,x1,revPairs), revPairs are the (reversed) edges connecting x0 to x1
type Path = Path of string * string * (string * string) list
let singletonPath (x0,x1) = Path(x0,x1,[x0,x1])
let isCycle   (Path (x0,x1,revPairs)) = x0=x1
let pathEdges (Path (x0,x1,revPairs)) = List.rev revPairs

let extendNonDecreasingPath (Path (x0,x1,revPairs)) =
    [ if graph.ContainsKey(x1) then
        for x2 in graph.[x1] do
          if x2 >= x0 then
            // The path is not extended to a node lower than the start node.
            // It is enough to assume cycles start at their lowest node.
            // So each cycle will appear only once.
            yield Path (x0,x2,(x1,x2) :: revPairs)
    ]

/// "cycles upto length n" and "non-decreasing paths of length n"    
let rec cyclesAndPathsUpto n =
    if n=1 then        
        [],List.map singletonPath pairs
    else
        // Extend paths of length (n-1) in non-decreasing way, splitting out the n-cycles.
        let cyclesPrev,pathsPrev = cyclesAndPathsUpto (n-1)
        let paths        = List.map_concat extendNonDecreasingPath pathsPrev
        let cycles,paths = List.partition isCycle paths        
        cycles @ cyclesPrev,paths

let cyclesUpto n = cyclesAndPathsUpto n |> fst |> List.map pathEdges

cyclesUpto 6