diff --git a/Makefile.in b/Makefile.in index fb2cbc32..0f05375a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -325,6 +325,14 @@ test-bf: $(CMA) tests/test_bf.ml test-johnson: $(CMA) tests/test_johnson.ml ocaml unix.cma graphics.cma $^ +test-floyd: bin/test-floyd.opt + +bin/test-floyd.opt: $(CMXA) tests/test_floydwarshall.ml + mkdir -p bin + $(OCAMLOPT) -o $@ unix.cmxa $^ + +test-floyd: bin/test-floyd.opt + bin/test-ts: $(CMXA) tests/test_topsort.ml mkdir -p bin $(OCAMLOPT) -o $@ unix.cmxa $^ diff --git a/src/path.ml b/src/path.ml index fb5e0cdb..f752d148 100644 --- a/src/path.ml +++ b/src/path.ml @@ -99,7 +99,6 @@ struct loop () end - (* The following module is a contribution of Yuto Takei (University of Tokyo) *) module BellmanFord @@ -187,6 +186,86 @@ struct in iter (Comp.scc_list g) +end + +(** Weight signature for Floyd's algorithm. *) +module type WF = sig + include Sig.WEIGHT + val infinity : t + (** Infini value*) +end + +(** The Floyd–Warshall algorithm is an algorithm for finding shortest paths in + a weighted graph with positive or negative edge weights + (but with no negative cycles)*) +module FloydWarshall + (G: G) + (W: WF with type edge = G.E.t) = +struct + open G.E + module HVV = Hashtbl.Make(Util.HTProduct(G.V)(G.V)) + + exception NegativeCycle + + let all_pairs_shortest_paths g = + let add wi wj = + let a = W.add wi wj in + if a > W.infinity then + W.infinity + else + a in + let msp = HVV.create 100 in + let psp = HVV.create 100 in + (* initialization *) + G.iter_vertex + (fun v -> + G.iter_vertex + (fun u -> + HVV.add msp (v,u) W.infinity; + HVV.add psp (v,u) u + ) g + ) g; + (*first step*) + G.iter_vertex + (fun v -> + G.iter_succ_e + (fun e -> + HVV.replace msp (v, (dst e)) (W.weight e); + HVV.replace psp (v, (dst e)) v + ) g v + ) g; + G.iter_vertex + (fun k -> + G.iter_vertex + (fun i -> + G.iter_vertex + (fun j -> + let p = add (HVV.find msp (i,k)) (HVV.find msp (k,j)) in + if p < (HVV.find msp (i,j)) then begin + HVV.replace msp (i,j) p ; + HVV.replace psp (i,j) (HVV.find psp (k,j)) + end + ) g + ) g ) g; + G.iter_vertex + (fun i -> + let m = HVV.find msp (i, i) in + if m < W.zero then raise NegativeCycle) g; + (msp,psp) + + let shortest_path p vs ve = + let rec loop acc p vs ve = + let vp = HVV.find p (vs,ve) in + if vs = vp then + vs::acc + else + loop (vp::acc) p vs vp + in + loop (ve::[]) p vs ve + + + + end module Johnson diff --git a/src/path.mli b/src/path.mli index 5b1e74ac..a1e1caac 100644 --- a/src/path.mli +++ b/src/path.mli @@ -99,6 +99,37 @@ module type WJ = sig (** Subtraction of weights. *) end +(** Weight signature for Floyd's algorithm. *) +module type WF = sig + include Sig.WEIGHT + val infinity : t + (** Infini value*) +end + +module FloydWarshall + (G: G) + (W: WF with type edge = G.E.t) : +sig + + module HVV : Hashtbl.S with type key = (G.V.t * G.V.t) + + exception NegativeCycle + + val all_pairs_shortest_paths : G.t -> (W.t HVV.t * G.V.t HVV.t) + (** [all_pairs_shortest_paths g] computes the distance of shortest + path between all pairs of vertex in [g]. They are returned as + a tuple of hash table. The first map each pair of vertex to their + distance and the seconde map each pair of vertices to the predecessor of + the seconde vertex. If [g] contains a negative-cycle, raises + [NegativeCycle].*) + val shortest_path : G.V.t HVV.t -> G.V.t -> G.V.t -> G.V.t list + (**[shortest_path p vs ve] from a hash table of predecessors return the list of + vertex that are reachable from vertex [vs] to [ve]. Be careful the hash table + must be obtained by all_pairs_shortest_paths*) +end + + + module Johnson (G: G) (W: WJ with type edge = G.E.t) : diff --git a/tests/test_floydwarshall.ml b/tests/test_floydwarshall.ml new file mode 100644 index 00000000..a84c72c7 --- /dev/null +++ b/tests/test_floydwarshall.ml @@ -0,0 +1,53 @@ + +(* Test file for Floyd Warshall inspired by test_johnson.ml E.PINEAU *) + +open Printf +open Graph + +module Int = struct + type t = int + let compare = compare + let hash = Hashtbl.hash + let equal = (=) + let default = 0 +end + + +module G = Imperative.Digraph.ConcreteLabeled(Int)(Int) + + +module W = struct + type edge = G.E.t + type t = int + let weight e = G.E.label e + let zero = 0 + let infinity = 999999 + let add = (+) + let compare = compare +end + +module F = Path.FloydWarshall(G)(W) +let test has_cycle tab = + let g = G.create () in + let build (s,w,t) = G.add_edge_e g (G.E.create s w t) in + List.iter build tab; + begin try + let (m,p) = F.all_pairs_shortest_paths g in + F.HVV.iter (fun (v, u) d -> Printf.printf "\n[%d -> %d : %d] " v u d; + List.iter (fun vs -> Printf.printf "V %d, " vs) (F.shortest_path p v u)) m; + + assert (not has_cycle) + with + | F.NegativeCycle -> printf "Negative cycle found \n"; assert (has_cycle) + (*| _ -> failwith "Unknown"*) +end + +let () = + printf "Test N°1 same data as the test of Johnson's algorithm :"; + test false [1, 3, 2; 1, (-4), 5; 1, 8, 3; 2, 7, 5; 2, 1, 4; + 3, 4, 2; 4, (-5), 3; + 4, 2, 1; 5, 6, 4]; + printf "\nTest N° 2 negative cycle :\n"; + test true [1, 3, 2 ; 1, 3, 4 ; 2, 2, 1 ; 2, 2, 3 ; 2, 2, 4 ; 3, (-6), 1; + 3, 1, 4; 4, 4, 2; 4, 4, 3]; + printf "All tests succeeded.\n"