From b85d6a0c86a89cb33f11d145e3d4a710c6f6cf71 Mon Sep 17 00:00:00 2001 From: Emmanuel-PLF Date: Wed, 27 Dec 2017 12:38:56 +0100 Subject: [PATCH 1/5] floyd first commit --- Makefile.in | 8 +++++ src/path.ml | 72 ++++++++++++++++++++++++++++++++++++- src/path.mli | 24 +++++++++++++ tests/test_floydwarshall.ml | 55 ++++++++++++++++++++++++++++ 4 files changed, 158 insertions(+), 1 deletion(-) create mode 100644 tests/test_floydwarshall.ml 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..645ef3a2 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 @@ -189,6 +188,77 @@ struct 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)) + + module W' = struct + open G.E + + type edge = G.E.t + type t = W.t + let zero = W.zero + let infinity = W.infinity + let weight e = W.weight e + let compare = W.compare + let add wi wj = + let a = W.add wi wj in + if a > infinity then + infinity + else + a + end + + let all_pairs_shortest_paths g = + 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) W.zero + ) g + ) g; + (*first step*) + G.iter_vertex + (fun v -> + G.iter_succ_e + (fun e -> + HVV.replace msp (v, (dst e)) (W.weight e) + ) g v + ) g; + G.iter_vertex + (fun k -> + G.iter_vertex + (fun i -> + G.iter_vertex + (fun j -> + let p = W'.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; + msp + +end + module Johnson (G: G) (W: WJ with type edge = G.E.t) = diff --git a/src/path.mli b/src/path.mli index 5b1e74ac..d294ad4b 100644 --- a/src/path.mli +++ b/src/path.mli @@ -99,6 +99,30 @@ 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) + + val all_pairs_shortest_paths : G.t -> W.t HVV.t + (** [all_pairs_shortest_paths g] computes the distance of shortest + path between all pairs of vertices in [g]. They are returned as + a hash table mapping each pair of vertices to their + distance. If [g] contains a negative-cycle, raises + [NegativeCycle l] where [l] is such a cycle.*) +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..510efa6c --- /dev/null +++ b/tests/test_floydwarshall.ml @@ -0,0 +1,55 @@ + +(* 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 g = G.create () + +let () = + G.add_edge_e g (G.E.create 1 3 2); + G.add_edge_e g (G.E.create 1 3 4); + G.add_edge_e g (G.E.create 2 2 1); + G.add_edge_e g (G.E.create 2 2 3); + G.add_edge_e g (G.E.create 2 2 4); + G.add_edge_e g (G.E.create 3 (-2) 1); + G.add_edge_e g (G.E.create 3 1 4); + G.add_edge_e g (G.E.create 4 4 2); + G.add_edge_e g (G.E.create 4 4 3) + (* + G.add_edge_e g (G.E.create 1 3 2); + G.add_edge_e g (G.E.create 1 (-4) 5); + G.add_edge_e g (G.E.create 1 8 3); + G.add_edge_e g (G.E.create 2 7 5); + G.add_edge_e g (G.E.create 2 1 4); + G.add_edge_e g (G.E.create 3 4 2); + G.add_edge_e g (G.E.create 4 (-5) 3); + G.add_edge_e g (G.E.create 4 2 1); + G.add_edge_e g (G.E.create 5 6 4) +*) +let () = let test = F.all_pairs_shortest_paths g in + F.HVV.iter (fun (v, u) d -> Printf.printf "[%d -> %d : %d]\n" v u d) test From 8f9186ab6a496211f7160409df1cd6804665d912 Mon Sep 17 00:00:00 2001 From: Emmanuel-PLF Date: Wed, 27 Dec 2017 15:47:07 +0100 Subject: [PATCH 2/5] test floyd update same as Johnson --- tests/test_floydwarshall.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/test_floydwarshall.ml b/tests/test_floydwarshall.ml index 510efa6c..f353157b 100644 --- a/tests/test_floydwarshall.ml +++ b/tests/test_floydwarshall.ml @@ -31,6 +31,7 @@ module F = Path.FloydWarshall(G)(W) let g = G.create () let () = + (* G.add_edge_e g (G.E.create 1 3 2); G.add_edge_e g (G.E.create 1 3 4); G.add_edge_e g (G.E.create 2 2 1); @@ -40,16 +41,16 @@ let () = G.add_edge_e g (G.E.create 3 1 4); G.add_edge_e g (G.E.create 4 4 2); G.add_edge_e g (G.E.create 4 4 3) - (* + *) G.add_edge_e g (G.E.create 1 3 2); G.add_edge_e g (G.E.create 1 (-4) 5); G.add_edge_e g (G.E.create 1 8 3); G.add_edge_e g (G.E.create 2 7 5); - G.add_edge_e g (G.E.create 2 1 4); + G.add_edge_e g (G.E.create 2 1 4); G.add_edge_e g (G.E.create 3 4 2); G.add_edge_e g (G.E.create 4 (-5) 3); G.add_edge_e g (G.E.create 4 2 1); G.add_edge_e g (G.E.create 5 6 4) -*) + let () = let test = F.all_pairs_shortest_paths g in F.HVV.iter (fun (v, u) d -> Printf.printf "[%d -> %d : %d]\n" v u d) test From f88592d864dea78fecfd215d46183588ab31f2e7 Mon Sep 17 00:00:00 2001 From: Emmanuel-PLF Date: Thu, 28 Dec 2017 14:55:21 +0100 Subject: [PATCH 3/5] negative cycle --- src/path.ml | 29 ++++++++++-------------- src/path.mli | 2 ++ tests/test_floydwarshall.ml | 44 ++++++++++++++++--------------------- 3 files changed, 33 insertions(+), 42 deletions(-) diff --git a/src/path.ml b/src/path.ml index 645ef3a2..0218db08 100644 --- a/src/path.ml +++ b/src/path.ml @@ -205,24 +205,15 @@ struct open G.E module HVV = Hashtbl.Make(Util.HTProduct(G.V)(G.V)) - module W' = struct - open G.E - - type edge = G.E.t - type t = W.t - let zero = W.zero - let infinity = W.infinity - let weight e = W.weight e - let compare = W.compare - let add wi wj = - let a = W.add wi wj in - if a > infinity then - infinity - else - a - end + 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 *) @@ -248,13 +239,17 @@ struct (fun i -> G.iter_vertex (fun j -> - let p = W'.add (HVV.find msp (i,k)) (HVV.find msp (k,j)) in + 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 end diff --git a/src/path.mli b/src/path.mli index d294ad4b..d5b05ac5 100644 --- a/src/path.mli +++ b/src/path.mli @@ -113,6 +113,8 @@ 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 (** [all_pairs_shortest_paths g] computes the distance of shortest path between all pairs of vertices in [g]. They are returned as diff --git a/tests/test_floydwarshall.ml b/tests/test_floydwarshall.ml index f353157b..242cffd0 100644 --- a/tests/test_floydwarshall.ml +++ b/tests/test_floydwarshall.ml @@ -27,30 +27,24 @@ module W = struct end module F = Path.FloydWarshall(G)(W) - -let g = G.create () +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 = F.all_pairs_shortest_paths g in + F.HVV.iter (fun (v, u) d -> Printf.printf "[%d -> %d : %d] " v u d) m; + (*assert (has_cycle)*) + with + | F.NegativeCycle -> printf "Negative cycle found \n" (*assert (not has_cycle)*) + (*| _ -> failwith "Unknown"*) +end let () = - (* - G.add_edge_e g (G.E.create 1 3 2); - G.add_edge_e g (G.E.create 1 3 4); - G.add_edge_e g (G.E.create 2 2 1); - G.add_edge_e g (G.E.create 2 2 3); - G.add_edge_e g (G.E.create 2 2 4); - G.add_edge_e g (G.E.create 3 (-2) 1); - G.add_edge_e g (G.E.create 3 1 4); - G.add_edge_e g (G.E.create 4 4 2); - G.add_edge_e g (G.E.create 4 4 3) - *) - G.add_edge_e g (G.E.create 1 3 2); - G.add_edge_e g (G.E.create 1 (-4) 5); - G.add_edge_e g (G.E.create 1 8 3); - G.add_edge_e g (G.E.create 2 7 5); - G.add_edge_e g (G.E.create 2 1 4); - G.add_edge_e g (G.E.create 3 4 2); - G.add_edge_e g (G.E.create 4 (-5) 3); - G.add_edge_e g (G.E.create 4 2 1); - G.add_edge_e g (G.E.create 5 6 4) - -let () = let test = F.all_pairs_shortest_paths g in - F.HVV.iter (fun (v, u) d -> Printf.printf "[%d -> %d : %d]\n" v u d) test + 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 "\nWith 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" From bdabd601bcbfe31f65b67d8db3c7ae4f3b038d38 Mon Sep 17 00:00:00 2001 From: Emmanuel-PLF Date: Sat, 30 Dec 2017 00:45:38 +0100 Subject: [PATCH 4/5] predecessor and tests --- src/path.ml | 20 +++++++++++++++++--- src/path.mli | 14 +++++++++----- tests/test_floydwarshall.ml | 10 ++++++---- 3 files changed, 32 insertions(+), 12 deletions(-) diff --git a/src/path.ml b/src/path.ml index 0218db08..f752d148 100644 --- a/src/path.ml +++ b/src/path.ml @@ -222,7 +222,7 @@ struct G.iter_vertex (fun u -> HVV.add msp (v,u) W.infinity; - HVV.add psp (v,u) W.zero + HVV.add psp (v,u) u ) g ) g; (*first step*) @@ -230,7 +230,8 @@ struct (fun v -> G.iter_succ_e (fun e -> - HVV.replace msp (v, (dst e)) (W.weight e) + HVV.replace msp (v, (dst e)) (W.weight e); + HVV.replace psp (v, (dst e)) v ) g v ) g; G.iter_vertex @@ -250,7 +251,20 @@ struct (fun i -> let m = HVV.find msp (i, i) in if m < W.zero then raise NegativeCycle) g; - msp + (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 diff --git a/src/path.mli b/src/path.mli index d5b05ac5..228da7f3 100644 --- a/src/path.mli +++ b/src/path.mli @@ -115,12 +115,16 @@ sig exception NegativeCycle - val all_pairs_shortest_paths : G.t -> W.t HVV.t + 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 vertices in [g]. They are returned as - a hash table mapping each pair of vertices to their - distance. If [g] contains a negative-cycle, raises - [NegativeCycle l] where [l] is such a cycle.*) + 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]*) end diff --git a/tests/test_floydwarshall.ml b/tests/test_floydwarshall.ml index 242cffd0..0ec23746 100644 --- a/tests/test_floydwarshall.ml +++ b/tests/test_floydwarshall.ml @@ -32,11 +32,13 @@ let test has_cycle tab = 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 = F.all_pairs_shortest_paths g in - F.HVV.iter (fun (v, u) d -> Printf.printf "[%d -> %d : %d] " v u d) m; - (*assert (has_cycle)*) + 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 (not has_cycle)*) + | F.NegativeCycle -> printf "Negative cycle found \n"; assert (has_cycle) (*| _ -> failwith "Unknown"*) end From 62ddf6fa3ab32eefb6f53748640d561b83c1b604 Mon Sep 17 00:00:00 2001 From: Emmanuel-PLF Date: Sat, 30 Dec 2017 22:56:04 +0100 Subject: [PATCH 5/5] Floyd Warshall --- src/path.mli | 3 ++- tests/test_floydwarshall.ml | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/path.mli b/src/path.mli index 228da7f3..a1e1caac 100644 --- a/src/path.mli +++ b/src/path.mli @@ -124,7 +124,8 @@ sig [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]*) + vertex that are reachable from vertex [vs] to [ve]. Be careful the hash table + must be obtained by all_pairs_shortest_paths*) end diff --git a/tests/test_floydwarshall.ml b/tests/test_floydwarshall.ml index 0ec23746..a84c72c7 100644 --- a/tests/test_floydwarshall.ml +++ b/tests/test_floydwarshall.ml @@ -43,10 +43,11 @@ let test has_cycle tab = 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 "\nWith negative cycle :\n"; + 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"