(**************************************************************************)
(*                                                                        *)
(*  Ocamlgraph: a generic graph library for OCaml                         *)
(*  Copyright (C) 2004-2007                                               *)
(*  Sylvain Conchon, Jean-Christophe Filliatre and Julien Signoles        *)
(*                                                                        *)
(*  This software is free software; you can redistribute it and/or        *)
(*  modify it under the terms of the GNU Library General Public           *)
(*  License version 2, with the special exception on linking              *)
(*  described in file LICENSE.                                            *)
(*                                                                        *)
(*  This software is distributed in the hope that it will be useful,      *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                  *)
(*                                                                        *)
(**************************************************************************)

open Printf
open Graph

module U = Unix
  
let utime f x =                                                   
  let u = (U.times()).U.tms_utime in                                  
  let y = f x in
  let ut = (U.times()).U.tms_utime -. u in
  (y,ut)

let print_utime f x = 
  let (y,ut) = utime f x in
  Printf.printf "user time: %2.2f\n" ut; flush Pervasives.stdout;
  y

let () = 
  printf "planar graphs demo
  use mouse to select two vertices (blue = source, green = destination)
  keys are
    - `r' generates a new random graph
    - `d' runs DFS
    - `b' runs BFS
    - `p' runs Dijkstra's shortest path
    - `q' to quit
    ";
  flush stdout

(* directed graphs with integer coordinates and integer labels on edges *)

module IntInt = struct 
  type t = int * int 
end
module Int = struct 
  type t = int 
  let compare = compare 
  let hash = Hashtbl.hash 
  let equal = (=)
  let default = 0
end
module G = Imperative.Digraph.AbstractLabeled(IntInt)(Int)
open G

let n_ = ref 30
let prob_ = ref 0.5
let () = 
  Arg.parse
      ["-v", Arg.Int (fun i -> n_ := i), 
       " <int>  number of vertices";
       "-prob", Arg.Float (fun f -> prob_ := f), 
       " <float>  probability to discrad an edge";
      ]
      (fun _ -> ())
      "usage: demo_planar <options>"
let n = !n_
let prob = !prob_

let round f = truncate (f +. 0.5)
let pi = 4.0 *. atan 1.0

module Point = struct
  type point = V.t
  let ccw v1 v2 v3 = 
    Delaunay.IntPoints.ccw (V.label v1) (V.label v2) (V.label v3)
  let in_circle v1 v2 v3 v4 =
    Delaunay.IntPoints.in_circle 
      (V.label v1) (V.label v2) (V.label v3) (V.label v4)
  let distance v1 v2 =
    let x1,y1 = V.label v1 in
    let x2,y2 = V.label v2 in
    let sqr x = let x = float x in x *. x in
    truncate (sqrt (sqr (x1 - x2) +. sqr (y1 - y2)))
end
module Triangulation = Delaunay.Make(Point)

let read_graph f =
  let c = open_in f in
  let l = ref [] in
  try
    while true do
      let s = input_line c in
      let x,y = Scanf.sscanf s "%d %f %f" (fun _ x y -> x,y) in
      printf "x=%f y=%f\n" x y;
      l := (x,y) :: !l
    done;
    assert false
  with End_of_file -> 
    close_in c;
    let rec min_list cmp = function
      | [] -> assert false
      | [x] -> x
      | x :: l -> let m = min_list cmp l in if cmp x m then x else m
    in
    let xmin,_ = min_list (fun (x,_) (x',_) -> x < x') !l in
    let xmax,_ = min_list (fun (x,_) (x',_) -> x > x') !l in
    let _,ymin = min_list (fun (_,y) (_,y') -> y < y') !l in
    let _,ymax = min_list (fun (_,y) (_,y') -> y > y') !l in
    let calibrate (x,y) =
      round (20. +. 760. *. (x -. xmin) /. (xmax -. xmin)),
      round (20. +. 560. *. (y -. ymin) /. (ymax -. ymin))
    in
    let vertices = 
      Array.map (fun xy -> V.create (calibrate xy)) (Array.of_list !l)
    in
    let t = Triangulation.triangulate vertices in
    let g = create () in
    Array.iter (G.add_vertex g) vertices;
    let add_edge v1 v2 = 
      let e = E.create v1 (Point.distance v1 v2) v2 in G.add_edge_e g e
    in
    Triangulation.iter (fun v1 v2 -> add_edge v1 v2; add_edge v2 v1) t;
    g

(* a random digraph with n vertices *)
let () = Random.self_init ()
module R = Rand.Planar.I(G)
let new_graph () = R.graph ~xrange:(20,780) ~yrange:(20,580) ~prob n
let g = ref (new_graph ())

let () = printf "nb edges : %d\n" (G.nb_edges !g); flush stdout

(* let () = g := read_graph "tmp/carron.txt" *)

open Graphics
let () = open_graph " 800x600"

let vertex_radius = 5

let draw_arrow ?(color=black) ?(width=1) (xu,yu) (xv,yv) =
  set_color color;
  set_line_width width;
  let dx = float (xv - xu) in
  let dy = float (yv - yu) in
  let alpha = atan2 dy dx in
  let r = sqrt (dx *. dx +. dy *. dy) in
  let ra = float vertex_radius *. 1.5 in
  let d = float vertex_radius +. 3. in
  let xs, ys = float xu +. d *. dx /. r, float yu +. d *. dy /. r in
  let xd, yd = float xv -. d *. dx /. r, float yv -. d *. dy /. r in
  let coords theta =
    round (xd +. ra *. cos (pi +. alpha +. theta)),
    round (yd +. ra *. sin (pi +. alpha +. theta))
  in
  moveto (round xs) (round ys);
  lineto (round xd) (round yd);
  let x1,y1 = coords (pi /. 6.) in
  moveto (round xd) (round yd); lineto x1 y1;
  let x2,y2 = coords (-. pi /. 6.) in
  moveto (round xd) (round yd); lineto x2 y2

let color_vertex v color =
  let x,y = G.V.label v in
  set_color color;
  fill_circle x y vertex_radius

type selection =
  | No
  | One of G.V.t
  | Two of G.V.t * G.V.t

let selection = ref No

let draw_selection () = match !selection with
  | No -> ()
  | One v1 -> color_vertex v1 blue
  | Two (v1, v2) -> color_vertex v1 blue; color_vertex v2 green

let draw_graph () = 
  clear_graph ();
  set_color red;
  set_line_width 1;
  G.iter_vertex 
    (fun v -> 
       let (x,y) = G.V.label v in
       draw_circle x y vertex_radius)
    !g;
  set_color black;
  G.iter_edges
    (fun v1 v2 -> draw_arrow (G.V.label v1) (G.V.label v2))
    !g;
  draw_selection ()

let distance (x1,y1) (x2,y2) =
  let dx = float (x1 - x2) in
  let dy = float (y1 - y2) in
  round (sqrt (dx *. dx +. dy *. dy))

let select () =
  let select_vertex v = match !selection with
    | No -> selection := One v
    | One v1 -> selection := Two (v1, v)
    | Two (_, v2) -> selection := Two (v2, v)
  in
  let p = mouse_pos () in
  try 
    G.iter_vertex 
      (fun v -> 
	 if distance p (G.V.label v) <= vertex_radius then begin 
	   select_vertex v; draw_graph (); raise Exit 
	 end) 
      !g
  with Exit -> 
    ()

module W = struct 
  type label = G.E.label
  type t = int
  let weight x = x
  let zero = 0
  let add = (+)
  let compare = compare
end
module Dij = Path.Dijkstra(G)(W)

let dijkstra () = match !selection with
  | Two (v1, v2) ->
      printf "running Dijkstra... "; flush stdout;
      let t_ = ref 0.0 in
      begin try
	let (p,l),t = utime (Dij.shortest_path !g v1) v2 in
	t_ := t;
	printf "path of length %d (%d nodes) (%2.2f s)\n" l (List.length p) t;
	flush stdout; 
	List.iter 
	  (fun e -> 
	     let v1 = G.E.src e in
	     let v2 = G.E.dst e in
	     draw_arrow ~color:red ~width:3 (G.V.label v1) (G.V.label v2))
	  p;
	ignore (Graphics.wait_next_event [ Key_pressed; Button_down ]);
	draw_graph ()
      with Not_found -> 
	printf "no path (%2.2f s)\n" !t_; flush stdout
      end
  | _ -> 
      ()

let draw_iteration f =
  let pause () = for i = 1 to 10000000 do () done in
  f (fun v -> color_vertex v red; pause ()) !g;
  ignore (Graphics.wait_next_event [ Key_pressed; Button_down ]);
  draw_graph ()

module Dfs = Traverse.Dfs(G)
let dfs () = draw_iteration Dfs.prefix
module Bfs = Traverse.Bfs(G)
let bfs () = draw_iteration Bfs.iter

(* brute-force coloring *)
let four_colors () =
  (* vertices still to be colored are queued in [q] *)
  let q = Queue.create () in
  let rec loop () =
    if not (Queue.is_empty q) then begin
      let v = Queue.pop q in
      assert (Mark.get v == 0);
      try_color v 1 ||
      try_color v 2 ||
      try_color v 3 ||
      try_color v 4 ||
      (Mark.set v 0; Queue.add v q; false)
    end else
      true
  and try_color v c =
    (try 
       G.iter_succ (fun w -> if Mark.get w == c then raise Exit) !g v; true
     with Exit -> 
       false) &&
    (Mark.set v c; loop ())
  in
  G.iter_vertex (fun v -> Queue.add v q) !g;
  Mark.clear !g;
  assert (loop ());
  let color = [| black; red; green; blue; yellow |] in
  G.iter_vertex (fun v -> color_vertex v (color.(Mark.get v))) !g;
  ignore (Graphics.wait_next_event [ Key_pressed; Button_down ])

let () =
  try
    let () = draw_graph () in
    while true do
      let st = Graphics.wait_next_event [ Key_pressed; Button_down ] in
      if st.keypressed then match st.key with
	| 'q' -> raise Exit
	| 'r' -> g := new_graph (); selection := No; draw_graph ()
	| 'p' -> dijkstra ()
	| 'd' -> dfs ()
	| 'b' -> bfs ()
	(* | 'c' -> four_colors () *)
	| _ -> ()
      else if st.button then
	select ()
    done
  with Exit ->
    close_graph ()

(*
Local Variables: 
compile-command: "make -C .. bin/demo_planar.opt"
End: 
*)