15.4.768  src/lib/graph/graph-dfs.pkg

#
# Some simple functions for performing depth first search
#
# -- Allen Leung

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

###            "Everything is vague to a degree you do not realize
###               till you have tried to make it precise."
###
###                                -- Bertrand Russell



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
    package bts =  bit_set;                     # bit_set                       is from   src/lib/graph/bit-set.pkg
herein


    package   graph_depth_first_search
    : (weak)  Graph_Depth_First_Search          # Graph_Depth_First_Search      is from   src/lib/graph/graph-dfs.api
    {
        # Depth first search

        fun dfs (odg::DIGRAPH ggg) f g roots
            =
            {   visited =   bts::create (ggg.capacity ());

                fun traverse n
                    =
                    if  (not (bts::mark_and_test (visited, n)))
                        f n;
                        apply traverse_edge (ggg.out_edges n);
                    fi

                also
                fun traverse_edge (e as (_, n, _))
                    =
                    if (not (bts::mark_and_test (visited, n)))
                        g e;
                        f n;
                        apply traverse_edge (ggg.out_edges n);
                    fi;

                apply traverse roots;
            };


        # Depth first search fold

        fun dfsfold (odg::DIGRAPH ggg) f g roots (x, y)
            =
            {   visited = bts::create (ggg.capacity ());

                fun traverse (n, x, y)
                    =
                    if (bts::mark_and_test (visited, n))
                        #
                        (x, y);
                    else
                        traverse_edges (ggg.out_edges n, f (n, x), y);
                    fi

                also
                fun traverse_edges ([], x, y)
                        =>
                        (x, y);

                    traverse_edges ((e as (_, n, _)) ! es, x, y)
                        =>
                        if  (bts::mark_and_test (visited, n))
                            #
                            traverse_edges (es, x, y);
                        else
                            y =  g (e, y);
                            x =  f (n, x);

                            my (x, y)
                                =
                                traverse_edges (ggg.out_edges n, x, y);

                            traverse_edges (es, x, y);
                        fi;
                end 

                also
                fun traverse_all ([], x, y)
                        =>
                        (x, y);

                    traverse_all (n ! ns, x, y)
                        => 
                        {   my (x, y) = traverse (n, x, y);
                            traverse_all (ns, x, y);
                        };
                end;

                traverse_all (roots, x, y);
            };


        fun dfsnum (odg::DIGRAPH ggg) roots
            =
            {   nnn     =  ggg.capacity ();

                dfsnum  =  rwv::make_rw_vector (nnn, -1);
                compnum =  rwv::make_rw_vector (nnn, -1);

                fun traverse ([], d, c)
                        =>
                        c;

                    traverse (n ! ns, d, c)
                        =>
                        if  (rwv::get (dfsnum, n) >= 0)
                            #
                            traverse (ns, d, c);
                        else
                            rwv::set (dfsnum, n, d); 
                            c = traverse (ggg.next n, d+1, c);
                            rwv::set (compnum, n, c);  
                            traverse (ns, d, c+1);
                        fi;
                end;

                traverse (roots, 0, 0);

                { dfsnum, compnum };
            };

        fun preorder_numbering (odg::DIGRAPH ggg) root
            =
            {   nnn =  ggg.capacity ();
                ppp =  rwv::make_rw_vector (nnn,-1);

                fun f (i, n)
                    = 
                    if (rwv::get (ppp, i) == -1)
                        #
                        fun g ([], n) =>   n; 

                            g((_, j, _) ! es, n)
                                =>
                                g (es, f (j, n));
                        end;

                        rwv::set (ppp, i, n); g (ggg.out_edges i, n+1);
                    else
                        n;
                    fi;

                f (root, 0);
                ppp;
            };

        fun postorder_numbering (odg::DIGRAPH ggg) root
            =
            {   nnn =  ggg.capacity ();
                ppp =  rwv::make_rw_vector (nnn,-2);

                fun f (i, n)
                    = 
                    if (rwv::get (ppp, i) == -2)
                        #
                        fun g ([], n) =>   n;

                            g((_, j, _) ! es, n)
                                =>
                                g (es, f (j, n));
                        end;

                        rwv::set (ppp, i,-1);
                        n =  g (ggg.out_edges i, n); 
                        rwv::set (ppp, i, n);
                        n+1;
                    else
                        n;
                    fi;

              f (root, 0);
              ppp;
           };
    };
end;