All Shortest Paths using Floyd warshall's algorithm

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 $^

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

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) :

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"