Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/MLRISC/graphs/graph-dfs.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/MLRISC/graphs/graph-dfs.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 410, Fri Sep 3 00:25:03 1999 UTC revision 411, Fri Sep 3 00:25:03 1999 UTC
# Line 1  Line 1 
1    (*
2     * Some simple functions for performing depth first search
3     *
4     * -- Allen
5     *)
6  structure GraphDFS : GRAPH_DEPTH_FIRST_SEARCH =  structure GraphDFS : GRAPH_DEPTH_FIRST_SEARCH =
7  struct  struct
8    
9     structure G = Graph     structure G = Graph
10     structure A = Array     structure A = Array
11       structure S = BitSet
12    
13     (*     (*
14      * Depth first search      * Depth first search
15      *)      *)
16     fun dfs f g (G.GRAPH G) roots =     fun dfs (G.GRAPH G) f g roots =
17     let val visited = BitSet.create(#capacity G ())     let val visited = S.create(#capacity G ())
        val out_edges = #out_edges G  
18         fun traverse n =         fun traverse n =
19             if BitSet.markAndTest(visited,n) then ()             if S.markAndTest(visited,n) then ()
20             else (f n; app traverse_edge (out_edges n))             else (f n; app traverse_edge (#out_edges G n))
21         and traverse_edge (e as (_,n,_)) =         and traverse_edge (e as (_,n,_)) =
22             if BitSet.markAndTest(visited,n) then ()             if S.markAndTest(visited,n) then ()
23             else (f n; g e; app traverse_edge (out_edges n))             else (g e; f n; app traverse_edge (#out_edges G n))
24     in  app traverse roots end     in  app traverse roots end
25    
    fun dfs_fold { node_f  = f,  
                   edge_f  = g,  
                   graph_f = h,  
                   node_unit = nu,  
                   edge_unit = eu,  
                   graph_unit = u  
                 } (G.GRAPH G) roots =  
    let val visited = BitSet.create(#capacity G ())  
        val out_edges = #out_edges G  
        fun fold_node (n, nu) =  
              if BitSet.markAndTest(visited,n) then nu  
              else f(n,fold_edges(out_edges n,eu))  
        and fold_edges ([], eu) = eu  
          | fold_edges ((e as (_,n,_))::es, eu) =  
              if BitSet.contains(visited,n) then fold_edges(es,eu)  
              else g(e,fold_node(n,nu),fold_edges(es,eu))  
        fun fold_nodes []      = u  
          | fold_nodes (n::ns) =  
              if BitSet.contains(visited,n) then fold_nodes ns  
              else h(fold_node(n, nu), fold_nodes ns)  
    in  
        fold_nodes roots  
    end  
   
26     (*     (*
27      *  Reachability      * Depth first search fold
28      *)      *)
29     fun reachables G =     fun dfsfold (G.GRAPH G) f g roots (x,y) =
30         dfs_fold { node_f     = op::,     let val visited = S.create(#capacity G ())
31                    node_unit  = [],         fun traverse(n,x,y) =
32                    edge_f     = fn (_,a,b) => a @ b,             if S.markAndTest(visited,n) then (x,y)
33                    edge_unit  = [],             else traverse_edges(#out_edges G n,f(n,x),y)
34                    graph_f    = op @,         and traverse_edges ([],x,y) = (x,y)
35                    graph_unit = [] } G           | traverse_edges ((e as (_,n,_))::es,x,y) =
36               if S.markAndTest(visited,n) then traverse_edges(es,x,y)
37               else let val y = g(e,y)
38                        val x = f(n,x)
39                        val (x,y) = traverse_edges(#out_edges G n,x,y)
40                    in  traverse_edges(es,x,y) end
41           and traverseAll([],x,y) = (x,y)
42             | traverseAll(n::ns,x,y) =
43                let val (x,y) = traverse(n,x,y)
44                in  traverseAll(ns,x,y) end
45       in  traverseAll(roots,x,y) end
46    
47    
48     (*     fun dfsnum (G.GRAPH G) roots =
49      * Closure     let val N       = #capacity G ()
50      *)         val dfsnum  = A.array(N,~1)
51           val compnum = A.array(N,~1)
52     (*         fun traverse([],d,c) = c
53      * Topological sort           | traverse(n::ns,d,c) =
54      *)             if A.sub(dfsnum,n) >= 0 then traverse(ns,d,c)
55     fun topsort (G.GRAPH G) roots =             else  let val _ = A.update(dfsnum,n,d);
56     let val visited = BitSet.create(#capacity G ())                       val c = traverse(#succ G n,d+1,c)
57         val succ    = #succ G                   in  A.update(compnum,n,c);
58         fun dfs (n, list) =                       traverse(ns,d,c+1)
           if BitSet.markAndTest(visited,n) then list  
           else dfs'(n,succ n,list)  
        and dfs'(x,[],list)    = x::list  
          | dfs'(x,n::ns,list) = dfs'(x,ns,dfs(n,list))  
        and dfs''([], list)    = list  
          | dfs''(n::ns, list) = dfs''(ns,dfs(n,list))  
    in  
        dfs''(roots,[])  
59     end     end
60       in  traverse(roots,0,0); {dfsnum=dfsnum,compnum=compnum} end
61    
62     fun preorder_numbering (G.GRAPH G) root =     fun preorder_numbering (G.GRAPH G) root =
63     let val N = #capacity G ()     let val N = #capacity G ()
# Line 101  Line 85 
85     in  f(root,0); P end     in  f(root,0); P end
86  end  end
87    
 (*  
  * $Log$  
  *)  
   

Legend:
Removed from v.410  
changed lines
  Added in v.411

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0