mp2i-vms.fr
Added graph display and separated files
This commit is contained in:
parent
8351fef480
commit
8ed1b5a320
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,106 @@
|
||||||
|
open Graphics ;;
|
||||||
|
|
||||||
|
let pi = 3.14159265358979343 ;;
|
||||||
|
|
||||||
|
let rec ln10 n = match n with
|
||||||
|
| k when k < 0 -> failwith "Are you sure about that ?"
|
||||||
|
| k when k < 10 -> 0
|
||||||
|
| k -> 1 + ln10 (k/10) ;;
|
||||||
|
|
||||||
|
let delta i j =
|
||||||
|
if i = j then 1 else 0 ;;
|
||||||
|
|
||||||
|
let draw_integer x0 y n0 r =
|
||||||
|
(* 7-seg display *)
|
||||||
|
let n = ref n0 in
|
||||||
|
let size = ln10 n0 in
|
||||||
|
let len = r/3 in
|
||||||
|
let offset = size*(len/2) in
|
||||||
|
for i = 0 to size do
|
||||||
|
let x = x0 - (-(1 - delta size 0)*8 - offset + i * (len+8)) in
|
||||||
|
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
|
||||||
|
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
|
||||||
|
|
||||||
|
n := !n/10;
|
||||||
|
done ;;
|
||||||
|
|
||||||
|
let identity n = n ;;
|
||||||
|
|
||||||
|
let improved_pretty_printing g wd ht r =
|
||||||
|
let n = Array.length g in
|
||||||
|
let coords = Array.make n (0, 0) in
|
||||||
|
|
||||||
|
let colors = Array.make n (rgb 0 0 0) in
|
||||||
|
for i = 0 to n-1 do
|
||||||
|
colors.(i) <- rgb ((255 * i) / n) ((255*(i+n/3)) / n) ((255*(2*i+n/3)) / n)
|
||||||
|
done;
|
||||||
|
|
||||||
|
for k = 0 to n-1 do
|
||||||
|
let theta = 2. *. pi *. (float_of_int k) /. (float_of_int (n)) +. pi /. (float_of_int (n)) in
|
||||||
|
let i = ref (int_of_float ((float_of_int wd) /. 2.) + int_of_float ((float_of_int wd) /. 2.2 *. cos theta)) in
|
||||||
|
let j = ref (int_of_float ((float_of_int ht) /. 2.) + int_of_float ((float_of_int ht) /. 2.2 *. sin theta)) in
|
||||||
|
set_line_width 8 ;
|
||||||
|
set_color colors.(k) ;
|
||||||
|
draw_circle !i !j r;
|
||||||
|
coords.(k) <- (!i, !j)
|
||||||
|
done ;
|
||||||
|
|
||||||
|
for k = 0 to n-1 do
|
||||||
|
set_color colors.(k) ;
|
||||||
|
for l = 0 to (Array.length g.(k))-1 do
|
||||||
|
draw_poly_line [|coords.(k); coords.(g.(k).(l))|];
|
||||||
|
done
|
||||||
|
done;
|
||||||
|
|
||||||
|
set_line_width 22 ;
|
||||||
|
for k = 0 to n-1 do
|
||||||
|
set_color colors.(k) ;
|
||||||
|
for l = 0 to (Array.length g.(k))-1 do
|
||||||
|
let slope = Float.atan2 (float_of_int (snd coords.(g.(k).(l)) - snd coords.(k))) (float_of_int (fst coords.(g.(k).(l)) - fst coords.(k))) in
|
||||||
|
|
||||||
|
let nexi = int_of_float (float_of_int (fst coords.(k)) +. (float_of_int r) *. 1.5 *. cos slope) in
|
||||||
|
let nexj = int_of_float (float_of_int (snd coords.(k)) +. (float_of_int r) *. 1.5 *. sin slope) in
|
||||||
|
draw_poly_line [|coords.(k); (nexi, nexj)|]
|
||||||
|
done
|
||||||
|
done;
|
||||||
|
|
||||||
|
for k = 0 to n-1 do
|
||||||
|
set_line_width 10 ;
|
||||||
|
set_color black ;
|
||||||
|
fill_circle (fst coords.(k)) (snd coords.(k)) r;
|
||||||
|
set_color colors.(k) ;
|
||||||
|
set_line_width 5 ;
|
||||||
|
draw_integer (fst coords.(k)) (snd coords.(k)) k r
|
||||||
|
done;
|
||||||
|
|
||||||
|
ignore (Scanf.bscanf Scanf.Scanning.stdin "%d\n" identity) ;;
|
||||||
|
|
||||||
|
|
||||||
|
(* ----------------------- Tests --------------------------- *)
|
||||||
|
|
||||||
|
open_graph " 1200x800" ;;
|
||||||
|
set_window_title "Graphs" ;;
|
||||||
|
|
||||||
|
let gr = [|[|3; 5; 7|]; [|0|]; [|1; 7; 8|]; [|2; 6|]; [|0; 1; 3|]; [|6; 7|]; [|0; 1; 2|]; [|8|]; [|0; 7; 6|]; [||]; [||]; [|9|]|] ;;
|
||||||
|
|
||||||
|
improved_pretty_printing gr 1200 800 50 ;;
|
||||||
|
|
||||||
|
close_graph () ;;
|
||||||
Binary file not shown.
Binary file not shown.
|
|
@ -350,253 +350,4 @@ fancy_dfs gr coords map blank_color_map ;;
|
||||||
(* --------------------------------------------------------------------------------------------------------- *)
|
(* --------------------------------------------------------------------------------------------------------- *)
|
||||||
(* --------------------------------------------------------------------------------------------------------- *)
|
(* --------------------------------------------------------------------------------------------------------- *)
|
||||||
(* --------------------------------------------------------------------------------------------------------- *)
|
(* --------------------------------------------------------------------------------------------------------- *)
|
||||||
open Graphics ;;
|
(* compilation command : ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics trees.ml *)
|
||||||
|
|
||||||
type 'a tree = Empty | Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
|
|
||||||
|
|
||||||
(*
|
|
||||||
STRUCT : (digit, xcoord, ycoord)
|
|
||||||
*)
|
|
||||||
|
|
||||||
let rec pw x n = match n with
|
|
||||||
| 0 -> 1
|
|
||||||
| 1 -> x
|
|
||||||
| k when k mod 2 = 0 -> let res = pw x (n/2) in res*res
|
|
||||||
| k -> let res = pw x (n/2) in res*res*x ;;
|
|
||||||
|
|
||||||
let rec depth_of_tree t = match t with
|
|
||||||
| Leaf _ -> 1
|
|
||||||
| Node (_, g, d) -> 1 + max (depth_of_tree g) (depth_of_tree d)
|
|
||||||
| Empty -> 0;;
|
|
||||||
|
|
||||||
let fill_data te ystep sx sy r =
|
|
||||||
let depth = depth_of_tree te in
|
|
||||||
let res = Array.make (depth+1) [] in
|
|
||||||
let rec aux t cur_x cur_d spacing pcx pcy = match t with
|
|
||||||
| Node (x, g, d) -> begin
|
|
||||||
aux g (cur_x - spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
|
|
||||||
res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - 20 - ystep * cur_d)))::(res.(cur_d));
|
|
||||||
aux d (cur_x + spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
|
|
||||||
end
|
|
||||||
| Leaf x -> begin
|
|
||||||
res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - ystep * cur_d)))::(res.(cur_d));
|
|
||||||
end
|
|
||||||
| Empty -> ()
|
|
||||||
in aux te (sx/2) 0 (r/2 + r * ((pw 2 (depth-1)) - 1)) (-1) (-1); res ;;
|
|
||||||
|
|
||||||
let rec ln10 n = match n with
|
|
||||||
| k when k < 0 -> failwith "Are you sure about that ?"
|
|
||||||
| k when k < 10 -> 0
|
|
||||||
| k -> 1 + ln10 (k/10) ;;
|
|
||||||
|
|
||||||
let delta i j =
|
|
||||||
if i = j then 1 else 0 ;;
|
|
||||||
|
|
||||||
let draw_integer x0 y n0 r =
|
|
||||||
(* 7-seg display *)
|
|
||||||
let n = ref n0 in
|
|
||||||
let size = ln10 n0 in
|
|
||||||
let len = r/3 in
|
|
||||||
let offset = size*(len/2) in
|
|
||||||
for i = 0 to size do
|
|
||||||
let x = x0 - (-(1 - delta size 0)*8 - offset + i * (len+8)) in
|
|
||||||
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
|
|
||||||
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
|
|
||||||
|
|
||||||
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
|
|
||||||
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
|
|
||||||
|
|
||||||
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
|
|
||||||
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
|
|
||||||
|
|
||||||
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
|
|
||||||
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
|
|
||||||
|
|
||||||
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
|
|
||||||
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
|
|
||||||
|
|
||||||
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
|
|
||||||
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
|
|
||||||
|
|
||||||
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
|
|
||||||
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
|
|
||||||
|
|
||||||
n := !n/10;
|
|
||||||
done ;;
|
|
||||||
|
|
||||||
let rec draw_list l d r = match l with
|
|
||||||
| [] -> ()
|
|
||||||
| h::t -> begin
|
|
||||||
set_color (rgb 192 192 192);
|
|
||||||
fill_circle (fst (snd h)) (snd (snd h)) r;
|
|
||||||
set_color black;
|
|
||||||
draw_circle (fst (snd h)) (snd (snd h)) r;
|
|
||||||
moveto (fst (snd h)) (snd (snd h));
|
|
||||||
set_color (rgb 32 192 32);
|
|
||||||
draw_integer (fst (snd h)) (snd (snd h)) (fst (fst h)) r;
|
|
||||||
draw_list t d r
|
|
||||||
end;;
|
|
||||||
|
|
||||||
let connect l0 =
|
|
||||||
let rec aux l = match l with
|
|
||||||
| [] -> ()
|
|
||||||
| ((_, (xf, yf)), (x, y))::t ->
|
|
||||||
if xf >= 0 && yf >= 0 then begin
|
|
||||||
set_color (rgb 192 192 192);
|
|
||||||
draw_poly_line [|(xf, yf); (x, y)|];
|
|
||||||
aux t
|
|
||||||
end
|
|
||||||
in aux l0 ;;
|
|
||||||
|
|
||||||
let even_more_pretty_printing t r ystep skip =
|
|
||||||
|
|
||||||
let sx = Graphics.size_x () in
|
|
||||||
let sy = Graphics.size_y () in
|
|
||||||
|
|
||||||
let graphdata = fill_data t ystep sx sy (6*r/10) in
|
|
||||||
(* graphdata is a ((int * (int * int)) * (int * int)) list array *)
|
|
||||||
(* <==> ((value, (parent_x, parent_y)), (this_x, this_y)) *)
|
|
||||||
if skip = false then begin
|
|
||||||
set_color (rgb 192 192 192);
|
|
||||||
set_line_width 15 ;
|
|
||||||
for dpth = 1 to (Array.length graphdata -1) do
|
|
||||||
connect graphdata.(dpth-1);
|
|
||||||
done;
|
|
||||||
|
|
||||||
set_line_width 5 ;
|
|
||||||
for dpth = 0 to (Array.length graphdata -1) do
|
|
||||||
draw_list graphdata.(dpth) dpth r
|
|
||||||
done;
|
|
||||||
|
|
||||||
let halt = ref false in
|
|
||||||
while !halt = false do
|
|
||||||
Unix.sleepf 0.1 ;
|
|
||||||
Unix.sleepf 2.0 ;
|
|
||||||
halt := true;
|
|
||||||
done;
|
|
||||||
end;
|
|
||||||
graphdata ;;
|
|
||||||
|
|
||||||
|
|
||||||
let generate_full_tree d =
|
|
||||||
let rec aux n = match n with
|
|
||||||
| 0 -> Leaf (Random.int 1000)
|
|
||||||
| k -> begin
|
|
||||||
Node (Random.int 1000, aux (n-1), aux (n-1))
|
|
||||||
end
|
|
||||||
in aux d ;;
|
|
||||||
|
|
||||||
let generate_some_tree maxd nodechance leafchance =
|
|
||||||
let rec aux n = match n with
|
|
||||||
| 0 -> if (Random.int 101 < leafchance) then Leaf (Random.int 100) else Empty
|
|
||||||
| k -> begin
|
|
||||||
match Random.int 101 with
|
|
||||||
| k when k <= nodechance -> Node (Random.int 1000, aux (n-1), aux (n-1))
|
|
||||||
| k -> if (Random.int 101 < leafchance) then Leaf (Random.int 1000) else Empty
|
|
||||||
end
|
|
||||||
in aux maxd ;;
|
|
||||||
|
|
||||||
let rec nth l n = match l with
|
|
||||||
| [] -> failwith "Out of range"
|
|
||||||
| h::t when n = 0 -> h
|
|
||||||
| h::t -> nth t (n-1) ;;
|
|
||||||
|
|
||||||
let even_more_fancy_dfs_prefixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
|
|
||||||
let d = depth_of_tree t in
|
|
||||||
let count_per_depth = Array.make d 0 in
|
|
||||||
let rec aux tr dpth =
|
|
||||||
match tr with
|
|
||||||
| Empty -> ()
|
|
||||||
| Leaf _ -> begin
|
|
||||||
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - count_per_depth.(dpth) - 1) in
|
|
||||||
count_per_depth.(dpth) <- count_per_depth.(dpth) + 1;
|
|
||||||
set_color (rgb rfound gfound bfound);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
Unix.sleepf tts;
|
|
||||||
set_color (rgb rmark gmark bmark);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
end
|
|
||||||
| Node (_, g, d) -> begin
|
|
||||||
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - count_per_depth.(dpth) - 1) in
|
|
||||||
count_per_depth.(dpth) <- count_per_depth.(dpth) + 1;
|
|
||||||
set_color (rgb rfound gfound bfound);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
Unix.sleepf tts;
|
|
||||||
set_color (rgb rmark gmark bmark);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
|
|
||||||
aux g (dpth+1);
|
|
||||||
aux d (dpth+1);
|
|
||||||
end
|
|
||||||
in aux t 0 ;;
|
|
||||||
|
|
||||||
|
|
||||||
let even_more_fancy_dfs_infixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
|
|
||||||
let rec aux tr dpth os =
|
|
||||||
match tr with
|
|
||||||
| Empty -> ()
|
|
||||||
| Leaf _ -> begin
|
|
||||||
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
|
||||||
set_color (rgb rfound gfound bfound);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
Unix.sleepf tts;
|
|
||||||
set_color (rgb rmark gmark bmark);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
end
|
|
||||||
| Node (_, g, d) -> begin
|
|
||||||
aux g (dpth+1) (2*os);
|
|
||||||
|
|
||||||
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
|
||||||
set_color (rgb rfound gfound bfound);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
Unix.sleepf tts;
|
|
||||||
set_color (rgb rmark gmark bmark);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
|
|
||||||
aux d (dpth+1) (2*os + 1);
|
|
||||||
end
|
|
||||||
in aux t 0 0 ;;
|
|
||||||
|
|
||||||
|
|
||||||
let even_more_fancy_dfs_postfixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
|
|
||||||
let rec aux tr dpth os =
|
|
||||||
match tr with
|
|
||||||
| Empty -> ()
|
|
||||||
| Leaf _ -> begin
|
|
||||||
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
|
||||||
set_color (rgb rfound gfound bfound);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
Unix.sleepf tts;
|
|
||||||
set_color (rgb rmark gmark bmark);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
end
|
|
||||||
| Node (_, g, d) -> begin
|
|
||||||
aux g (dpth+1) (2*os);
|
|
||||||
aux d (dpth+1) (2*os + 1);
|
|
||||||
|
|
||||||
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
|
||||||
set_color (rgb rfound gfound bfound);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
Unix.sleepf tts;
|
|
||||||
set_color (rgb rmark gmark bmark);
|
|
||||||
draw_circle (fst (snd data)) (snd (snd data)) r;
|
|
||||||
end
|
|
||||||
in aux t 0 0 ;;
|
|
||||||
|
|
||||||
(* --------------------------------------| TESTS |-------------------------------------- *)
|
|
||||||
Random.self_init ;;
|
|
||||||
|
|
||||||
open_graph " 1800x800" ;;
|
|
||||||
set_window_title "Trees" ;;
|
|
||||||
|
|
||||||
let tt = generate_some_tree 4 100 75 ;;
|
|
||||||
|
|
||||||
let gdata = even_more_pretty_printing tt 40 150 false ;;
|
|
||||||
|
|
||||||
even_more_fancy_dfs_prefixe tt gdata 40 0.2 255 255 32 32 32 255 ;;
|
|
||||||
|
|
||||||
close_graph () ;;
|
|
||||||
|
|
||||||
(* compilation command : ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics pretty_printing.ml *)
|
|
||||||
print_int 0 ;;
|
|
||||||
print_char '\n' ;;
|
|
||||||
|
|
@ -0,0 +1,250 @@
|
||||||
|
open Graphics ;;
|
||||||
|
|
||||||
|
type 'a tree = Empty | Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
|
||||||
|
|
||||||
|
(*
|
||||||
|
STRUCT : (digit, xcoord, ycoord)
|
||||||
|
*)
|
||||||
|
|
||||||
|
let rec pw x n = match n with
|
||||||
|
| 0 -> 1
|
||||||
|
| 1 -> x
|
||||||
|
| k when k mod 2 = 0 -> let res = pw x (n/2) in res*res
|
||||||
|
| k -> let res = pw x (n/2) in res*res*x ;;
|
||||||
|
|
||||||
|
let rec depth_of_tree t = match t with
|
||||||
|
| Leaf _ -> 1
|
||||||
|
| Node (_, g, d) -> 1 + max (depth_of_tree g) (depth_of_tree d)
|
||||||
|
| Empty -> 0;;
|
||||||
|
|
||||||
|
let fill_data te ystep sx sy r =
|
||||||
|
let depth = depth_of_tree te in
|
||||||
|
let res = Array.make (depth+1) [] in
|
||||||
|
let rec aux t cur_x cur_d spacing pcx pcy = match t with
|
||||||
|
| Node (x, g, d) -> begin
|
||||||
|
aux g (cur_x - spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
|
||||||
|
res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - 20 - ystep * cur_d)))::(res.(cur_d));
|
||||||
|
aux d (cur_x + spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
|
||||||
|
end
|
||||||
|
| Leaf x -> begin
|
||||||
|
res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - ystep * cur_d)))::(res.(cur_d));
|
||||||
|
end
|
||||||
|
| Empty -> ()
|
||||||
|
in aux te (sx/2) 0 (r/2 + r * ((pw 2 (depth-1)) - 1)) (-1) (-1); res ;;
|
||||||
|
|
||||||
|
let rec ln10 n = match n with
|
||||||
|
| k when k < 0 -> failwith "Are you sure about that ?"
|
||||||
|
| k when k < 10 -> 0
|
||||||
|
| k -> 1 + ln10 (k/10) ;;
|
||||||
|
|
||||||
|
let delta i j =
|
||||||
|
if i = j then 1 else 0 ;;
|
||||||
|
|
||||||
|
let draw_integer x0 y n0 r =
|
||||||
|
(* 7-seg display *)
|
||||||
|
let n = ref n0 in
|
||||||
|
let size = ln10 n0 in
|
||||||
|
let len = r/3 in
|
||||||
|
let offset = size*(len/2) in
|
||||||
|
for i = 0 to size do
|
||||||
|
let x = x0 - (-(1 - delta size 0)*8 - offset + i * (len+8)) in
|
||||||
|
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
|
||||||
|
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
|
||||||
|
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
|
||||||
|
|
||||||
|
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
|
||||||
|
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
|
||||||
|
|
||||||
|
n := !n/10;
|
||||||
|
done ;;
|
||||||
|
|
||||||
|
let rec draw_list l d r = match l with
|
||||||
|
| [] -> ()
|
||||||
|
| h::t -> begin
|
||||||
|
set_color (rgb 192 192 192);
|
||||||
|
fill_circle (fst (snd h)) (snd (snd h)) r;
|
||||||
|
set_color black;
|
||||||
|
draw_circle (fst (snd h)) (snd (snd h)) r;
|
||||||
|
moveto (fst (snd h)) (snd (snd h));
|
||||||
|
set_color (rgb 32 192 32);
|
||||||
|
draw_integer (fst (snd h)) (snd (snd h)) (fst (fst h)) r;
|
||||||
|
draw_list t d r
|
||||||
|
end;;
|
||||||
|
|
||||||
|
let connect l0 =
|
||||||
|
let rec aux l = match l with
|
||||||
|
| [] -> ()
|
||||||
|
| ((_, (xf, yf)), (x, y))::t ->
|
||||||
|
if xf >= 0 && yf >= 0 then begin
|
||||||
|
set_color (rgb 192 192 192);
|
||||||
|
draw_poly_line [|(xf, yf); (x, y)|];
|
||||||
|
aux t
|
||||||
|
end
|
||||||
|
in aux l0 ;;
|
||||||
|
|
||||||
|
let even_more_pretty_printing t r ystep skip =
|
||||||
|
|
||||||
|
let sx = Graphics.size_x () in
|
||||||
|
let sy = Graphics.size_y () in
|
||||||
|
|
||||||
|
let graphdata = fill_data t ystep sx sy (6*r/10) in
|
||||||
|
(* graphdata is a ((int * (int * int)) * (int * int)) list array *)
|
||||||
|
(* <==> ((value, (parent_x, parent_y)), (this_x, this_y)) *)
|
||||||
|
if skip = false then begin
|
||||||
|
set_color (rgb 192 192 192);
|
||||||
|
set_line_width 15 ;
|
||||||
|
for dpth = 1 to (Array.length graphdata -1) do
|
||||||
|
connect graphdata.(dpth-1);
|
||||||
|
done;
|
||||||
|
|
||||||
|
set_line_width 5 ;
|
||||||
|
for dpth = 0 to (Array.length graphdata -1) do
|
||||||
|
draw_list graphdata.(dpth) dpth r
|
||||||
|
done;
|
||||||
|
|
||||||
|
let halt = ref false in
|
||||||
|
while !halt = false do
|
||||||
|
Unix.sleepf 0.1 ;
|
||||||
|
Unix.sleepf 2.0 ;
|
||||||
|
halt := true;
|
||||||
|
done;
|
||||||
|
end;
|
||||||
|
graphdata ;;
|
||||||
|
|
||||||
|
|
||||||
|
let generate_full_tree d =
|
||||||
|
let rec aux n = match n with
|
||||||
|
| 0 -> Leaf (Random.int 1000)
|
||||||
|
| k -> begin
|
||||||
|
Node (Random.int 1000, aux (n-1), aux (n-1))
|
||||||
|
end
|
||||||
|
in aux d ;;
|
||||||
|
|
||||||
|
let generate_some_tree maxd nodechance leafchance =
|
||||||
|
let rec aux n = match n with
|
||||||
|
| 0 -> if (Random.int 101 < leafchance) then Leaf (Random.int 100) else Empty
|
||||||
|
| k -> begin
|
||||||
|
match Random.int 101 with
|
||||||
|
| k when k <= nodechance -> Node (Random.int 1000, aux (n-1), aux (n-1))
|
||||||
|
| k -> if (Random.int 101 < leafchance) then Leaf (Random.int 1000) else Empty
|
||||||
|
end
|
||||||
|
in aux maxd ;;
|
||||||
|
|
||||||
|
let rec nth l n = match l with
|
||||||
|
| [] -> failwith "Out of range"
|
||||||
|
| h::t when n = 0 -> h
|
||||||
|
| h::t -> nth t (n-1) ;;
|
||||||
|
|
||||||
|
let even_more_fancy_dfs_prefixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
|
||||||
|
let d = depth_of_tree t in
|
||||||
|
let count_per_depth = Array.make d 0 in
|
||||||
|
let rec aux tr dpth =
|
||||||
|
match tr with
|
||||||
|
| Empty -> ()
|
||||||
|
| Leaf _ -> begin
|
||||||
|
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - count_per_depth.(dpth) - 1) in
|
||||||
|
count_per_depth.(dpth) <- count_per_depth.(dpth) + 1;
|
||||||
|
set_color (rgb rfound gfound bfound);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
Unix.sleepf tts;
|
||||||
|
set_color (rgb rmark gmark bmark);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
end
|
||||||
|
| Node (_, g, d) -> begin
|
||||||
|
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - count_per_depth.(dpth) - 1) in
|
||||||
|
count_per_depth.(dpth) <- count_per_depth.(dpth) + 1;
|
||||||
|
set_color (rgb rfound gfound bfound);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
Unix.sleepf tts;
|
||||||
|
set_color (rgb rmark gmark bmark);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
|
||||||
|
aux g (dpth+1);
|
||||||
|
aux d (dpth+1);
|
||||||
|
end
|
||||||
|
in aux t 0 ;;
|
||||||
|
|
||||||
|
|
||||||
|
let even_more_fancy_dfs_infixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
|
||||||
|
let rec aux tr dpth os =
|
||||||
|
match tr with
|
||||||
|
| Empty -> ()
|
||||||
|
| Leaf _ -> begin
|
||||||
|
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
||||||
|
set_color (rgb rfound gfound bfound);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
Unix.sleepf tts;
|
||||||
|
set_color (rgb rmark gmark bmark);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
end
|
||||||
|
| Node (_, g, d) -> begin
|
||||||
|
aux g (dpth+1) (2*os);
|
||||||
|
|
||||||
|
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
||||||
|
set_color (rgb rfound gfound bfound);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
Unix.sleepf tts;
|
||||||
|
set_color (rgb rmark gmark bmark);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
|
||||||
|
aux d (dpth+1) (2*os + 1);
|
||||||
|
end
|
||||||
|
in aux t 0 0 ;;
|
||||||
|
|
||||||
|
|
||||||
|
let even_more_fancy_dfs_postfixe t graphdata r tts rfound gfound bfound rmark gmark bmark =
|
||||||
|
let rec aux tr dpth os =
|
||||||
|
match tr with
|
||||||
|
| Empty -> ()
|
||||||
|
| Leaf _ -> begin
|
||||||
|
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
||||||
|
set_color (rgb rfound gfound bfound);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
Unix.sleepf tts;
|
||||||
|
set_color (rgb rmark gmark bmark);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
end
|
||||||
|
| Node (_, g, d) -> begin
|
||||||
|
aux g (dpth+1) (2*os);
|
||||||
|
aux d (dpth+1) (2*os + 1);
|
||||||
|
|
||||||
|
let data = nth graphdata.(dpth) (List.length graphdata.(dpth) - os - 1) in
|
||||||
|
set_color (rgb rfound gfound bfound);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
Unix.sleepf tts;
|
||||||
|
set_color (rgb rmark gmark bmark);
|
||||||
|
draw_circle (fst (snd data)) (snd (snd data)) r;
|
||||||
|
end
|
||||||
|
in aux t 0 0 ;;
|
||||||
|
|
||||||
|
(* --------------------------------------| TESTS |-------------------------------------- *)
|
||||||
|
Random.self_init ;;
|
||||||
|
|
||||||
|
open_graph " 1800x800" ;;
|
||||||
|
set_window_title "Trees" ;;
|
||||||
|
|
||||||
|
let tt = generate_some_tree 4 100 75 ;;
|
||||||
|
|
||||||
|
let gdata = even_more_pretty_printing tt 40 150 false ;;
|
||||||
|
|
||||||
|
even_more_fancy_dfs_prefixe tt gdata 40 0.2 255 255 32 32 32 255 ;;
|
||||||
|
|
||||||
|
close_graph () ;;
|
||||||
|
|
||||||
|
(* compilation command : ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics trees.ml *)
|
||||||
|
print_int 0 ;;
|
||||||
|
print_char '\n' ;;
|
||||||
Loading…
Reference in New Issue