fixed transitive_reduction

also fixed 'make check' (tests/check.ml was not run anymore)

Makefile.in

@@ -68,8 +68,9 @@ OCAMLGRAPH_LIB= unionfind heap bitv persistentQueue
 OCAMLGRAPH_LIB:=$(patsubst %, $(OCAMLGRAPH_LIBDIR)/%.cmo, $(OCAMLGRAPH_LIB))
 
 CMO =	util blocks persistent imperative \
-	delaunay builder classic rand oper \
-	components path nonnegative traverse coloring topological kruskal flow \
+	delaunay builder classic rand \
+	components path nonnegative traverse oper \
+	coloring topological kruskal flow \
 	prim dominator graphviz gml dot_parser dot_lexer dot pack \
 	gmap minsep cliquetree mcs_m md strat fixpoint leaderlist contraction \
 	graphml merge mincut clique weakTopological chaoticIteration
@@ -351,7 +352,7 @@ bin/testunix.opt: $(CMXA) myTest/testunix.ml
 	$(OCAMLOPT) -unsafe -inline 100 -o $@ unix.cmxa $^
 
 check: $(CMA) tests/check.ml bin/test-ts
-	ocaml -I . $(CMA) tests/test_clique.ml tests/check.ml
+	ocaml -I . $(CMA) tests/check.ml
 	bin/test-ts 10
 
 # Additional rules

src/oper.ml

@@ -89,6 +89,7 @@ module Make(B : Builder.S) = struct
          with Invalid_argument _ ->
            (* [v] not in [g2] *)
            g)
+
       g1 (B.empty ())
 
   let union g1 g2 =
@@ -102,14 +103,25 @@ module Make(B : Builder.S) = struct
     add g1 (B.copy g2)
 
   let replace_by_transitive_reduction ?(reflexive=false) g0 =
+    (* first compute reachability in g0 using a DFS from each vertex *)
+    let module H = Hashtbl.Make(G.V) in
+    let module D = Traverse.Dfs(G) in
+    let reachable = H.create (G.nb_vertex g0) in
+    let path_from v =
+      let s = H.create 8 in
+      H.add reachable v s;
+      D.prefix_component (fun w -> H.add s w ()) g0 v in
+    G.iter_vertex path_from g0;
+    let path u v = H.mem (H.find reachable u) v in
+    (* then remove redundant edges *)
     let phi v g =
       let g = if reflexive then B.remove_edge g v v else g in
       G.fold_succ
         (fun sv g ->
-           G.fold_pred
-             (fun pv g ->
-                if G.V.equal pv v || G.V.equal sv v then g
-                else B.remove_edge g pv sv)
+           G.fold_succ
+             (fun sv' g ->
+                if not (G.V.equal sv sv') && path sv sv'
+                then B.remove_edge g v sv' else g)
              g v g)
         g v g
     in

tests/check.ml

@@ -441,6 +441,7 @@ module Traversal = struct
   open Format
   let pre v = printf "pre %d@." (G.V.label v)
   let post v = printf "post %d@." (G.V.label v)
+  (*
   let () = printf "iter:@."; Dfs.iter_component ~pre ~post g w
   let () = printf "prefix:@."; Dfs.prefix_component pre g w
   let () =
@@ -451,6 +452,7 @@ module Traversal = struct
       visit (Dfs.step it)
     in
     try visit (Dfs.start g) with Exit -> ()
+   *)
 
 end
 
@@ -488,7 +490,7 @@ module FF_Goldberg = struct
   end
 
   module FF = Flow.Ford_Fulkerson(G)(F)
-  module Gold = Flow.Goldberg(G)(F)
+  module Gold = Flow.Goldberg_Tarjan(G)(F)
 
   let () =
     assert (snd (FF.maxflow g 1 6) = 23);
@@ -523,11 +525,11 @@ module FF_Goldberg = struct
   end
 
   module FF2 = Flow.Ford_Fulkerson(G2)(F2)
-  module Gold2 = Flow.Goldberg(G2)(F2)
+  module Gold2 = Flow.Goldberg_Tarjan(G2)(F2)
 
   let () =
-    assert (snd (FF2.maxflow g 1 4) = 2);
-    assert (snd (Gold2.maxflow g 1 4) = 2)
+    assert (snd (FF2.maxflow g 1 4) = 2); (* growth of the flow *)
+    assert (snd (Gold2.maxflow g 1 4) = 3) (* max flow *)
 
 end
 
@@ -679,7 +681,7 @@ module type RightSigPack = sig
   end
   val shortest_path : t -> V.t -> V.t -> E.t list * int
   val ford_fulkerson : t -> V.t -> V.t -> (E.t -> int) * int
-  val goldberg : t -> V.t -> V.t -> (E.t -> int) * int
+  val goldberg_tarjan : t -> V.t -> V.t -> (E.t -> int) * int
   val dot_output : t -> string -> unit
 end
 
@@ -688,7 +690,89 @@ module TestSigPack : RightSigPack = struct
   type g = t
 end
 
-include Test_clique
+module Test_clique = struct
+  (* Test file for Brom-Kerbosch *)
+
+  open Graph
+
+  module G = Persistent.Graph.Concrete (struct
+    type t = int
+    let compare = compare
+    let hash = Hashtbl.hash
+    let equal = (=)
+  end)
+
+  module BK = Clique.Bron_Kerbosch(G)
+
+  let () =
+    let vertices = [1;2;3;4;5;6;7] in
+    let edges = [(1,2);(1,5);(2,5);(2,3);(4,5);(3,4);(4,6)] in
+    let g = List.fold_left (fun graph v -> G.add_vertex graph v) G.empty vertices in
+    let g = List.fold_left (fun graph (v1, v2) -> G.add_edge graph v1 v2) g edges in
+    let cliques = BK.maximalcliques g in
+    (* The cliques of this graph should be: [2, 3], [3, 4], [1, 2, 5], [4, 5], [4, 6], [7] *)
+    assert (List.length cliques == 6);
+    assert (List.exists (fun cl -> List.length cl == 2 && List.mem 2 cl && List.mem 3 cl) cliques);
+    assert (List.exists (fun cl -> List.length cl == 2 && List.mem 3 cl && List.mem 4 cl) cliques);
+    assert (List.exists (fun cl -> List.length cl == 3 && List.mem 1 cl && List.mem 2 cl && List.mem 5 cl) cliques);
+    assert (List.exists (fun cl -> List.length cl == 2 && List.mem 4 cl && List.mem 5 cl) cliques);
+    assert (List.exists (fun cl -> List.length cl == 2 && List.mem 4 cl && List.mem 6 cl) cliques);
+    assert (List.exists (fun cl -> List.length cl == 1 && List.mem 7 cl) cliques)
+end
+
+module Test_reduction = struct
+
+  open Graph
+
+  module G = Imperative.Digraph.Concrete(struct
+                 type t = int
+                 let compare = compare
+                 let hash = Hashtbl.hash
+                 let equal = (=) end)
+  open G
+
+  module R = Rand.I(G)
+  module O = Oper.I(G)
+
+  let check_included g1 g2 =
+    iter_vertex (fun v -> assert (mem_vertex g2 v)) g1;
+    iter_edges (fun u v -> assert (mem_edge g1 u v)) g1
+
+  let check_same_graph g1 g2 =
+    check_included g1 g2;
+    check_included g2 g1
+
+  let test v e =
+    let g = R.graph ~loops:true ~v ~e () in
+    let t = O.transitive_closure g in
+    check_included g t;
+    let r = O.transitive_reduction g in
+    check_included r g;
+    check_same_graph (O.transitive_closure r) t
+
+  let () =
+    for v = 1 to 10 do
+      for e = 0 to v * (v-1) / 2 do
+        test v e
+      done
+    done
+
+  (* issue #91 *)
+  let () =
+    let g = create () in
+    for v = 1 to 5 do add_vertex g v done;
+    add_edge g 1 2; add_edge g 2 3; add_edge g 3 4; add_edge g 4 5;
+    add_edge g 2 5;
+    let r = O.transitive_reduction g in
+    check_included r g;
+    assert (nb_edges r = 4);
+    assert (not (mem_edge r 2 5));
+    ()
+
+end
+
+let () = Format.printf "check: all tests succeeded@."
+
 
 (*
 Local Variables:

tests/test.ml

@@ -67,4 +67,3 @@ let n, f = Comp.scc g
 let () = G.iter_edges (fun u v -> printf "%d -> %d@." u v) g
 let () = printf "%d components@." n
 let () = G.iter_vertex (fun v -> printf "  %d -> %d@." v (f v)) g
-

tests/test_topsort.ml

@@ -17,13 +17,13 @@ let test ?(check=true) iter n edges =
   iter (fun v -> incr i; num.(V.label v) <- !i) g;
   let r = Array.init n (fun i -> i) in
   Array.sort (fun i j -> num.(i) - num.(j)) r;
-  if check then for v = 0 to n-1 do printf "%d " r.(v) done; printf "@.";
+  (* if check then for v = 0 to n-1 do printf "%d " r.(v) done; printf "@."; *)
   (* check *)
   let path = PathCheck.check_path (PathCheck.create g) in
   let check_edge (x,y) =
     let vx = v.(x) and vy = v.(y) in
-    printf "x=%d y=%d num(x)=%d num(y)=%d@." x y num.(x) num.(y);
-    printf "x-->y=%b  y-->x=%b@." (path vx vy) (path vy vx);
+    (* printf "x=%d y=%d num(x)=%d num(y)=%d@." x y num.(x) num.(y);
+     * printf "x-->y=%b  y-->x=%b@." (path vx vy) (path vy vx); *)
     assert (num.(x) > 0 && num.(y) > 0);
     assert (num.(x) >= num.(y) || path vx vy || not (path vy vx)) in
   if check then
@@ -58,7 +58,7 @@ let tests iter =
   test 7 [0,1; 1,0; 1,2; 2,3; 3,2; 3,4; 4,5; 5,6; 6,4];
   (* 3 cycles with 2 cycles in a cycle *)
   test 7 [0,1; 1,0; 1,2; 2,3; 3,2; 3,4; 4,5; 5,6; 6,4; 5,2];
-  printf "All tests succeeded.@."
+  printf "test topsort: all tests succeeded.@."
 
 let () = tests Topological.iter
 (* let () = tests Topological.iter_stable *)