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