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/matching.sml
ViewVC logotype

Annotation of /MLRISC/trunk/graphs/matching.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (view) (download)

1 : monnier 409 (*
2 :     * This module implenents max cardinality matching.
3 :     * Each edge of the matching are folded together with a user supplied
4 :     * function.
5 :     *
6 :     * Note: The graph must be a bipartite graph.
7 :     * Running time is O(|V||E|)
8 :     * From the book by Aho, Hopcroft, Ullman
9 :     *
10 :     * -- Allen
11 :     *)
12 :    
13 :     structure BipartiteMatching : BIPARTITE_MATCHING =
14 :     struct
15 :    
16 :     structure G = Graph
17 :     structure A = Array
18 :    
19 :     fun matching (G.GRAPH G) f x =
20 :     let val N = #capacity G ()
21 :     val mate = A.array(N,~1)
22 :    
23 :     fun married i = A.sub(mate,i) >= 0
24 :     fun match(i,j) =
25 :     ((* print("match "^Int.toString i^" "^Int.toString j^"\n"); *)
26 :     A.update(mate,i,j); A.update(mate,j,i))
27 :     (*
28 :     * Simple greedy algorithm to find an initial matching
29 :     *)
30 :     fun compute_initial_matching() =
31 :     let fun edges [] = ()
32 :     | edges((i,j,_)::es) =
33 :     if i = j orelse married j then edges es else match(i,j)
34 :     in #forall_nodes G (fn (i,_) =>
35 :     if married i then () else edges(#out_edges G i))
36 :     end
37 :    
38 :     val visited = A.array(N,~1)
39 :     val pred = A.array(N,~1) (* bfs spanning tree *)
40 :    
41 :     (*
42 :     * Build an augmenting path graph using bfs
43 :     * Invariants:
44 :     * (1) the neighbors of an unmarried vertex must all be married
45 :     * (2) unmarried vertices on the queue are the roots of BFS
46 :     * Returns true iff a new augmenting path is found
47 :     *)
48 :     fun build_augmenting_path(phase,unmarried) =
49 :     let (* val _ = print("Phase "^Int.toString phase^"\n") *)
50 :     fun neighbors u = #succ G u @ #pred G u
51 :     fun marked u = A.sub(visited,u) = phase
52 :     fun mark u = A.update(visited,u,phase)
53 :     fun edge(u,v) = A.update(pred,v,u)
54 :     fun bfsRoots [] = false
55 :     | bfsRoots(r::roots) =
56 :     if marked r orelse married r then bfsRoots roots
57 :     else (mark r; bfsEven(r,neighbors r,[],[],roots))
58 :    
59 :     and bfs([],[],roots) = bfsRoots roots
60 :     | bfs([],R,roots) = bfs(rev R,[],roots)
61 :     | bfs(u::L,R,roots) = bfsOdd(u,neighbors u,L,R,roots)
62 :    
63 :     (* u is married, find an unmatched neighbor v *)
64 :     and bfsOdd(u,[],L,R,roots) = bfs(L,R,roots)
65 :     | bfsOdd(u,v::vs,L,R,roots) =
66 :     if marked v then bfsOdd(u,vs,L,R,roots) else
67 :     let val w = A.sub(mate,v)
68 :     in if u = w then bfsOdd(u,vs,L,R,roots)
69 :     else if w < 0 then (edge(u,v); path v) (*v is unmarried!*)
70 :     else (mark v; mark w; edge(u,v); bfsOdd(u,vs,L,w::R,roots))
71 :     end
72 :    
73 :     (* u is unmarried, all neighbors vs are married *)
74 :     and bfsEven(u,[],L,R,roots) = bfs(L,R,roots)
75 :     | bfsEven(u,v::vs,L,R,roots) =
76 :     if marked v then bfsEven(u,vs,L,R,roots)
77 :     else let val w = A.sub(mate,v)
78 :     in mark v; mark w; edge(u,v); bfsEven(u,vs,L,w::R,roots)
79 :     end
80 :    
81 :     (* found a path, backtrack and update the matching edges *)
82 :     and path ~1 = true
83 :     | path u = let val v = A.sub(pred,u)
84 :     val w = A.sub(mate,v)
85 :     in match(u,v); path w end
86 :     in bfsRoots(unmarried) end
87 :    
88 :     (*
89 :     * Main loop
90 :     *)
91 :     fun iterate() =
92 :     let val unmarried = List.foldr
93 :     (fn ((u,_),L) => if married u then L else u::L) [] (#nodes G ())
94 :     fun loop(phase) =
95 :     if build_augmenting_path(phase,unmarried) then
96 :     loop(phase+1) else ()
97 :     in loop(0) end
98 :    
99 :     (* fold result; make sure parallel and opposite edges are handled *)
100 :     fun fold(f,x) =
101 :     let val m = ref x
102 :     val k = ref 0
103 :     in #forall_edges G (fn e as (i,j,_) =>
104 :     if A.sub(mate,i) = j then
105 :     (A.update(mate,i,~1); A.update(mate,j,~1);
106 :     k := !k + 1; m := f(e,!m))
107 :     else ());
108 :     (!m,!k)
109 :     end
110 :    
111 :     in compute_initial_matching();
112 :     iterate();
113 :     fold(f,x)
114 :     end
115 :    
116 :     end

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