15.4.763  src/lib/graph/enumerate-simple-cycles.pkg

# enumerate-simple-cycles.pkg
# Enumerate all simple cycles in a graph with no duplicates.
#
# This module enumerates all simple cycles in a graph.
# Each cycle is reprensented as a list of edges.  Adjacent edges
# are adjacent in the list.  The function works like fold: all cycles
# are ``folded'' together with a user supplied function.
#
# -- Allen Leung

# Compiled by:
#     src/lib/graph/graphs.lib


stipulate
    package odg =  oop_digraph;                                         # oop_digraph           is from   src/lib/graph/oop-digraph.pkg
    package rwv =  rw_vector;                                           # rw_vector                     is from   src/lib/std/src/rw-vector.pkg
herein


    package   enumerate_simple_cycles
    : (weak)  Enumerate_Simple_Cycles                                   # Enumerate_Simple_Cycles       is from   src/lib/graph/enumerate-simple-cycles.api
    {

        fun cycles  (graph as odg::DIGRAPH ggg)  f  x
            =
            {   nnn      = ggg.capacity ();
                in_scc   = rwv::make_rw_vector (nnn, (-1, 0));
                in_cycle = rwv::make_rw_vector (nnn, FALSE);

                fun process_scc (scc, x)
                    =
                    {   witness = head scc;                     #  order each node in the scc 

                        fun init ([], _)
                                =>
                                ();

                            init (u ! us, i)
                                =>
                                {   rwv::set (in_scc, u, (witness, i));
                                    init (us, i+1);
                                };
                        end;

                        fun dfs (n, root, u, cycle, x)          # "dfs" == "depth-first search", maybe?
                            =
                            dfs_succ (n, root, ggg.in_edges u, cycle, x)

                        also
                        fun dfs_succ (_, _,[], _, x) =>  x;

                            dfs_succ (n, root, (e as (v, u, _)) ! es, cycle, x)
                                =>
                                if (root == v)
                                    #
                                    dfs_succ (n, root, es, cycle, f (e ! cycle, x));
                                else
                                    my (w, m) =  rwv::get (in_scc, v);

                                    if (w != witness or m <= n or rwv::get (in_cycle, v) )
                                        # 
                                        dfs_succ (n, root, es, cycle, x);
                                    else
                                        rwv::set (in_cycle, v, TRUE);
                                        x = dfs (n, root, v, e ! cycle, x);
                                        rwv::set (in_cycle, v, FALSE);
                                        dfs_succ (n, root, es, cycle, x);
                                    fi;
                                fi;
                        end;

                        fun has_back_edge ([], n) => FALSE;

                            has_back_edge((v, _, _) ! es, n)
                                =>
                                {   my (w, m)
                                        =
                                        rwv::get (in_scc, v);

                                    w == witness and m >= n   or
                                    has_back_edge (es, n);
                                };
                        end; 

                        fun enumerate_all (_,[], x)
                                =>
                                x;

                            enumerate_all (n, u ! us, x)
                                =>
                                {   x = if (has_back_edge (ggg.in_edges u, n) )   dfs (n, u, u,[], x);
                                        else                                      x;               fi;

                                    enumerate_all (n+1, us, x);
                                };
                        end;

                        init (scc, 0);
                        enumerate_all (0, scc, x);
                    };

                graph_strongly_connected_components::scc
                    graph process_scc
                    x;
            };
    };
end;