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 /MLRISC/trunk/graphs/min-cut.sml
ViewVC logotype

Annotation of /MLRISC/trunk/graphs/min-cut.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 545 - (view) (download)
Original Path: sml/trunk/src/MLRISC/graphs/min-cut.sml

1 : monnier 409 (*
2 :     * This module implements minimal (undirected) cut.
3 :     * The algorithm is due to Mechtild Stoer and Frank Wagner.
4 :     *
5 :     * -- Allen
6 :     *)
7 :    
8 : george 545 functor MinCut(Num : ABELIAN_GROUP) : MIN_CUT =
9 : monnier 409 struct
10 :    
11 :     structure Num = Num
12 :     structure G = Graph
13 :     structure A = Array
14 : george 545 structure Q = NodePriorityQueue(A)
15 : monnier 409 structure L = CatnetableList (* for fast concatenation *)
16 :    
17 :     fun min_cut {graph=G.GRAPH G, weight} =
18 :     let val N = #capacity G ()
19 :     val adj = A.array(N,[])
20 :     val group = A.array(N,L.empty)
21 :     val onQueue = A.array(N,~1)
22 :     val adjEdges = A.array(N,(~1,ref Num.zero))
23 :     val weights = A.array(N,Num.zero)
24 :    
25 :     fun new_edge(i,j,w) =
26 :     (A.update(adj,i,(j,w)::A.sub(adj,i));
27 :     A.update(adj,j,(i,w)::A.sub(adj,j)))
28 :    
29 :     (* Initialize the adjacency and group arrays *)
30 :     fun initialize(nodes) =
31 :     let fun node(i) = A.update(group,i,L.unit i)
32 :     fun edge(e as (i,j,_)) =
33 :     if i <> j then new_edge(i,j,ref(weight e)) else ()
34 :     in app (fn i => (node i; app edge (#out_edges G i))) nodes
35 :     end
36 :    
37 :     (* Priority queue ranked by non-decreasing cut weights *)
38 :     val Q = Q.create N (fn (u,v) => Num.<(A.sub(weights,v),A.sub(weights,u)))
39 :    
40 :     (* Find a better cut (V-{t},{t}) *)
41 :     fun find_cut(phase,a,nodes) =
42 :     let fun mark v = A.update(onQueue,v,phase)
43 :     fun unmark v = A.update(onQueue,v,~1)
44 :     fun marked v = A.sub(onQueue,v) = phase
45 :     fun deleted v = A.sub(onQueue,v) = ~2
46 :     fun relax(v,w) = (A.update(weights,v,Num.+(A.sub(weights,v),!w));
47 :     Q.decreaseWeight(Q,v))
48 :     fun loop(s,t) =
49 :     if Q.isEmpty Q then (s,t,A.sub(weights,t))
50 :     else let val t' = Q.deleteMin Q
51 :     in unmark t';
52 :     app (fn (v,w) => if marked v then relax(v,w) else ())
53 :     (A.sub(adj,t'));
54 :     loop(t,t')
55 :     end
56 :     in app (fn u => if deleted u then () else
57 :     (A.update(weights,u,Num.zero);
58 :     mark u; Q.insert(Q,u))) nodes;
59 :     app relax (A.sub(adj,a));
60 :     loop(~1,a)
61 :     end
62 :    
63 :     (* Coalesce vertices s and t *)
64 :     fun coalesce(s,t) =
65 :     ( (* merge the group of s and t *)
66 :     A.update(group,s,L.append(A.sub(group,s),A.sub(group,t)));
67 :     (* mark neighbors of s *)
68 :     app (fn (u,w) => A.update(adjEdges,u,(s,w))) (A.sub(adj,s));
69 :     (* change t-v(w) and s-v(w') to s-v(w+w')
70 :     * change t-v(w) to s-v(w)
71 :     *)
72 :     let fun rmv([],L) = L
73 :     | rmv((x as (u,_))::L,L') = rmv(L,if t = u then L' else x::L')
74 :     in app (fn (v,w) =>
75 :     let val (s',w') = A.sub(adjEdges,v)
76 :     in if s = s' then w' := Num.+(!w',!w)
77 :     else if s <> v then new_edge(s,v,w)
78 :     else ();
79 :     A.update(adj,v,rmv(A.sub(adj,v),[]))
80 :     end) (A.sub(adj,t))
81 :     end;
82 :     A.update(adj,t,[]);
83 :     A.update(onQueue,t,~2) (* delete node t *)
84 :     )
85 :    
86 :     fun iterate(n,a,best_group,best_cut,best_weight,nodes) =
87 :     if n >= 2 then
88 :     let val (s,t,w) = find_cut(n,a,nodes)
89 :     val (best_group,best_cut,best_weight) =
90 :     if best_group < 0 orelse Num.<(w,best_weight)
91 :     then (t,A.sub(group,t),w)
92 :     else (best_group,best_cut,best_weight)
93 :     in coalesce(s,t);
94 :     iterate(n-1,a,best_group,best_cut,best_weight,nodes)
95 :     end
96 :     else (L.toList(best_cut),best_weight)
97 :    
98 :     val nodes = map #1 (#nodes G ())
99 :    
100 :     in case nodes of
101 :     [] => ([],Num.zero)
102 :     | [_] => ([],Num.zero)
103 :     | a::L => (initialize(nodes);
104 :     iterate(length nodes,a,~1,L.empty,Num.zero,L))
105 :     end
106 :    
107 :     end

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