OCamlGraph Inconsistency

ocamlgraph_bug.ml

open Core_kernel.Std

(* Make a persistent graph where:
   A -> B
   B -> C
   C -> B *)
module G = Graph.Persistent.Digraph.ConcreteBidirectional(String)
let g = List.fold [("A", "B"); ("B", "C"); ("C", "B")] ~f:(fun g (x, y) ->
  G.add_edge g x y) ~init:G.empty;;

(* Contract the SCC *)
module C = Graph.Components.Make(G)
let contract g =
  let names = Array.map (C.scc_array g) ~f:(String.concat ~sep:",") in
  let (_, numbering) = C.scc g in
  Array.fold names ~f:(fun g x -> G.remove_edge g x x)
    ~init:(G.map_vertex (fun x -> names.(numbering x)) g);;

(* Check that the original edge exists *)
G.iter_edges (fun x y -> Printf.printf "g: %s -> %s\n" x y) g;

(* Check the in degree and predecessors of "B",
   this should be 2 and "A", "C" *)
Printf.printf "g: in_degree: %d\n" (G.in_degree g "B");
List.iter (G.pred g "B") ~f:(Printf.printf "g: pred: %s\n");
Printf.printf "g: in_degree: %d\n" (G.in_degree g "B");
List.iter (G.pred g "B") ~f:(Printf.printf "g: pred: %s\n");

(* Remap the names of the nodes *)
let g' = contract g in

(* Check that the edge we expect exists *)
G.iter_edges (fun x y -> Printf.printf "g': %s -> %s\n" x y) g';

(* Check the in degree and predecessors of "C,B", this should be 1 and "A" *)
Printf.printf "g': in_degree: %d\n" (G.in_degree g' "C,B");
List.iter (G.pred g' "C,B") ~f:(Printf.printf "g': pred: %s\n");

(*
Build with:
ocamlbuild -pkg ocamlgraph -pkg core_kernel ocamlgraph_bug.native
Run with:
./ocamlgraph_bug.native I got:
g: A -> B
g: B -> C
g: C -> B
g: in_degree: 2
g: pred: A
g: pred: C
g': A -> C,B
g': in_degree: 0
*)