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

SCM Repository

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

Annotation of /sml/branches/SMLNJ/src/MLRISC/graphs/graph-cycles.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)

1 : monnier 245 (*
2 : monnier 411 * Enumerate all simple cycles in a graph with no duplicates.
3 :     *
4 :     * This module enumerates all simple cycles in a graph.
5 :     * Each cycle is reprensented as a list of edges. Adjacent edges
6 :     * are adjacent in the list. The function works like fold: all cycles
7 :     * are ``folded'' together with a user supplied function.
8 :     *
9 :     * -- Allen
10 : monnier 245 *)
11 : monnier 411
12 : monnier 245 structure GraphCycles : GRAPH_SIMPLE_CYCLES =
13 :     struct
14 :    
15 :     structure G = Graph
16 :     structure A = Array
17 :    
18 :     fun cycles (graph as G.GRAPH G) f x =
19 :     let val N = #capacity G ()
20 :     val inSCC = A.array(N,(~1,0))
21 :     val inCycle = A.array(N,false)
22 :    
23 :     fun processSCC(scc,x) =
24 :     let val witness = hd scc
25 :     (* order each node in the scc *)
26 :     fun init([],_) = ()
27 :     | init(u::us,i) = (A.update(inSCC,u,(witness,i)); init(us,i+1))
28 :    
29 :     fun dfs(n,root,u,cycle,x) = dfsSucc(n,root,#in_edges G u,cycle,x)
30 :     and dfsSucc(_,_,[],_,x) = x
31 :     | dfsSucc(n,root,(e as (v,u,_))::es,cycle,x) =
32 :     if root = v then dfsSucc(n,root,es,cycle,f(e::cycle,x))
33 :     else let val (w,m) = A.sub(inSCC,v)
34 :     in if w <> witness orelse m <= n orelse A.sub(inCycle,v)
35 :     then dfsSucc(n,root,es,cycle,x)
36 :     else let val _ = A.update(inCycle,v,true)
37 :     val x = dfs(n,root,v,e::cycle,x)
38 :     val _ = A.update(inCycle,v,false)
39 :     in dfsSucc(n,root,es,cycle,x)
40 :     end
41 :     end
42 :    
43 :     fun hasBackEdge([],n) = false
44 :     | hasBackEdge((v,_,_)::es,n) =
45 :     let val (w,m) = A.sub(inSCC,v)
46 :     in w = witness andalso m >= n orelse hasBackEdge(es,n) end
47 :    
48 :     fun enumerateAll(_,[],x) = x
49 :     | enumerateAll(n,u::us,x) =
50 :     let val x = if hasBackEdge(#in_edges G u,n)
51 :     then dfs(n,u,u,[],x) else x
52 :     in enumerateAll(n+1,us,x)
53 :     end
54 :     in init(scc,0);
55 :     enumerateAll(0,scc,x)
56 :     end
57 :    
58 : monnier 411 in GraphSCC.strong_components graph processSCC x
59 : monnier 245 end
60 :    
61 :     end
62 :    

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