Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
(* 4-coloring planar graphs *) open Printf open Graph (* command line *) let n_ = ref 30 let prob_ = ref 0.5 let arg_spec = ["-v", Arg.Int (fun i -> n_ := i), " number of vertices"; "-prob", Arg.Float (fun f -> prob_ := f), " probability to discrad an edge" ] let () = Arg.parse arg_spec (fun _ -> ()) "usage: color " let n = !n_ let prob = !prob_ (* undirected 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.Graph.AbstractLabeled(IntInt)(Int) open G (* a random graph with n vertices *) let () = Random.self_init () module R = Rand.Planar.I(G) let g0 = R.graph ~xrange:(20,780) ~yrange:(20,580) ~prob n (* drawing *) let round f = truncate (f +. 0.5) let pi = 4.0 *. atan 1.0 open Graphics let () = open_graph " 800x600" let vertex_radius = 5 let draw_edge v1 v2 = let (xu,yu) = G.V.label v1 in let (xv,yv) = G.V.label v2 in set_color black; let dx = float (xv - xu) in let dy = float (yv - yu) in let r = sqrt (dx *. dx +. dy *. dy) 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 moveto (round xs) (round ys); lineto (round xd) (round yd) let draw_vertex v = let (x,y) = G.V.label v in set_color red; draw_circle x y vertex_radius let color_vertex v color = let x,y = G.V.label v in set_color color; fill_circle x y vertex_radius let draw_graph () = clear_graph (); set_color red; set_line_width 1; G.iter_vertex draw_vertex g0; G.iter_edges draw_edge g0 module Dfs = Traverse.Dfs(G) module Bfs = Traverse.Bfs(G) let test_bfs () = let rec loop i = let v = Bfs.get i in color_vertex v red; ignore (Graphics.wait_next_event [ Key_pressed ]); loop (Bfs.step i) in try loop (Bfs.start g0) with Exit -> () let test_dfs () = let rec loop i = let v = Dfs.get i in color_vertex v red; ignore (Graphics.wait_next_event [ Key_pressed ]); loop (Dfs.step i) in try loop (Dfs.start g0) with Exit -> () let cols = [| white; red; green; blue; yellow; black |] exception NoColor (* Algo I. Brute force. *) let coloring_a k = Mark.clear g0; (* first step: we eliminate vertices with less than 4 successors *) let stack = Stack.create () in let finish = ref false in let round = ref 1 in let nb_to_color = ref n in while not !finish do let c = ref 0 in finish := true; let erase v = incr c; finish := false; Mark.set v (k+1); Stack.push v stack in G.iter_vertex (fun v -> if Mark.get v = 0 && out_degree g0 v < k then erase v) g0; printf "round %d: removed %d vertices\n" !round !c; incr round; nb_to_color := !nb_to_color - !c done; flush stdout; (* second step: we 4-color the remaining of the graph *) (* [try_color v i] tries to assigne color [i] to vertex [v] *) let try_color v i = iter_succ (fun w -> if Mark.get w = i then raise NoColor) g0 v; Mark.set v i in let uncolor v = Mark.set v 0 in if !nb_to_color > 0 then begin let rec iterate iter = let v = Bfs.get iter in if Mark.get v = k+1 then iterate (Bfs.step iter) else begin for i = 1 to k do try try_color v i; iterate (Bfs.step iter); assert false with NoColor -> () done; uncolor v; raise NoColor end in try iterate (Bfs.start g0); assert false with Exit -> () end; (* third step: we color the eliminated vertices, in reverse order *) Stack.iter (fun v -> try for i = 1 to k do try try_color v i; raise Exit with NoColor -> () done; assert false with Exit -> ()) stack; (* finally we display the coloring *) iter_vertex (fun v -> color_vertex v cols.(Mark.get v)) g0 (* Algo II. we use marks to color; bits are used as follows: 0: set if node is discarded at step 1 1-4: available colors 5-7: the color (0 = not colored, else color in 1..4 *) let print_8_bits x = for i = 7 downto 0 do if (x lsr i) land 1 = 1 then printf "1" else printf "0" done let dump () = let dump_mark v = printf "["; print_8_bits (Mark.get v); printf "]" in iter_vertex dump_mark g0; printf "\n"; flush stdout let mask_color = [| 0; 0b11101; 0b11011; 0b10111; 0b01111 |] let coloring_b () = (* initially all 4 colors available and every vertex to be colored *) iter_vertex (fun v -> Mark.set v 0b11110) g0; (* first step: we eliminate vertices with less than 4 successors *) let stack = Stack.create () in let finish = ref false in let round = ref 1 in let nb_to_color = ref n in while not !finish do let c = ref 0 in finish := true; let erase v = incr c; finish := false; Mark.set v 0b11111; Stack.push v stack in G.iter_vertex (fun v -> if Mark.get v = 0 && out_degree g0 v < 4 then erase v) g0; printf "round %d: removed %d vertices\n" !round !c; incr round; nb_to_color := !nb_to_color - !c done; flush stdout; (* second step: we 4-color the remaining of the graph *) (* [try_color v i] tries to assigne color [i] to vertex [v] *) let try_color v i = assert (1 <= i && i <= 4); let m = Mark.get v in assert (m lsr 5 = 0); if (m lsr i) land 1 = 0 then raise NoColor; (* color [i] not available *) let remove_color w = (* make color [i] unavailable for [w] *) let m = Mark.get w in if m lsr 5 > 0 then assert (m lsr 5 <> i) (* [w] already colored *) else begin let m' = m land mask_color.(i) in if m' = 0 then raise NoColor; (* no more color available for [w] *) Mark.set w m' end in iter_succ remove_color g0 v; Mark.set v (m lor (i lsl 5)) in let uncolor v = let m = Mark.get v in let c = m lsr 5 in assert (0 <= c && c <= 4); if c > 0 then begin Mark.set v (m land 0b11111); let update w = (* give back color [c] to [w] only when no more succ. has color [c] *) try iter_succ (fun u -> if Mark.get u lsr 5 = c then raise Exit) g0 w; Mark.set w ((Mark.get w) lor (1 lsl c)) with Exit -> () in iter_succ update g0 v end in if !nb_to_color > 0 then begin let rec iterate iter = let v = Bfs.get iter in if Mark.get v land 1 = 1 then (* no need to color this vertex *) iterate (Bfs.step iter) else begin for i = 1 to 4 do try try_color v i; iterate (Bfs.step iter); assert false with NoColor -> uncolor v done; raise NoColor end in try iterate (Bfs.start g0); assert false with Exit -> () end; (* third step: we color the eliminated vertices, in reverse order *) Stack.iter (fun v -> assert (Mark.get v land 1 = 1); try for i = 1 to 4 do try try_color v i; raise Exit with NoColor -> uncolor v done; assert false (* we must succeed *) with Exit -> ()) stack; (* finally we display the coloring *) iter_vertex (fun v -> let m = Mark.get v in let c = (Mark.get v) lsr 5 in assert (1 <= c && c <= 4); color_vertex v cols.(c)) g0 let () = draw_graph (); (* test_bfs (); *) (* test_dfs (); *) coloring_a 4; ignore (Graphics.wait_next_event [ Key_pressed ]); draw_graph (); coloring_b (); ignore (Graphics.wait_next_event [ Key_pressed ]); close_graph ()