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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2126 - (view) (download)

1 : monnier 409 (*
2 :     * This is Johnson's algorithm for computing all pairs shortest paths.
3 :     * Good for sparse graphs.
4 :     * -- Allen
5 :     *)
6 :    
7 : george 545 functor Johnson(Num : ABELIAN_GROUP_WITH_INF) :
8 : monnier 409 sig include ALL_PAIRS_SHORTEST_PATHS
9 :     exception NegativeCycle
10 :     end =
11 :     struct
12 :    
13 :     structure Num = Num
14 :     structure G = Graph
15 :     structure A2 = Array2
16 :     structure A = Array
17 : george 545 structure D = Dijkstra(Num)
18 :     structure BF = BellmanFord(Num)
19 :     structure GI = DirectedGraph(HashArray)
20 : monnier 409 structure U = UnionGraphView
21 :    
22 :     exception NegativeCycle = BF.NegativeCycle
23 :    
24 :     fun all_pairs_shortest_paths
25 :     {graph=G as G.GRAPH g : ('n,'e,'g) G.graph,weight} =
26 :     let val N = #capacity g ()
27 :     val dist = A2.array(N,N,Num.inf)
28 :     val pred = A2.array(N,N,~1)
29 :     exception EDGE of 'e
30 :     exception NODE of 'n
31 :     exception Empty
32 :     fun arbEdge() =
33 :     (#forall_edges g (fn (_,_,e) => raise EDGE e); raise Empty)
34 :     handle EDGE e => e
35 :     fun arbNode() =
36 :     (#forall_nodes g (fn (_,n) => raise NODE n); raise Empty)
37 :     handle NODE n => n
38 :     in let val e = arbEdge()
39 :     val n = arbNode()
40 :     val G' as G.GRAPH g' = GI.graph("dummy source",#graph_info g,1)
41 :     val G'' = U.union_view (fn (a,b) => a) (G,G')
42 :     val op+ = Num.+
43 :     val op- = Num.-
44 :     val s = N
45 :     val _ = #forall_nodes g (fn (v,_) => #add_edge g' (s,v,e))
46 :     val _ = #add_node g' (s,n)
47 :     fun weight'(u,v,e) = if u = s then Num.zero else weight(u,v,e)
48 :     val {dist=h,...} = D.single_source_shortest_paths
49 :     {graph=G'',s=s,weight=weight'}
50 :     fun weight''(u,v,e) = weight(u,v,e) + A.sub(h,u) - A.sub(h,v)
51 :     in #forall_nodes g
52 :     (fn (u,_) =>
53 :     let val {dist=d,pred=p} = BF.single_source_shortest_paths
54 :     {graph=G,s=u,weight=weight''}
55 :     val h_u = A.sub(h,u)
56 :     in #forall_nodes g (fn (v,_) =>
57 :     (A2.update(dist,u,v,A.sub(d,v) + A.sub(h,v) - h_u);
58 :     A2.update(pred,u,v,A.sub(p,v))))
59 :     end)
60 :     end handle Empty => ();
61 :     {dist=dist,pred=pred}
62 :     end
63 :     end

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