(*i $Id: check.ml,v 1.45 2005/02/25 13:54:33 signoles Exp $ i*)

open Graph

module Int = struct 
  type t = int 
  let compare = compare 
  let hash = Hashtbl.hash 
  let equal = (=)
  let default = 0
end

module W = struct 
  type label = int
  type t = int
  let weight x = x 
  let zero = 0
  let add = (+)
  let compare = compare
end


(********************************************)
(* Generic functions                        *)
(********************************************)

module Generic = struct

  (* nb_vertex and nb_edges *)

  module Make
    (G : Sig.I with type V.t = int)
    (V : sig val v: int val e: int end) = 
  struct
    let g = G.create ()
    let () =
      G.add_edge g 1 2;
      G.add_edge g 1 3;
      G.add_edge g 2 1;
      G.add_edge g 2 2;
      G.add_edge g 2 2;
      assert (G.nb_vertex g = V.v && G.nb_edges g = V.e);
  end

  let () =
    let module D = Make
      (Imperative.Digraph.ConcreteLabeled(Int)(Int))
      (struct let v = 3 let e = 4 end)
    in
    let module G = Make
      (Imperative.Graph.ConcreteLabeled(Int)(Int))
      (struct let v = 3 let e = 3 end)
    in
    ()

  (* find_edge *)

  module Make2
    (G : Sig.I 
     with type V.t = int and type E.label = int and type E.t = int * int * int)
    =
  struct

    let g = G.create ()

    let test_exn v1 v2 =
      try
	let _ = G.find_edge g v1 v2 in
	assert false
      with Not_found ->
	()

    let () =
      let e1 = 1, 0, 2 in
      let e2 = 1, 1, 3 in
      let e3 = 2, 2, 1 in
      let e4 = 2, 1, 2 in
      G.add_edge_e g e1;
      G.add_edge_e g e2;
      G.add_edge_e g e3;
      G.add_edge_e g e3;
      assert (G.find_edge g 1 2 = e1);
      test_exn 2 3;
      test_exn 2 4;
      test_exn 5 2

  end

  let () =
    let module D = Make2(Imperative.Digraph.ConcreteLabeled(Int)(Int)) in
    D.test_exn 3 1;
    let module G = Imperative.Graph.ConcreteLabeled(Int)(Int) in
    let module G2 = Make2(G) in
    assert (G.find_edge G2.g 3 1 = (3, 1, 1))

end

(********************************************)
(* Dijkstra                                 *)
(********************************************)

module Dijkstra = struct

  module TestDijkstra
    (G : Sig.G with type V.label = int and type E.label = int)
    (B : Builder.S with module G = G) = 
  struct

    let g = B.empty ()
    let v1 = G.V.create 1 
    let g = B.add_vertex g v1
    let v2 = G.V.create 2 
    let g = B.add_vertex g v2
    let v3 = G.V.create 3 
    let g = B.add_vertex g v3
    let v4 = G.V.create 4 
    let g = B.add_vertex g v4
    let v5 = G.V.create 5 
    let g = B.add_vertex g v5
      
    let g = B.add_edge_e g (G.E.create v1 10 v2)
    let g = B.add_edge_e g (G.E.create v2 50 v3)
    let g = B.add_edge_e g (G.E.create v1 30 v4)
    let g = B.add_edge_e g (G.E.create v1 100 v5)
    let g = B.add_edge_e g (G.E.create v3 10 v5)
    let g = B.add_edge_e g (G.E.create v4 20 v3)
    let g = B.add_edge_e g (G.E.create v4 60 v5)

    module Dij = Path.Dijkstra(G)(W)
    module Dfs = Traverse.Dfs(G)

    let test g i j w l =
      let p,w' = Dij.shortest_path g i j in 
      assert (w' = w && List.length p = l)
    let test_not_found g i j =
      try let _ = Dij.shortest_path g i j in assert false with Not_found -> ()

    let () = test g v1 v5 60 3
    let () = test g v1 v1 0 0
    let () = if G.is_directed then test_not_found g v5 v1
    let () = if G.is_directed then assert (not (Dfs.has_cycle g))
    let gc = B.add_edge_e g (G.E.create v5 10 v1)
    let v6 = G.V.create 6
    let gc = B.add_vertex gc v6
    let () = if G.is_directed then test gc v1 v5 60 3
    let () = test gc v5 v1 10 1
    let () = test_not_found gc v1 v6

    let () = assert (Dfs.has_cycle gc)

  end

  (* Dijkstra on Persistent Directed Labeled Graphs *)

  module G = Persistent.Digraph.ConcreteLabeled(Int)(Int)
  module Test1 = TestDijkstra(G)(Builder.P(G))

  (* Dijkstra on Persistent Directed Abstract Labeled Graphs *)

  module G2 = Persistent.Digraph.AbstractLabeled(Int)(Int)
  module Test2 = TestDijkstra(G2)(Builder.P(G2))

  (* Dijkstra on Imperative Hashed Directed Labeled Graphs *)

  module G3 = Imperative.Digraph.ConcreteLabeled(Int)(Int)
  module Test3 = TestDijkstra(G3)(Builder.I(G3))

  (* Dijkstra on Persistent Abstract Labeled Graphs *)
    (*
      module G = Persistent.Graph.AbstractLabeled(Int)(Int)
      module Test4 = TestDijkstra(G)(Builder.APLG(G))
    *)

  (* Dijkstra on adjacency matrices *)

  module Test4 = TestDijkstra

end

(********************************************)
(* Traversal                                *)
(********************************************)

module Traversal = struct

  module G = Imperative.Digraph.AbstractLabeled(Int)(Int)
  module Dfs = Traverse.Dfs(G)
  module Mark = Traverse.Mark(G)

  let g = G.create ()
  let newv () = let v = G.V.create 0 in G.add_vertex g v; v
  let v1 = newv ()
  let v2 = newv ()
  let v3 = newv ()
  let v4 = newv ()
  let v5 = newv ()
  let add_edge g v1 l v2 = G.add_edge_e g (G.E.create v1 l v2)
  let () =
    add_edge g v1 10 v2;
    add_edge g v2 50 v3;
    add_edge g v1 30 v4;
    add_edge g v1 100 v5;
    add_edge g v3 10 v5;
    add_edge g v4 20 v3;
    add_edge g v4 60 v5
  let () = assert (not (Mark.has_cycle g) && not (Dfs.has_cycle g))
  let v6 = newv ()
  let () = assert (not (Mark.has_cycle g) && not (Dfs.has_cycle g))
  let () = add_edge g v5 10 v1
  let () = assert (Mark.has_cycle g && Dfs.has_cycle g)

end

(********************************************)
(* Ford-Fulkerson and Goldberg              *)
(********************************************)

module FF_Goldberg = struct

  module G = Persistent.Digraph.ConcreteLabeled(Int)(Int)

  let add_edge g v1 l v2 = G.add_edge_e g (G.E.create v1 l v2)
  let g = G.empty
  let g = add_edge g 1 16 2
  let g = add_edge g 1 13 3
  let g = add_edge g 2 10 3
  let g = add_edge g 3 4 2
  let g = add_edge g 2 12 4
  let g = add_edge g 4 9 3
  let g = add_edge g 3 14 5
  let g = add_edge g 5 7 4
  let g = add_edge g 4 20 6
  let g = add_edge g 5 4 6

  module F = struct
    type label = int
    type t = int
    let max_capacity x = x
    let min_capacity _ = 0
    let flow _ = 0
    let add = (+)
    let sub = (-)
    let compare = compare
    let zero = 0
  end

  module FF = Flow.Ford_Fulkerson(G)(F)
  module Gold = Flow.Goldberg(G)(F)

  let () = 
    assert (snd (FF.maxflow g 1 6) = 23);
    assert (snd (Gold.maxflow g 1 6) = 23);
    assert (snd (FF.maxflow g 1 1) = 0);
    assert (snd (Gold.maxflow g 1 1) = 0)

  module G2 = 
    Persistent.Digraph.ConcreteLabeled
      (Int)
      (struct include Util.OTProduct(Int)(Int) let default = 0, 0 end)

  let add_edge g v1 l v2 = G2.add_edge_e g (G2.E.create v1 l v2)
  let g = G2.empty
  let g = add_edge g 1 (1, 1) 2
  let g = add_edge g 1 (3, 0) 3
  let g = add_edge g 2 (1, 1) 3
  let g = add_edge g 3 (1, 0) 2
  let g = add_edge g 2 (3, 0) 4
  let g = add_edge g 3 (1, 1) 4

  module F2 = struct
    type label = int * int
    type t = int
    let max_capacity = fst
    let min_capacity _ = 0
    let flow = snd
    let add = (+)
    let sub = (-)
    let compare = compare
    let zero = 0
  end

  module FF2 = Flow.Ford_Fulkerson(G2)(F2)
  module Gold2 = Flow.Goldberg(G2)(F2)

  let () = 
    assert (snd (FF2.maxflow g 1 4) = 2);
    assert (snd (Gold2.maxflow g 1 4) = 2)

end

(********************************************)
(* Neighbourhood                            *)
(********************************************)

module Neighbourhood = struct

  module G = Graph.Imperative.Graph.Concrete(Int)
  open G

  let g = create ()
  let add = add_edge g
  let () =
    add 1 2;
    add 1 3;
    add 1 4;
    add 2 5;
    add 3 5;
    add 4 5;
    add 5 6

  module N = Oper.Neighbourhood(G)
  module V = N.Vertex_Set
  let s2 = V.add 1 (V.singleton 5)
  let () = assert (V.equal (N.set_from_vertex g 2) s2)
  let s25 = V.add 1 (V.add 3 (V.add 4 (V.singleton 6)))
  let () = assert (V.equal (N.set_from_vertices g [ 2; 5 ]) s25)

end

(********************************************)
(* Minimal seperators                       *)
(********************************************)

module Minsep = struct

  module P = struct

    module G = Graph.Persistent.Graph.Concrete(Int)
    open G

    let g = empty
    let g = add_edge g 1 2
    let g = add_edge g 1 3
    let g = add_edge g 1 4
    let g = add_edge g 2 5
    let g = add_edge g 3 5
    let g = add_edge g 4 5
    let g = add_edge g 5 6

    module M = Minsep.P(G)
    module S = M.Vertex_Set
    module VS = M.VSetset
    let s5 = S.singleton 5
    let s15 = S.add 1 s5
    let s234 = S.add 2 (S.add 3 (S.singleton 4))
    let bigs = VS.add s5 (VS.add s15 (VS.singleton s234))
    let () = assert (VS.equal (M.set_of_allminsep g) bigs)

  end

  module I = struct

    module G = Graph.Imperative.Graph.Abstract(struct type t = unit end)
    open G
    
    let g = create ()
    let v1 = V.create ()
    let v2 = V.create ()
    let v3 = V.create ()
    let v4 = V.create ()
    let v5 = V.create ()
    let v6 = V.create ()
    let add = add_edge g
    let () =
      add v1 v2;
      add v1 v3;
      add v1 v4;
      add v2 v5;
      add v3 v5;
      add v4 v5;
      add v5 v6

    module M = Minsep.I(G)
    module S = M.Vertex_Set
    module VS = M.VSetset
    let s5 = S.singleton v5
    let s15 = S.add v1 s5
    let s234 = S.add v2 (S.add v3 (S.singleton v4))
    let bigs = VS.add s5 (VS.add s15 (VS.singleton s234))
    let () =
      let g' =  G.copy g in
      assert (VS.equal (M.set_of_allminsep g) bigs)

  end

end

(********************************************)
(* Checking signature                       *)
(********************************************)

(* check that signature [Sig_pack.S] (which is manually expanded) does not
   forget anything *)
module type RightSigPack = sig
  include Sig.IA with type V.label = int and type E.label = int
  val find_vertex : t -> int -> V.t
  include Oper.S with type g = t
  module Dfs : sig
    val iter : ?pre:(V.t -> unit) -> 
               ?post:(V.t -> unit) -> t -> unit
    val prefix : (V.t -> unit) -> t -> unit
    val postfix : (V.t -> unit) -> t -> unit

    val iter_component : 
               ?pre:(V.t -> unit) -> 
               ?post:(V.t -> unit) -> t -> V.t -> unit
    val prefix_component : (V.t -> unit) -> t -> V.t -> unit
    val postfix_component : (V.t -> unit) -> t -> V.t -> unit

    val has_cycle : t -> bool
  end
  module Bfs : sig
    val iter : (V.t -> unit) -> t -> unit
    val iter_component : (V.t -> unit) -> t -> V.t -> unit
  end
  module Marking : sig
    val dfs : t -> unit
    val has_cycle : t -> bool
  end
  module Classic : sig
    val divisors : int -> t
    val de_bruijn : int -> t
    val vertex_only : int -> t
    val full : ?self:bool -> int -> t
  end
  module Rand : sig
    val graph : ?loops:bool -> v:int -> e:int -> unit -> t
    val labeled : 
      (V.t -> V.t -> E.label) -> 
	?loops:bool -> v:int -> e:int -> unit -> t
  end
  module Components : sig
    val scc : t -> (V.t -> int)
    val scc_list : t -> V.t list list
  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 dot_output : t -> string -> unit 
end

module TestSigPack : RightSigPack = 
struct 
  include Pack.Digraph
  type g = t 
end